[英]Interactive plotting with R raster: values on mouseover
我想在 R 中做一个小程序,用于交互式可视化和修改一些栅格数据集,被视为彩色图像。 用户应该打开一个文件(从终端可以),绘制它,用鼠标点击选择要编辑的点,然后插入新值。
到目前为止,我轻松实现了这一目标。 我使用raster
包中的plot()
函数来可视化绘图,然后click()
选择点并通过终端编辑它们的值。
我想添加在鼠标悬停时显示值的功能。 我已经搜索了如何执行此操作的方法,但是对于标准 R 包,这似乎是不可能的。 这样对吗?
在这种情况下,我可能会被迫使用外部软件包,例如 gGobi、iPlots、Shiny 或 Plotly。 但是,我更喜欢KISS并仅使用“标准”图形工具,例如 raster plot()
函数或网格图形对象(例如来自rasterVis
)。
我知道 Shiny 应用程序可能是最好的,但它需要大量时间来学习和完善。
随着leaflet
, mapview
和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")
把它放在一个闪亮的应用程序中,你会得到:
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)
以下示例说明了将栅格转换为简单要素/形状文件的想法。 它不适用于大文件,但标签可以单独设计,数据是可编辑的,并且可以轻松地显示在表格中。
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)
我给你一个简单的例子,说明如何在没有外部 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)
要退出,请在定位器处于活动状态时按 Esc。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.