我建立了一张传单地图，我想绘制我点击的多边形.我尝试使用input$mymap_shape_click"和event$id"，但它不起作用.请你帮助我好吗 ?这是一个可重现的例子.
I built a leaflet map and I would like to plot the polygon I have clicked on. I tried to use "input$mymap_shape_click" and "event$id" but it does not work. Could you please help me ? This is a reproducible example.
这是我的用户界面:
library(shiny) library(shinydashboard) library(leaflet) library(plotly) library(shinyBS) ui <- dashboardPage( dashboardHeader( title = "TEST", titleWidth = 500), # end of dashboardHeader dashboardSidebar(## Sidebar content sidebarMenu( id = "Menu1", menuItem("Map", tabName = "map", icon = icon("globe")) ) # end of sidebarMenu ), # end of dashboardSidebar # Body content dashboardBody( tabItem(tabName = "map", bsModal("modal", "Map datas", "btn_modal", size = "large", fluidRow( column(12, dataTableOutput("map_table")) ) # end of fluidRow( ), # end of bsModal( fluidRow( div(class="outer", tags$head(includeCSS("D:/R/TEST_RP_2014/www/styles.css")), # Map leafletOutput("mymap",width="100%",height="945px"), # Controls absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE, draggable = FALSE, top = "auto", left = "auto", right = 10, bottom = 200, width = 440, height = 500, h2("TEST"), plotlyOutput("graphe_df", height = 300), br(), fluidRow( column(3,actionButton("reset_button", "", width = 80, icon = icon("home"), style = "color : #FFF ; background-color : #333333 ; border-color : #FFF")), column(3,actionButton("btn_modal", "", width = 80, icon("table"), icon("globe"), class = "btn_block", style = "color : #FFF ; background-color : #333333 ; border-color : #FFF")), column(3,downloadButton("downloadData_map", "Export", class = "butt"), tags$head(tags$style(".butt{background-color : #333333;} .butt{border-color: #FFF;} .butt{color: #FFF;}"))), column(3,actionButton("export_map", "", width = 80, icon("arrow-down"), icon("globe"), style = "color : #FFF ; background-color : #333333 ; border-color : #FFF")) ) # end of fluidRow( ) # end of absolutePanel ) # end of div(class="outer", ) # end of fluidRow ) # end of tabItem ) # end of dashboardBody ) # end of dashboardPage还有我的服务器:
shinyServer(function(input, output, session) { ################################## OUTPUT BASE MAP ####################################### output$mymap <- renderLeaflet({ leaflet() %>% setView(lng = 166, lat = -21, zoom = 8) %>% # Basemap addProviderTiles("Esri.WorldImagery", group = "Esri World Imagery") }) # end of renderLeaflet # Joint shapefile and table T_1_1 shape_new_table <- append_data(Shape_Com_simples, T_1_2, key.shp = "CODE_COM", key.data="PC") # Joint hapefile and Centroide shape_new_table2 <- append_data(shape_new_table, Centroides, key.shp = "CODE_COM", key.data="PC") # Checking joint str(shape_new_table2@data) # Col Pal Palette_col <- colorBin(palette = c("#FFF4BF", "#E3CB7D", "#DBA54F", "#B37A00", "#8C6000"), bins = c(28, 30, 32, 34, 36, 38), domain=shape_new_table2@data$P_20, n = 5) # Tooltips infob <- paste0("<span style='color: #B37A00; font-size: 10pt'><strong>Commune : </strong></span>", shape_new_table2@data$Commune, br(), "<span style='color: #B37A00; font-size: 10pt'><strong>Population : </strong></span>", shape_new_table2@data$Population, br(), br(), "<span style='color: #B37A00; font-size: 10pt'><strong>moins de 20 ans : </strong></span>", shape_new_table2@data$M_20, " - ", shape_new_table2@data$P_20, " %", br(), "<span style='color: #B37A00; font-size: 10pt'><strong>20 - 39 ans : </strong></span>", shape_new_table2@data$T_20_39, " - ", shape_new_table2@data$P_20_39, " %", br(), "<span style='color: #B37A00; font-size: 10pt'><strong>40 - 59 ans : </strong></span>", shape_new_table2@data$T_40_59, " - ", shape_new_table2@data$P_40_59, " %", br(), "<span style='color: #B37A00; font-size: 10pt'><strong>60 ans et plus : </strong></span>", shape_new_table2@data$T_60, " - ", shape_new_table2@data$P_60, " %", br()) ################################### MAP UPDATE ####################################### leafletProxy("mymap") %>% # Displaying COMMUNE choropleth layer addPolygons(data = shape_new_table2, stroke=TRUE, weight = 0.5, fillOpacity = 1, color = "#666666", opacity = 1, fillColor= ~Palette_col(shape_new_table2@data$P_20), popup=infob, group = "Rate") %>% # Proportional symbols addCircles(data = shape_new_table2, lng = ~POINT_X, lat = ~POINT_Y, stroke = TRUE, weight = 0.5, color = "#C71F1F", fillOpacity = 0.6, radius = ~sqrt(shape_new_table2@data$M_20) * 150, popup=infob, group = "Number") %>% # Displaying COMMUNE LIMITS layer addPolygons(data = shape_new_table2, stroke=TRUE, weight = 0.5, color = "#666666", opacity = 1, fillOpacity = 0, popup=infob, group = "Cities limits") %>% # Layers controls addLayersControl(baseGroups = c("Esri World Imagery","OpenStreetMap.Mapnik","Stamen Watercolor"), overlayGroups = c("Rate", "Number", "Cities limits"), position = "bottomleft", options = layersControlOptions(collapsed = TRUE)) %>% # Legend addLegend(position = "bottomright", title = paste("Sur 100 personnes en 2014", br(), "combien ont moins de 20 ans"), opacity = 1, colors = c("#FFF4BF", "#E3CB7D", "#DBA54F", "#B37A00", "#8C6000"), labels = c("28 - 29%","30 - 31%", "32 - 33%", "34 - 35%", "36 - 38%")) # Back to initial zoom observe({ input$reset_button leafletProxy("mymap") %>% setView(lng = 166, lat = -21, zoom = 8) }) # Access to map datas observe({ input$btn_modal output$map_table <- renderDataTable({get(paste0("T_","1_2"))}, options = list(lengthMenu = c(10, 20, 33), pageLength = 20)) }) # Mouse event observeEvent(input$mymap_shape_click, { event <- input$mymap_shape_click if(is.null(event)) return() if(!is.null(event)) { leafletProxy("mymap") %>% setView(lng = event$lng, lat = event$lat, zoom = 11) # Create pie chart tmp <- T_1_2 Graphe_dfFL3 <- data.frame( Ages = c("less than 20 yrs old", "20 - 39 yrs old", "40 - 59 yrs old", "More than 60 yrs old"), Number = c(tmp [1,4], tmp [1,6], tmp [1,8], tmp [1,10]), # f. de c Rate = c(tmp [1,5], tmp [1,7], tmp [1,9], tmp [1,11]) # f. de c ) # f. de data.frame Graphe_dfFL3 output$graphe_df <- renderPlotly({ colors <- c('rgb(211,94,96)','rgb(128,133,133)','rgb(144,103,167)','rgb(171,104,87)') plot_ly(Graphe_dfFL3, labels = ~Ages, values = ~Rate, type = 'pie', textposition = 'inside', textinfo = 'label+percent', insidetextfont = list(color = '#FFFFFF'), hoverinfo = 'text', text = ~paste(Ages, ":",Number, "people"), marker = list(colors = colors, line = list(color = '#FFFFFF', width = 1)), showlegend = FALSE) %>% layout(title = NULL, xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE), yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE)) }) # end of output$graphe_df } # end of if }) # end of observeEvent }) # end of shinyServer还有styles.CSS:
And the styles.CSS :
div.outer { position: fixed; top: 50px; left: 0; right: 0; bottom: 0; overflow: hidden; padding: 0; } #controls { /* Appearance */ background-color: transparent; padding: 0 20px 20px 20px; cursor: move; /* Fade out while not hovering */ opacity: 0; zoom: 1.0; transition: opacity 500ms 1s; } #controls:hover { /* Fade in while hovering */ opacity: 1; transition-delay: 0; }您可以在此处找到 shapefile:www.dropbox/s/mdb6m8hej01ykwp/Ilots_communaux_simples_R.zip?dl=0
You can find the shapefile here : www.dropbox/s/mdb6m8hej01ykwp/Ilots_communaux_simples_R.zip?dl=0
还有这里的表格:www.dropbox/s/e3twfm8mwdl9nrg/T_1_2.csv?dl=0
如您所见，我需要获取单击的多边形的PC"值才能正确绘制，但我不知道该怎么做.
As you'll see, I need to get the "PC" value of the polygon I clicked on to plot correctly but I don't know how to do that.
非常感谢您的帮助.
推荐答案您的示例太大/太复杂，我不喜欢下载外部数据/形状，因此我将其简化为此处的示例.
Your example is too big/complex and I don't fancy downloading external data/shapes, so I've simplified it into the example here.
在我看来，当您单击一个形状时，您想要绘制有关该形状的一些信息.
It seems to me that when you click on a shape, you then want to plot some information about that shape.
在我的示例中，我使用 reactiveValues 来存储可在创建它们的函数之外访问的对象，但也是反应式的.(参见反应性值)
In my example I'm using reactiveValues to store objects that are accessible outside of the function that creates them, but are also reactive. (see reactive values )
因此，当 input$mymap_shape_click 被观察"时，我将创建一个 data.frame 并将其存储在 reactiveValues()对象.
Therefore, when the input$mymap_shape_click is 'observed', I'm creating a data.frame and storing it in a reactiveValues() object.
然后我可以使用任何我想要的 output$... 来响应这个 reactiveValues 对象的变化.在这个例子中，我只是简单地输出一个被点击的形状的纬度/经度表.
I can then use any output$... I want that will react to this reactiveValues object changing. In this example I'm simply outputting a table of the lat/lon of the shape that's clicked.
为了访问所点击形状的 id，您需要在地图上绘制的基础数据中指定一个 id 值.
And in order to access the id of the shape clicked, you need to specify an id value in the underlying data that is plotted on the map.
查看 print 语句的输出，了解单击形状时发生的情况.
See the outputs of the print statements to see what's going on when you click the shapes.
library(shiny) library(leaflet) ui <- fluidPage( leafletOutput(outputId = "mymap"), tableOutput(outputId = "myDf_output") ) server <- function(input, output){ ## use reactive values to store the data you generate from observing the shape click rv <- reactiveValues() rv$myDf <- NULL cities <- read.csv(textConnection(" City,Lat,Long,Pop Boston,42.3601,-71.0589,645966 Hartford,41.7627,-72.6743,125017 New York City,40.7127,-74.0059,8406000 Philadelphia,39.9500,-75.1667,1553000 Pittsburgh,40.4397,-79.9764,305841 Providence,41.8236,-71.4222,177994 ")) cities$id <- 1:nrow(cities) ## I'm adding an 'id' value to each shape output$mymap <- renderLeaflet({ leaflet(cities) %>% addTiles() %>% addCircles(lng = ~Long, lat = ~Lat, weight = 1, radius = ~sqrt(Pop) * 30, popup = ~City, layerId = ~id) }) observeEvent(input$mymap_shape_click, { print("shape clicked") event <- input$mymap_shape_click print(str(event)) ## update the reactive value with your data of interest rv$myDf <- data.frame(lat = event$lat, lon = event$lng) print(rv$myDf) }) ## you can now 'output' your generated data however you want output$myDf_output <- renderTable({ rv$myDf }) } shinyApp(ui, server)更多推荐
R在传单地图中绘制匹配选定多边形
发布评论