使用R栅格进行交互式绘图:鼠标悬停时的值

问题描述:

我想在R中做一个小程序,用于交互式可视化和修改某些栅格数据集(可视为彩色图像). 用户应该打开一个文件(从终端上可以),将其绘制出来,单击鼠标以选择要编辑的点,然后插入新值.

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 terminal it's OK), plot it, select the points to edit with mouse clicks, and insert the new values.

到目前为止,我轻松实现了这一目标.我使用raster包中的plot()函数可视化绘图,然后使用click()选择点并通过终端编辑它们的值.

So far I achieved that easily. I use the plot() function from the raster package to visualize the plot, then click() to select the points and edit their value via the terminal.

我想添加在鼠标悬停时显示值的功能.我已经搜索了如何执行此操作的方法,但是使用标准R包似乎无法做到这一点.这是正确的吗?

I'd like to add the ability to show the values on mouse over. I've searched for ways on how to do this, but this doesn't seem to be possible with the standard R packages. Is this correct?

在这种情况下,我可能*使用外部软件包,例如gGobi,iPlots,Shiny或Plotly.但是,我非常希望 KISS 并仅使用标准"图形工具,例如光栅plot()函数或网格图形对象(例如,来自rasterVis的网格).

In this case, I may be forced to use external packages, such as gGobi, iPlots, Shiny or Plotly. However, I'd greatly prefer to KISS and use only "standard" graphics tools, such as the raster plot() function or maybe trellis graphics objects (e.g. from rasterVis).

我知道最好使用Shiny应用程序,但是学习和完善它需要花费很多时间.

I understand a Shiny app would probably be best, but it takes lots of time to learn and perfect.

使用leafletmapview,您可以实现以下目标:

With leaflet and mapview you can achieve something like this:

library(raster)
library(mapview)
library(leaflet)

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)


以下示例说明了将栅格转换为简单要素/Shapefile的想法.它不适用于大文件,但标签可以单独设计,数据可以可编辑,并且可以轻松地显示在表格中.


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)