我制作了一张传单地图，我想绘制我点击过的多边形。我尝试使用“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",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：
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”值才能正确绘制，但我不知道该怎么做。
非常感谢您的帮助。
答案 0 :(得分：5)
你的例子太大/太复杂了我不想下载外部数据/形状，所以我把它简化为这里的例子。
在我看来，当你点击一个形状时，你想要绘制一些关于那个形状的信息。
在我的示例中，我使用reactiveValues来存储在创建它们的函数之外可访问的对象，但也是被动的。 （见reactive values）
因此，当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)