https://github.com/dreamrs/r2d3maps
r2d3 experiment to draw maps in D3
https://github.com/dreamrs/r2d3maps
d3 draw-maps r
Last synced: 12 months ago
JSON representation
r2d3 experiment to draw maps in D3
- Host: GitHub
- URL: https://github.com/dreamrs/r2d3maps
- Owner: dreamRs
- License: other
- Created: 2018-05-08T22:09:18.000Z (about 8 years ago)
- Default Branch: master
- Last Pushed: 2018-09-11T08:00:24.000Z (almost 8 years ago)
- Last Synced: 2025-06-12T13:46:32.748Z (about 1 year ago)
- Topics: d3, draw-maps, r
- Language: R
- Size: 3.21 MB
- Stars: 75
- Watchers: 7
- Forks: 2
- Open Issues: 2
-
Metadata Files:
- Readme: README.md
- License: LICENSE
Awesome Lists containing this project
README
# r2d3maps
> Fun with [`r2d3`](https://github.com/rstudio/r2d3) and [`geojsonio`](https://github.com/ropensci/geojsonio) : draw D3 maps
[](https://travis-ci.org/dreamRs/r2d3maps)
[](http://www.repostatus.org/#wip)
[](https://www.tidyverse.org/lifecycle/#experimental)
## Installation
You can install from Github:
```r
source("https://install-github.me/dreamRs/r2d3maps")
# or with devtools:
devtools::install_github("dreamRs/r2d3maps")
```
## Basic examples
Create D3 maps from `sf` objects, try it with NaturalEarth map data from [`rnaturalearth`](https://github.com/ropenscilabs/rnaturalearth) :
```r
library( r2d3maps )
library( rnaturalearth )
### Japan
japan <- ne_states(country = "japan", returnclass = "sf")
d3_map(shape = japan) %>%
add_labs(title = "Japan")
### South America
south_america <- ne_countries(continent = "south america", returnclass = "sf")
d3_map(shape = south_america) %>%
add_labs(title = "South America")
```
## Choropleth map
### Continuous scale
There is two way to plot a continuous variable: by defining intervals or using a gradient.
```r
# Packages
library( r2d3maps )
library( sf )
library( CARTElette ) # devtools::install_github("antuki/CARTElette/CARTElette@RPackage")
library( dplyr )
library( rmapshaper )
# map data
dept <- loadMap(nivsupra = "DEP") # shapes
dept <- st_transform(dept, crs = 4326) # changing coordinates
dept <- ms_simplify(dept) # simplify shapes
# add population data
data("pop_fr", package = "r2d3maps")
dept <- left_join(
x = dept,
y = pop_fr,
by = c("DEP" = "code_departement")
)
# draw map
d3_map(dept) %>%
add_continuous_breaks(var = "population_totale", na_color = "#b8b8b8") %>%
add_legend(d3_format = ".2s") %>%
add_tooltip(value = "{nom} : {population_totale}")
```
With a gradient:
```r
d3_map(dept) %>%
add_continuous_gradient(var = "population_totale") %>%
add_legend(d3_format = ".2s") %>%
add_tooltip(value = "{nom} : {population_totale}")
```
You can also use a diverging colour gradient:
```r
library( r2d3maps )
library( rnaturalearth )
library( dplyr )
# shapes
ireland <- ne_states(country = "ireland", returnclass = "sf")
# add data
data("pop_irl")
ireland <- left_join(
x = ireland,
y = pop_irl
)
# draw map
d3_map(shape = ireland, stroke_col = "#585858") %>%
add_tooltip(value = "{woe_name}: {changes_percentage}%") %>%
add_continuous_gradient2(var = "changes_percentage", range = c(-9, 9)) %>%
add_legend(title = "Changes in population (2011-2016)", suffix = "%") %>%
add_labs(
title = "Ireland",
caption = "Data from NaturalEarth"
)
```
### Discrete scale
Plot categorical variables, you can use a color palette or manual values:
```r
# map data
fr_dept <- ne_states(country = "france", returnclass = "sf")
fr_dept <- fr_dept[fr_dept$type_en %in% "Metropolitan department", ]
# firstnames data
data("prenoms_fr", package = "r2d3maps")
prenoms_fr_89 <- prenoms_fr %>%
filter(annais == 1989, sexe == 2) %>%
group_by(preusuel) %>%
mutate(n = n()) %>%
ungroup() %>%
mutate(prenom = if_else(n < 2, "AUTRE", preusuel))
fr_dept <- left_join(
x = fr_dept,
y = prenoms_fr_89,
by = "adm1_code"
)
# draw map
d3_map(shape = fr_dept) %>%
add_discrete_scale(
var = "prenom", palette = "Set2",
labels_order = c(setdiff(unique(na.omit(fr_dept$prenom)), "AUTRE"), "AUTRE")
) %>%
add_tooltip(value = "{name}: {prenom}", .na = NULL) %>%
add_legend(title = "Prénoms") %>%
add_labs(
title = "Prénoms féminins les plus attribués en 1989",
caption = "Data: Insee"
)
```
### Shiny usage
A proxy method allow to update maps without re-generating them:
Code:
```r
library( shiny )
library( r2d3maps )
library( rnaturalearth )
library( dplyr )
# data --------------------------------------------------------------------
# shapes
africa <- ne_countries(continent = "Africa", returnclass = "sf")
# drinking water data (from WHO)
data("water_africa")
# add data to shapes
africa <- left_join(
x = africa %>% select(adm0_a3_is, name, geometry),
y = water_africa %>% filter(year == 2015),
by = c("adm0_a3_is" = "iso3")
)
# app ---------------------------------------------------------------------
ui <- fluidPage(
fluidRow(
column(
width = 10, offset = 1,
tags$h2("Proxy example:"),
d3Output(outputId = "mymap", width = "600px", height = "500px"),
radioButtons(
inputId = "var",
label = "Indicator:",
choices = list(
"Basic" = "national_at_least_basic",
"Limited" = "national_limited_more_than_30_mins",
"Unimproved" = "national_unimproved",
"Surface water" = "national_surface_water"
),
inline = TRUE
),
radioButtons(
inputId = "palette",
label = "Change color palette",
choices = c("viridis", "magma", "plasma", "Blues", "Greens", "Reds"),
inline = TRUE
)
)
)
)
server <- function(input, output, session) {
output$mymap <- renderD3({
d3_map(shape = africa) %>%
add_continuous_breaks(var = "national_at_least_basic") %>%
add_tooltip(value = "{name}: {national_at_least_basic}%") %>%
add_legend(title = "Population with at least basic access", suffix = "%") %>%
add_labs(title = "Drinking water in Africa", caption = "Data: https://washdata.org/")
})
title_legend <- list(
"national_at_least_basic" = "basic access",
"national_limited_more_than_30_mins" = "limited access",
"national_unimproved" = "unimproved water",
"national_surface_water" = "surface water"
)
observeEvent(list(input$var, input$palette), {
d3_map_proxy(shinyId = "mymap", data = africa) %>%
update_continuous_breaks(var = input$var, palette = input$palette) %>%
update_legend(title = sprintf(
"Population with %s", title_legend[[input$var]]
), suffix = "%")
}, ignoreInit = TRUE)
}
shinyApp(ui, server)
```
### Make your own
Use `r2d3map` with an `sf` object to convert it to topojson and use a custom JavaScript script like in `r2d3`:
```r
library(r2d3maps)
library(rnaturalearth)
# Data ----
Indonesia <- ne_states(country = "Indonesia", returnclass = "sf")
# Map ----
r2d3map(
data = Indonesia,
script = "my_map.js"
)
```
Create a minimal template with `use_r2d3map`, this will create 3 scripts (R, JS & CSS) to draw maps:
```r
use_r2d3map("my_map.R")
```