I made this plot
With the following code.
library(XML)
library(ggplot2)
library(scales)
library(plyr)
library(maps)
unemp <-
readHTMLTable('http://www.bls.gov/web/laus/laumstrk.htm',
colClasses = c('character', 'character', 'numeric'))[[2]]
names(unemp) <- c('rank', 'region', 'rate')
unemp$region <- tolower(unemp$region)
us_state_map <- map_data('state')
map_data <- merge(unemp, us_state_map, by = 'region')
map_data <- arrange(map_data, order)
states <- data.frame(state.center, state.abb)
p1 <- ggplot(data = map_data, aes(x = long, y = lat, group = group))
p1 <- p1 + geom_polygon(aes(fill = cut_number(rate, 5)))
p1 <- p1 + geom_path(colour = 'gray', linestyle = 2)
p1 <- p1 + scale_fill_brewer('Unemployment Rate (Jan 2011)', palette = 'Set1')
p1 <- p1 + coord_map()
p1 <- p1 + geom_text(data = states, aes(x = x, y = y, label = state.abb, group = NULL), size = 2)
p1 <- p1 + theme_bw()
p1
Now I want to reproduce the same plot with leaflet R package.
library(leaflet)
leaflet(data = map_data) %>%
setView(lng = -77.0167, lat = 38.8833, zoom = 4) %>%
addTiles()
How can I annotate rate from map_data data.frame on the map with leaflet as geom_polygon did in ggplot2 version?
Maybe here's one way as a starting point:
mapStates = map("state", fill = TRUE, plot = FALSE)
rates <- cut_number(unemp$rate[match(sub("(.*?):.*", "\\1", mapStates$names), unemp$region)], 5)
leaflet(data = mapStates) %>% addTiles() %>%
addPolygons(fillColor = brewer_pal(palette = "Set1")(8)[as.numeric(rates)], stroke = FALSE) %>%
addLegend(colors = brewer_pal(palette = "Set1")(nlevels(rates)), labels = levels(rates), opacity = .2)
Add:
With regards to your other question:
library(raster)
pakistan.adm2.spdf <- getData("GADM", country = "Pakistan", level = 2)
rates <- cut_number(unemployment.df$unemployment[match(pakistan.adm2.spdf#data$NAME_2, unemployment.df$id)], 5)
leaflet(pakistan.adm2.spdf) %>% addTiles() %>%
addPolygons(fillColor = brewer_pal(palette = "PuRd")(nlevels(rates))[as.numeric(rates)], stroke = FALSE, fillOpacity = .6) %>%
addLegend(colors = brewer_pal(palette = "PuRd")(nlevels(rates)), labels = levels(rates), opacity = .6) %>%
setView(lng = 69.374268, lat = 30.028617, zoom = 5)
Related
I want to create an interactive alluvial plot in R. I would like to do something similar to This Sankey diagram. I want a list of IDs to pop when you hover over the flow edge (I don't know the proper term). I can create a basic plot using the code below.
sdata <- read.csv("data.csv", header = TRUE, sep = ",")
view(sdata)
df <- sdata %>%
make_long(col1, col2, col3, col4, col5)
df
dagg <- df %>%
dplyr::group_by(node) %>%
tally()
view(dagg)
df2 <- merge(df, dagg, by.x = 'node', by.y = 'node', all.x = TRUE)
pl <- ggplot(df2, aes(x = x
, next_x = next_x
, node = node
, next_node = next_node
, fill = factor(node)
, label = paste0(node," n=", n)))
pl <- pl +geom_alluvial(flow.alpha = 0.5, color = "gray40", show.legend = TRUE)
pl <- pl +geom_alluvial_text(size = 1.5, color = "white", hjust = 0.7)
pl <- pl + theme(legend.position = "none")
pl <- pl + scale_fill_viridis_d(option = "inferno")
pl <- pl + labs(title = "CML")
pl <- pl + labs(subtitle = "Conc")
pl <- pl + labs(fill = 'Nodes')
pl
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")
I am new to crosstalk & trying to make rmarkdown file more interactive by using on bar+line plot but it is not giving line on the plot and also gets weird when I change country.
library(tidyverse)
library(plotly)
library(crosstalk)
library(glue)
library(scales)
library(tidytext)
load data:
file_url <- "https://raw.githubusercontent.com/johnsnow09/covid19-df_stack-code/main/test_crosswalk.csv"
test_df <- read.csv(url(file_url))
Country_selected = c("Brazil")
selected_case_type = c("Confirmed_daily")
trend_sd <- test_df %>%
filter(Daily_Cases_type %in% selected_case_type
# Country.Region %in% Country_selected,
) %>%
select(Country.Region, date, Cases_count)%>%
arrange(date) %>%
group_by(Country.Region) %>%
mutate(new_avg = cumsum(Cases_count)/ seq_len(length(Cases_count))) %>%
ungroup() %>%
SharedData$new()
bscols(widths = c(9, 3),
list(
filter_select(id = "country", label = "Country:", sharedData = trend_sd, group = ~ Country.Region),
ggplotly(ggplot(data = trend_sd) +
geom_col(aes(x = date, y = Cases_count), fill = "turquoise", alpha = .3) +
geom_point(aes(x = date, y = new_avg), col = "tomato") +
geom_line(aes(x = date, y = new_avg), col = "tomato", size = .9, alpha = .3) +
scale_y_continuous(labels = comma) +
# expand_limits(y = 100000) +
labs(title = glue("{Country_selected}'s {selected_case_type} Cases {date_from} onwards"),
caption = "Data source: covid19.analytics")
))
)
This doesn't give correct line plot & even when I change country to some other then bars gets distorted.
Code & Plot Result below without crosstalk & plotly:
Country_selected = c("India") # can be selective
selected_case_type = c("Confirmed_daily")
test_df %>%
filter(Daily_Cases_type %in% selected_case_type,
Country.Region %in% Country_selected,
) %>%
select(Country.Region, date, Cases_count)%>%
arrange(date) %>%
group_by(Country.Region) %>%
mutate(new_avg = cumsum(Cases_count)/ seq_len(length(Cases_count))) %>%
ungroup() %>%
ggplot() +
geom_col(aes(x = date, y = Cases_count), fill = "turquoise", alpha = .3) +
geom_point(aes(x = date, y = new_avg), col = "tomato") +
geom_line(aes(x = date, y = new_avg), col = "tomato", size = .9, alpha = .3) +
scale_y_continuous(labels = comma) +
labs(title = glue("{Country_selected}'s {selected_case_type} Cases {date_from} onwards"),
subtitle = "With Average Daily Cases Trend line",
caption = "Data source: covid19.analytics")
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 am creating a map and then adding some cities on top of it, and I want to have multiple legend items.
So far I have this code:
library(tidyverse)
library(raster)
library(sf)
library(maptools)
#a location to add to the map
city <- tibble(y = c(47.7128),
x = c(74.0060))
city <- st_as_sf(city, coords = c("x", "y"), crs = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs +towgs84=0,0,0")
#world map to plot, along with a raster of distance from a point
data(wrld_simpl)
wrld_simpl_sf <- sf::st_as_sf(wrld_simpl)
r <- raster(wrld_simpl, res = 1)
wrld_r <- rasterize(wrld_simpl, r)
#
pt1 <- matrix(c(100,0), ncol = 2)
dist1 <- distanceFromPoints(r, pt1)
values(dist1)[values(dist1) > 5e6] <- NA
plot(dist1)
gplot_data <- function(x, maxpixels = 50000) {
x <- raster::sampleRegular(x, maxpixels, asRaster = TRUE)
coords <- raster::xyFromCell(x, seq_len(raster::ncell(x)))
## Extract values
dat <- utils::stack(as.data.frame(raster::getValues(x)))
names(dat) <- c('value', 'variable')
dat <- dplyr::as.tbl(data.frame(coords, dat))
if (!is.null(levels(x))) {
dat <- dplyr::left_join(dat, levels(x)[[1]],
by = c("value" = "ID"))
}
dat
}
gplot_dist1 <- gplot_data(dist1)
gplot_wrld_r <- gplot_data(wrld_r)
#plot data
ggplot() +
geom_sf(data = wrld_simpl_sf, fill = "grey20",
colour = "white", size = 0.2) +
geom_tile(data = gplot_dist1,
aes(x = x, y = y, fill = value)) +
scale_fill_gradient("Distance",
low = 'yellow', high = 'blue',
na.value = NA) +
geom_sf(data = city, fill = "red", color = "red", size = 3, shape = 21)
which returns:
This is all fine but now I just want to add the red point from geom_sf(data = city, fill = "red", color = "red", size = 3, shape = 21) to the legend with the caption "Cities".
You could use the scale_color_manual function. The way I understand (I found out about this today), it allows you to map colors to "levels" that then appear in the legend.
Changing your code to have the following does the trick.
geom_sf(data = city, fill = "red", aes(color = "Cities"), size = 3, shape = 21) +
scale_color_manual(values = c("Cities" = "red"))
This is the result