【发布时间】：2020-11-28 12:04:24
【问题描述】：
我正在尝试通过单击来自两个不同地图的多边形来将数据加载到两个不同的图上。
我希望用户能够通过单击第一张地图的一个多边形来加载第一个选项卡中的绘图。如果他单击第二个选项卡中的一个多边形，也会发生同样的事情。
我的尝试：
###Reprodutible code:
library(shiny)
library(shinydashboard)
library(tidyr)
library(dplyr)
library(rgdal)
library(tidyverse)
library(leaflet)
#Creation of dummy polygon 1:
Sr1 = Polygon(cbind(c(2,4,4,1,2),c(2,3,5,4,2)))
Sr2 = Polygon(cbind(c(5,4,2,5),c(2,3,2,2)))
Srs1 = Polygons(list(Sr1), "s1")
Srs2 = Polygons(list(Sr2), "s2")
SpP = SpatialPolygons(list(Srs1,Srs2), 1:2)
SpPDF <- SpatialPolygonsDataFrame(SpP, data = data.frame(x=1:length(SpP)), match.ID = F)
Extent = extent(SpPDF)
SpPDF$shapefile_ID<-1:nrow(SpPDF)
#Creation of dummy polygon 2:
SrA = Polygon(cbind(c(12,24,25,45,65),c(45,65,41,22,33)))
SrB = Polygon(cbind(c(55,45,25,55),c(25,35,25,25)))
SrsA = Polygons(list(SrA), "sA")
SrsB = Polygons(list(SrB), "sB")
SpP2 = SpatialPolygons(list(SrsA,SrsB), 1:2)
SpPDF2 <- SpatialPolygonsDataFrame(SpP2, data = data.frame(x=1:length(SpP2)), match.ID = F)
Extent = extent(SpPDF2)
SpPDF2$shapefile_ID<-1:nrow(SpPDF2)
#Creation of dummy dataframe 1:
shapefile_ID <- c('1','2')
x<- c(10, 20)
y <- c(145, 412)
test1 <- data.frame(shapefile_ID, x,y)
#Creation of dummy dataframe 1:
shapefile_ID <- c('1','2')
x2<- c(4, 8)
y2 <- c(12, 154)
test2 <- data.frame(shapefile_ID, x2,y2)
ui <- dashboardPage(dashboardHeader(title="test"),dashboardSidebar(sidebarMenu(menuItem("test", tabname="test"))),dashboardBody(
fluidRow(
box(title = "Test",
width = 12,
status = "info",
solidHeader = T,
collapsible = F,
tabBox(id = "window1", width = 12,
tabPanel("tab1", fluidRow(
column(width = 5, leafletOutput(outputId = "test_map", height = 500)),
column(width = 7, plotOutput(outputId = "plot1", height = 500)
),
)),
tabPanel("tab2", fluidRow(
column(width = 5, leafletOutput(outputId = "test_map2", height = 500)),
column(width = 7, plotOutput(outputId = "plot2", height = 500),
))))))))
server <- function(input, output, session) {
### --------------------------------
rv <- reactiveVal()
output$test_map<-renderLeaflet(
leaflet() %>%
setView(1.23, 5.42, zoom = 4) %>%
addTiles() %>%
addPolygons(data=SpPDF,
fillColor = "blue",
weight = 2,
opacity = 1,
color = "blue",
dashArray = "3",
fillOpacity = 0.3,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE,
layerId = ~shapefile_ID)
))
observeEvent(input$test_map_shape_click, {
rv(input$test_map_shape_click$id)
})
output$test_map2<-renderLeaflet(
leaflet() %>%
setView(5.33, 45.6, zoom = 2) %>%
addTiles() %>%
addPolygons(data=SpPDF2,
fillColor = "blue",
weight = 2,
opacity = 1,
color = "blue",
dashArray = "3",
fillOpacity = 0.3,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE,
layerId = ~shapefile_ID)))
observeEvent(input$test_map2_shape_click, {
rv(input$test_map2_shape_click$id)
})
output$plot1 <- renderPlot({
if (is.null(rv())) return (NULL)
test1 %>%
filter(shapefile_ID == rv()) %>%
plot(x = x, y = y)
})
output$plot2 <- renderPlot({
if (is.null(rv())) return (NULL)
test2 %>%
filter(shapefile_ID == rv()) %>%
plot(x = x, y = y)
})
}
shinyApp(ui, server)
有人可以帮我解决这个问题吗？
【问题讨论】：