简体   繁体   English

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

[英]Interactive plotting with R raster: values on mouseover

I'd like to do a small program in R for interactive visualization and modification of some raster datasets, seen as colored images.我想在 R 中做一个小程序,用于交互式可视化和修改一些栅格数据集,被视为彩色图像。 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.用户应该打开一个文件(从终端可以),绘制它,用鼠标点击选择要编辑的点,然后插入新值。

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.我使用raster包中的plot()函数来可视化绘图,然后click()选择点并通过终端编辑它们的值。

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.我已经搜索了如何执行此操作的方法,但是对于标准 R 包,这似乎是不可能的。 Is this correct?这样对吗?

In this case, I may be forced to use external packages, such as gGobi, iPlots, Shiny or Plotly.在这种情况下,我可能会被迫使用外部软件包,例如 gGobi、iPlots、Shiny 或 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 (eg from rasterVis ).但是,我更喜欢KISS并仅使用“标准”图形工具,例如 raster plot()函数或网格图形对象(例如来自rasterVis )。

I understand a Shiny app would probably be best, but it takes lots of time to learn and perfect.我知道 Shiny 应用程序可能是最好的,但它需要大量时间来学习和完善。

With leaflet , mapview , and leafem you can achieve something like this:随着leafletmapviewleafem就可以实现这样的事情:

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)

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。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM