Loop through dataframe and produce individual location maps - r

I want to loop through a dataframe that contains different monitoring sites and produce an individual leaflet map for each site.
See the minimal example below. I realize the loop, as written, will just overwrite each map. In my actual file, each site will have its own individual .html file with some ancillary information specific to each site produced at the end of the loop.
Is it possible to create leaflet maps in this way while retaining the for-loop? Do I need to add in a step that filters the larger dataframe based on the current site in the loop, and use that? Thanks in advance!
library(leaflet)
library(dataRetrieval)
# Create dataframe with 3 example sites
site1 <- readNWISsite(372322081241501)
site2 <- readNWISsite(380252079472801)
site3 <- readNWISsite(372223080234801)
df <- rbind(site1, site2)
df <- rbind(df, site3)
# Create a location map for each individual site in df
map <- leaflet()
q <- length(df$site_no)
for (j in 1:q) {
map %>%
addCircleMarkers(
lng = df[j]$dec_long_va,
lat = df[j]$dec_lat_va,
radius = 9.0,
color = "black",
weight = 1,
fillColor = "gray",
stroke = T,
fillOpacity = 1.0
)
}
# Error in validateCoords(lng, lat, funcName) :
# addCircleMarkers requires non-NULL longitude/latitude values

First, the issue with your code is that you have use df[j, ] instead of df[j] to get the first row of your data. But IMHO you could achieve your result much easier by using a list and to use lapply to read your data and to create your maps. Not sure what's the next step in your workflow. As you say that you want to add the maps to a HTML document per site you could for example loop over the list of maps to add them to create your documents.
library(leaflet)
library(dataRetrieval)
siteNumbers <- c(372322081241501, 380252079472801, 372223080234801)
names(siteNumbers) <- paste0("site", seq_along(siteNumbers))
sites <- lapply(siteNumbers, readNWISsite)
lapply(sites, function(x) {
leaflet() %>%
addCircleMarkers(
data = x,
lng = ~dec_long_va,
lat = ~dec_lat_va,
radius = 9.0,
color = "black",
weight = 1,
fillColor = "gray",
stroke = T,
fillOpacity = 1.0
)
})
#> $site1
#>
#> $site2
#>
#> $site3
But just in case. If you want to stick with the for loop you could achieve the same result like so:
library(leaflet)
library(dataRetrieval)
# Create dataframe with 3 example sites
site1 <- readNWISsite(372322081241501)
site2 <- readNWISsite(380252079472801)
site3 <- readNWISsite(372223080234801)
df <- rbind(site1, site2)
df <- rbind(df, site3)
map <- leaflet()
maps <- list()
for (j in seq(nrow(df))) {
maps[[j]] <- map %>%
addCircleMarkers(
lng = df[j, "dec_long_va"],
lat = df[j, "dec_lat_va"],
radius = 9.0,
color = "black",
weight = 1,
fillColor = "gray",
stroke = T,
fillOpacity = 1.0
)
}
maps
#> [[1]]
#>
#> [[2]]
#>
#> [[3]]

Related

Map vector group in specific order - R leaflet

I have a shapefile with polylines of routes in different years. Here is an example data shapefile with routes in the year 2000 and year 2013. I would like the map to show the older routes at the top and more recent routes at the bottom. I've had a look at the addMapPane function but not sure how to apply it for a vector in the same file. Here is my code so far:
sample_palette <- leaflet::colorFactor(palette = rainbow(2),
domain = data_sample$Year)
sample_plot <- leaflet(data_sample) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolylines(color = ~sample_palette(Year),
opacity = 1) %>%
leaflet::addLegend(values = ~Year,
opacity = 1,
pal = sample_palette,
title = "Routes")
sample_plot
I am using leaflet and R.
Please find one possible solution to get the older routes on top of recent routes: just need to change the order of rows in data_sample
Code
library(sf)
library(leaflet)
data_sample <- st_read("ADD YOUR PATH HERE")
# Order 'data_sample' rows in decreasing order of 'Year'
data_sample <- data_sample %>%
arrange(., desc(Year))
# Choose colors
sample_palette <- leaflet::colorFactor(palette = rainbow(2),
domain = data_sample$Year)
# Build the map
sample_plot <- leaflet(data_sample) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolylines(color = ~sample_palette(Year),
opacity = 1) %>%
leaflet::addLegend(values = ~Year,
opacity = 1,
pal = sample_palette,
title = "Routes")
Visualization
sample_plot

