传单AddCircleMarkers设置为取消选中，直到用户选择-R SHINY

时间：2019-03-11 02:16:14

标签： r shiny leaflet

我已经根据以下示例使用了代码：https://www.r-graph-gallery.com/4-tricks-for-working-with-r-leaflet-and-shiny/

我希望地图一开始不添加任何圆形标记，然后在用户与可用选项进行交互时将其添加或删除。

这是用户加载地图时的当前外观： enter image description here

这是用户加载地图时的样子： enter image description here

我尝试删除组和图层，但似乎没有任何效果。我很可能会错过一些显而易见的东西。谢谢：）

加载库

 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)

3 个答案:

答案 0 :(得分：2)

解决方案非常简单。默认情况下，组在控件中启用。您可以通过以下命令将其关闭：

map %>% hideGroup("groupName")

有关更多信息，请参见此处：https://rstudio.github.io/leaflet/showhide.html

答案 1 :(得分：2)

根据亚历山大·里奥的建议进行回答。我将所有组添加到hideGroup参数中。

  output$map<-renderLeaflet({

leaflet(logan_sa2) %>%
  addTiles()%>%
  hideGroup(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"))%>%
  setView(153, -27, zoom = 22)%>%

  # Centre the map in the middle of our co-ordinates
  fitBounds(152.8, -27.7, 153.3, -27.6)
   })

这会产生所需的结果，使地图最初加载时没有选中“圆形”标记的复选框。

enter image description here

答案 2 :(得分：1)

您需要将输出代码包装到类似observeEvent函数的位置，以便在进行输入时仅显示输出，否则不显示。

从提供的同一链接中检查Trick2和Trick4。希望你能有个主意。

给主持人的PS：对不起，我的评论部分尚未激活，这就是为什么我必须在答案部分中添加它。您可以将其移至评论。谢谢。

相关问题
最新问题