- done in R with
V8,svglite, andsf - 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
)
}
}
}
)
