Colour specific countries on a worldmap and adding mappoint cities - r

I want to design a worldmap to show from which country and which city the participants to my survey come from. I used the highcharter package.
First part is : colour the countries --> it worked well ! A scale is created from 0 to 1.
Second part is : adding the cities --> the points are created but the countries colored in blue disappeared ! The scale has changed and is now induced from cities.
I try to change the order of my code but nothing is working.
library(dplyr)
library(maps)
library(magrittr)
# I use the dataset called iso3166 from the {maps} package and rename it date
dat <- iso3166
head(dat)
# I rename the variable a3 by iso-a3
dat <- rename(dat, "iso-a3" = a3)
head(dat)
# I create a vector with the countries I want to colour
part1X_countries <- c("CHE", "FRA", "USA", "GBR", "CAN", "BRA")
dat$part1X <- ifelse(dat$`iso-a3` %in% part1X_countries, 1, 0)
head(dat)
# I add the name of cities with geographical coordinates
cities <- data.frame(
name = c("St Gallen", "Fort Lauderdale", "Paris", "Nottingham", "Winnipeg", "Chicago", "Leeds", "Montréal", "New Rochelle", "São Paulo", "Saint-Genis-Pouilly", "Canterbury"),
lat = c(47.42391, 26.122438, 48.866667, 52.950001, 49.8955, 41.881832, 53.801277, 45.5016889, 40.9232, -23.5489, 46.24356, 51.279999),
lon = c(9.37477, -80.137314, 2.333333, -1.150000, -97.1383, -87.623177, -1.548567, -73.567256, -73.7793, -46.6388, 6.02119, 1.080000))
# I create my worldmap with countries and cities
worldmap <- hcmap(
map = "custom/world-highres3", # high resolution world map
data = dat, # name of dataset
value = "part1X",
joinBy = "iso-a3",
showInLegend = FALSE, # hide legend
download_map_data = TRUE
) %>%
hc_add_series(
data = cities,
type = "mappoint",
name = "Cities"
) %>%
hc_title(text = "Representation of participants by country")```

You need to define a colorkey and add a color axis for the hcmap. The below code keeps the colors from the countries and has the name of the countries added on top as black map points.
worldmap <- hcmap(
map = "custom/world-highres3", # high resolution world map
data = dat, # name of dataset
value = "part1X",
joinBy = "iso-a3",
colorKey = "value",
showInLegend = F, # hide legend
download_map_data = TRUE) %>%
hc_colorAxis(min = min(dat$part1X),
max = max(dat$part1X)) %>%
hc_add_series(
data = cities,
type = "mappoint",
name = "Cities",
dataLabels = list(enabled = TRUE, format = '{point.name}'),
latField = "lat",
longField = "lon",
# color = "color"
valueField = "part1X"
) %>%
hc_title(text = "Representation of participants by country")
worldmap

Related

Create an interactive world map using R and shiny

I have a dataset, more especifically the Unicorn Company data set. I want to create an interactive choropleth that has countries with higher mean valuation would have darker color, that when user clicks on the country it would display the name + valuation of that country.
output$map_plot <- renderPlotly({
# Get the average valuation for each country
industry_investors_data <- unicorn_countries_clustering_cleaned %>%
group_by(Country) %>%
summarize(Valuation = mean(Valuation...B.))
world_map_data <- map_data("world2")
#print(sort(unique(ggplot2::map_data("world")$region)))
# Merge the map data with your data and fill in missing values
world_map_valuation <- world_map_data %>%
right_join(industry_investors_data, by = c("region" = "Country")) %>%
mutate(Valuation = coalesce(Valuation, 0.0))
plot_ly(data = world_map_valuation,
locations = ~region,
z = ~Valuation,
type = "choropleth",
locationmode = "country names",
color = ~Valuation,
colors = "Blues",
title = "Map of the world by country valuation",
showlegend = FALSE)
})
This shows a map on the worldly valuation however it takes very long to render and is not interactive in any way. Before I had left_join instead of right join the result was the same.

Order legend in a R Plotly Bubblemap following factor order

I'm working on a Bubble map where I generated two columns, one for a color id (column Color) and one for a text refering to the id (column Class). This is a classification of my individuals (Color always belongs to Class).
Class is a factor following a certain order that I made with :
COME1039$Class <- as.factor(COME1039$Class, levels = c('moins de 100 000 F.CFP',
'entre 100 000 et 5 millions F.CFP',
'entre 5 millions et 1 milliard F.CFP',
'entre 1 milliard et 20 milliards F.CFP',
'plus de 20 milliards F.CFP'))
This is my code
g <- list(
scope = 'world',
visible = F,
showland = TRUE,
landcolor = toRGB("#EAECEE"),
showcountries = T,
countrycolor = toRGB("#D6DBDF"),
showocean = T,
oceancolor = toRGB("#808B96")
)
COM.g1 <- plot_geo(data = COME1039,
sizes = c(1, 700))
COM.g1 <- COM.g1 %>% add_markers(
x = ~LONGITUDE,
y = ~LATITUDE,
name = ~Class,
size = ~`Poids Imports`,
color = ~Color,
colors=c(ispfPalette[c(1,2,3,7,6)]),
text=sprintf("<b>%s</b> <br>Poids imports: %s tonnes<br>Valeur imports: %s millions de F.CFP",
COME1039$NomISO,
formatC(COME1039$`Poids Imports`/1000,
small.interval = ",",
digits = 1,
big.mark = " ",
decimal.mark = ",",
format = "f"),
formatC(COME1039$`Valeur Imports`/1000000,
small.interval = ",",
digits = 1,
big.mark = " ",
decimal.mark = ",",
format = "f")),
hovertemplate = "%{text}<extra></extra>"
)
COM.g1 <- COM.g1%>% layout(geo=g)
COM.g1 <- COM.g1%>% layout(dragmode=F)
COM.g1 <- COM.g1 %>% layout(showlegend=T)
COM.g1 <- COM.g1 %>% layout(legend = list(title=list(text='Valeurs des importations<br>'),
orientation = "h",
itemsizing='constant',
x=0,
y=0)) %>% hide_colorbar()
COM.g1
Unfortunately my data are too big to be added here, but this is the output I get :
As you can see, the order of the legend is not the one of the factor levels. How to get it ? If data are mandatory to help you to give me a hint, I will try to limit their size.
Many thanks !
Plotly is going to alphabetize your legend and you have to 'make' it listen. The order of the traces in your plot is the order in which the items appear in your legend. So if you rearrange the traces in the object, you'll rearrange the legend.
I don't have your data, so I used some data from rnaturalearth.
First I created a plot, using plot_geo. Then I used plotly_build() to make sure I had the trace order in the Plotly object. I used lapply to investigate the current order of the traces. Then I created a new order, rearranged the traces, and plotted it again.
The initial plot and build.
library(tidyverse)
library(plotly)
library(rnaturalearth)
canada <- ne_states(country = "Canada", returnclass = "SF")
x = plot_geo(canada, sizes = c(1, 700)) %>%
add_markers(x = ~longitude, y = ~latitude,
name = ~name, color = ~name)
x <- plotly_build(x) # capture all elements of the object
Now for the investigation; this is more so you can see how this all comes together.
# what order are they in?
y = vector()
invisible(
lapply(1:length(x$x$data),
function(i) {
z <- x$x$data[[i]]$name
message(i, " ", z)
})
)
# 1 Alberta
# 2 British Columbia
# 3 Manitoba
# 4 New Brunswick
# 5 Newfoundland and Labrador
# 6 Northwest Territories
# 7 Nova Scotia
# 8 Nunavut
# 9 Ontario
# 10 Prince Edward Island
# 11 Québec
# 12 Saskatchewan
# 13 Yukon
In your question, you show that you made the legend element a factor. That's what I've done as well with this data.
can2 = canada %>%
mutate(name = ordered(name,
levels = c("Manitoba", "New Brunswick",
"Newfoundland and Labrador",
"Northwest Territories",
"Alberta", "British Columbia",
"Nova Scotia", "Nunavut",
"Ontario", "Prince Edward Island",
"Québec", "Saskatchewan", "Yukon")))
I used the data to reorder the traces in my Plotly object. This creates a vector. It starts with the levels and their row number or order (1:13). Then I alphabetized the data by the levels (so it matches the current order in the Plotly object).
The output of this set of function calls is a vector of numbers (i.e., 5, 6, 1, etc.). Since I have 13 names, I have 1:13. You could always make it dynamic, as well 1:length(levels(can2$name).
# capture order
df1 = data.frame(who = levels(can2$name), ord = 1:13) %>%
arrange(who) %>% select(ord) %>% unlist()
Now all that's left is to rearrange the object traces and visualize it.
x$x$data = x$x$data[order(c(df1))] # reorder the traces
x # visualize
Originally:
With reordered traces:

Add two addLayersControl to one map (have markers be in more than one group)

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))

Drawing arbitrary lines on a highchart map in R (library highcharter)

I am drawing a highcharts map using the highcharter package in R. I added already some points (cities) and want to link them by drawing an additionnal beeline using the world map-coordinates.
I already managed to draw the beelines by first drawing the map, then hovering over the cities which shows me the plot-coordinates, and then redrawing the plot using the aforementioned plot-coordinates. (Watch out: I used the PLOT-coordinates and my goal is to use directly the WORLD MAP-coordinates.)
If you only have 1 or two cities, it's not a big deal. But if you have like 100 cities/points, it's annoying. I guess the answer will be something like here: Is it possible to include maplines in highcharter maps?.
Thank you!
Here my code:
library(highcharter)
library(tidyverse)
# cities with world coordinates
ca_cities <- data.frame(
name = c("San Diego", "Los Angeles", "San Francisco"),
lat = c(32.715736, 34.052235, 37.773972), # world-map-coordinates
lon = c(-117.161087, -118.243683, -122.431297) # world-map-coordinates
)
# path which I create AFTER the first drawing of the map as I get the
# plot-coordinates when I hover over the cities.
path <- "M669.63,-4963.70,4577.18,-709.5,5664.42,791.88"
# The goal: the path variable above should be defined using the WORLD-
# coordinates in ca_cities and not using the PLOT-coordinates.
# information for drawing the beeline
ca_lines <- data.frame(
name = "line",
path = path,
lineWidth = 2
)
# construct the map
map <- hcmap("countries/us/us-ca-all", showInLegend = FALSE) %>%
hc_add_series(data = ca_cities, type = "mappoint", name = "Cities") %>%
hc_add_series(data = ca_lines, type = "mapline", name = "Beeline", color = "blue")
map
See picture here
After several hours, I found an answer to my problem. There are maybe easier ways, but I'm going to post my version using the rgdal-package.
The idea is to convert first the world map-coordinates to the specific map's coordinate system (ESRI) and then back-transform all adjustments from highcharts:
library(highcharter)
library(tidyverse)
library(rgdal) # you also need rgdal
# cities with world coordinates
ca_cities <- data.frame(
name = c("San Diego", "Los Angeles", "San Francisco"),
lat = c(32.715736, 34.052235, 37.773972),
lon = c(-117.161087, -118.243683, -122.431297)
)
# pre-construct the map
map <- hcmap("countries/us/us-ca-all", showInLegend = FALSE)
# extract the transformation-info
trafo <- map$x$hc_opts$series[[1]]$mapData$`hc-transform`$default
# convert to coordinates
ca_cities2 <- ca_cities %>% select("lat", "lon")
coordinates(ca_cities2) <- c("lon", "lat")
# convert world geosystem WGS 84 into transformed crs
proj4string(ca_cities2) <- CRS("+init=epsg:4326") # WGS 84
ca_cities3 <- spTransform(ca_cities2, CRS(trafo$crs)) #
# re-transform coordinates according to the additionnal highcharts-parameters
image_coords_x <- (ca_cities3$lon - trafo$xoffset) * trafo$scale * trafo$jsonres + trafo$jsonmarginX
image_coords_y <- -((ca_cities3$lat - trafo$yoffset) * trafo$scale * trafo$jsonres + trafo$jsonmarginY)
# construct the path
path <- paste("M",
paste0(paste(image_coords_x, ",", sep = ""),
image_coords_y, collapse = ","),
sep = "")
# information for drawing the beeline
ca_lines <- data.frame(
name = "line",
path = path,
lineWidth = 2
)
# add series
map <- map %>%
hc_add_series(data = ca_cities, type = "mappoint", name = "Cities") %>%
hc_add_series(data = ca_lines, type = "mapline", name = "Beeline", color = "blue")
map

Merging IDs of two spatial objects to create a choropleth map

Aim:
To create a choropleth map by municipalities in Catalonia using population.
Reproducible data:
Ok, so my first step was to download the population and municipality shapefile.
Population: https://www.idescat.cat/cat/idescat/biblioteca/docs/publicacions/gridpoblacio01012016.zip
Municipality borders: http://auriga.icc.cat/bseccen_etrs89/bseccenv10sh1f1_2002a2016_0.zip
Steps so far:
Imported both, gave them same coordinates:
catapop<-readOGR("location","rp2016_qtree_level2_ofus_allvar")
catasense<-readOGR("location","bseccenv10sh1f1_20160101_0")
catapop<-spTransform(catapop,CRSobj = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs+towsgs84=0,0,0")
catasense<-spTransform(catasense,CRSobj = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs+towsgs84=0,0,0")
Issue
When I look at the data in the shapefiles they contain what I need:
But when I look at the ID's in catasense compared to the ID's in catapop, I don't know what's happening and how I can match the ID's of catapop to catasense.
I would like to keep the ID's of catasense "MUNICIPI" since they seem the most standard in the Catalonia public data.
Any ideas on how to match the ID's and create a chloropleth map for population "TOTAL" would be really appreciated!
If there's any clarification needed, let me know!
So the first step is import this two tables to R
tab1
tab2
library(readxl)
pop <- read_excel("Downloads/rp2016/pop.xlsx")
cod <- read_excel("Downloads/rp2016/cod.xlsx")
names(cod) <- c("Codi", "Nom2", "Codi comarca", "Nom comarca")
codf <- merge(cod, pop, by.x = "Nom2", by.y = "Nom", all.x = TRUE)
#I make a treatment in the Codi field to put 0 in front of a code that starts with 8.
b <- codf$Codi
b[grep("^8", b)] <- paste0("0",b[grep("^8", b)])
codf$Codi <- b
data2 <- catasense#data
codf2 <- merge(data2, codf, by.x = "MUNICIPI", by.y = "Codi", all.x = TRUE, sort = FALSE)
catasense#data$pop <- codf2$`Població (2016)`
catasense#data$name <- codf2$Nom2
library(leaflet)
pal <- colorNumeric("viridis", NULL)
map <- leaflet(catasense) %>%
addPolygons(color = "#444444", weight = 1, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 1,
fillColor = ~pal(log10(as.numeric(pop))),
popup = ~paste0("<b>", name, "</b>", " <br> ", "pop:", pop, "<br>"
),
label = ~paste0(name),
highlightOptions = highlightOptions(color = "white", weight = 2,
bringToFront = TRUE)) %>%
addLegend(pal = pal, values = ~log10(pop), opacity = 1.0,
labFormat = labelFormat(transform = function(x) round(10^x)))
map
#you can save leaflet map in html
library(htmlwidgets)
saveWidget(map, file="cata2.html")
download and open this html file and see the map

Resources