J'ai utilisé du code basé sur cet exemple de: https://www.r-graph-gallery.com/4-tricks-for-working-with-r-leaflet-and-shiny/
Je voudrais ma carte pour commencer avec aucun des marqueurs de cercle ajouté, puis pour les ajouter ou les supprimer lorsque l'utilisateur interagit avec les options disponibles.
Voici à quoi il ressemble actuellement lorsqu'un utilisateur charge la carte:
Et voici à quoi j'aimerais qu'elle ressemble lorsqu'un utilisateur charge la carte:
J'ai essayé de supprimer des groupes et des calques et rien ne semble fonctionner. Il me manque probablement quelque chose d'assez évident. Merci :)
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)
CODE RÉEL basé sur l'exemple ci-dessus
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))
3 Réponses :
Vous devez envelopper votre code de sortie dans quelque chose comme la fonction observeEvent , de sorte que lorsqu'une entrée est effectuée, seule la sortie est affichée et sinon non.
Vérifiez les Trick2 et Trick4 à partir du même lien que vous avez fourni. J'espère que vous aurez une idée.
PS aux modérateurs: Désolé, ma section commentaire n'est pas encore activée, c'est pourquoi j'ai dû le faire dans la section réponse. Vous pouvez le déplacer vers les commentaires. Merci.
Génial, je jetterai un coup d'œil à cela demain matin et je pourrai le marquer comme correct alors. J'avais le sentiment que la solution serait simple!
merci pour la suggestion aurais-je besoin de créer un événement d'observation pour chaque groupe ou marqueurs? J'ai ajouté mon code réel ci-dessus si cela aide
La solution est assez simple. Par défaut, les groupes sont activés dans le contrôle. Vous pouvez les désactiver à l'aide de la commande suivante:
map %>% hideGroup("groupName")
Pour plus d'informations, cliquez ici: https://rstudio.github.io/leaflet/showhide.html
Aurais-je besoin de le faire pour chaque groupe de marqueurs (il y en a plusieurs), j'ai ajouté mon code réel ci-dessus si cela peut aider. Merci pour votre temps.
Je l'ai eu et j'ai ajouté tous les groupes à l'argument hideGroup - j'ai ajouté un exemple du code ci-dessus. MERCI
Réponse basée sur la suggestion d'Alexander Leow. J'ai ajouté tous les groupes à l'argument 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)
})
Cela produit le résultat souhaité de n'avoir aucune des cases à cocher pour les marqueurs Circle lors du chargement initial de la carte.
Le code que vous avez donné ne semble pas refléter la capture d'écran que vous avez partagée.
Vous avez raison, ils ne le font pas. J'ai partagé l'exemple sur lequel j'ai basé mon code par souci de simplicité, je peux ajouter mon code exact si cela aide.
Veuillez ne pas modifier votre réponse dans votre question. Au lieu de cela, affichez-le comme une réponse afin que d'autres puissent voter dessus. J'ai annulé votre modification.
Désolé donc je la poste comme ma propre réponse même si la suggestion vient de la suggestion d'Alexander Lowe? Désolé pour la nouveauté