From 6253a024ab440b20f437d095220d92a0fff001a8 Mon Sep 17 00:00:00 2001 From: Josh Sumner <51797700+joshqsumner@users.noreply.github.com> Date: Thu, 27 Aug 2026 14:02:24 -0500 Subject: [PATCH 1/6] add option for constant priors --- CRAN-SUBMISSION | 4 ++-- R/brmSS.R | 3 ++- R/brmSSHelpers.R | 6 +++++- R/growthSS.R | 2 ++ man/growthSS.Rd | 2 ++ 5 files changed, 13 insertions(+), 4 deletions(-) diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index 81faded0..98b2788d 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ Version: 1.4.1 -Date: 2026-06-23 12:55:28 UTC -SHA: 2f488b3aa26db9b410db06b9992defa0d3dabdcb +Date: 2026-06-23 14:20:55 UTC +SHA: a6dd636783dd7e4c660715e64382cf5834562c60 diff --git a/R/brmSS.R b/R/brmSS.R index 8d931068..b24ef6e9 100644 --- a/R/brmSS.R +++ b/R/brmSS.R @@ -20,7 +20,8 @@ #' and T_5(mu, 3) priors for changepoint parameters. #' This is done because the values are strictly positive and the lognormal distribution #' is easily interpreted. The changepoint priors are T distributions for symmetry, 5 DF -#' having been chosen for heavy but not unmanageable tails. +#' having been chosen for heavy but not unmanageable tails. Constant priors can be specified +#' by providing the value as a string (ie, "3" for a constant 3 value for that variable). #' If this argument is not provided then priors are not #' returned and a different set of priors will need to be made for the model using #' \code{brms::set_prior}. This works similarly to the \code{params} argument diff --git a/R/brmSSHelpers.R b/R/brmSSHelpers.R index 4f6914f8..6d28a50d 100644 --- a/R/brmSSHelpers.R +++ b/R/brmSSHelpers.R @@ -82,7 +82,7 @@ default_prior <- .explicitDefaultPrior(formula, df, family) default_interaction_prior <- default_prior[grepl(":", default_prior$coef), ] tenth_of_priors <- lapply(priors, function(x) { - return(mean(x) / 10) + return(mean(as.numeric(x)) / 10) }) for (nlp in unique(default_interaction_prior$nlpar)) { sd <- ifelse(nlp %in% names(tenth_of_priors), tenth_of_priors[[nlp]], 3) @@ -191,6 +191,10 @@ .stanStringHelper <- function(priors, pars, USEGROUP) { if (!is.null(pars)) { priorStanStrings <- lapply(pars, function(par) { + if (methods::is(priors[[par]][1], "character")) { + par_string <- paste0("constant(", priors[[par]], ")") # constant prior + return(par_string) + } if (!grepl("changePoint|I$", par)) { par_string <- paste0("lognormal(log(", priors[[par]], "), 0.25)") # growth parameters are LN } else { diff --git a/R/growthSS.R b/R/growthSS.R index 42ef09ff..2106e1f6 100644 --- a/R/growthSS.R +++ b/R/growthSS.R @@ -93,6 +93,8 @@ #' If this is not provided then starting values are picked with \code{stats::selfStart}. #' When type = "brms" these should be provided and are treated as the means of #' lognormal priors for all growth model parameters and T_5(mu, 3) priors for changepoint parameters. +#' Constant priors can be specified by providing the value as a string +#' (ie, "3" for a constant 3 value for that variable). #' This is done because the values are strictly positive and the lognormal distribution #' is easily interpreted. The changepoint priors are T distributions for symmetry, 5 DF #' having been chosen for heavy but not unmanageable tails. diff --git a/man/growthSS.Rd b/man/growthSS.Rd index 74e979bd..6a2de563 100644 --- a/man/growthSS.Rd +++ b/man/growthSS.Rd @@ -110,6 +110,8 @@ Note that rows with NA or infinite values in x, y, or hierarchical predictors ar If this is not provided then starting values are picked with \code{stats::selfStart}. When type = "brms" these should be provided and are treated as the means of lognormal priors for all growth model parameters and T_5(mu, 3) priors for changepoint parameters. + Constant priors can be specified by providing the value as a string + (ie, "3" for a constant 3 value for that variable). This is done because the values are strictly positive and the lognormal distribution is easily interpreted. The changepoint priors are T distributions for symmetry, 5 DF having been chosen for heavy but not unmanageable tails. From 4482ecaded9e4d8e09c59121e420842224027114 Mon Sep 17 00:00:00 2001 From: Josh Sumner <51797700+joshqsumner@users.noreply.github.com> Date: Thu, 27 Aug 2026 14:07:47 -0500 Subject: [PATCH 2/6] tests --- tests/testthat/test-brmsModels.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-brmsModels.R b/tests/testthat/test-brmsModels.R index 64e71227..3764c7f5 100644 --- a/tests/testthat/test-brmsModels.R +++ b/tests/testthat/test-brmsModels.R @@ -17,7 +17,7 @@ test_that("Logistic brms model pipeline", { ) ss <- growthSS( model = "logistic", form = y ~ time | id / group, sigma = "gam", - list("A" = 130, "B" = 10, "C" = 3), + list("A" = 130, "B" = 10, "C" = "3"), # "3" as a string for a constant prior df = simdf, type = "brms" ) expect_equal(ss$prior$nlpar, c("", "", "A", "B", "C")) From 36053edcc9cc236e630132bc07defc5d813b3951 Mon Sep 17 00:00:00 2001 From: Josh Sumner <51797700+joshqsumner@users.noreply.github.com> Date: Thu, 27 Aug 2026 14:44:19 -0500 Subject: [PATCH 3/6] remote linter throwing a fit --- .gitignore | 1 + R/conjugate.R | 4 ++-- R/growthSim.R | 16 ++++++++-------- R/mv_ag.R | 4 ++-- R/readpcv3.R | 15 ++++++--------- R/stat_brms_model.R | 12 ++++++++++-- R/stat_nlme_model.R | 6 +++++- 7 files changed, 34 insertions(+), 24 deletions(-) diff --git a/.gitignore b/.gitignore index aaf63e47..3976ee6b 100644 --- a/.gitignore +++ b/.gitignore @@ -16,3 +16,4 @@ tools/lib tools/*.html \#\*R:scripts\*\# demon.org +tools/coverage-test-failures.zip diff --git a/R/conjugate.R b/R/conjugate.R index c263d312..970f479a 100644 --- a/R/conjugate.R +++ b/R/conjugate.R @@ -369,7 +369,7 @@ conjugate <- function(s1 = NULL, s2 = NULL, sample <- samplesList[[i]] prior <- priors[[i]] #* `Check sample class` - if (is.matrix(sample) | is.data.frame(sample)) { + if (is.matrix(sample) || is.data.frame(sample)) { vec_suffix <- "mv" sample <- .mvSampleFormatting(sample) } else if (is.vector(sample)) { @@ -531,7 +531,7 @@ conjugate <- function(s1 = NULL, s2 = NULL, sample <- samplesList[[i]] prior <- priors[[i]] #* `Check sample class` - if (is.matrix(sample) | is.data.frame(sample)) { + if (is.matrix(sample) || is.data.frame(sample)) { vec <- FALSE } else if (is.vector(sample)) { vec <- TRUE diff --git a/R/growthSim.R b/R/growthSim.R index fe6d1677..698ffad0 100644 --- a/R/growthSim.R +++ b/R/growthSim.R @@ -268,13 +268,13 @@ #' growthSim <- function( - model = c( - "logistic", "logistic4", "logistic5", "gompertz", "double logistic", "double gompertz", - "monomolecular", "exponential", "linear", "power law", "frechet", "weibull", "gumbel", - "logarithmic", "bragg", "lorentz", "beta" - ), - n = 20, t = 25, params = list(), D = 0, - returnParams = FALSE) { + model = c( + "logistic", "logistic4", "logistic5", "gompertz", "double logistic", "double gompertz", + "monomolecular", "exponential", "linear", "power law", "frechet", "weibull", "gumbel", + "logarithmic", "bragg", "lorentz", "beta" + ), + n = 20, t = 25, params = list(), D = 0, + returnParams = FALSE) { if (grepl("count:", model)) { COUNT <- TRUE model <- trimws(gsub("count:", "", model)) @@ -388,7 +388,7 @@ growthSim <- function( names(iterNoise) <- sub(paste0(iterModelFindParams, u, "|Point."), "", names(iterNoise)) iter_data <- do.call(rbind, lapply(1:n, function(i) { - if (is.null(nextChangepoints) | u == length(component_models)) { + if (is.null(nextChangepoints) || u == length(component_models)) { iterChangepointsRand <- rep(t, length(iterParams[[1]])) } else { iterChangepointsRand <- lapply(nextChangepoints, function(fc) { diff --git a/R/mv_ag.R b/R/mv_ag.R index 4ba74804..ff771323 100644 --- a/R/mv_ag.R +++ b/R/mv_ag.R @@ -142,7 +142,7 @@ mv_ag <- function(df, group, mvCols = "frequencies", n_per_group = 1, outRows = } rownames(mv) <- seq_len(nrow(mv)) nms <- sample(rownames(mv), nrow(mv), replace = FALSE) - if (nrow(mv) > 1 & iter_n > 1) { + if (nrow(mv) > 1 && iter_n > 1) { index <- cut(seq_len(nrow(mv)), iter_n) nms_split <- split(nms, index) } else { @@ -199,7 +199,7 @@ mv_ag <- function(df, group, mvCols = "frequencies", n_per_group = 1, outRows = return(id_d) })) #* separate IDS into groups - if (length(IDS) > 1 & iter_n > 1) { + if (length(IDS) > 1 && iter_n > 1) { index <- cut(seq_along(IDS), iter_n) ids_split <- split(IDS, index) } else { diff --git a/R/readpcv3.R b/R/readpcv3.R index 087eecbc..da728e50 100644 --- a/R/readpcv3.R +++ b/R/readpcv3.R @@ -72,15 +72,12 @@ #' @export read.pcv.3 <- function( - file = NULL, - snapshotFile = NULL, - designFile = NULL, - metaCol = "meta", - metaForm = "vis_view_angle_zoom_horizontal_gain_exposure_v_new_n_rep", - joinSnapshot = "id", - conversions = NULL, - mode = "long", - ...) { + file = NULL, snapshotFile = NULL, designFile = NULL, + metaCol = "meta", + metaForm = "vis_view_angle_zoom_horizontal_gain_exposure_v_new_n_rep", + joinSnapshot = "id", conversions = NULL, + mode = "long", ...) { + phenos <- read.pcv(filepath = file, mode = mode, ...) #* `parse metadata` diff --git a/R/stat_brms_model.R b/R/stat_brms_model.R index 7be6819b..e4350624 100644 --- a/R/stat_brms_model.R +++ b/R/stat_brms_model.R @@ -101,7 +101,11 @@ statBrmsMod <- ggplot2::ggproto("StatBrm", Stat, } old <- old[, !(names(old) %in% names(new)), drop = FALSE] non_constant <- vapply(old, vctrs::vec_unique_count, integer(1)) > 1L - non_constant_columns <<- c(non_constant_columns, names(old)[non_constant]) + assign( + "non_constant_columns", + c(non_constant_columns, names(old)[non_constant]), + parent.frame() + ) vc <- vctrs:::vec_cbind( new, old[rep(1, nrow(new)), , drop = FALSE] @@ -214,7 +218,11 @@ statBrmsStaticMod <- ggplot2::ggproto("StatStaticBrm", Stat, } old <- old[, !(names(old) %in% names(new)), drop = FALSE] non_constant <- vapply(old, vctrs::vec_unique_count, integer(1)) > 1L - non_constant_columns <<- c(non_constant_columns, names(old)[non_constant]) + assign( + "non_constant_columns", + c(non_constant_columns, names(old)[non_constant]), + parent.frame() + ) vc <- vctrs:::vec_cbind( new, old[rep(1, nrow(new)), , drop = FALSE] diff --git a/R/stat_nlme_model.R b/R/stat_nlme_model.R index f1509715..cc72798b 100644 --- a/R/stat_nlme_model.R +++ b/R/stat_nlme_model.R @@ -103,7 +103,11 @@ statNlmeMod <- ggplot2::ggproto("StatNlme", Stat, } old <- old[, !(names(old) %in% names(new)), drop = FALSE] non_constant <- vapply(old, vctrs::vec_unique_count, integer(1)) > 1L - non_constant_columns <<- c(non_constant_columns, names(old)[non_constant]) + assign( + "non_constant_columns", + c(non_constant_columns, names(old)[non_constant]), + parent.frame() + ) vc <- vctrs:::vec_cbind( new, old[rep(1, nrow(new)), , drop = FALSE] From ec5c9780f5628d4aae796e85b607c74c424a1ee5 Mon Sep 17 00:00:00 2001 From: Josh Sumner <51797700+joshqsumner@users.noreply.github.com> Date: Thu, 27 Aug 2026 14:45:47 -0500 Subject: [PATCH 4/6] don't fit the constant model for combinedraws sake --- tests/testthat/test-brmsModels.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/testthat/test-brmsModels.R b/tests/testthat/test-brmsModels.R index 3764c7f5..e88509fb 100644 --- a/tests/testthat/test-brmsModels.R +++ b/tests/testthat/test-brmsModels.R @@ -20,6 +20,11 @@ test_that("Logistic brms model pipeline", { list("A" = 130, "B" = 10, "C" = "3"), # "3" as a string for a constant prior df = simdf, type = "brms" ) + ss <- growthSS( + model = "logistic", form = y ~ time | id / group, sigma = "gam", + list("A" = 130, "B" = 10, "C" = 3), + df = simdf, type = "brms" + ) expect_equal(ss$prior$nlpar, c("", "", "A", "B", "C")) fit <- fitGrowth(ss, backend = "cmdstanr", iter = 500, chains = 1, cores = 1, From dbf484c9cb5da5a1425f44039722f74ff55030cb Mon Sep 17 00:00:00 2001 From: Josh Sumner <51797700+joshqsumner@users.noreply.github.com> Date: Thu, 27 Aug 2026 15:05:18 -0500 Subject: [PATCH 5/6] more linting --- R/stat_nls_model.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/stat_nls_model.R b/R/stat_nls_model.R index a1d797dc..a09f5be1 100644 --- a/R/stat_nls_model.R +++ b/R/stat_nls_model.R @@ -64,7 +64,11 @@ statNlsMod <- ggplot2::ggproto("StatNls", Stat, } old <- old[, !(names(old) %in% names(new)), drop = FALSE] non_constant <- vapply(old, vctrs::vec_unique_count, integer(1)) > 1L - non_constant_columns <<- c(non_constant_columns, names(old)[non_constant]) + assign( + "non_constant_columns", + c(non_constant_columns, names(old)[non_constant]), + parent.frame() + ) vc <- vctrs:::vec_cbind( new, old[rep(1, nrow(new)), , drop = FALSE] From aa4551864671b4367e28abfdc9a5d4da693bada2 Mon Sep 17 00:00:00 2001 From: Josh Sumner <51797700+joshqsumner@users.noreply.github.com> Date: Mon, 31 Aug 2026 08:55:28 -0500 Subject: [PATCH 6/6] whitespace --- R/stat_nls_model.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/stat_nls_model.R b/R/stat_nls_model.R index a09f5be1..09ca6634 100644 --- a/R/stat_nls_model.R +++ b/R/stat_nls_model.R @@ -68,7 +68,7 @@ statNlsMod <- ggplot2::ggproto("StatNls", Stat, "non_constant_columns", c(non_constant_columns, names(old)[non_constant]), parent.frame() - ) + ) vc <- vctrs:::vec_cbind( new, old[rep(1, nrow(new)), , drop = FALSE]