rshinyr-leaflet
Leaflet AddCircleMarkers set to deselected until user selects
I have used code based on this example from :https://www.r-graph-gallery.com/4-tricks-for-working-with-r-leaflet-and-shiny/
I would like my map to start out with none of the circle markers added and then to have them added or removed as the user interacts with the available options.
This is how it currently looks when a user loads the map:
And this is how I would like it to look when a user loads the map:
I've tried removing groups and layers and nothing seems to work. I am very likely missing something quite obvious.
Load libraries
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))
ACTUAL CODE based on example above
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)
Solution
Answer based on the suggestion from Alexander Leow. I added all the groups to the hideGroup argument.
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)
})
This produces the desired result to have none of the checkboxes for the Circle markers selected when the map initially loads.
- Calculate transition probabilities
- How to subset R dataframe based on specific values in several columns?
- Change colon to period in figure caption in Quarto
- Applying different functions to different groups using 2 data frames
- Disable button for 5 seconds with different label and change after it
- How to group columns with an odd index, based on columns with an even index?
- Different plots of marginal effects with interaction term and offset when using different packages
- Animate a MWE GIF in R
- populating a matrix by rows
- How to relevel in ROC curve in R/plotROC?
- R - glmer different results on different machines (non-deterministic)
- Dynamically operate on column (inside :=)
- Random change in obj_addr() output when including the objects into a list and vectorizing over them
- Add to curly-curly argument
- h2o predict error: Test/Validation dataset has no columns in common with the training set
- Is is possible to convert a dataframe object to a tribble constructor?
- encoding issues in R
- How to Scrape NBA stats page using rvest
- Conversion of Decimal Minutes Seconds into Decimal Degrees when cells within the Columns Contains the Factor 'Missed' in R
- Difficulty using case_when() to add column that, conditionally, pastes value from another column
- Flip the matrix
- Creating test for date columns incorrectly throwing error
- Exists() and getSymbols() can't find symbol listed in yahoo
- spearman's rho plot
- Use OpenMP on M2 Mac with R and data.table
- How to find the connected instances from a minimum spanning trees model in R
- Hide a column in shiny datatable but keep it searchable
- How to extract data from an edited datatable in shiny?
- Render Data Table with double header
- filter dataTables in Shiny Dashboad based on selectInput Values