How to filter a raster layer and plot only the cells above a certain value in R using Leaflet?

I have a raster layer that contains 24-hour snow accumulations across the United States. The data can be pulled from here:
https://www.nohrsc.noaa.gov/snowfall_v2/data/202105/sfav2_CONUS_24h_2021052412.tif
I only want to plot the cells in the raster with values greater than or equal to 4 (inches) on a leaflet map. This is what my current map looks like:
https://i.stack.imgur.com/2Mi4r.png
I changed all values less than 4 to NA thinking that the raster cells wouldn't show up on the map. I want to remove all cells on the map that are greyed-out. The functions subset() and filter() do not work on raster layers. Any ideas? My code below for reference:
library(dplyr)
library(rgdal)
library(raster)
library(ncdf4)
library(leaflet)
library(leaflet.extras)
download.file(obsvSnow_Link, destfile = file.path(folderpath, 'observedSnow.tif'))
obsvSnow <- raster(file.path(folderpath, 'observedSnow.tif'))
names(obsvSnow) <- 'snowfall'
obsvSnow[obsvSnow < 4,] <- NA
colores <- c("transparent","#99CCFF","#3399FF","#0000FF","#FFE066", "#FF9900", "#E06666","#CC0000","#990033")
at <- c(4,8,seq(12,42,6),100)
cb <- colorBin(palette = colores, bins = at, domain = at)
mp <- leaflet(width = "100%",options = leafletOptions(zoomControl = FALSE)) %>%
addTiles() %>%
addRasterImage(x=obsvSnow$snowfall,
colors = cb,
opacity = 0.6) %>%
addLegend(title = 'Inches',
position='bottomright',
pal = cb, values = at) %>%
leaflet.extras::addSearchUSCensusBureau(options = searchOptions(autoCollapse=TRUE, minLength=10)) %>%
addScaleBar(position='bottomleft') %>%
addFullscreenControl()
mp

Chloropleth graph colours in the wrong countries

