Skip to content

Commit

Permalink
testing / demoing various hz subsetting functions
Browse files Browse the repository at this point in the history
  • Loading branch information
dylanbeaudette committed May 31, 2024
1 parent 946e4dc commit 849d9bd
Show file tree
Hide file tree
Showing 2 changed files with 56 additions and 3 deletions.
6 changes: 3 additions & 3 deletions misc/sandbox/auto-panel-sketches.R
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ z$.chunk <- makeChunks(seq_along(z), size = .size)

## TODO: this doesn't work for thematic sketches, as each panel gets its own legend

par(mar = c(0, 0, 0, 2), mfrow = c(.n, 1))
par(mar = c(0, 0, 0, 0), mfrow = c(.n, 1))

for(i in .chunkIds) {
.idx <- which(z$.chunk == i)
Expand All @@ -41,8 +41,8 @@ for(i in .chunkIds) {
lwd = 0.1,
divide.hz = FALSE,
width = 0.4,
max.depth = 110,
depth.axis = list(line = -4, cex = 1),
max.depth = 150,
depth.axis = FALSE,
n = .size,
# color = 'texcl'
# color = 'p1'
Expand Down
53 changes: 53 additions & 0 deletions misc/sandbox/demo-hz-subsetting-functionality.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
library(aqp)

data(sp4)
depths(sp4) <- id ~ top + bottom
hzdesgnname(sp4) <- 'name'

# test effect of potential sorting alpha vs. numeric
# profile_id(sp4) <- as.character(1:length(sp4))

profile_id(sp4) <- sprintf("%0.3d", 1:length(sp4))

# profile_id(sp4) <- letters[1:length(sp4)]

.top <- 10
.bottom <- 35

d <- dice(sp4, (.top):(.bottom - 1) ~ .)
g <- glom(sp4, z1 = .top, z2 = .bottom)
gt <- glom(sp4, z1 = .top, z2 = .bottom, truncate = TRUE)
st <- hz_segment(sp4, intervals = c(.top, .bottom))
s <- hz_segment(sp4, intervals = c(.top, .bottom), trim = FALSE)


# normalize IDs
profile_id(d) <- sprintf("%s\nD", profile_id(d))
profile_id(g) <- sprintf("%s\nG", profile_id(g))
profile_id(gt) <- sprintf("%s\nGT", profile_id(gt))
profile_id(s) <- sprintf("%s\nS", profile_id(s))
profile_id(st) <- sprintf("%s\nST", profile_id(st))
profile_id(sp4) <- sprintf("%s\n", profile_id(sp4))

x <- combine(sp4, d, g, gt, s, st)

par(mar = c(0, 0, 3, 0))

plotSPC(x, color = 'CEC_7', name.style = 'center-center', width = 0.4, id.style = 'top', col.palette = hcl.colors(25, palette = 'viridis'), depth.axis = list(line = -5))

abline(h = c(.top, .bottom), lwd = 2, lty = 3, col = 'red')



z <- duplicate(sp4, times = 100)
library(microbenchmark)

m <- microbenchmark(
dice = dice(z, (.top):(.bottom - 1) ~ .),
glom = glom(z, z1 = .top, z2 = .bottom, truncate = TRUE),
hz_segment = hz_segment(sp4, intervals = c(.top, .bottom), trim = TRUE),
times = 10
)

m

0 comments on commit 849d9bd

Please sign in to comment.