使用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.

我想在R中做一个小程序，用于交互式可视化和修改某些栅格数据集，看作彩色图像。用户应该打开一个文件（从终端可以），绘制它，用鼠标点击选择要编辑的点，然后插入新值。

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.

到目前为止，我很容易实现。我使用光栅包中的plot（）函数来显示图，然后单击（）以选择点并通过终端编辑它们的值。

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?

我想添加在鼠标上显示值的功能。我已经搜索了如何做到这一点的方法，但标准的R包看起来似乎不可能。它是否正确？

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).

在这种情况下，我可能会*使用外部软件包，例如gGobi，iPlots，Shiny或Plotly。但是，我更喜欢KISS并且只使用“标准”图形工具，例如栅格图（）函数或格子图形对象（例如来自rasterVis）。

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

我理解一个Shiny应用可能是最好的，但它需要很多时间来学习和完善。

2 个解决方案

#1

With leaflet and mapview you can achieve something like this:

使用传单和mapview，您可以实现以下目标：

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)

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.

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

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)

#2

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.

我给你一个简单的例子，说明如何在没有外部Java库的情况下在R中执行它，如果你想要Javan的功能你可以适应它，但是每个java图形库都是不同的，我从来没有做过类似的事情。

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.

要在定位器处于活动状态时退出按Esc键。

#1