Bit of a strange problem using the leaflet package on R. I'm trying to colour in certain countries depending on how many users are in those countries. Everything goes well, except the countries are being coloured in with the wrong data. So for example, Morocco is being coloured in as if it were Jordan, etc.
I'm working with this free world map shapefile: http://thematicmapping.org/downloads/world_borders.php
When I draw a map with only the data included with the shapefile (data$POP2005), everything is fine. So perhaps there is a problem with my join?
user_data table:
NAME USERS
Morocco 250
Jordan 1000
Canada 5007
Code used:
world <- readOGR(dsn=path.expand("~/TM_WORLD_BORDERS_SIMPL-0.3"),
layer="TM_WORLD_BORDERS_SIMPL-0.3")
world#data <- merge(world#data, user_data, by="NAME", all.x = TRUE)
pal <- colorBin("YlOrRd", domain = world#data$USERS, bins = 5)
m <- leaflet(world) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(world#data$USERS),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7)
m
When I try the code above, Morocco is showing as 1000 users (the result Jordan should have). Other countries are similarly incorrect. What am I doing wrong?
Many thanks!
I think that by merging world#data with itself is causing some strange interactions that are hard to track down (for example, in my first attempt Morocco was fine but Cuba was red). Instead I used sp::merge from the sp package which allowed me to simplify my code a bit:
library(rgdal)
library(leaflet)
user_data <- data.frame(NAME = c("Morocco", "Jordan", "Canada"),
USERS = c(250, 1000, 5007))
world <- readOGR(dsn="TM_WORLD_BORDERS_SIMPL-0.3.shp",
layer="TM_WORLD_BORDERS_SIMPL-0.3")
world_merged <- sp::merge(world, user_data)
pal <- colorBin("YlOrRd", domain = world_merged$USERS, bins = 5)
m <- leaflet(world) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(world_merged$USERS),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7)
m
And yielded this leaflet map (zoomed in here):

Mapping Bus Routes with Leaflet in R

I recently found this shape file of NYC bus routes shape file of NYC bus routes (zip file) that I am interested in plotting with the leaflet package in R.
When I attempt to do so, some routes do not show up on the map. I can tell they're missing because I overlay the bus stop data and some do not line up with the routes.
When I read in the shape file, I notice that the spatial lines data frame that is created has nested lists, which I think leaflet is not mapping.
What do I need to do so that leaflet reads coordinates of these missing routes? Below is the code I used to produce the map with missing routes:
bus <- readOGR(dsn = path.expand("bus_route_shapefile"), layer = "bus_route_shapefile")
bus.pj <- spTransform(bus, CRS("+proj=longlat +datum=WGS84"))
bus.st <- readOGR(dsn = path.expand("bus_stop_shapefile"), layer = "bus_stop_shapefile")
bus.st.pj <- spTransform(bus.st, CRS("+proj=longlat +datum=WGS84"))
bus_map <- leaflet() %>%
setView(lng = -73.932667, lat = 40.717266, zoom = 11) %>%
addPolylines(data = bus.pj, color = "black", opacity = 1) %>%
addCircles(data=bus.st.pj#data,~stop_lon, ~stop_lat, color = "red") %>%
addTiles()
bus_map
It would be easier to help you if you provided not only bus_routes but also bus_stop (zip file). You can solve it by converting bus.pj into new SpatialLinesxxx obj where each class Lines has only one class Line. SLDF below code makes doesn't have bus.pj#data$trip_heads because of unknown.
library(dplyr); library(sp); library(leaflet)
## resolve bus.pj#lines into list(Line.objs) (Don't worry about warnings)
Line_list <- lapply(bus.pj#lines, getLinesLinesSlot) %>% unlist()
## If you want just Lines infromation, finish with this line.
SL <- sapply(1:length(Line_list), function(x) Lines(Line_list[[x]], ID = x)) %>%
SpatialLines()
## make new ids (originalID_nth)
ori_id <- getSLLinesIDSlots(bus.pj) # get original ids
LinLS <- sapply(bus.pj#lines, function(x) length(x#Lines)) # how many Line.obj does each Lines.obj has
new_id <- sapply(1:length(LinLS), function(x) paste0(x, "_", seq.int(LinLS[[x]]))) %>%
unlist()
## make a new data.frame (only route_id)
df <- data.frame(route_id = rep(bus.pj#data$route_id, times = LinLS))
rownames(df) <- new_id
## integrate Line.objs, ids and a data.frame into SpatialLinesDataFrame.obj
SLDF <- mapply(function(x, y) Lines(x, ID = y), x = Line_list, y = new_id) %>%
SpatialLines() %>% SpatialLinesDataFrame(data = df)
leaflet() %>%
setView(lng = -73.932667, lat = 40.717266, zoom = 11) %>%
addPolylines(data = SLDF, color = "black", opacity = 1, weight = 1) %>%
addCircles(data=bus.st.pj#data,~stop_lon, ~stop_lat, color = "red", weight = 0.3)

radius of circles in leaflet app to be driven by the selectInput

I am trying to make the radius of my circle markers in this Shiny leaflet app be driven by the selectInput variable.
The dropdown has three values, "Week.1", "Week.2" and "Week.3", which are all numeric vectors (of large dollar revenue values in millions) in the d at the bottom of this question.
selectInput("weekView", "Week's Revenue:",
c("1" = "Week.1",
"2" = "Week.2",
"3" = "Week.3")),
I am currently loading Week.1 and get thr result. I wNt the input to change the weeks and react with the corresponding $ on the map.
When I try and use input$weekView instead of the static ~(Week.1), I get errors as it is "Week.1". I've tried using quote = False in place to remove them before the radius is calculated but I'm failing to find the right place to do so...
leaflet(data = P) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addCircleMarkers(~Long, ~Lat, popup = ~Week.1,
radius = ~(Week.1)/40000,
stroke = FALSE,
fillOpacity = 0.5)
Can any one advise on how best to go about this? What I want to say is
radius = input$weekView/40000
All the script:
library(shiny)
library(leaflet)
ui <- fluidPage(
selectInput("weekView", "Week's Revenue:",
c("1" = "Week.1",
"2" = "Week.2",
"3" = "Week.3")),
leafletOutput("mymap"),
p()
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
x <- input$weekView
P<- read.csv("Lebara_weeks_rev4.csv")
as.numeric(P$Long)
as.numeric(P$Lat)
as.character(P$Week.1)
P$Week.1 <- as.numeric(gsub(",","",P$Week.1))
P$Week.2 <- as.numeric(gsub(",","",P$Week.2))
P$Week.3 <- as.numeric(gsub(",","",P$Week.3))
long <- P$Long
Lat <- P$Lat
leaflet(data = P) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addCircleMarkers(~Long, ~Lat, popup = ~Week.1,
radius = ~(Week.1)/40000,
stroke = FALSE,
fillOpacity = 0.5)
})
}
shinyApp(ui, server)
Head of the df = P
> head(P)
group Lat Long Country Week.1 Week.2 Week.3 Week.4
1 178.100 55.37805 -3.435973 United Kingdom 649,613 665,147 640,732 649,642
2 174.890 51.16569 10.451526 Germany 117,766 120,402 104,167 91,157
3 144.100 46.22764 2.213749 France 135,784 117,759 109,337 101,873
4 174.211 52.13263 5.291266 Netherlands 403,950 397,438 377,855 389,345
5 174.990 40.46367 -3.749220 Spain 94,472 95,742 88,313 86,400
6 178.600 56.26392 9.501785 Denmark 70,094 72,487 67,597 66,769
Thanks!
Pete
I used tidyr and subsetWeek1 <- P[1:7,] then made variables for the subsetWeek1$value/40000 to make them small enough for the radius values) of those subsets. I tried to make the selectInput 1 = subsetWeek1$value, 2 = subsetWeek2$value and 3 = subsetWeek3$value...
library(tidyr)
P <- tidyr::gather(P, week, value, Week.1:Week.3)
subsetWeek1 <- P[1:7,]
subsetWeek2 <- P[8:14,]
subsetWeek3 <- P[15:21,]
Week1val <- subsetWeek1$value
Week2val <- subsetWeek2$value
Week3val <- subsetWeek3$value
This doesn't seem to pick up the selectInput value and change the map. There are no markers on the map and no errors provided. Could it be the scale of the circles makes them invisible? In the non-app version they are OK.
You're close, you just need to update variable names and clean up a bit. Generally, if you're repeating the same line with a slightly different parameter, there's a better way. An option, using tidyr for gather and extract_numeric:
library(shiny)
library(tidyr)
library(leaflet)
P <- read.csv("Lebara_weeks_rev4.csv")
# do munging that won't change based on input here
P2 <- gather(P, week, value, Week.1:Week.4) # gather to long form
P2$value <- extract_numeric(P2$value) # convert to numeric
ui <- fluidPage(
selectInput("weekView", "Week's Revenue:",
c("1" = "Week.1",
"2" = "Week.2",
"3" = "Week.3",
"4" = "Week.4")),
leafletOutput("mymap")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
# do munging dependent on input here
P3 <- P2[P2$week == input$weekView, ] # subset based on input
leaflet(data = P3) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addCircleMarkers(lng = ~Long, lat = ~Lat,
popup = ~format(value, big.mark = ','), # reinsert commas
radius = ~value/40000,
stroke = FALSE,
fillOpacity = 0.5)
})
}
shinyApp(ui, server)

Resources