readme proxy + example legend

R/d3_map_proxy.R

@@ -270,7 +270,51 @@ update_continuous_gradient <- function(proxy, var, low = NULL, high = NULL, rang
 #' @examples
 #' \dontrun{
 #'
-#' # todo
+#' if (interactive()) {
+#'
+#' library(r2d3maps)
+#' library(shiny)
+#'
+#' # data about Paris
+#' data("paris")
+#'
+#'
+#' # app
+#' ui <- fluidPage(
+#'   fluidRow(
+#'     column(
+#'       width = 8, offset = 2,
+#'       tags$h2("Proxy for continuous breaks scale"),
+#'       d3Output(outputId = "mymap"),
+#'       selectInput(
+#'         inputId = "var", label = "Variable:",
+#'         choices = grep(pattern = "AGE", x = names(paris), value = TRUE)
+#'       )
+#'     )
+#'   )
+#' )
+#'
+#' server <- function(input, output, session) {
+#'
+#'   output$mymap <- renderD3({
+#'     d3_map(shape = paris) %>%
+#'       add_continuous_gradient(var = "AGE_00", low = "#FEE0D2", high = "#CB181D") %>%
+#'       add_legend(d3_format = ".2s")
+#'   })
+#'
+#'   observeEvent(input$var, {
+#'     d3_map_proxy(shinyId = "mymap", data = paris) %>%
+#'       update_continuous_gradient(var = input$var) %>%
+#'       update_legend(title = tolower(gsub(
+#'         patter = "_", replacement = " ", x = input$var
+#'       )), d3_format = ".1s")
+#'   }, ignoreInit = TRUE)
+#'
+#' }
+#'
+#' shinyApp(ui, server)
+#'
+#' }
 #'
 #' }
 update_legend <- function(proxy, title = "", prefix = "", suffix = "", d3_format = NULL) {
@@ -279,7 +323,9 @@ update_legend <- function(proxy, title = "", prefix = "", suffix = "", d3_format
   .r2d3maps_proxy(
     proxy = proxy,
     name = "legend",
-    title = title, prefix = prefix, suffix = suffix,
+    title = title,
+    prefix = prefix,
+    suffix = suffix,
     d3_format = d3_format
   )
 }

README.md

@@ -160,6 +160,98 @@ d3_map(shape = fr_dept) %>%
 ![](img/choropleth_france3.png)
 
 
+### Shiny usage
+
+A proxy method allow to update maps without re-generating them:
+
+![](img/d3maps-proxy.gif)
+
+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 = "<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)
+```
+
+
 ### Make your own
 
 Use `r2d3map` with an `sf` object to convert it to topojson and use a custom JavaScript script like in `r2d3`:

dev/example-proxy.R

@@ -3,11 +3,9 @@
 
 # Packages ----------------------------------------------------------------
 
-library(shiny)
+library( shiny )
 library( r2d3maps )
-library( r2d3 )
 library( rnaturalearth )
-library( magrittr )
 library( dplyr )
 
 
@@ -16,23 +14,15 @@ library( dplyr )
 # shapes
 africa <- ne_countries(continent = "Africa", returnclass = "sf")
 
-
 # drinking water data
 data("water_africa")
-glimpse(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")
 )
-africa$national_at_least_basic <- round(africa$national_at_least_basic)
-africa$national_limited_more_than_30_mins <- round(africa$national_limited_more_than_30_mins)
-africa$national_unimproved <- round(africa$national_unimproved)
-africa$national_surface_water <- round(africa$national_surface_water)
 
 
 
@@ -42,7 +32,7 @@ ui <- fluidPage(
   fluidRow(
     column(
       width = 10, offset = 1,
-      tags$h2("Example proxy"),
+      tags$h2("Proxy example:"),
       d3Output(outputId = "mymap", width = "600px", height = "500px"),
       radioButtons(
         inputId = "var",