I have a choropleth map created using plotly::plot_geo. I would like to add labels on top of the map so that, for instance, over the location of Alabama on the map, it would say 'AL (68)', but for all states, as in the example below:
Can anyone tell me if there is a way to do this?
library(tidyverse)
library(plotly)
set.seed(1)
density <- sample(1:100, 50, replace = T)
g <- list(
scope = 'usa',
projection = list(type = 'albers usa'),
lakecolor = toRGB('white')
)
plot_geo() %>%
add_trace(
z = ~density, text = state.name, span = I(0),
locations = state.abb, locationmode = 'USA-states'
) %>%
layout(geo = g)
Using your example, this is possible with plotly::plot_ly()
set.seed(1)
density <- sample(1:100, 50, replace = T)
g <- list(
scope = 'usa',
projection = list(type = 'albers usa'),
lakecolor = toRGB('white')
)
plot_ly() %>%
layout(geo = g) %>%
add_trace(type = "choropleth", locationmode = 'USA-states',
locations = state.abb,
z = ~density, text = state.name,
color = ~density, autocolorscale = TRUE) %>%
add_trace(type = "scattergeo", locationmode = 'USA-states',
locations = state.abb, text = paste0(state.abb, "\n", density),
mode = "text",
textfont = list(color = rgb(0,0,0), size = 12))
Output is:
Still not sure how to do this with plotly::plot_geo(), but this solution does allow you to stay within the plotly family.
I don't think this is reasonably possible in R, at least for the time being. However, this is supported in python (see #r-beginners comment and https://plotly.com/python/text-and-annotations/).
I am showing a couple of examples of alternative approaches using ggplot and leaflet, but each presents considerable drawbacks if you are wedded to plotly. Mapbox appears to be another option, but I have never used it. Examples using all of these packages in the article that was already linked in the comments (https://plotly-r.com/maps.html).
Example dataset
library(sf)
set.seed(1)
nc <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
nc$density <- sample(1:100, nrow(nc), replace = T)
nc$lat <- st_coordinates(st_centroid(nc))[,"Y"]
nc$lon <- st_coordinates(st_centroid(nc))[,"X"]
Plot with ggplot (static)
library(ggplot2)
ggplot(nc) +
geom_sf(aes(fill = density)) +
geom_text(
aes(x = lon, y = lat),
label = paste0(nc$NAME, "\n", "(", nc$density, ")"),
check_overlap = TRUE) +
scale_fill_viridis_c() +
theme_void()
Plot with leaflet (interactive)
library(leaflet)
library(viridis)
pal <- colorNumeric(viridis_pal(option = "C")(2), domain = nc$density)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
setView(-80, 34.5, zoom = 6.2) %>%
addPolygons(
data = nc,
fillColor = ~pal(nc$density),
fillOpacity = 0.8,
weight = 0.2,
smoothFactor = 0.2,
popup = ~density) %>%
addLabelOnlyMarkers(
lng = nc$lon,
lat = nc$lat,
label = paste0(nc$NAME, "\n", "(", nc$density, ")"),
#label = "LABEL",
labelOptions = labelOptions(noHide = T, textOnly = TRUE)) %>%
addLegend(
pal = pal,
values = nc$density,
position = "bottomright",
title = "Density")
Using tmap in view-mode allows to reach nearly what you want (shapes are used via the urbnmapr package):
library(tidyverse)
library(tmap)
library(sf)
library(urbnmapr)
states <- get_urbn_map("states", sf = T) %>%
as.tibble() %>%
mutate(density = sample(1:100, 51, replace = T)) %>%
mutate(abbvAndDens = str_c(state_abbv, " (", density, ")")) %>%
st_as_sf()
tmap_mode("view")
tm_shape(states) +
tm_fill("density",
palette = "viridis",
style = "cont",
breaks = seq(0, 100, 20)) +
tm_borders(lwd = .5, col = "black") +
tm_text("abbvAndDens", size= .75, col = "black")
Related
My plot won't show the symbol that I added using "add_markers". My hope was that the legend would appear to the right of the plot, but for some reason, it does not.
library(plotly)
library(tidyverse)
my_data = data.frame(
Y_LABEL = c("Label1", "Label2"),
START = c(66, 72),
END = c(20, 28),
COLOR_VAR = c("Color1", "Color2"),
SYMBOL_TIME = c(7.2, 7.2)
)
my_plot <- plot_ly() %>%
add_segments(data=my_data,
x=~START, xend=~END, y=~Y_LABEL, yend=~Y_LABEL,
color=~COLOR_VAR, line=list(width=9), showlegend=F)
my_plot = my_plot %>% add_markers(x = ~SYMBOL_TIME, y = "Symbol",
showlegend = T, inherit = F,
marker=list(symbol = "diamond",
size = 9,
color = "white",
line = list(color = "blue",
width = 1)),
name = "My Symbol")
You could use the layout function to add the legend for the respective traces like this:
library(plotly)
library(tidyverse)
my_plot <- plot_ly() %>%
add_segments(data=my_data,
x=~START, xend=~END, y=~Y_LABEL, yend=~Y_LABEL,
color=~COLOR_VAR, line=list(width=9), showlegend=F) %>%
add_markers(x = ~SYMBOL_TIME, y = "Symbol",
showlegend = T, inherit = T,
marker=list(symbol = "diamond",
size = 9,
color = "white",
line = list(color = "blue",
width = 1)),
name = "My Symbol") %>%
layout(showlegend = T)
my_plot
Created on 2023-01-28 with reprex v2.0.2
I am working with the R Programming language.
Using the following link as a tutorial (https://plotly.com/r/lines-on-maps/), I was able to make an interactive plot:
#load libraries
library(dplyr)
library(leaflet)
library(plotly)
library(data.table)
#generate data for example (longitude and latitude of cities)
lat = rnorm(100, 43, 3)
long = rnorm(100, -79, 3)
map_data = data.frame(lat, long)
map_data$type = as.factor(1:100)
#change format of the data so that it is compatible for this example
result = rbind(
cbind(map_data[1:nrow(map_data)-1,c(1,2)], map_data[-1,c(1,2)]),
cbind(map_data[nrow(map_data), c(1,2)], map_data[1,c(1,2)])
)
colnames(result) <- c("start_lat", "start_long", "end_lat", "end_long")
my_data = result
my_data$type = as.factor(1:nrow(my_data))
my_data$type1 = as.character(1:100)
my_data$count = as.integer(1)
my_data$id = 1:100
#### begin visualization
# map projection
geo <- list(
scope = 'north america',
projection = list(type = 'azimuthal equal area'),
showland = TRUE,
landcolor = toRGB("gray95"),
countrycolor = toRGB("gray80")
)
fig <- plot_geo(locationmode = 'USA-states', color = I("red"))
fig <- fig %>% add_markers(
data = my_data, x = ~start_long, y = ~start_lat, alpha = 0.5
)
fig <- fig %>% add_markers(
data = my_data, x = ~start_long, y = ~start_lat, hoverinfo = "text", alpha = 0.5
)
fig <- fig %>% add_segments(
data = group_by(my_data, type),
x = ~start_long, xend = ~end_long,
y = ~start_lat, yend = ~end_lat,
alpha = 0.3, size = I(1), hoverinfo = "none"
)
fig <- fig %>% layout(
title = 'Plot 1',
geo = geo, showlegend = FALSE, height=800
)
#final result
fig
This produces the following result:
Now, I am trying to get the "interactive text" to work:
# map projection
geo <- list(
scope = 'north america',
projection = list(type = 'azimuthal equal area'),
showland = TRUE,
landcolor = toRGB("gray95"),
countrycolor = toRGB("gray80")
)
fig <- plot_geo(locationmode = 'USA-states', color = I("red"))
fig <- fig %>% add_markers(
data = my_data, x = ~start_long, y = ~start_lat, alpha = 0.5
)
fig <- fig %>% add_markers(
data = my_data, x = ~start_long, y = ~start_lat, text = ~type1, size = ~count, hoverinfo = "text", alpha = 0.5
)
fig <- fig %>% add_segments(
data = group_by(my_data, type),
x = ~start_long, xend = ~end_long,
y = ~start_lat, yend = ~end_lat,
alpha = 0.3, size = I(1), hoverinfo = "none"
)
fig <- fig %>% layout(
title = 'Plot 1',
geo = geo, showlegend = FALSE, height=800
)
fig
The interactive text is now working, but the data points are appearing "much bulkier".
My Question: Is it possible to make the interactive text work, but have the data points appear the same way they do in the first picture?
I originally tried to do this without a "count" variable:
fig <- fig %>% add_markers(
data = my_data, x = ~start_long, y = ~start_lat, text = ~type1, hoverinfo = "text", alpha = 0.5
)
But when I do this, the interactive text isn't working - the interactive text only works when a "count" variable is added.
Is this "count" variable necessary? Can someone please show me how to fix this?
Thanks!
You don't need to use count. However, there is something odd here with the segments. Either way, this achieves what I think you're looking for.
I have provided two examples because you didn't say what you wanted to have in the hover text. In the first example, I just use the x and y (lat and long). In the second, I used custom hover content.
Everything that precedes the creation of fig was left unchanged.
Notable changes:
the order the fig elements are assembled; segments seems to only work if it is before the markers
hoverinfo for the segments add is now set to text--this didn't add hover content, but for some reason none here was a problem...odd
I dropped a call to fig or two, that seemed to be doing nothing...
in add_markers, this changed differently in the two options
in one, hovertext = "text" was changed to hovertext = "lat+lon"
in the other, there were multiple changes--you'll have to look at the code for this one
in layout, I deleted the height argument; it's ignored
fig <- plot_geo(locationmode = 'USA-states', color = I("red"))
fig <- fig %>% add_segments( # add segments
data = group_by(my_data, type),
x = ~start_long, xend = ~end_long,
y = ~start_lat, yend = ~end_lat,
alpha = 0.3, size = I(1), hoverinfo = "text" # changed hoverinfo
)
fig <- fig %>% add_markers(
data = my_data, x = ~start_long, y = ~start_lat,
alpha = 0.5, hoverinfo = "lat+lon" # changed hoverinfo
)
fig <- fig %>% layout(
title = 'Plot 1',
geo = geo, showlegend = FALSE # removed height argument
)
#final result
fig
Here's the custom text version
fig <- plot_geo(locationmode = 'USA-states', color = I("red"))
fig <- fig %>% add_segments( # add segments
data = group_by(my_data, type),
x = ~start_long, xend = ~end_long,
y = ~start_lat, yend = ~end_lat,
alpha = 0.3, size = I(1), hoverinfo = "text" # changed hoverinfo
)
fig <- fig %>% add_markers(
data = my_data, x = ~start_long, y = ~start_lat,
alpha = 0.5, hoverinfo = "text", # hoverinfo unchanged
text = ~paste0("Longitude: ", # text changed here**
round(my_data$start_long, 2),
"<br>Latitude: ",
round(my_data$start_lat, 2))
)
fig <- fig %>% layout(
title = 'Plot 1',
geo = geo, showlegend = FALSE # removed height argument
)
#final result
fig
Let me know if you have any questions!
I would like to ask is there a way how to set xend and yend from geom_segment arguments in leaflet`s addPolylines function?
insted of explaining I rather provide reproduceble example since it is mut easire to see rather than explain:
library(leaflet)
library(spdep)
library(ggplot2)
URL <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_DEU_1_sp.rds"
data <- readRDS(url(URL))
cns <- knearneigh(coordinates(data), k = 1, longlat = T)
scnsn <- knn2nb(cns, row.names = NULL, sym = T)
cns
scnsn
cS <- nb2listw(scnsn)
# Plotting results
plot(data)
plot(cS, coordinates(data), add = T)
# Plotting in ggplot
# Converting to data.frame
data_df <- data.frame(coordinates(data))
colnames(data_df) <- c("long", "lat")
n = length(attributes(cS$neighbours)$region.id)
DA = data.frame(
from = rep(1:n,sapply(cS$neighbours,length)),
to = unlist(cS$neighbours),
weight = unlist(cS$weights)
)
DA = cbind(DA, data_df[DA$from,], data_df[DA$to,])
colnames(DA)[4:7] = c("long","lat","long_to","lat_to")
ggplot(data, aes(x = long, y =lat))+
geom_polygon(aes(group = group), color = "black", fill = FALSE)+
geom_point(data = data_df, aes(x= long, y = lat), size = 1)+
geom_segment(data = DA, aes(xend = long_to, yend = lat_to), size=0.5, color = "red")
# Plotting in leaflet
leaflet() %>% addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=data, weight = 0.8, fill = F, color = "red") %>%
addPolylines(data=DA, lng = DA$long_to, lat = DA$lat_to, weight = 0.85)
It can be seen then result in leaflet are not right (Spatial Map is different) how ever plots in basic plot and ggplot are how things should look like,
Is there a way how to reproduce plots above in leaflet? Reading leaflet documentation did not help me
A possible workaround is to use the function addFlows() implemented in library(leaflet.minicharts).
leaflet() %>% addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=data, weight = 0.8, fill = F, color = "red") %>%
addFlows(lng0 = DA$long, lat0 = DA$lat,lng1 = DA$long_to, lat1 = DA$lat_to, dir = 1, maxThickness= 0.85)
I want to create a flight path map using plotly. When following the plotly tutorial called 'Lines on Maps', I do not get the expected output. While all flight paths are indeed drawn, for some reason, a lot of lines seems to connect to the origin (longitude==0, latitude==0). . What is wrong?
library(plotly)
library(dplyr)
# airport locations
air <- read.csv('https://raw.githubusercontent.com/plotly/datasets/master/2011_february_us_airport_traffic.csv')
# flights between airports
flights <- read.csv('https://raw.githubusercontent.com/plotly/datasets/master/2011_february_aa_flight_paths.csv')
flights$id <- seq_len(nrow(flights))
# map projection
geo <- list(
scope = 'world',
projection = list(type = 'azimuthal equal area'),
showland = TRUE,
landcolor = toRGB("gray95"),
countrycolor = toRGB("gray80")
)
p <- plot_geo(locationmode = 'USA-states', color = I("red")) %>%
add_markers(
data = air, x = ~long, y = ~lat, text = ~airport,
size = ~cnt, hoverinfo = "text", alpha = 0.5
) %>%
add_segments(
data = group_by(flights, id),
x = ~start_lon, xend = ~end_lon,
y = ~start_lat, yend = ~end_lat,
alpha = 0.3, size = I(1), hoverinfo = "none"
) %>%
layout(
title = 'Feb. 2011 American Airline flight paths<br>(Hover for airport names)',
geo = geo, showlegend = FALSE, height=800
)
ggplotly(p)
You can use the split argument with your id variable to stop drawing between each line of you data.frame :
add_segments(
data = group_by(flights, id),
x = ~start_lon, xend = ~end_lon,
y = ~start_lat, yend = ~end_lat, split=~id,
alpha = 0.3, size = I(1), hoverinfo = "none"
) %>%
I am currently trying to change the sizes of the Bubbles for Plotly's bubble map manually. I was successful in changing the colors of the map using the data provided but I am unable to use the same logic to change the size. To change the colors I simply called: colors_wanted <- c("red", "blue", "black", "pink") and passed this command to colors within plot_ly. Do you think it is possible to change the sizes rather than using the formula in this case sqrt to claim the sizes?
library(plotly)
df <- read.csv('https://raw.githubusercontent.com/plotly/datasets/master/2014_us_cities.csv')
df$hover <- paste(df$name, "Population", df$pop/1e6, " million")
df$q <- with(df, cut(pop, quantile(pop), include.lowest = T))
levels(df$q) <- paste(c("1st", "2nd", "3rd", "4th"), "Quantile")
df$q <- as.ordered(df$q)
g <- list(scope = 'usa',projection = list(type = 'albers usa'),showland = TRUE,landcolor = toRGB("gray85"),
subunitwidth = 1, countrywidth = 1, subunitcolor = toRGB("white"),countrycolor = toRGB("white"))
plot_ly(df, lon = lon, lat = lat, text = hover,
marker = list(size = sqrt(pop/10000) + 1, line = list(width = 0)),
color = q, colors= colors_wanted, type = 'scattergeo', locationmode = 'USA-states') %>%
layout(title = '2014 US city populations<br>(Click legend to toggle)', geo= g)
If you want the size to correspond to a quartile then this works (and there are any number of variations on this that you could do to make the size more analytically meaningful):
plot_ly(df, lon = lon, lat = lat, text = hover, size = as.numeric(df$q),
#marker = list(size = sqrt(pop/10000) + 1, line = list(width = 0)),
color = q, colors= colors_wanted, type = 'scattergeo', locationmode = 'USA-states') %>%
layout(title = '2014 US city populations<br>(Click legend to toggle)', geo= g)
Here's an interesting variation:
plot_ly(df, lon = lon, lat = lat, text = hover, size = aggregate(df$pop,by=list(df$q),sqrt)$x,
#marker = list(size = sqrt(pop/10000) + 1, line = list(width = 0)),
color = q, colors= colors_wanted, type = 'scattergeo', locationmode = 'USA-states') %>%
layout(title = '2014 US city populations<br>(Click legend to toggle)', geo= g)