So i'm trying to include some numeric figures in my label but am struggling to get it in the correct accounting format so that it is consistent with the legend. I have no trouble producing the labels without any numeric formatting, so any help in achieving the desired thousands separator would be brilliant.
library(geojson)
library(geojsonio)
library(leaflet)
library(sf)
url <- "http://leafletjs.com/examples/choropleth/us-states.js"
doc <- readLines(url)
doc2 <- gsub("var statesData = ", "", doc)
write(doc2, file = "tempgeo.json")
states <- geojson_read("tempgeo.json", what = "sp")
bins <- c(0, 10000, 20000, 50000, 100000, 200000, 500000, 1000000, Inf)
pal <- colorBin("YlOrRd", domain = states$density, bins = bins)
states$density <- states$density*1000
c <- leaflet(states) %>%
setView(-96, 37.8, 4) %>%
addProviderTiles("MapBox", options = providerTileOptions(
id = "mapbox.light",
accessToken = Sys.getenv('MAPBOX_ACCESS_TOKEN')))
labels <- sprintf(
"<strong>%s</strong><br/>%g",
states$name, states$density
) %>% lapply(htmltools::HTML)
c <- c %>% addPolygons(
fillColor = ~pal(density),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(pal = pal, values = ~density, opacity = 0.7, title = NULL,
position = "bottomright")
c
Thank you
You can convert the label to a string, and use prettyNum to format it with commas.
labels <- sprintf(
"<strong>%s</strong><br/>%s",
states$name, prettyNum(states$density, big.mark = ",")
) %>% lapply(htmltools::HTML)
Related
Using the code below, I have created a map within the shiny app context. However, as shown in the picture, the polygons' colors are inconsistent with the legend color scheme. I wonder how they can be consistent preferably by changing the legend color scheme. In the code below, the bi_class variable was defined in 9 categories involving a 3-dimensional quantile of x and y variables (i.e, low-low, low-medium, low-high, medium-low, medium-medium, ...).
output$bi_ACSB_BlackP <- renderLeaflet ({
npal2 <- colorFactor(
palette = ("Greens"),
domain = IDD_nhmap$bi_class
)
labels <- sprintf(
"<strong>Zip Code=%s </strong> <br/> African American (ACS) = %s <br/> African American (Projects)= %s ",
IDD_mapdata_()$Zip,
IDD_mapdata_()$Zip_Black,
IDD_mapdata_()$Zip_Hisp
) %>%
lapply(htmltools::HTML)
leaflet (IDD_mapdata_(), options = leafletOptions(zoomSnap = 0.25, zoomDelta =
0.25)) %>%
addProviderTiles("CartoDB.Positron",
options = providerTileOptions(opacity = 2)) %>%
clearControls() %>%
clearShapes() %>%
addPolygons(
fillColor = ~npal2(bi_class),
stroke = T,
weight = 1,
smoothFactor = 0.2,
fillOpacity = 1,
color = "black",
# label=~paste0(NAME," ","County",":"," ",input$sex_map,",", " ",
# input$ProjectID,"=",Age,"%"),
label = labels,
labelOptions = labelOptions(
interactive = TRUE,
style = list(
'direction' = 'auto',
'color' =
'black',
'font-family' = 'sans-serif',
# 'font-style'= 'italic',
'box-shadow' = '3px 3px rgba(0,0,0,0.25)',
'font-size' = '14px',
'border-color' = 'rgba(0,0,0,0.5)'
)
),
# label=~paste(NAME,"<br>",input$sex_map,
# input$ProjectID,"=",Age,"%"),
# label = lapply(labs, htmltools::HTML),
highlightOptions = highlightOptions(
#color = "red",
weight = 2,
bringToFront = T,
# color = "#666",
fillOpacity = 0.7
)
) %>%
setView(lng = IDD_mapdata_1()$long,
lat = IDD_mapdata_1()$lat,
zoom = 8) %>%
bivariatechoropleths::addBivariateChoropleth(
map_data = bivariatechoropleths::renfrew_county,
var1_name = pop_2016,
var2_name = median_household_income_2015,
ntiles= 3,
var1_label = "African American",
var2_label = "Hispanics",
region_name = "CSDNAME",
weight = 1,
fillOpacity = 0.7,
color = "grey",
highlightOptions = leaflet::highlightOptions(color = "orange",
weight = 2,
opacity = 1)) %>%
addTiles(options = tileOptions(opacity = 2))
})
I think if you declare a function that selects the Green colors like this one should probably work:
palColFun <- function(colorPalette = "Greens", n = 9){
pal <- RColorBrewer::brewer.pal(n, colorPalette)
return(pal)
}
Then in your code for bivariatechropleth you should add as follows:
bivariatechoropleths::addBivariateChoropleth(
map_data = bivariatechoropleths::renfrew_county,
var1_name = pop_2016,
var2_name = median_household_income_2015,
ntiles= 3,
var1_label = "African American",
var2_label = "Hispanics",
region_name = "CSDNAME",
weight = 1,
paletteFunction = palColFun,
fillOpacity = 0.7,
color = "grey",
highlightOptions = leaflet::highlightOptions(color = "orange",
weight = 2,
opacity = 1)) %>%
addTiles(options = tileOptions(opacity = 2))
Ideally you would link palColFun with the same color you generated for the plots, but given the example above, it is not for me to reproduce the example.
Hopefully this works.
I am using the R leaflet package to plot data for California counties. I would like the polygons of each county to vary in opacity based on the number of parcels in that county. Counties with more parcels should be more opaque, and counties with fewer parcels should be more transparent. Is this possible?
I have tried changing the fillOpacity option similar to how fillColor varies with number of parcels:
fillOpacity = ~num.parcels
Sample of my data:
packages <- c('dplyr','leaflet','sf','USAboundaries')
lapply(packages, library, character.only = TRUE)
ca_counties <- USAboundaries::us_counties(states = 'CA')
parcels <- structure(list(county = c("Yuba", "Sacramento", "Inyo", "Los Angeles", "Sierra"),
num.parcels = c(27797L, 452890L, 6432L, 15830L, 54291L)), row.names = c(NA, -5L), class = "data.frame")
parcels <- st_as_sf(left_join(parcels, ca_counties[,c('name')], by = c("county" = "name")))
Leaflet map:
labels <- sprintf(
"<strong>%s County</strong><br/>
Parcels: %g<br/>",
parcels$county, parcels$num.parcels
) %>% lapply(htmltools::HTML)
leaflet(parcels) %>%
setView(-119, 37.9, 6) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(num.parcels),
weight = 2,
opacity = 1,
color = 'black',
dashArray = '2',
fillOpacity = 0.7,
highlightOptions = highlightOptions(color = "red", weight = 3,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "4px 8px"),
textsize = "15px",
direction = 'auto')) %>%
addLegend(pal = pal, values = ~num.parcels, opacity = 0.7, title = "Number of Parcels",
position = "bottomleft")
try setting fillOpacity = ~num.parcels / max(num.parcels),
I also included a pal-function.. it seemed to be missing from your code..
# Create a continuous palette function
pal <- colorNumeric( palette = "Reds", domain = parcels$num.parcels )
#calculate fillopacity
labels <- sprintf(
"<strong>%s County</strong><br/>
Parcels: %g<br/>",
parcels$county, parcels$num.parcels
) %>% lapply(htmltools::HTML)
leaflet(parcels) %>%
setView(-119, 37.9, 6) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(num.parcels),
weight = 2,
opacity = 1,
color = 'black',
dashArray = '2',
fillOpacity = ~num.parcels / max(num.parcels),
highlightOptions = highlightOptions(color = "red", weight = 3,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "4px 8px"),
textsize = "15px",
direction = 'auto')) %>%
addLegend(pal = pal, values = ~num.parcels, opacity = 1, title = "Number of Parcels",
position = "bottomleft")
I'm developing a shiny app to show a choropleth map, using leaflet and a shapefile to add the polygons. Outside shiny everything works fine, but with shiny I got a problem when using addLegend as follows:
mypal <- reactive({
colorBin(palette = "RdYlBu", domain = get("map_fires")[[paste0("qm_", selectedYear())]],
bins = 5, reverse = TRUE, pretty = FALSE,
na.color = "#FFFAFA")
})
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
addPolygons(data = map_fires,
stroke = TRUE, weight = 1, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal()(get("map_fires")[[paste0("qm_", selectedYear())]]),
highlight = highlightOptions(
weight = 5,
color = "#666",
fillOpacity = 0.7,
bringToFront = TRUE),
label= lapply(stats_labels(), HTML),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(position = "bottomright", pal = ~mypal(),
values = ~get("map_fires")[[paste0("qm_", selectedYear())]],
opacity = 1)
})
The code above returns:
Warning: Error in if: argument is of length zero
104: addLegend
...
I'm using paste0("qm_", selectedYear()) to refer to different columns with yearly data.
I believe the problem is in values = ~get("map_fires")[[paste0("qm_", selectedYear())]], but can't tell why. I have already tried to specify the dataset on addLegend, and also to put a specific column on values = (i.e., without depending on the reactive value of selectedYear()), to no avail.
Outside shiny things work good with the code below (where I keep using get("map_fires")[[paste0("qm_", 2018)]], changing selectedYear() for a specific year, just to better show my case):
mypal <- colorBin(palette = "RdYlBu", domain = get("map_fires")[[paste0("qm_", 2018)]],
bins = 5, reverse = TRUE, pretty = FALSE,
na.color = "#FFFAFA")
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
addPolygons(data = map_fires,
stroke = TRUE, weight = 1, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal(get("map_fires")[[paste0("qm_", 2018)]]),
highlight = highlightOptions(
weight = 5,
color = "#666",
fillOpacity = 0.7,
bringToFront = TRUE),
label= lapply(stats_labels, HTML),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(position = "bottomright", pal = mypal,
values = get("map_fires")[[paste0("qm_", 2018)]],
opacity = 1)
Am I missing something?
I want to make a loop to add polygons to a leaflet map according to different columns of a data frame.
for (i in 18:22)
createMap = lapply((concello_wgs84_Datos#data[,i]),function(x){
data <- concello_wgs84_Datos#data[,i]
nombre <- names(concello_wgs84_Datos#data[,i])
pal3 <- leaflet::colorBin("YlOrRd", domain = data, 20, pretty = TRUE)
m = leaflet(data=concello_wgs84_Datos[1:17 & concello_wgs84_Datos#data[,i] == x], options = leafletOptions(minZoom = 8, maxZoom = 18)) %>%
addProviderTiles(providers$Esri.WorldImagery) %>% setView(-8.00, 42.80, zoom = 8.3) %>%
addPolygons(data=datos,
fill= TRUE,
fillColor = ~pal3(data),
stroke = FALSE,
color = "#0000CD",
smoothFactor = 0.5,
opacity = 1.0,
fillOpacity = 1,
weight = 0.5,
label = ~as.character(datos$CONCELLO),
labelOptions = labelOptions(noHide = F,
textsize = "7px",
direction = "topright"),
highlightOptions = highlightOptions(color = "white",
weight = 1,
bringToFront = TRUE)) %>%
addCircles(data = coordenadasOAC,
lat = ~ coordenadasOAC$LAT,
lng = ~ coordenadasOAC$LONG,radius =0.3,
color="#CD3333",
fillOpacity = 0.8,
popup = ~as.character(coordenadasOAC$OAC)) %>%
addLegend("bottomleft",
pal = pal3,
values = data,
title = nombre,
labFormat = labelFormat(prefix = ""),opacity = 1)})
htmltools::tagList(createMap)
but I have the following error: Error in`[.data.frame´(x#data,i,j,...,drop=False): undefined columns selected.
Could you help me?
# From http://leafletjs.com/examples/choropleth/us-states.js
states <- geojsonio::geojson_read("json/us-states.geojson", what = "sp")
bins <- c(0, 10, 20, 50, 100, 200, 500, 1000, Inf)
pal <- colorBin("YlOrRd", domain = states$density, bins = bins)
labels <- sprintf(
"<strong>%s</strong><br/>%g people / mi<sup>2</sup>",
states$name, states$density
) %>% lapply(htmltools::HTML)
leaflet(states) %>%
setView(-96, 37.8, 4) %>%
addProviderTiles("MapBox", options = providerTileOptions(
id = "mapbox.light",
accessToken = Sys.getenv('MAPBOX_ACCESS_TOKEN'))) %>%
addPolygons(
fillColor = ~pal(density),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(pal = pal, values = ~density, opacity = 0.7, title = NULL,
position = "bottomright")
The above code is copied from https://rstudio.github.io/leaflet/choropleths.html.
I am trying to reproduce the output. However, I got stuck in the first step - downloading the geojson file. I used the link shown in the first line, and save it as a text file and then rename it as a geojson file. But I failed to read that file. Obviously something wrong with file download or loading to R, but I have no idea where it is.
Can someone give any instructions? I have never deal with geojson data before. I just need help with the first two lines of codes, and I can handle all the others by myself.
The download file has a javascript assignment at the head. Removing it seems to fix the issue ,
library(geojson)
library(geojsonio)
url <- "http://leafletjs.com/examples/choropleth/us-states.js"
# read as text file
doc <- readLines(url)
# remove the javascript assignment at the front
doc2 <- gsub("var statesData = ", "", doc)
# write out as a temp file and read
write(doc2, file = "tempgeo.json")
states <- geojson_read("tempgeo.json", what = "sp")