使用R光栅的交互式打印：鼠标悬停上的值

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

到目前为止，我很容易做到这一点。我使用

graster

软件包中的

plot（）

功能来可视化绘图，然后

单击（）

选择点并通过终端编辑其值

我想添加鼠标悬停时显示值的功能。我一直在寻找如何做到这一点的方法，但在标准的R软件包中似乎不可能做到这一点。这是正确的吗

在这种情况下，我可能会被迫使用外部软件包，如gGobi、iPlots、shinny或Plotly。但是，我非常喜欢并且只使用“标准”图形工具，例如光栅

plot（）

函数，或者网格图形对象（例如，来自

rasterVis

）

---

我知道一个闪亮的应用程序可能是最好的，但它需要大量的时间来学习和完善。

我给你一个简单的例子，告诉你如何在没有外部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)

set.seed（123）
mydata使用
传单
、
地图视图
和
leafem
可以实现以下功能：

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

库（光栅）
图书馆（地图视图）
图书馆（单张）
图书馆（leafem）
f%
addMouseCoordinates（）%>%
addImageQuery（r，type=“mousemove”，layerId=“values”）


将其放入一个闪亮的应用程序中，您将获得：

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)

库（光栅）
图书馆（地图视图）
图书馆（单张）
图书馆（闪亮）
f也许这对你有用@OscarPerpiñán:谢谢，但我已经研究了rasterVis的交互功能（这就是我在问题中提到它的原因），就我所见，
identifRaster（）
与我已经使用的
raster:：click
相比，没有太多附加功能。特别是，没有办法在鼠标上方显示数据，这正是我要做的。如果我错了，请纠正我，我很乐意使用这样一个好的解决方案（我喜欢rasterVis，并且经常使用）。你是对的<代码>识别光栅
和
单击
大致相同（分别适用于晶格图形和基础图形）。据我所知，R生产的图形设备不可能实现您的尝试。恐怕您需要一些javascript代码。我没有关于将javascript与光栅数据相结合的解决方案的信息。您可以尝试使用
gridSVG
包来构建自己的解决方案。可能（使用点数据）对您有用：。此外，创建了到javascript库的R绑定，但据我所知，这些绑定都不能处理光栅数据。我看到优秀的
ggiraph
的github版本现在包含了一个函数
geom\u sf\u interactive
，它与
sf
包一起工作。如果我正确理解了你的需求，我认为这对你来说是可行的，可以让你在没有光泽的情况下进行互动。我知道这并不能完全回答我的问题，但无论如何我都会接受这个答案。我相信在今天的R软件包中，人们真的会想到在传单/Shining中这样做，而不是使用base
raster
或类似工具。我不知道
addRasterImage
是否支持鼠标事件，我在手册中没有找到任何内容。因此，一个想法是创建一个与光栅分辨率相同的网格，并基于该形状文件执行鼠标事件。要么只使用shapefile执行所有操作，要么只获取单击网格的中心点，并过滤该单元格的光栅，以便在标签中包含值/坐标。是的，我也会这样做。但是使用大型形状文件会变得笨拙。我认为
mapview:：addImageQuery
可以满足您的需要。目前无法进行任何编辑。尽管我们正在mapedit中对此进行研究。也许我们还可以提供一些光栅数据。我会记住这一点。
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)