d3-contour in R with V8 and sf

• done in R with V8, svglite, and sf
• contours supplied by the new d3-contour
• assembled with blockbuilder.org

---

In celebration of a brand new release from Mike Bostock d3-contour, I wanted to use it in R.

library(V8)

ctx <- v8()
ctx$source("https://unpkg.com/d3-contour@1.0.0")
ctx$source("https://unpkg.com/d3-array")

ctx$eval(
"
// example provided with d3-contour
//  https://github.com/d3/d3-contour
//  Mike Bostock

// Populate a grid of n×m values where -2 ≤ x ≤ 2 and -2 ≤ y ≤ 1.
var n = 256, m = 256, values = new Array(n * m);
for (var j = 0.5, k = 0; j < m; ++j) {
  for (var i = 0.5; i < n; ++i, ++k) {
    values[k] = goldsteinPrice(i / n * 4 - 2, 1 - j / m * 3);
  }
}

// Compute the contour polygons at log-spaced intervals; returns an array of MultiPolygon.
var contours = d3.contours()
  .size([n, m])
  .thresholds(d3.range(2, 21).map(function(p){return Math.pow(2, p)}))
  (values);

// See https://en.wikipedia.org/wiki/Test_functions_for_optimization
function goldsteinPrice(x, y) {
  return (1 + Math.pow(x + y + 1, 2) * (19 - 14 * x + 3 * x * x - 14 * y + 6 * x * x + 3 * y * y))
* (30 + Math.pow(2 * x - 3 * y, 2) * (18 - 32 * x + 12 * x * x + 48 * y - 36 * x * y + 27 * y * y));
}
"
)

contours <- ctx$get("contours", simplifyDataFrame = FALSE)

library(purrr)
library(sf)
library(scales)

vals <- log(map_int(contours, "value"))
ramp_color <- colour_ramp(brewer_pal(palette="YlGnBu")(9))


plot(st_multipolygon(contours[[1]]$coordinates))
walk(
  contours[-1],
  ~{
    if(is.array(.x$coordinates)) {
      plot(
        st_polygon(
          list(matrix(as.vector(.x$coordinates),ncol=2))
        ),
        col = ramp_color(rescale(log(.x$value), from=range(vals))),
        add=TRUE
      )
    } else {
      if(is_list(.x$coordinates[[1]])) {
        plot(st_multipolygon(.x$coordinates),,
             col = ramp_color(rescale(log(.x$value), from=range(vals))),
             add=TRUE
        )
      } else {
        plot(
          st_polygon(
            lapply(.x$coordinates, function(x) matrix(as.vector(x),ncol=2))
          ),
          col = ramp_color(rescale(log(.x$value), from=range(vals))),
          add=TRUE
        )
      }
    }
  }
)