From 849d9bd0a916e736722ae23a6bbf5108f1fe4393 Mon Sep 17 00:00:00 2001
From: Beaudette <dylan.beaudette@usda.gov>
Date: Fri, 31 May 2024 13:03:09 -0700
Subject: [PATCH] testing / demoing various hz subsetting functions

---
 misc/sandbox/auto-panel-sketches.R            |  6 +--
 .../demo-hz-subsetting-functionality.R        | 53 +++++++++++++++++++
 2 files changed, 56 insertions(+), 3 deletions(-)
 create mode 100644 misc/sandbox/demo-hz-subsetting-functionality.R

diff --git a/misc/sandbox/auto-panel-sketches.R b/misc/sandbox/auto-panel-sketches.R
index 2f0bc534a..0e144fadb 100644
--- a/misc/sandbox/auto-panel-sketches.R
+++ b/misc/sandbox/auto-panel-sketches.R
@@ -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)
@@ -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'
diff --git a/misc/sandbox/demo-hz-subsetting-functionality.R b/misc/sandbox/demo-hz-subsetting-functionality.R
new file mode 100644
index 000000000..51ba81b81
--- /dev/null
+++ b/misc/sandbox/demo-hz-subsetting-functionality.R
@@ -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
+