R在小册子地图中绘制匹配所选多边形

我建立了一个传单地图,我想绘制我点击的多边形.我尝试使用"input $ mymap_shape_click"和"event $ id"但它不起作用.请你帮助我好吗 ？这是一个可重复的例子.

这是我的ui:

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",,), 

                # 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("Commune : ",
                shape_new_table2@data$Commune,
                br(),
                "Population : ",
                shape_new_table2@data$Population,
                br(), br(),
                "moins de 20 ans : ",
                shape_new_table2@data$M_20, " - ", shape_new_table2@data$P_20, " %",
                br(),
                "20 - 39 ans : ",
                shape_new_table2@data$T_20_39, " - ", shape_new_table2@data$P_20_39, " %",
                br(),
                "40 - 59 ans : ",
                shape_new_table2@data$T_40_59, " - ", shape_new_table2@data$P_40_59, " %",
                br(),
                "60 ans et plus : ",
                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:

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:https://www.dropbox.com/s/mdb6m8hej01ykwp/Ilots_communaux_simples_R.zip？ dl = 0

这里的表格:https://www.dropbox.com/s/e3twfm8mwdl9nrg/T_1_2.csv？dl = 0

正如您将看到的,我需要获取我点击的多边形的"PC"值才能正确绘制,但我不知道该怎么做.

非常感谢您的帮助.

你的例子太大/太复杂了,我不喜欢下载外部数据/形状,所以我把它简化为这里的例子.

在我看来,当你点击一个形状时,你想要绘制一些有关该形状的信息.

在我的例子中,我reactiveValues用来存储在创建它们的函数之外可访问的对象,但也是反应性的.(见反应值)

因此,当input$mymap_shape_click'观察'时,我正在创建一个data.frame并将其存储在一个reactiveValues()对象中.

然后,我可以使用任何output$...我想要的对这个reactiveValues对象发生变化的反应.在这个例子中,我只是输出一个被点击的形状的lat/lon表.

并且为了访问id单击的形状,您需要id在地图上绘制的基础数据中指定一个值.

查看print语句的输出以查看单击形状时发生的情况.

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)