Interactive plotting with R raster: values on mouseover

后端 未结 2 1757
梦毁少年i
梦毁少年i 2021-02-01 19:11

I\'d like to do a small program in R for interactive visualization and modification of some raster datasets, seen as colored images. The user should open a file (from the termin

相关标签:
2条回答
  • 2021-02-01 19:52

    With leaflet, mapview, and leafem you can achieve something like this:

    library(raster)
    library(mapview)
    library(leaflet)
    library(leafem)
    
    f <- system.file("external/test.grd", package="raster")
    r <- raster(f)
    
    leaflet() %>% 
      addRasterImage(r, layerId = "values") %>% 
      addMouseCoordinates() %>%
      addImageQuery(r, type="mousemove", layerId = "values")
    

    Putting that in a shiny app you get:

    library(raster)
    library(mapview)
    library(leaflet)
    library(shiny)
    
    f <- system.file("external/test.grd", package="raster")
    r <- raster(f)
    
    ui <- fluidPage(
      leafletOutput("map")
    )
    
    server <- function(input, output){
      output$map <- renderLeaflet({
        leaflet() %>% 
          addRasterImage(r, layerId = "values") %>% 
          addMouseCoordinates() %>%
          addImageQuery(r, type="mousemove", layerId = "values")
      })
    }
    
    shinyApp(ui, server)
    

    The following example illustrates the idea of converting the raster to Simple Features / Shapefiles. Its not realy useable for big Files, but the labels can be designed individually, the data is editable and can easily be shown in a Table.

    library(raster)
    library(leaflet)
    library(shiny)
    library(sf)
    library(DT)
    library(dplyr)
    
    ## DATA
    f <- system.file("external/test.grd", package="raster")
    r <- raster(f)
    r1 = aggregate(r, 30)
    
    sp = st_as_sf(rasterToPolygons(r1))
    cn = st_coordinates(st_transform(st_centroid(sp),4326))
    sp = st_transform(sp, 4326)
    sp = cbind(sp, cn)
    sp$id <- 1:nrow(sp)
    colnames(sp)[1] <- "value"
    
    
    ## UI
    ui <- fluidPage(
      leafletOutput("map"),
      uiOutput("newValueUI"),
      textInput("newVal", label = "Enter new value"),
      actionButton("enter", "Enter new value"),
      hr(),
      dataTableOutput("table")
    )
    
    
    ## SERVER
    server <- function(input, output){
    
      ## Reactive Shapefile
      sp_react <- reactiveValues(sp = sp)
      
      ## Leaflet Map
      output$map <- renderLeaflet({
        pal= colorNumeric(topo.colors(25), sp_react$sp$value)
        leaflet() %>% 
          addPolygons(data = sp_react$sp, label= paste(
            "Lng: ", as.character(round(sp_react$sp$X,4)),
            "Lat: ", as.character(round(sp_react$sp$Y,4)),
            "Val: ", as.character(round(sp_react$sp$value,4))),
            color = ~pal(sp_react$sp$value), 
            layerId = sp_react$sp$id
          )
      })
      
      ## Observe Map Clicks
      observeEvent(input$map_shape_click, {
        
        click_id = input$map_shape_click$id
        
        click_grid <- sp_react$sp[sp_react$sp$id == click_id,]
    
      })
      
      ## Observe Action Button
      observeEvent(input$enter, {
        click_id <- input$map_shape_click$id
        sp_react$sp[sp_react$sp$id == click_id,]$value <- as.numeric(input$newVal)
      })
    
      ## Data Table
      output$table <- DT::renderDataTable({
        sp_react$sp %>% st_set_geometry(NULL) %>% 
          dplyr::select(id,X,Y,value)
      })
      proxy = dataTableProxy('table')
      
      ## Table Proxy
      observeEvent(input$map_shape_click$id, {
        req(input$map_shape_click$id)
        proxy %>% selectRows(as.numeric(input$map_shape_click$id))
      })
    }
    
    shinyApp(ui, server)
    
    0 讨论(0)
  • 2021-02-01 19:59

    I give you a simple example of how to do it in R without external Java libraries, if you want Javan's features you can adapt it, but each java graphics library is different and I have never done anything similar.

    set.seed(123)
    mydata <- data.frame(x = runif(10), y = runif(10))
    
    edit_plot <- function(data) {
      plot(data)
    
      sel <- locator(n = 1)
      if(is.null(sel)) return(TRUE)
      dd <- (data$x - sel$x)^2 + (data$y - sel$y)^2
    
      data[which.min(dd),] <- edit(data[which.min(dd),])
      r <- edit_plot(data)
      if(r) return(TRUE)
    }
    edit_plot(mydata)
    

    To exit press Esc when locator is active.

    0 讨论(0)
提交回复
热议问题