How can I change the background color of this Treemap Chart according to the colors in my colors column of my highchart in R/Shiny?
This is my code:
library(highcharter)
library(tidyverse)
library(gapminder)
library("RColorBrewer")
colors <- c(brewer.pal(n = 9, name = "Greens"),
brewer.pal(n = 11, name = "BrBG"),
brewer.pal(n = 5, name = "RdBu"))
data <- gapminder::gapminder %>%
dplyr::filter(year == 2007, continent == 'Americas') %>% mutate(colors = colors)
data %>%
highcharter::data_to_hierarchical(group_vars = c(continent, country),
size_var = pop) %>%
hchart(type = "treemap",colorByPoint = TRUE)
How about this?
data %>%
highcharter::data_to_hierarchical(group_vars = c(continent, country),
size_var = pop) %>%
hchart(type = "treemap",colorByPoint = TRUE) %>%
hc_colors(colors = colors)
I'm making an interactive map of squirrels chasing behavior in New York central Park and I'm using "leaflet" in R.I want to use different colors to distinguish the different times (PM,AM) so that we can see how chasing behavour varies across.
pal <- colorNumeric(palette = "RdYlBu",domain = d$chasingInt)
d %>%
filter(!is.na(chasingInt)) %>%
leaflet() %>%
addTiles() %>%
addCircleMarkers(lng = ~x,
lat = ~y, radius = 3, stroke = FALSE, fillOpacity = 0.5) %>%
addLegend(position ="bottomright", pal = pal, values = ~ chasingInt)%>%
addCircleMarkers(~x,
~y,
radius = ~chasingInt/10,
color ="red",
stroke = FALSE,
fillOpacity = 0.4,
group = "shift",
popup = ~as.character(shift))
All PM and AM are colored as red so there is no difference on the plot
How can I render a plotly map with only a single color. In the example below, I would like the fill for all states to be red, or #FF0000.
library(plotly)
library(tidyverse)
dat <- data.frame(state = state.abb)
plot_ly(dat,
type = "choropleth",
locationmode = 'USA-states',
locations = ~state) %>%
add_trace(color = "red") %>%
layout(geo = list(
projection = list(
type = "albers usa")))
From what I understand of the plotly documentation this is a way to achive it (cloropleth is kind of heatmap but you want one color for all):
library(plotly)
dat <- data.frame(state = state.abb)
plot_ly(dat,
type = "scattergeo",
mode = 'none',
locationmode = 'USA-states',
locations = ~state) %>%
layout(geo = list(landcolor = "#FF0000",
showland = TRUE,
projection = list(type = "albers usa")))
This question already has an answer here:
Colorbar in legend when using plotly
(1 answer)
Closed 2 years ago.
I am trying change the scale title in plotly but am a little stumped. Here is the basic plot I am creating:
library(sf)
library(plotly)
library(magrittr)
nc <- st_read(system.file("shape/nc.shp", package="sf"))
nc %>%
plot_ly(split = ~AREA,
color = ~AREA,
showlegend = FALSE)
Now really what I want is to change the title of currently specified by "AREA". You can change the title of the plot like so:
nc %>%
plot_ly(split = ~AREA,
color = ~AREA,
showlegend = FALSE) %>%
layout(legend=list(title=list(text='<b> A title? </b>')))
My first attempt was to simply replace legend with scale:
nc %>%
plot_ly(split = ~AREA,
color = ~AREA,
showlegend = FALSE) %>%
layout(scale=list(title=list(text='<b> A title? </b>')))
that didn't work and neither did this:
nc %>%
plot_ly(split = ~AREA,
color = ~AREA,
colorbar = "foo",
showlegend = FALSE)
Any ideas how I can change the title for the colorbar?
You were almost there... Try this:
library(sf)
library(plotly)
library(magrittr)
nc = st_read(system.file('shape/nc.shp', package = 'sf'))
title = '' # insert your title here
nc %>%
plot_ly(split = ~AREA, color = ~AREA, showlegend = FALSE) %>%
layout(legend = list(title = list(text = paste('<b>', title, '</b>'))))
Let me know if it solved your problem...
What I like to do
I like to plot isochrones from multiple locations on a map so I can visually find the travel time from an arbitrary town to the closest location. It should look like a kernel density 2D plot:
library(purrr)
library(ggmap)
locations <- tibble::tribble(
~city, ~lon, ~lat,
"Hamburg", 9.992246, 53.550354,
"Berlin", 13.408163, 52.518527,
"Rostock", 12.140776, 54.088581
)
data <- map2_dfr(locations$lon, locations$lat, ~ data.frame(lon = rnorm(10000, .x, 0.8),
lat = rnorm(10000, .y, 0.7)))
ger <- c(left = min(locations$lon) - 1, bottom = min(locations$lat) - 1,
right = max(locations$lon) + 1, top = max(locations$lat) + 1)
get_stamenmap(ger, zoom = 7, maptype = "toner-lite") %>%
ggmap() +
stat_density_2d(data = data, aes(x= lon, y = lat, fill = ..level.., alpha = ..level..),
geom = "polygon") +
scale_fill_distiller(palette = "Blues", direction = 1, guide = FALSE) +
scale_alpha_continuous(range = c(0.1,0.3), guide = FALSE)
What I tried
You can easily get isochrones via osrm and plot them with leaflet. However, these isochrones are independent from each other. When I plot them they overlap each other.
library(osrm)
library(leaflet)
library(purrr)
library(ggmap)
locations <- tibble::tribble(
~city, ~lon, ~lat,
"Hamburg", 9.992246, 53.550354,
"Berlin", 13.408163, 52.518527,
"Rostock", 12.140776, 54.088581
)
isochrone <- map2(locations$lon, locations$lat,
~ osrmIsochrone(loc = c(.x, .y),
breaks = seq(0, 120, 30))) %>%
do.call(what = rbind)
isochrone#data$drive_times <- factor(paste(isochrone#data$min, "bis",
isochrone#data$max, "Minuten"))
factpal <- colorFactor("Blues", isochrone#data$drive_times, reverse = TRUE)
leaflet() %>%
setView(mean(locations$lon), mean(locations$lat), zoom = 7) %>%
addProviderTiles("Stamen.TonerLite") %>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",
fillColor = ~factpal(isochrone#data$drive_times),
weight = 0.5, fillOpacity = 0.6,
data = isochrone, popup = isochrone#data$drive_times,
group = "Drive Time") %>%
addLegend("bottomright", pal = factpal, values = isochrone#data$drive_time,
title = "Fahrtzeit")
How can I merge these isochrone so that they don't overlap?
Really cool question. What you want to do is merge the shapes by ID, so all the 0-30 minute areas are one shape, all the 30-60 minute areas are another, and so on. There are ways to do this with other spatial packages, but it seems well-suited to sf, which uses dplyr-style functions.
After you create isochrone, you can convert it to a sf object, make the same type of distance label, group by ID, and call summarise. The default when you summarize sf objects is just a spatial union, so you don't need to supply a function there.
library(sf)
library(dplyr)
iso_sf <- st_as_sf(isochrone)
iso_union <- iso_sf %>%
mutate(label = paste(min, max, sep = "-")) %>%
group_by(id, label) %>%
summarise()
I didn't have leaflet handy, so here's just the default print method:
plot(iso_union["label"], pal = RColorBrewer::brewer.pal(4, "Blues"))
I'm not sure what's up with the areas that have abrupt vertical edges, but those are in your plot as well.
I had a hard time using the map2 method you used because it does both a union as well as, I think, another set theory like function to create specific intervals. Instead, I would recommend creating a raster layer of the layers you create and apply one opacity to that one raster, like the ggmap example does. There's an excellent blog post that I stole alot of code from here (along with from user:camille).
It uses a different API that requires mapbox but it is free. Another limitation is that it won't return isocrones that are the size you like but I recreated it in another location where three points are closer together to prove the method.
I also didn't bother vectorizing the process of creating the isocrone web request so I leave that to someone smarter.
# First be sure to get your mapbox token
library(fasterize)
library(sf)
library(mapboxapi)
library(leaflet)
#mapboxapi::mb_access_token("Go get the token and put it here",
# install = TRUE, overwrite = TRUE)
isos1 <- mb_isochrone(
location = c("-149.883234, 61.185765"),
profile = "driving",
time = c(5,10,15),
)
isos2 <- mb_isochrone(
location = c("-149.928200, 61.191227"),
profile = "driving",
time = c(5,10,15),
)
isos3 <- mb_isochrone(
location = c("-149.939484, 61.160192"),
profile = "driving",
time = c(5,10,15),
)
library(sf)
library(dplyr)
isocrones <- rbind(isos1,isos2,isos3)
iso_sf <- st_as_sf(isocrones)
iso_union <- iso_sf %>%
group_by(time) %>%
summarise()
isos_proj <- st_transform(iso_sf, 32615)
template <- raster(isos_proj, resolution = 100)
iso_surface <- fasterize(isos_proj, template, field = "time", fun = "min")
pal <- colorNumeric("viridis", isos_proj$time, na.color = "transparent")
leaflet() %>%
addTiles() %>%
addRasterImage(iso_surface, colors = pal, opacity = 0.5) %>%
addLegend(values = isos_proj$time, pal = pal,
title = "Minutes of Travel") %>%
addMarkers(lat = c(61.185765, 61.191227, 61.160192), lng = c(-149.883234, -149.928200, -149.939484))