diff --git a/DESCRIPTION b/DESCRIPTION index f1c577d2..efc32ca6 100644 --- a/DESCRIPTION +++ b/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 = "dylan.beaudette@usda.gov"), person(given="Pierre", family="Roudier", email="roudierp@landcareresearch.co.nz", role = c("aut", "ctb")), person(given="Andrew", family="Brown", email="andrew.g.brown@usda.gov", role = c("aut", "ctb"))) Author: Dylan Beaudette [aut, cre], Pierre Roudier [aut, ctb], Andrew Brown [aut, ctb] diff --git a/NEWS.md b/NEWS.md index 3db71cdd..9c4279e4 100644 --- a/NEWS.md +++ b/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 diff --git a/R/plotSPC.R b/R/plotSPC.R index 62b9a0d1..174e2909 100644 --- a/R/plotSPC.R +++ b/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) diff --git a/misc/sandbox/ragged-profile-bottom.R b/misc/sandbox/ragged-profile-bottom.R index a688c628..83bba9c5 100644 --- a/misc/sandbox/ragged-profile-bottom.R +++ b/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)