na color in continuous scale

DESCRIPTION

@@ -23,4 +23,3 @@ Imports:
     magrittr
 Suggests: rnaturalearth, sf
 RoxygenNote: 6.0.1
-Remotes: rstudio/r2d3

R/scale-continuous.R

@@ -12,6 +12,7 @@
 #'  If -1, the order of colors is reversed.
 #' @param n_breaks Number of breaks to cut data (depending on \code{style}, number of breaks can be re-computed).
 #' @param style Style for computing breaks, see \code{\link[classInt]{classIntervals}}.
+#' @param na_color Color to use for missing value(s).
 #'
 #' @export
 #'
@@ -77,7 +78,7 @@
 #'   add_legend(title = "foo", d3_format = ".0f")
 #'
 add_continuous_breaks <- function(map, var, palette = "viridis", direction = 1,
-                                 n_breaks = 5, style = "pretty") {
+                                 n_breaks = 5, style = "pretty", na_color = "#b8b8b8") {
   palette <- match.arg(
     arg = palette,
     choices = c("viridis", "magma", "plasma", "inferno", "cividis",
@@ -113,6 +114,7 @@ add_continuous_breaks <- function(map, var, palette = "viridis", direction = 1,
     color_var = var,
     range_var = c(0, max(var_, na.rm = TRUE)),
     range_col = range_col,
+    na_color = na_color,
     colors = c("#fafafa", colors)
   )
 }
@@ -129,6 +131,7 @@ add_continuous_breaks <- function(map, var, palette = "viridis", direction = 1,
 #' @param var Variable to map.
 #' @param low,high Colours for low and high ends of the gradient.
 #' @param range A length two vector to force range of data.
+#' @param na_color Color to use for missing value(s).
 #'
 #' @export
 #'
@@ -177,7 +180,7 @@ add_continuous_breaks <- function(map, var, palette = "viridis", direction = 1,
 #'   add_legend(title = "Population with at least basic access", suffix = "%") %>%
 #'   add_labs(title = "Drinking water in Africa", caption = "Data: https://washdata.org/")
 #'
-add_continuous_gradient <- function(map, var, low = "#132B43", high = "#56B1F7", range = NULL) {
+add_continuous_gradient <- function(map, var, low = "#132B43", high = "#56B1F7", range = NULL, na_color = "#b8b8b8") {
   if (is.null(map$x$options$data))
     stop("No data !", call. = FALSE)
   var_ <- map$x$options$data[[var]]
@@ -190,7 +193,7 @@ add_continuous_gradient <- function(map, var, low = "#132B43", high = "#56B1F7",
     stop("'var' must be a numeric vector!", call. = FALSE)
   if (!is.null(range))
     var_ <- c(var_, range)
-  var_ <- sort(unique(var_), na.last = TRUE)
+  var_ <- sort(unique(var_))
   pal <- seq_gradient_pal(low = low, high = high)
   var_scale <- rescale(var_, to = c(0, 1))
   colors <- pal(var_scale)
@@ -203,6 +206,7 @@ add_continuous_gradient <- function(map, var, low = "#132B43", high = "#56B1F7",
     scale_var = var_scale,
     colors = c(colors, "#fafafa"),
     colors_legend = colors_legend,
+    na_color = na_color,
     legend_label = append(
       x = range(var_, na.rm = TRUE),
       values = diff(range(var_, na.rm = TRUE))/2,
@@ -220,7 +224,8 @@ add_continuous_gradient <- function(map, var, low = "#132B43", high = "#56B1F7",
 #' @importFrom scales div_gradient_pal muted
 #'
 #' @rdname gradient-scale
-add_continuous_gradient2 <- function(map, var, low = muted("red"), mid = "white", high = muted("blue"), range = NULL) {
+add_continuous_gradient2 <- function(map, var, low = muted("red"), mid = "white", high = muted("blue"),
+                                     range = NULL, na_color = "#b8b8b8") {
   if (is.null(map$x$options$data))
     stop("No data !", call. = FALSE)
   var_ <- map$x$options$data[[var]]
@@ -246,6 +251,7 @@ add_continuous_gradient2 <- function(map, var, low = muted("red"), mid = "white"
     scale_var = var_scale,
     colors = c(colors, "#fafafa"),
     colors_legend = colors_legend,
+    na_color = na_color,
     legend_label = append(
       x = range(var_, na.rm = TRUE),
       values = diff(range(var_, na.rm = TRUE))/2,

dev/exemple-CARTElette.R

@@ -0,0 +1,52 @@
+
+#  ------------------------------------------------------------------------
+#
+# Title : Exemple avec CARTElette
+#    By : Victor
+#  Date : 2018-05-30
+#
+#  ------------------------------------------------------------------------
+
+
+
+# Packages ----------------------------------------------------------------
+
+library( r2d3maps )
+library( sf )
+library( CARTElette )
+library( dplyr )
+library( rmapshaper )
+
+
+
+# Data --------------------------------------------------------------------
+
+# fond de carte
+dept <- loadMap(nivsupra = "DEP")
+dept <- st_transform(dept, crs = 4326)
+dept <- ms_simplify(dept)
+
+# population france
+data("pop_fr", package = "r2d3maps")
+dept <- left_join(
+  x = dept,
+  y = pop_fr,
+  by = c("DEP" = "code_departement")
+)
+
+
+
+# Carte -------------------------------------------------------------------
+
+d3_map(dept) %>%
+  add_continuous_breaks(var = "population_totale", na_color = "#b8b8b8") %>%
+  add_legend(d3_format = ".2s") %>%
+  add_tooltip(value = "{nom} : {population_totale}")
+
+d3_map(dept) %>%
+  add_continuous_gradient(var = "population_totale") %>%
+  add_legend(d3_format = ".2s") %>%
+  add_tooltip(value = "{nom} : {population_totale}")
+
+
+

inst/js/r2d3maps2.js

@@ -65,7 +65,7 @@ r2d3.onRender(function(json, svg, width, height, options) {
   // define bounding box & associated scale & transform
   var b = path.bounds(states),
       s = 0.9 / Math.max((b[1][0] - b[0][0]) / width, (b[1][1] - b[0][1]) / height),
-      t = [(width - s * (b[1][0] + b[0][0])) / 2, (height - s * (b[1][1] + b[0][1])) / 2];
+      t = [(width - s * (b[1][0] + b[0][0])) / 2, (height - 20 - s * (b[1][1] + b[0][1])) / 2];
 
   // re-project
   projection
@@ -179,7 +179,14 @@ r2d3.onRender(function(json, svg, width, height, options) {
             .selectAll("path")
             .data(topojson.feature(json, json.objects.states).features)
             .enter().append("path")
-              .attr("fill", function(d) { return color(d.properties[options.colors.color_var]); })
+              .attr("fill", function(d) {
+                //console.log(d.properties[options.colors.color_var]);
+                if (d.properties[options.colors.color_var] == 'NA') {
+                  return options.colors.na_color;
+                } else {
+                  return color(d.properties[options.colors.color_var]);
+                }
+              })
               .attr("stroke", options.stroke_col)
               .attr("stroke-width", options.stroke_width + "px")
               .attr("d", path);
@@ -282,7 +289,11 @@ r2d3.onRender(function(json, svg, width, height, options) {
             .data(topojson.feature(json, json.objects.states).features)
             .enter().append("path")
               .attr("fill", function(d) {
-                return colorGradient(colorInterpolateGradient(d.properties[options.colors.color_var]));
+                if (d.properties[options.colors.color_var] == 'NA') {
+                  return options.colors.na_color;
+                } else {
+                  return colorGradient(colorInterpolateGradient(d.properties[options.colors.color_var]));
+                }
               })
               .attr("stroke", options.stroke_col)
               .attr("stroke-width", options.stroke_width + "px")