r - Leaflet AddCircleMarkers 设置为取消选择，直到用户选择 - R SHINY
问题描述
我使用了基于以下示例的代码：https ://www.r-graph-gallery.com/4-tricks-for-working-with-r-leaflet-and-shiny/
我希望我的地图一开始不添加任何圆形标记，然后在用户与可用选项交互时添加或删除它们。
这是用户加载地图时的当前外观：
这就是我希望它在用户加载地图时的样子：
我试过删除组和图层，但似乎没有任何效果。我很可能遗漏了一些非常明显的东西。谢谢 ：）
加载库
library(shiny)
library(leaflet)
# Make data with several positions
data_red=data.frame(LONG=42+rnorm(10), LAT=23+rnorm(10),
PLACE=paste("Red_place_",seq(1,10)))
data_blue=data.frame(LONG=42+rnorm(10), LAT=23+rnorm(10),
PLACE=paste("Blue_place_",seq(1,10)))
# Initialize the leaflet map:
leaflet() %>%
setView(lng=42, lat=23, zoom=8 ) %>%
# Add two tiles
addProviderTiles("Esri.WorldImagery", group="background 1") %>%
addTiles(options = providerTileOptions(noWrap = TRUE), group="background
2") %>%
# Add 2 marker groups
addCircleMarkers(data=data_red, lng=~LONG , lat=~LAT, radius=8 ,
color="black", fillColor="red", stroke = TRUE, fillOpacity = 0.8,
group="Red") %>%
addCircleMarkers(data=data_blue, lng=~LONG , lat=~LAT, radius=8 , color="black", fillColor="blue", stroke = TRUE, fillOpacity = 0.8, group="Blue") %>%
# Add the control widget
addLayersControl(overlayGroups = c("Red","Blue") , baseGroups = c("background 1","background 2"), options = layersControlOptions(collapsed = FALSE))
基于上述示例的实际代码
ui <- shiny::fluidPage("Logan Service Response Map",
div(class="outer",
tags$head(
# Include our custom CSS
includeCSS("styles.css")),
leafletOutput("map", width="100%", height="100%"),
selectInput("stats", "",
label="Select an ABS statistic to display on the map.",
choices = list("Population per SA2"="sum_pop",
"Average weekly income" = "inc_pw",
"Average income" = "Mean",
"Median income"="Median",
"Age Pension recipients"= "Age.Pension",
"Low Income Card holders"= "Low.Income.Card",
"Newstart Allowance recipients"= "Newstart.Allowance",
"Commonwealth Rent Assistance recipients"="Commonwealth.Rent.Assistance..income.units.",
"Carer Allowance recipients"="Carer.Allowance",
"Disability Support Pension recipients"="Disability.Support.Pension",
"Family Tax Benefit A recipients"="Family.Tax.Benefit.A",
'Family Tax Benefit B recipients'="Family.Tax.Benefit.B",
"Gini co-efficient"="Gini.coefficient"))
tags$div(id="cite",
br(),
'Data from ABS and Service location data compiled by Logan Together 2018/2019.'
))
server <- function(input, output, session){
pal<-c("#85499A","#660066","#EE3A32","orange","#FCD30B","#006666",
"#330066","turquoise","red","#235766","#1D9DD9","#A1DDFA",
"pink","#7AC04D")
colourCount = length(unique(logan_sa2$SA2_NAME16))
getPalette = colorRampPalette(pal)
output$map<-renderLeaflet({
leaflet(logan_sa2) %>%
addTiles()%>%
setView(153, -27, zoom = 22)%>%
# Centre the map in the middle of our co-ordinates
fitBounds(152.8, -27.7, 153.3, -27.6)
})
labels <- sprintf(
"<strong>%s</strong><br/>
SA2 Population: %s <br/><br/>
Average weekly income: %s <br/><br/>
Average total income: %s<br/><br/>
Median total income: %s<br/><br/>
Gini coefficient: %s<br/>",
logan_sa2$SA2_NAME16, logan_sa2$sum_pop,logan_sa2$inc_pw, logan_sa2$Mean, logan_sa2$Median,
logan_sa2$Gini.coefficient) %>% lapply(htmltools::HTML)
#creating a proxy map that displays the various stats from the stats drp down
leafletProxy("map", data = logan_sa2) %>%
clearShapes() %>%
addMeasure(primaryLengthUnit = "kilometers",
primaryAreaUnit = "sqmeters",
activeColor = "#3D535D",
completedColor = "#7D4479")%>%
addEasyButton(easyButton(
icon="fa-crosshairs", title="Locate Me",
onClick=JS("function(btn, map){ map.locate({setView: true}); }")))%>%
addPolygons(
layerId = logan_sa2$SA2_NAME16,
group = "sa2_log",
fillColor = ~pal(logan_sa2[[input$stats]]),
fillOpacity = 0.6,
weight = 0.6,
opacity = 1,
color = "#FFFFFF",
dashArray = "2",
label = labels,
highlight = highlightOptions(
weight = 4,
color = "#FFFFFF",
dashArray = "3",
fillOpacity = 2,
bringToFront = FALSE),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 5px"),
textsize = "13px",
direction = "auto")) %>%
#addMarkers(data=marker_data())%>%
#add markers for service types
addCircleMarkers(data=Alcohol_Drugs, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="red", stroke = FALSE, fillOpacity = 1, group="Alcohol & Other Drugs", popup = labels_services) %>%
addCircleMarkers(data=Child_Family, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#da74e4", stroke = FALSE, fillOpacity = 1, group="Child & Family", popup = labels_services) %>%
addCircleMarkers(data=Domestic_Family_Violence, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#ea2525", stroke = FALSE, fillOpacity = 1, group="Domestic & Family Violence", popup = labels_services) %>%
addCircleMarkers(data=Employment, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#e28a3f", stroke = FALSE, fillOpacity = 1, group="Employment", popup = labels_services) %>%
addCircleMarkers(data=Finance, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#1d8f8f", stroke = FALSE, fillOpacity = 1, group="Finance", popup = labels_services) %>%
addCircleMarkers(data=Health_Social_Connection_Wellbeing, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#421076", stroke = FALSE, fillOpacity = 1, group="Health, Social Connection & Wellbeing", popup = labels_services) %>%
addCircleMarkers(data=Housing_Homelessness, lng=~LONG , lat=~LAT, radius=7 , #="black",
fillColor="#a792e4", stroke = FALSE, fillOpacity = 1, group="Housing & Homelessness", popup = labels_services) %>%
addCircleMarkers(data=Information_Advice_Referral, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#e2c920", stroke = FALSE, fillOpacity = 1, group="Information Advice & Referral", popup = labels_services) %>%
addCircleMarkers(data=Legal, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#e27d3f", stroke = FALSE, fillOpacity = 1, group="Legal", popup = labels_services) %>%
addCircleMarkers(data=Mental_Health, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#e2c920", stroke = FALSE, fillOpacity = 1, group="Mental & Health", popup = labels_services) %>%
addCircleMarkers(data=Migrant_Refugee, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#7b0c22", stroke = FALSE, fillOpacity = 1, group="Migrant & Refugee", popup = labels_services) %>%
addCircleMarkers(data=Sexual_Assault_Abuse, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#33a4bf", stroke = FALSE, fillOpacity = 1, group="Sexual Assault & Abuse", popup = labels_services) %>%
addCircleMarkers(data=Youth, lng=~LONG , lat=~LAT, radius=7 , #color="black",
fillColor="#4a48b6", stroke = FALSE, fillOpacity = 1, group="Youth", popup = labels_services) %>%
#add map background theme options
addProviderTiles("OpenStreetMap.BlackAndWhite", group="Background Map 1")%>%
addTiles(options=providerTileOptions(noWrap = TRUE), group="Background Map 2")%>%
addLayersControl(baseGroups = c("Background Map 1","Background Map 2"), options = layersControlOptions(collapsed = FALSE))%>%
#add markers for service support level
#addAwesomeMarkers(data=Secondary,lng=~LONG , lat=~LAT,group="Secondary", icon=icons)%>%
#addAwesomeMarkers(data=Early_Intervention_Prevention,lng=~LONG , lat=~LAT,group="Early Intervention & Prevention",icon=icons)%>%
#addAwesomeMarkers(data=Tertiary,lng=~LONG , lat=~LAT,group="Tertiary",icon=icons)%>%
#add layer controls
addLayersControl(overlayGroups = c("Alcohol & Other Drugs","Child & Family","Domestic & Family Violence","Employment","Finance",
"Health, Social Connection & Wellbeing","Housing & Homelessness", "Information Advice & Referral",
"Legal","Mental & Health","Migrant & Refugee","Sexual Assault & Abuse","Youth"),baseGroups = c("Background Map 1","Background Map 2"),
options = layersControlOptions(collapsed = FALSE))
#this information is also displayed in the pop-ups for each clickable electorate
varname<-switch(input$stats,
"sum_pop"="Total population per SA2", "Electorate Population"="CED_pop_total",
"inc_pw"="Average weekly income per SA2",
"Mean"="Average (mean) total income per SA2",
"Median"="Median total income per SA2",
"Gini.coefficient"="Gini coefficient",
"Age.Pension"="Number of Age Pension recipients",
"Low.Income.Card"="Number of Low Income Card holders",
"Newstart.Allowance"="Number of Newstart Allowance recipients",
"Commonwealth.Rent.Assistance..income.units."="Number of Commonwealth Rent Assistance recipients",
"Carer.Allowance"="Number of Carer Allowance recipients",
"Disability.Support.Pension"="Numbers of Disability Support Pension recipients",
"Family.Tax.Benefit.A"="Number of Family Tax Benefit A recipients",
"Family.Tax.Benefit.B"='Number of Family Tax Benefit B recipients')
leafletProxy("map", data = logan_sa2) %>% clearControls() %>%
addLegend(pal = pal, opacity = 0.9, title = varname,
values = ~logan_sa2[[input$stats]],labels = c(min(input$stats), max(input$stats)),
position = "bottomright")
})
}
shinyApp(ui, server)
解决方案
解决方案相当简单。默认情况下，这些组在控件中启用。您可以通过以下命令关闭它们：
map %>% hideGroup("groupName")
有关更多信息，请参见此处：https ://rstudio.github.io/leaflet/showhide.html
推荐阅读
- javascript - 如何编写为每个表分别创建固定标题的javascript
- couchbase - 在 CouchBase 数据库中看不到文档
- docker - 在 Heroku 上使用发布阶段的替代方法是什么？
- java - 如何在 Spring 框架上使用抽象类？
- nginx - 上传大 buildpack 失败，因为 Cloud Foundry cc nginx 超时
- html - 如何在 html 中添加 2 个单独的背景？
- python - 无法访问 Locust WebInterface“ERR_CONNECTION_REFUSED”
- c# - 在 asp.net 核心上的 log4net
- kotlin - Kotlin中成员变量中逗号的含义
- macos - 如何找到我系统的 gcc 编译标志？