README.md
In dreamRs/r2d3maps: Create Maps with D3

r2d3maps

Fun with r2d3 and geojsonio : draw D3 maps

You can install from Github:

source("https://install-github.me/dreamRs/r2d3maps")

# or with devtools:
devtools::install_github("dreamRs/r2d3maps")

Create D3 maps from sf objects, try it with NaturalEarth map data from rnaturalearth :

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

There is two way to plot a continuous variable: by defining intervals or using a gradient.

# 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:

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:

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

Plot categorical variables, you can use a color palette or manual values:

# 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 = "<b>{name}</b>: {prenom}", .na = NULL) %>%
  add_legend(title = "Prénoms") %>%
  add_labs(
    title = "Prénoms féminins les plus attribués en 1989",
    caption = "Data: Insee"
  )

A proxy method allow to update maps without re-generating them:

Code:

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 = "<b>{name}</b>: {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)

Use r2d3map with an sf object to convert it to topojson and use a custom JavaScript script like in r2d3:

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: