Related
Anyone created a leaflet map in Code Workbook using r-Leaflet? I have a functioning script that runs (also double checked in R) but how do I get it to visualise and then use in a Report etc. I have tried various tweaks on what may get it to run but no success - any ideas
leaflet_map <- function(map_data) {
library(leaflet)
data<-map_data
# first cut the continuous variable into bins
# these bins are now factors
data$Fill_rateLvl <- cut(data$Fill_rate,
c(0,.5,0.6,0.7,0.8,0.9,1), include.lowest = T,
labels = c('<50%', '50-60%', '60-70%', '70-80%', '80-90%','90-100%'))
# then assign a palette to this using colorFactor
# in this case it goes from red for the smaller values to yellow and green
# standard stoplight for bad, good, and best
FillCol <- colorFactor(palette = 'RdYlGn', data$Fill_rateLvl)
m<-leaflet() %>%
addTiles() %>%
addProviderTiles(providers$CartoDB.Positron)%>%
setView(lng = -0, lat = 50, zoom = 8) %>%
addCircleMarkers(data = data, lat = ~lat, lng = ~long,
color = ~FillCol(Fill_rateLvl), popup = data$Lead_employer,
radius = ~sqrt(Fill_rate*50), group = 'Fill rate') %>%
addLegend('bottomright', pal = FillCol, values = data$Fill_rateLvl,
title = 'Fill rate for next two weeks',
opacity = 1)
return(NULL)
}
I am not familiar with R in code workbook, but it sounds to me that you need to materialize your leaflet map as a dataset and then consume it in some sort of map compatible UI.
For example slate has a map widget which is backed by leaflets. You can find documentation and examples for it in https://www.palantir.com/docs/foundry/slate/widgets-map/
I have a dataset that includes both a date and a species for each bird observed in a county. I've mapped them using leaflet, but want to use two AddLayersControl to control for both the date and the species. Right now I can only control for the year or the species. I would like the second group of checkboxes so I can control the species as well. I want the marker to go away if either its year group is unchecked or its species group is unchecked.
What I think I need to do is to assign each marker to two different groups that I could control independently. I don't think I am able to assign certain markers as base layers because I don't want a certain subset of them always available. I have also tried just adding another AddLayersControl - sadly the second one will always win and it doesn't seem like you can have two on the same map.
library(leaflet)
library(magrittr)
library(dplyr)
library(htmltools)
# Data
birds <- data.frame(observed_on = c("4/4/2009",
"4/1/2009",
"3/6/2016",
"2/9/2016"),
url = c("http://www.inaturalist.org/observations/2236",
"http://www.inaturalist.org/observations/2237",
"http://www.inaturalist.org/observations/2778201",
"https://www.inaturalist.org/observations/9796150"),
latitude = c(43.08267975,
43.0844841,
43.055512,
43.0180932),
longitude = c(-89.43265533,
-89.43793488,
-89.314878,
-89.52836138),
scientific_name = c("Agelaius phoeniceus",
"Bubo virginianus",
"Quiscalus quiscula",
"Strix varia"),
common_name = c("Red-winged Blackbird",
"Great Horned Owl",
"Common Grackle",
"Barred Owl"),
taxon_order_name = c("Passeriformes",
"Strigiformes",
"Passeriformes",
"Strigiformes"),
taxon_species_name = c("Agelaius phoeniceus",
"Bubo virginianus",
"Quiscalus quiscula",
"Strix varia" ),
year = c("2009", "2009", "2016", "2016"))
# Leaflet Chart Formatting --------------------------------------------------------
palette <- colorFactor(palette = rainbow(length(unique(birds$taxon_order_name))),
domain = birds$taxon_order_name)
# Leaflet Chart -------------------------------------------------------------------
mymap <- leaflet(birds) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
setView(lng = -89.398721,
lat = 43.071580,
zoom = 13)
for (t in unique(birds$year)){
sub <- birds[birds$year == t,]
labels <- mapply(function(x, y, z, a) {
HTML(sprintf("%s<br><em>%s</em><br>%s<br><a href=%s>link</a>",
htmlEscape(x),
htmlEscape(y),
htmlEscape(z),
htmlEscape(a)))},
sub$common_name,
sub$taxon_species_name,
sub$observed_on,
sub$url,
SIMPLIFY = FALSE)
mymap <- mymap %>%
addCircleMarkers(data = sub,
lng = ~longitude,
lat = ~latitude,
fillOpacity = 0.6,
radius = 8,
fillColor = ~palette(taxon_order_name),
color = "black",
weight = 1,
opacity = 0.5,
popup = labels,
group = as.character(t))
}
mymap %>%
addLegend(pal = palette,
values = ~taxon_order_name,
title = "Taxon Order") %>%
addLayersControl(overlayGroups = as.character(unique(birds$year)),
options = layersControlOptions(collapsed = FALSE))
# addLayersControl(overlayGroups = unique(birds$taxon_order_name), options = layersControlOptions(collapsed = FALSE))
map showing points with both year and species info but layers control for the only year
does this work?
addLayersControl(overlayGroups = as.character(c(unique(birds$year),unique(birds$taxon_order_name)), options = layersControlOptions(collapsed = FALSE))
I can get all US counties and I can get one state, but I can't get all the counties from two states into the same map. Here is my R code:
hcmap("countries/us/us-all-all", data = dataframe, value = "value1",
joinBy = c("name"), name = "Name",
dataLabels = list(enabled = TRUE, format = "{point.name}"),
tooltip = list(valueDecimals = 0, valueSuffix = "%"),
pointFormat = "County: {point.name}<br/>{point.value1}")
I tried downloading each state's data:
camapdata <- get_data_from_map(download_map_data("countries/us/us-ca-all"))
nvmapdata <- get_data_from_map(download_map_data("countries/us/us-nv-all"))
Then combining into one data set, but then hcmap errors because it's not a URL.
I can also download and filter the whole US map:
mapdata <- get_data_from_map(download_map_data("countries/us/us-all-all"))
canvmap <- filter(mapdata, `hc-key` == "us-ca*")
but get the same problem.
Is there a way to filter the US county map to specific states within the hcmap function?
This is the best I have so far--but I can only get CA and NV in one map...
camapdata <- get_data_from_map(download_map_data("countries/us/us-ca-all"))
nvmapdata <- get_data_from_map(download_map_data("countries/us/us-nv-all"))
states2<-join(camapdata,nvmapdata,by=c("fips"), type="full",match="all")
setnames(states2, old=c("hc-a2"), new=c("STABBR"))
setnames(states2, old=c("hc-middle-y"), new=c("HCMIDDLE"))
XXX<-sqldf("select * from states2 where STABBR in ('CA','OR')")
library(highcharter)
hcmap("countries/us/us-all-all", data = states2, value = "HCMIDDLE",
joinBy = c("name"), name = "Name",
dataLabels = list(enabled = TRUE, format = "{point.name}"),
tooltip = list(valueDecimals = 0, valueSuffix = "%"),
pointFormat = "County: {point.name}<br/>{point.value1}")
I'm trying to render a graph in a shiny app using highcharter that shares an x-axis (days) but has multiple y-axes (a percent and a count). After some research it seems like I should use the 'hc_yAxis_multiples' method. On the left y-axis, I have % displayed. On the right y-axis, I want the count displayed. There is a line graph that is based on the left y-axis (%), and a stacked bar graph that is displayed based on the right y-axis.
I have been able to overlay the two graphs, but the bar chart portion based on the right y-axis is not formatted to the corresponding y-axis. Based on what I have been looking at, it seems like something like this would produce a result that I want:
##This first block is to show what the data types of the variables I'm using are and what the structure of my df looks like
df$inbox_rate <- df$total_inbox / df$total_volume
df$inbox_rate <- round((df$inbox_rate*100),0)
df$received_dt <- as.character(df$received_dt)
df$received_dt <- as.Date(df$received_dt, "%Y%m%d")
df <- df[order(df$received_dt),]
## This second block here is where I'm trying to build the chart with two Y-axes
hc <- highchart()%>%
hc_title(text = paste(domain_name,sep=""),align = "center") %>%
hc_legend(align = "center") %>%
hc_xAxis(type = "datetime", labels = list(format = '{value:%m/%d}')) %>%
hc_yAxis_multiples(list(title = list(text = "IPR"),labels=list(format = '{value}%'),min=0,
max=100,showFirstLabel = TRUE,showLastLabel=TRUE,opposite = FALSE),
list(title = list(text = "Total Subscribers"),min=0,max = max(df$total_users),
labels = list(format = "{value}"),showLastLabel = FALSE, opposite = TRUE)) %>%
hc_plotOptions(column = list(stacking = "normal")) %>%
hc_add_series(df,"column",hcaes(
x=received_dt,y=total_users,group=isp,yAxis=total_users)) %>%
hc_add_series(df,type="line",hcaes(
x=received_dt,y=inbox_rate,group=isp,yAxis=inbox_rate)) %>%
hc_exporting(enabled = TRUE) %>%
hc_add_theme(thm)
hc
However this produces something that looks like this.
To give more insight about the data I'm using, the domain_name is a string variable that looks like this: example.com. The total_users variable is a number that varies from 0 to about 50000. The received_dt variable is a date, formatted using as.Date(df$received_dt, "%Y%m%d"). The inbox_rate variable is a percent, from 0 to 100.
The bar counts are all displaying to the full height of the graph, even though the values of the bars vary widely. To reiterate, I want the right y-axis that the bar chart heights are based on to be the count of the df$total_users. Within the hc_yAxis_multiples function, there are two lists given. I thought that the first list gives the left y-axis, and the second gives the right. The closest answer to my question that I could find was given by this stackoverflow response
If anyone has any insight, it would be very much appreciated!
Your use of the yAxis statement in hc_add_series seems to be off. First, it should not be inside hcaes and second, it's a number specifying which axis (in order of appearance in hy_yAxis_multiple call) the series belongs to. So hc_add_series(..., yAxis = 1) should be used to assign a series to the second (right) axis.
Below is a (fully self-explaining, independent, minimal) example that shows how it should work.
library(highcharter)
df <- data.frame(
total_inbox = c(2, 3, 4, 5, 6),
total_volume = c(30, 30, 30, 30, 30),
total_users = c(300, 400, 20, 340, 330),
received_dt = c("20180202", "20180204", "20180206", "20180210", "20180212"),
isp = "ProviderXY"
)
df$inbox_rate <- df$total_inbox / df$total_volume
df$inbox_rate <- round((df$inbox_rate*100),0)
df$received_dt <- as.character(df$received_dt)
df$received_dt <- as.Date(df$received_dt, "%Y%m%d")
df <- df[order(df$received_dt),]
hc <- highchart()%>%
hc_xAxis(type = "datetime", labels = list(format = '{value:%m/%d}')) %>%
hc_yAxis_multiples(list(title = list(text = "IPR"),labels=list(format = '{value}%'),min=0,
max=100,showFirstLabel = TRUE,showLastLabel=TRUE,opposite = FALSE),
list(title = list(text = "Total Subscribers"),min=0,max = max(df$total_users),
labels = list(format = "{value}"),showLastLabel = FALSE, opposite = TRUE)) %>%
hc_plotOptions(column = list(stacking = "normal")) %>%
hc_add_series(df,type="column",hcaes(x=received_dt,y=total_users,group=isp),yAxis=1) %>%
hc_add_series(df,type="line",hcaes(x=received_dt,y=inbox_rate,group=isp))
hc
Maybe take this as an example how code in questions should be like. Copy-Paste-Runnable, no outside variables and minus all the things that dont matter here (like the theme and legend for example).
Is there a way to implement a time slider for Leaflet or any other interactive map library in R? I have data arranged in a time series, and would like to integrate that into a "motion" map where the plot points change dynamically over time.
I was thinking of breaking my data into pieces, using subset to capture the corresponding data table for each month. But how would I move between the different data sets corresponding to different months?
As it stands now, I took the average and plotted those points, but I'd rather produce a map that integrates the time series.
Here is my code so far:
data<-read.csv("Stericycle Waste Data.csv")
library(reshape2)
library(ggplot2)
library(plyr)
library(ggmap)
names(data)<-c("ID1","ID2", "Site.Address", "Type", "City", "Province", "Category", "Density", "Nov-14", "Dec-14", "Jan-15", "Feb-15", "Mar-15", "Apr-15", "May-15", "Jun-15", "Jul-15", "Aug-15", "Sep-15", "Oct-15", "Nov-15", "Dec-15", "Jan-16")
data<-melt(data, c("ID1","ID2", "Site.Address","Type", "City", "Province", "Category", "Density"))
data<-na.omit(data)
data_grouped<-ddply(data, c("Site.Address", "Type","City", "Province", "Category", "Density", "variable"), summarise, value=sum(value))
names(data_grouped)<-c("Site.Address", "Type", "City", "Province", "Category", "Density", "Month", 'Waste.Mass')
dummy<-read.csv('locations-coordinates.csv')
geodata<-merge(data_grouped, dummy, by.x="Site.Address", by.y="Site.Address", all.y=TRUE)
library(leaflet)
d = geodata_avg$density_factor
d = factor(d)
cols <- rainbow(length(levels(d)), alpha=NULL)
geodata_avg$colors <- cols[unclass(d)]
newmap <- leaflet(data=geodata_avg) %>% addTiles() %>%
addCircleMarkers(lng = ~lon, lat = ~lat, weight = 1, radius = ~rank*1.1, color = ~colors, popup = paste("Site Address: ", geodata_avg$Site.Address, "<br>", "Category: ", geodata_avg$Category, "<br>", "Average Waste: ", geodata_avg$value))
newmap
Thanks in advance! Any guidance/insight would be greatly appreciated.
Recognizing this is a very old question, in case anyone's still wondering...
The package leaflet.extras2 has some functions that might help. Here's an example that uses some tidyverse functions, sf, and leaflet.extras2::addPlayback() to generate and animate some interesting GPS tracks near Ottawa.
library(magrittr)
library(tibble)
library(leaflet)
library(leaflet.extras2)
library(sf)
library(lubridate)
# how many test data points to create
num_points <- 100
# set up an sf object with a datetime column matching each point to a date/time
# make the GPS tracks interesting
df <- tibble::tibble(temp = (1:num_points),
lat = seq(from = 45, to = 46, length.out = num_points) + .1*sin(temp),
lon = seq(from = -75, to = -75.5, length.out = num_points) + .1*cos(temp),
datetime = seq(from = lubridate::ymd_hms("2021-09-01 8:00:00"),
to = lubridate::ymd_hms("2021-09-01 9:00:00"),
length.out = num_points)) %>%
sf::st_as_sf(coords = c("lon", "lat"), crs = "WGS84", remove = FALSE)
# create a leaflet map and add an animated marker
leaflet() %>%
addTiles() %>%
leaflet.extras2::addPlayback(data = df,
time = "datetime",
options = leaflet.extras2::playbackOptions(speed = 100))
Here is an answer that may be of help.
Alternatively, you could provide the time series of a point as a popup graph using mapview::popupGraph. It is also possible to provide interactive, htmlwidget based graphs to popupGraph