rshinyreactiveshiny-reactivityr-leaflet
How to update fillColor to selected input in shiny and leaflet map
I am having a difficult time transitioning my map from static to reactive so a user can select what data they want to look at. I am pretty new to R so please bare with me but I think I figured out how to make reproducible data (please let me know if this doesn't work).
## Library of installed packages
library(leaflet)
library(magrittr)
library(sf)
library(geojsonio)
library(htmltools)
library(htmlwidgets)
library(stringi)
library(RColorBrewer)
library(shiny)
library(shinyWidgets)
# DATA
vancouver <- structure(list(name = c("Downtown", "Dunbar-Southlands", "Fairview"
), Total...Age.groups.and.average.age.of.the.population...100..data = c("62,030",
"21,425", "33,620"), X0.to.14.years = c(4000L, 3545L, 2580L),
X0.to.4.years = c(2080L, 675L, 1240L), X5.to.9.years = c(1105L,
1225L, 760L), X10.to.14.years = c(810L, 1650L, 580L), X15.to.64.years = c(51275L,
14215L, 25140L), X15.to.19.years = c(1180L, 1800L, 655L),
X20.to.24.years = c(4050L, 1740L, 1865L), X25.to.29.years = c(8810L,
1110L, 4025L), X30.to.34.years = c(9750L, 695L, 4395L), X35.to.39.years = c(6620L,
765L, 3175L), X40.to.44.years = c(4755L, 1325L, 2450L), X45.to.49.years = c(4610L,
2025L, 2340L), X50.to.54.years = c(4160L, 1895L, 2110L),
X55.to.59.years = c(3970L, 1460L, 2145L), X60.to.64.years = c(3365L,
1400L, 1980L), X65.years.and.over = c(6760L, 3660L, 5895L
), X65.to.69.years = c(2640L, 1290L, 2005L), X70.to.74.years = c(1710L,
865L, 1345L), X75.to.79.years = c(1095L, 655L, 930L), X80.to.84.years = c(700L,
415L, 690L), X85.years.and.over = c(615L, 430L, 930L), X85.to.89.years = c(390L,
265L, 525L), X90.to.94.years = c(170L, 115L, 270L), X95.to.99.years = c(45L,
45L, 105L), X100.years.and.over = c(10L, 10L, 25L), vancouverLabels = list(
structure("<b>Downtown</b><br/>4000 people", html = TRUE, class = c("html",
"character")), structure("<b>Dunbar-Southlands</b><br/>3545 people", html = TRUE, class = c("html",
"character")), structure("<b>Fairview</b><br/>2580 people", html = TRUE, class = c("html",
"character"))), geometry = structure(list(structure(list(
structure(c(-123.112266540527, -123.10424041748, -123.09928894043,
-123.099998474121, -123.101699829102, -123.11107635498,
-123.114448547363, -123.121162414551, -123.129280090332,
-123.137680053711, -123.132331848145, -123.12109375,
-123.136680603027, -123.134689331055, -123.122711181641,
-123.112266540527, 49.2901649465775, 49.2881660452104,
49.2892723074174, 49.2727508535599, 49.2729721060013,
49.2729263296341, 49.2717742910599, 49.2695388784622,
49.2695312490677, 49.2753181448197, 49.276931761763,
49.2843666067338, 49.2944564810014, 49.2958106985307,
49.2915000906205, 49.2901649465775), dim = c(16L, 2L))), class = c("XY",
"POLYGON", "sfg")), structure(list(structure(c(-123.170166015625,
-123.170249938965, -123.178703308105, -123.179092407227,
-123.179084777832, -123.179100036621, -123.179756164551,
-123.18041229248, -123.181060791016, -123.181701660156, -123.182327270508,
-123.182952880859, -123.183555603027, -123.184150695801,
-123.184722900391, -123.185279846191, -123.185813903809,
-123.186332702637, -123.186820983887, -123.187286376953,
-123.187728881836, -123.187950134277, -123.188186645508,
-123.188438415527, -123.188697814941, -123.18896484375, -123.189247131348,
-123.18953704834, -123.189834594727, -123.190147399902, -123.190460205078,
-123.190773010254, -123.191101074219, -123.19758605957, -123.197853088379,
-123.198112487793, -123.198364257812, -123.198616027832,
-123.198852539062, -123.199089050293, -123.199317932129,
-123.199531555176, -123.199745178223, -123.19994354248, -123.205505371094,
-123.205909729004, -123.20629119873, -123.206642150879, -123.206970214844,
-123.20726776123, -123.207542419434, -123.208885192871, -123.209167480469,
-123.209480285645, -123.209823608398, -123.210182189941,
-123.210571289063, -123.210983276367, -123.211418151855,
-123.219856262207, -123.221946716309, -123.219924926758,
-123.208595275879, -123.205604553223, -123.196830749512,
-123.196853637695, -123.198570251465, -123.198570251465,
-123.196853637695, -123.196784973145, -123.198547363281,
-123.198585510254, -123.198631286621, -123.198677062988,
-123.198715209961, -123.198760986328, -123.198799133301,
-123.198844909668, -123.198883056641, -123.198921203613,
-123.198959350586, -123.198997497559, -123.199035644531,
-123.199066162109, -123.204940795898, -123.200996398926,
-123.200790405273, -123.200576782227, -123.20036315918, -123.200141906738,
-123.199928283691, -123.198677062988, -123.198677062988,
-123.19660949707, -123.196548461914, -123.202880859375, -123.203216552734,
-123.183990478516, -123.178070068359, -123.178100585938,
-123.177925109863, -123.176162719727, -123.175010681152,
-123.173477172852, -123.171897888184, -123.16960144043, -123.170928955078,
-123.172187805176, -123.170951843262, -123.170516967773,
-123.170166015625, 49.2478904714797, 49.2347030630324, 49.2347221365187,
49.216804503462, 49.2155570974561, 49.2155570974561, 49.2155876150342,
49.2156372060987, 49.215713500044, 49.2158126821729, 49.2159347524854,
49.2160797109815, 49.2162475576612, 49.2164344778272, 49.2166442861768,
49.2168731680128, 49.217121123335, 49.2173919668409, 49.2176780691358,
49.2179794302198, 49.2182998647901, 49.2184638967725, 49.2186164846631,
49.2187614431592, 49.2188987722608, 49.2190246572706, 49.2191429128858,
49.2192497244092, 49.2193489065382, 49.219432829878, 49.2195091238233,
49.2195739736768, 49.2196235647413, 49.2205543508741, 49.2206001272413,
49.220653533003, 49.2207183828565, 49.2207908621046, 49.2208747854444,
49.2209663381788, 49.2210617056104, 49.2211685171339, 49.2212829580518,
49.2214050283643, 49.2249946584913, 49.2252998342726, 49.2256164541456,
49.2259445181104, 49.2262878408644, 49.2266387930128, 49.227001189253,
49.2289466848585, 49.2292594900343, 49.2295608511183, 49.2298469534132,
49.2301216116163, 49.2303810110304, 49.2306251516554, 49.2308540334913,
49.2350234976027, 49.2365760793898, 49.2395477285597, 49.2351837148878,
49.2372016897414, 49.234855650923, 49.2365150442335, 49.2365188589308,
49.2383460989211, 49.2384796133253, 49.2461967458938, 49.2462081899855,
49.2462081899855, 49.2462081899855, 49.2462120046828, 49.2462158193801,
49.2462234487746, 49.2462310781691, 49.2462387075637, 49.2462463369582,
49.24625778105, 49.2462730398391, 49.2462882986281, 49.2462997427199,
49.2463188162063, 49.2492637624953, 49.2499732961867, 49.2500114431594,
49.2500381460402, 49.2500572195266, 49.2500686636184, 49.2500724783156,
49.2500762930129, 49.2499237051223, 49.2499275198195, 49.2565193166946,
49.2566146841262, 49.258148192427, 49.2578659048294, 49.2577667227005,
49.2571640005325, 49.2569389333938, 49.2556114187454, 49.2540817251418,
49.252849577925, 49.2515449514602, 49.2489624014113, 49.2496719351027,
49.2500457754348, 49.2484474172805, 49.2480926504348, 49.2478904714797
), dim = c(111L, 2L))), class = c("XY", "POLYGON", "sfg")),
structure(list(structure(c(-123.145988464355, -123.145401000977,
-123.145347595215, -123.145286560059, -123.145217895508,
-123.145141601562, -123.145050048828, -123.144950866699,
-123.144844055176, -123.144737243652, -123.14461517334,
-123.144485473633, -123.144348144531, -123.14421081543,
-123.144058227539, -123.143905639648, -123.143745422363,
-123.139282226562, -123.137680053711, -123.129280090332,
-123.121162414551, -123.114448547363, -123.115043640137,
-123.127212524414, -123.127212524414, -123.131767272949,
-123.13200378418, -123.132247924805, -123.132499694824,
-123.132766723633, -123.133033752441, -123.133316040039,
-123.133598327637, -123.133888244629, -123.134178161621,
-123.134475708008, -123.134780883789, -123.135078430176,
-123.135383605957, -123.135688781738, -123.135986328125,
-123.136169433594, -123.136344909668, -123.136520385742,
-123.136695861816, -123.136863708496, -123.137031555176,
-123.137191772461, -123.137351989746, -123.137504577637,
-123.137657165527, -123.137802124023, -123.137939453125,
-123.138069152832, -123.138191223145, -123.138305664062,
-123.13842010498, -123.145988464355, 49.2571220388625,
49.2718467703079, 49.2719612112259, 49.2720756521439,
49.2721862783646, 49.2722969045853, 49.2723999014114,
49.2725028982376, 49.2726020803665, 49.2726974477982,
49.2727890005325, 49.2728729238724, 49.2729568472122,
49.2730331411576, 49.2731056204056, 49.2731704702591,
49.2732315054154, 49.2748260488724, 49.2753181448197,
49.2695312490677, 49.2695388784622, 49.2717742910599,
49.256870268843, 49.257099150679, 49.2569694509719, 49.2570304861282,
49.2571525564407, 49.2572669973587, 49.2573738088821,
49.257472991011, 49.2575607290481, 49.2576408376907,
49.2577095022415, 49.2577705373977, 49.2578201284622,
49.2578582754348, 49.2578849783157, 49.257904051802,
49.2579116811965, 49.2579078664993, 49.2578964224075,
49.2578849783157, 49.2578659048294, 49.2578392019485,
49.2578086843704, 49.257774352095, 49.2577285757278,
49.2576827993606, 49.2576255789016, 49.2575683584426,
49.2574996938919, 49.2574310293411, 49.2573547353958,
49.2572746267532, 49.2571907034133, 49.257099150679,
49.2570075979446, 49.2571220388625), dim = c(58L, 2L))), class = c("XY",
"POLYGON", "sfg"))), class = c("sfc_POLYGON", "sfc"), precision = 0, bbox = structure(c(xmin = -123.221946716309,
ymin = 49.2155570974561, xmax = -123.09928894043, ymax = 49.2958106985307
), class = "bbox"), crs = structure(list(input = "WGS 84",
wkt = "GEOGCRS[\"WGS 84\",\n DATUM[\"World Geodetic System 1984\",\n ELLIPSOID[\"WGS 84\",6378137,298.257223563,\n LENGTHUNIT[\"metre\",1]]],\n PRIMEM[\"Greenwich\",0,\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n CS[ellipsoidal,2],\n AXIS[\"latitude\",north,\n ORDER[1],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n AXIS[\"longitude\",east,\n ORDER[2],\n ANGLEUNIT[\"degree\",0.0174532925199433]],\n ID[\"EPSG\",4326]]"), class = "crs"), n_empty = 0L)), sf_column = "geometry", agr = structure(c(name = NA_integer_,
Total...Age.groups.and.average.age.of.the.population...100..data = NA_integer_,
X0.to.14.years = NA_integer_, X0.to.4.years = NA_integer_, X5.to.9.years = NA_integer_,
X10.to.14.years = NA_integer_, X15.to.64.years = NA_integer_,
X15.to.19.years = NA_integer_, X20.to.24.years = NA_integer_,
X25.to.29.years = NA_integer_, X30.to.34.years = NA_integer_,
X35.to.39.years = NA_integer_, X40.to.44.years = NA_integer_,
X45.to.49.years = NA_integer_, X50.to.54.years = NA_integer_,
X55.to.59.years = NA_integer_, X60.to.64.years = NA_integer_,
X65.years.and.over = NA_integer_, X65.to.69.years = NA_integer_,
X70.to.74.years = NA_integer_, X75.to.79.years = NA_integer_,
X80.to.84.years = NA_integer_, X85.years.and.over = NA_integer_,
X85.to.89.years = NA_integer_, X90.to.94.years = NA_integer_,
X95.to.99.years = NA_integer_, X100.years.and.over = NA_integer_,
vancouverLabels = NA_integer_), levels = c("constant", "aggregate",
"identity"), class = "factor"), row.names = c(NA, 3L), class = c("sf",
"data.frame"))
### CODE
paletteNum <- colorNumeric('Blues', domain = NULL)
### NEW CODE
# Labeling
vancouverLabels <- sprintf('<b>%s</b><br/>%g people',
vancouver$name, vancouver$X0.to.14.years) %>%
lapply(function(x) HTML(x))
vancouver <- cbind(vancouver, matrix(vancouverLabels, ncol = 1, dimnames = list(c(), c('vancouverLabels'))))
# Integrating Leaflet with Shiny
ui <- fluidPage(
# Title
titlePanel("Census Data"),
#Leaflet Map
leafletOutput("mymap"),
absolutePanel(
pickerInput(
inputId = "agegroup",
label = "Select an Age Group",
choices = c("X0.to.14.years",
"X0.to.4.years",
"X5.to.9.years")
))
)
server <- function(input, output, session) {
##(SOMETHING WRONG HERE)
filteredDataUpdate <- reactive({
vancouver[input$agegroup,]
})
## (SOMETHING WRONG HERE)
# This reactive expression represents the palette function,
# which changes as the user makes selections in UI.
#paletteNum<- reactive({
# colorNumeric('blues', vancouver[input$agegroup,])
#})
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$CartoDB.PositronNoLabels) %>%
setView(lng = -123.11934, lat = 49.24966, zoom = 11) %>%
addPolygons(data = vancouver,
color = 'white',
weight = 1,
smoothFactor = .3,
fillOpacity = .75,
fillColor = ~paletteNum(vancouver$X0.to.14.years),
label = ~vancouverLabels,
labelOptions = labelOptions(
style = list(color = 'gray30'),
textsize = '10px'),
highlightOptions = highlightOptions(
weight = 3,
color = 'dodgerblue'
)
) %>%
addLegend(pal = paletteNum, values = vancouver$X0.to.14.years,
title = '<small>2016 Vancouver Census Data <br> Population: Ages 0 to 14 </small>',
position = 'bottomleft')
})
}
shinyApp(ui, server)
I understand I also need leafletProxy() to update my fillColor but I have no idea how to do that... I think the mistake might be the way my data is set up but this is just a guess. If you were to uncomment this:
#paletteNum<- reactive({
# colorNumeric('blues', vancouver[input$agegroup,])
#})
My code just stops working even though I know this is suppose to be reactive, and it is suppose to effect the fillColor.
Solution
Below you find an example where I fixed some issues:
Subsetting of the data, e.g. you need
vancouver[[input$agegroup]],definition of the
fillColorargument:fillColor = ~paletteNum()(vancouver[[input$agegroup]])(also used
'Blues'instead of'blues'),introduced the
leafletProxy.
I omitted the data in the code below due to a character limit. It is the same as in your question.
library(shiny)
library(shinyWidgets)
library(leaflet)
library(RColorBrewer)
ui <- fluidPage(titlePanel("Census Data"),
leafletOutput("mymap"),
absolutePanel(
pickerInput(
inputId = "agegroup",
label = "Select an Age Group",
choices = c("X0.to.14.years",
"X0.to.4.years",
"X5.to.9.years")
)
))
server <- function(input, output, session) {
filteredDataUpdate <- reactive({
vancouver[[input$agegroup]]
})
paletteNum <- reactive({
colorNumeric('Blues', vancouver[[input$agegroup]])
})
vancouverLabels <- reactive({
sprintf('<b>%s</b><br/>%g people',
vancouver$name,
vancouver[[input$agegroup]]) |>
lapply(function(x)
HTML(x))
})
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles(providers$CartoDB.PositronNoLabels) |>
setView(lng = -123.11934,
lat = 49.24966,
zoom = 11)
})
m <- leafletProxy("mymap", session)
observeEvent(input$agegroup, {
m |>
clearShapes() |>
clearControls() |>
addPolygons(
data = vancouver,
group = "mygroup",
color = 'white',
weight = 1,
smoothFactor = .3,
fillOpacity = .75,
fillColor = ~ paletteNum()(vancouver[[input$agegroup]]),
label = ~ vancouverLabels(),
labelOptions = labelOptions(style = list(color = 'gray30'),
textsize = '10px'),
highlightOptions = highlightOptions(weight = 3,
color = 'dodgerblue')
) |>
addLegend(
pal = paletteNum(),
values = filteredDataUpdate(),
title = paste0(
'<small>2016 Vancouver Census Data <br> Population: ',
input$agegroup,
'</small>'
),
position = 'bottomleft'
)
})
}
shinyApp(ui, server)
- Matching pair-wise columns from left to right across rows in one dataframe to another dataframe and adding new columns with matching values
- color mapping in geom_conn_bundle not showing correctly
- Print R package startup message AFTER automatic package conflict messages instead of before
- Summing a set of R dataframe rows (column-wise), while retaining the first n columns
- Added variable / partial regression plots for groups in an interaction?
- how to make a topoplot in R with coordinates variable distribution
- List of all functions in base R?
- Plotting multiple plots for different initial conditions in one graph
- Printing repetitively on the same line in R
- Generating UI/Server based on initial selection
- Subset dataframe based on pickerInput
- How to let user pick the data in R-shiny?
- Couldn't show my simple bar charts separately on Shiny R dashboardBody
- How to programmatically filter contents of a second shiny app displayed via iframe
- How to select specific interesting groups for the boxplot in R Shiny app?
- Crosstable and Plot grouping with reactive values
- Is there a way to make multiple Shiny picker inputs where the selections must be disjoint?
- Delay/avoid duplication of shiny server side functions until after credentials
- Predictions only returns value "1"
- How to display a busy indicator in a shiny app?
- Append doesn't work when writing to CSV in R
- Changing the start date of a gantt chart in DiagrammeR
- Check for installed packages before running install.packages()
- Compare two columns element-wise
- For loop is several times faster in R than in Python using the rpy2 library
- Setting a flag based on two samples' dates
- How to bring pop-ups for long text string selection items forward in front of modal they are rendered from when using virtualSelectInput()?
- R data.table update join by reference the, but updating the RIGHT table
- How to add tooltip labels in R Sparkline?
- How to draw circles (circular dots) from linetype in ggplot2