问题
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.
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.
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?
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
).
I understand a Shiny app would probably be best, but it takes lots of time to learn and perfect.
回答1:
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)
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)
回答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.
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.
来源:https://stackoverflow.com/questions/30704487/interactive-plotting-with-r-raster-values-on-mouseover