more consistent number of osc. in ragged bottom, better detection of …

…device information

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: aqp
-Version: 2.0.3
+Version: 2.0.4
 Title: Algorithms for Quantitative Pedology
 Authors@R: c(person(given="Dylan", family="Beaudette", role = c("aut", "cre"), email = "[email protected]"), person(given="Pierre", family="Roudier", email="[email protected]", role = c("aut", "ctb")), person(given="Andrew", family="Brown", email="[email protected]", role = c("aut", "ctb")))
 Author: Dylan Beaudette [aut, cre], Pierre Roudier [aut, ctb], Andrew Brown [aut, ctb]

NEWS.md

@@ -1,3 +1,6 @@
+# aqp 2.0.4 (2024-06-14)
+ * ragged bottom lines in `plotSPC()` now adjusted as function of number of profiles and device width
+
 # aqp 2.0.3 (2024-04-18)
  * CRAN release
  * `simulateColor()` gains new method `mvnorm` for simulating plausible colors

R/plotSPC.R

@@ -722,20 +722,6 @@ plotSPC <- function(
   # get profile labels from @site
   pLabels <- site(x)[[label]]
 
-  ## this should probably use strwidth() AFTER plot() has been called
-  # if profile style is auto, determine style based on font metrics
-  if(id.style == 'auto') {
-    sum.ID.str.width <- sum(sapply(pLabels, strwidth, units='inches', cex=cex.id, font=2))
-    plot.width <- par('pin')[1]
-    ID.width.ratio <- sum.ID.str.width  / plot.width
-    #   	print(ID.width.ratio)
-
-    if(ID.width.ratio > 0.7)
-      id.style <- 'side'
-    else
-      id.style <- 'top'
-  }
-
 
 
   ## init plotting region, unless we are appending to an existing plot
@@ -760,9 +746,42 @@ plotSPC <- function(
   }
 
 
+
+  ########################
+  ## device information ##
+  ########################
+
+  # note: all of this has to happen after plot(...), or if `add = TRUE`
+
+  .par_usr <- par('usr')
+  .par_dev <- par('pin')
+  .par_xWidth <- diff(.par_usr[1:2])
+  .par_devWidth <- .par_dev[1]
+
+  # profiles / device width (inches)
+  .dev_sketch_density <- (.par_xWidth / .par_devWidth)
+
   # calculate width of a single character on current plot device
   one.char.width <- strwidth('W')
 
+
+  ################################
+  ## profile ID style selection ##
+  ################################
+
+  # if profile style is auto, determine style based on font metrics
+  if(id.style == 'auto') {
+    sum.ID.str.width <- sum(sapply(pLabels, strwidth, units = 'inches', cex = cex.id, font = 2))
+    ID.width.ratio <- sum.ID.str.width  / .par_devWidth
+    print(ID.width.ratio)
+
+    if(ID.width.ratio > 0.7)
+      id.style <- 'side'
+    else
+      id.style <- 'top'
+  }
+
+
   ## TODO dynamically adjust `width` based on strwidth(longest.hz.name)
   ## TODO abstract single profile sketch code into a single function
   ## TODO skip sketch rendering when i == `n` outside of length(SPC) (depths are NA)
@@ -938,10 +957,13 @@ plotSPC <- function(
         if(truncation_flag_i & !all(is.na(xx))) {
 
           # must be an even number of oscillations
-          # computed as function of number of profiles
+          # computed as function of (ideal oscillations / 2) / sketch density
           # adjusted to width (n.osc increases with width)
-          # min value of 4
-          .raggedN <- pmax(4, round((2.5 * width) * 32 / (n / 2)) * 2)
+          # min value of 6
+          # max value of 32
+          .raggedN <- round((2.5 * width) * (8 / .dev_sketch_density)) * 2
+          .raggedN <- pmax(6, .raggedN)
+          .raggedN <- pmin(32, .raggedN)
 
           # ragged bottom line segment: lr -> ll ordering
           .r <- .raggedLines(x1 = x.ll, x2 = x.lr, y = y0[j], o = .raggedOffsets, n = .raggedN)
@@ -1027,10 +1049,15 @@ plotSPC <- function(
         if(truncation_flag_i & !all(is.na(xx))) {
 
           # must be an even number of oscillations
-          # computed as function of number of profiles
+          # computed as function of (ideal oscillations / 2) / sketch density
           # adjusted to width (n.osc increases with width)
-          # min value of 4
-          .raggedN <- pmax(4, round((2.5 * width) * 32 / (n / 2)) * 2)
+          # min value of 6
+          # max value of 32
+          .raggedN <- round((2.5 * width) * (8 / .dev_sketch_density)) * 2
+          .raggedN <- pmax(6, .raggedN)
+          .raggedN <- pmin(32, .raggedN)
+
+          ## TODO: allow user adjustments via argument
 
           # ragged bottom line segment: lr -> ll ordering
           .r <- .raggedLines(x1 = x.ll, x2 = x.lr, y = y0[j], o = .raggedOffsets, n = .raggedN)

misc/sandbox/ragged-profile-bottom.R

@@ -205,13 +205,13 @@ plotSPC(p[1:10, , .FIRST], cex.names = 0.66, name.style = 'center-center', width
 plotSPC(p[1:10, , .FIRST], cex.names = 0.66, name.style = 'center-center', width = 0.25, hz.distinctness.offset = 'hzd')
 
 
-plotSPC(p[1, ], cex.names = 0.66, name.style = 'center-center', width = 0.1, hz.distinctness.offset = 'hzd')
+plotSPC(p[1, ], cex.names = 0.66, name.style = 'center-center', width = 0.1, hz.distinctness.offset = 'hzd', max.depth = 145)
 
-plotSPC(p[1, ], cex.names = 0.66, name.style = 'center-center', width = 0.33, hz.distinctness.offset = 'hzd')
+plotSPC(p[1, ], cex.names = 0.66, name.style = 'center-center', width = 0.33, hz.distinctness.offset = 'hzd', max.depth = 145)
 
-plotSPC(p[1:5, ], cex.names = 0.66, name.style = 'center-center', width = 0.33, hz.distinctness.offset = 'hzd')
+plotSPC(p[1:5, ], cex.names = 0.66, name.style = 'center-center', width = 0.33, hz.distinctness.offset = 'hzd', max.depth = 145)
 
-plotSPC(p[1:10, ], cex.names = 0.66, name.style = 'center-center', width = 0.33, hz.distinctness.offset = 'hzd')
+plotSPC(p[1:10, ], cex.names = 0.66, name.style = 'center-center', width = 0.33, hz.distinctness.offset = 'hzd', max.depth = 145)