library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(purrr)
library(p5)
##
## Attaching package: 'p5'
## The following object is masked from 'package:dplyr':
##
## between
## The following object is masked from 'package:stats':
##
## line
## The following object is masked from 'package:graphics':
##
## rect
## scaling always does my head in
## extent volcano is 0, 1, 0, 1
## dimension is 87, 61
cl <- contourLines(volcano)
x <- purrr::map_df(cl, ~tibble::as_tibble(.x[c("x", "y")]), .id = "level")
nr <- nrow(volcano)
nc <- ncol(volcano)
scale x into [0, 1]
scl <- function(x) (x - min(x)) / diff(range(x))
scale data frame of x,y into [0, nr, 0, nc] [x0, x1, y0, y1]
scaler <- function(x, nr, nc, exag = 1) {
nr <- nr * exag
nc <- nc * exag
dplyr::mutate(x, x = scl(x) * nr, y = scl(y) * nc)
}
index-push a path sequence into pairs
segmenter_i <- function(x) {
utils::head(suppressWarnings(matrix(x, nrow = length(x) + 1, ncol = 2, byrow = FALSE)), -2L)
}
convert sequential xy pairs into 4-col matrix (x0, x1, y0, y1)
segmenter_xy <- function(x) {
segs <- segmenter_i(seq_len(nrow(x)))
do.call(cbind, purrr::map(x[c("x", "y")],
~matrix(.x[as.vector(t(segs))], ncol = 2, byrow = TRUE)))
}
## scale (with exag)
exag_fact <- 4
segs <- split(scaler(x, nr, nc, exag = exag_fact), x$level) %>%
purrr::map(segmenter_xy) %>% do.call(rbind, .)
## expand the canvas (not sure with p5(width, height) do?
p5() %>% createCanvas(nr * exag_fact, nc * exag_fact) %>%
line(x1 = segs[,1], y1 = segs[,3], x2 = segs[,2], y2 = segs[,4])