From 663a46e85b66c424a38c461650f1a05eaf8d3a39 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 20:25:43 -0500 Subject: [PATCH 01/42] Update roxygen version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 31a6de3..baf95ac 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,7 @@ Suggests: tidyr, viridis Config/testthat/edition: 3 -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) Depends: R (>= 4.1.0) From f22760ea5e23fe8c33b822688f8c96e3f87e0fff Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 20:25:58 -0500 Subject: [PATCH 02/42] Update pkg version to 0.1.1 --- DESCRIPTION | 1 + 1 file changed, 1 insertion(+) diff --git a/DESCRIPTION b/DESCRIPTION index baf95ac..1c26e75 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,6 +2,7 @@ Package: trps Type: Package Title: Bayesian Trophic Position Models using 'stan' Version: 0.1.0 +Version: 0.1.1 Authors@R: c( person( "Benjamin L.", "Hlina", From 2376c503d59b8e966224aaaf0289dc84d6d367ef Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 20:26:13 -0500 Subject: [PATCH 03/42] Stan --- DESCRIPTION | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1c26e75..ffdbe40 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,6 @@ Package: trps Type: Package -Title: Bayesian Trophic Position Models using 'stan' -Version: 0.1.0 +Title: Bayesian Trophic Position Models using 'Stan' Version: 0.1.1 Authors@R: c( person( From f76d914b827797505192be06e17be29df0180d13 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 20:54:20 -0500 Subject: [PATCH 04/42] add in check from utils and remove error messages --- R/add_alpha.R | 31 +++---------------------------- 1 file changed, 3 insertions(+), 28 deletions(-) diff --git a/R/add_alpha.R b/R/add_alpha.R index 37a0da0..1eeb81d 100644 --- a/R/add_alpha.R +++ b/R/add_alpha.R @@ -33,35 +33,10 @@ add_alpha <- function( data, abs = FALSE) { - if (!(inherits(data, c( - "data.frame", "tibble", - "data.table" - )))) { - cli::cli_abort(c( - "`data` must be a data.frame, tibble, or data.table", - "i" = "Please provide data.frame" - )) - } - - rv <- c("d13c", "c1", "c2") - - if (!all(rv %in% names(data))) { - mv <- setdiff(rv, names(data)) - - cli::cli_abort(c( - "The data.frame is missing: {mv}", - "i" = "Please provide {mv}" - )) - } - - - if (!(is.logical(abs))) { - cli::cli_abort(c( - "`abs` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } + check_data_frame(data) + check_column_names(data) + check_logical(abs) if (isFALSE(abs)) { dat <- data |> From 64df32b9ba49e6cb33fe8139338c44007f06a664 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 20:54:35 -0500 Subject: [PATCH 05/42] Initial commit of utils --- R/utils.R | 95 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) create mode 100644 R/utils.R diff --git a/R/utils.R b/R/utils.R new file mode 100644 index 0000000..bc24b9e --- /dev/null +++ b/R/utils.R @@ -0,0 +1,95 @@ +#' Error functions +#' +#' @param bp value of `TRUE` or `FALSE` or it errors. +#' +#' @name error_functions +#' @keywords internal + +check_bp <- function(bp) { + if (!(is.logical(bp))) { + cli::cli_abort(c( + "`bp` argument must be a logical value", + "i" = "Please provide TRUE or FALSE" + )) + } +} + +#' @param x prior to check +#' +#' @name error_functions +#' @keywords internal + +check_column_names <- function(x) { + rv <- c("d13c", "c1", "c2") + + if (!all(rv %in% names(x))) { + mv <- setdiff(rv, names(x)) + + cli::cli_abort(c( + "The `{x}` is missing: {mv}", + "i" = "Please provide {mv}" + )) + } +} + +#' @param x prior to check +#' +#' @name error_functions +#' @keywords internal + +check_data_frame <- function(x) { + if (!(inherits(data, c("data.frame", "tibble", "data.table")))) { + cli::cli_abort(c( + "`{x}` must be a data.frame, tibble, or data.table", + "i" = "Please provide data.frame" + )) + } +} + +#' @param x prior to check +#' +#' @name error_functions +#' @keywords internal + +check_logical <- function(x) { + if (!(is.logical(x))) { + cli::cli_abort(c( + "`{x}` argument must be a logical value", + "i" = "Please provide TRUE or FALSE" + )) + } +} + +#' @param x prior to check +#' +#' @name error_functions +check_prior_params <- function(x) { + + if (!is.numeric(x) || length(x) != 1) { + cli::cli_abort(c( + "`{x}` argument must be a numerical value.", + "i" = "Please provide a numerical value as a piror." + )) + } +} + + +# args <- list(...) +# +# for (arg_name in names(args)) { +# value <- args[[arg_name]] +# +# # Skip NULLs if allowed +# if (.allow_null && is.null(value)) { +# next +# } +# +# # Check numeric scalar +# if (!is.numeric(value) || length(value) != 1) { +# cli::cli_abort(c( +# "`{arg_name}` must be a numeric value of length 1.", +# "i" = "Please provide a numeric scalar as a prior." +# )) +# } +# } + From 5a3fa57186d1c6a866b7fa2a501871662b9a1db8 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 20:55:12 -0500 Subject: [PATCH 06/42] Initial commit of error_functions manual --- man/error_functions.Rd | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) create mode 100644 man/error_functions.Rd diff --git a/man/error_functions.Rd b/man/error_functions.Rd new file mode 100644 index 0000000..16fdf59 --- /dev/null +++ b/man/error_functions.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{error_functions} +\alias{error_functions} +\alias{check_bp} +\alias{check_column_names} +\alias{check_data_frame} +\alias{check_logical} +\alias{check_prior_params} +\title{Error functions} +\usage{ +check_bp(bp) + +check_column_names(x) + +check_data_frame(x) + +check_logical(x) + +check_prior_params(x) +} +\arguments{ +\item{bp}{value of \code{TRUE} or \code{FALSE} or it errors.} + +\item{x}{prior to check} +} +\description{ +Error functions +} +\keyword{internal} From 3f838fdbb5a2a3b12dc912966debcb6fb27252f2 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 20:55:27 -0500 Subject: [PATCH 07/42] minor reformating --- R/add_alpha.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/add_alpha.R b/R/add_alpha.R index 1eeb81d..60ebf00 100644 --- a/R/add_alpha.R +++ b/R/add_alpha.R @@ -32,7 +32,8 @@ add_alpha <- function( data, - abs = FALSE) { + abs = FALSE +) { check_data_frame(data) check_column_names(data) From 271b52ef0424f22de2fd46c0a4b00af44047f72b Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 20:55:36 -0500 Subject: [PATCH 08/42] Change to Stan --- man/trps-package.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/trps-package.Rd b/man/trps-package.Rd index 9dc2988..89bfa98 100644 --- a/man/trps-package.Rd +++ b/man/trps-package.Rd @@ -4,7 +4,7 @@ \name{trps-package} \alias{trps} \alias{trps-package} -\title{trps: Bayesian Trophic Position Models using 'stan'} +\title{trps: Bayesian Trophic Position Models using 'Stan'} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} From 2cccd1f0fd63e59949927c388f34f65d597560cb Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 20:58:46 -0500 Subject: [PATCH 09/42] check brp with check_logical --- R/one_source_model.R | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/R/one_source_model.R b/R/one_source_model.R index 2db6e50..f40490d 100644 --- a/R/one_source_model.R +++ b/R/one_source_model.R @@ -34,12 +34,7 @@ #' @export one_source_model <- function(bp = FALSE) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } + check_logical(bp) if (isFALSE(bp)) { model <- brms::bf( From 23f857a08c752cb18a99a6575ee341b0183ad64c Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:05:20 -0500 Subject: [PATCH 10/42] Change to being in alpha numeric order --- R/zzz.R | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index 7955010..af8216d 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -2,26 +2,28 @@ packageStartupMessage("version 0.1.0 ('one-skate').\nHave you loaded {brms}?") } utils::globalVariables(c( - "n1", - "n1_sigma", - "normal", - "uniform", + "a", "alpha", - "min_alpha", - "max_alpha", - "d13c", + "b", "c1", "c2", + "c1_mean", + "c2_mean", + "c1_sigma", + "c2_sigma", + "d13c", "dn", "dn_sigma", + "max_alpha", + "min_alpha", + "n1", + "n2", + "n1_sigma", + "n2_sigma", + "normal", "sigma_lb", - "sigma_ub", "tp_lb", + "sigma_ub", + "tp_lb", "tp_ub", - "c1_mean", - "c2_mean", "n2", - "n2_sigma", - "c1_sigma", - "c2_sigma", - "a", - "b" + "uniform" )) From cce0ab617749519cc8f0a6da43c39bf83f1a1947 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:05:45 -0500 Subject: [PATCH 11/42] Change pkg version number to twp-skate --- R/zzz.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/zzz.R b/R/zzz.R index af8216d..2ce19ff 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,5 +1,5 @@ .onAttach <- function(libname, pkgname) { - packageStartupMessage("version 0.1.0 ('one-skate').\nHave you loaded {brms}?") + packageStartupMessage("version 0.1.1 ('two-skate').\nHave you loaded {brms}?") } utils::globalVariables(c( "a", From 649f9b6fb8dce0a53db244be2a88010cb87a7030 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:06:53 -0500 Subject: [PATCH 12/42] change to use check_logical --- R/one_source_priors.R | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/R/one_source_priors.R b/R/one_source_priors.R index 41f38aa..268e3e4 100644 --- a/R/one_source_priors.R +++ b/R/one_source_priors.R @@ -18,13 +18,7 @@ #' @export one_source_priors <- function(bp = FALSE) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } - + check_logical(bp) if (isFALSE(bp)) { # set priors @@ -71,7 +65,5 @@ one_source_priors <- function(bp = FALSE) { ) } - - return(priors) } From 7e21e7cd5e25b8b9da0daf06089d9c56e2260086 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:15:54 -0500 Subject: [PATCH 13/42] Remove check_bp and replace with check_logical --- R/utils.R | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/R/utils.R b/R/utils.R index bc24b9e..4990437 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,19 +1,4 @@ #' Error functions -#' -#' @param bp value of `TRUE` or `FALSE` or it errors. -#' -#' @name error_functions -#' @keywords internal - -check_bp <- function(bp) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } -} - #' @param x prior to check #' #' @name error_functions From 212f2c2801597928adbb084902fdb992aa14f1c2 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:16:18 -0500 Subject: [PATCH 14/42] Cheange check_prior_params to check_numerical --- R/utils.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index 4990437..e4d04f5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -48,12 +48,12 @@ check_logical <- function(x) { #' @param x prior to check #' #' @name error_functions -check_prior_params <- function(x) { +check_numerical <- function(x) { if (!is.numeric(x) || length(x) != 1) { cli::cli_abort(c( "`{x}` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." + "i" = "Please provide a numerical value" )) } } From ca4045c517dcf5dcf916ed7ff075e57f45479170 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:17:01 -0500 Subject: [PATCH 15/42] update error function manaul --- man/error_functions.Rd | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/man/error_functions.Rd b/man/error_functions.Rd index 16fdf59..07e96e0 100644 --- a/man/error_functions.Rd +++ b/man/error_functions.Rd @@ -2,26 +2,21 @@ % Please edit documentation in R/utils.R \name{error_functions} \alias{error_functions} -\alias{check_bp} \alias{check_column_names} \alias{check_data_frame} \alias{check_logical} -\alias{check_prior_params} +\alias{check_numerical} \title{Error functions} \usage{ -check_bp(bp) - check_column_names(x) check_data_frame(x) check_logical(x) -check_prior_params(x) +check_numerical(x) } \arguments{ -\item{bp}{value of \code{TRUE} or \code{FALSE} or it errors.} - \item{x}{prior to check} } \description{ From d6c73c92a9169013ffd3a28499a930152237b2c6 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:20:10 -0500 Subject: [PATCH 16/42] replace defaults with more streamlined version and move error message to check_numerical --- R/one_source_priors_params.R | 143 +++++++---------------------------- 1 file changed, 29 insertions(+), 114 deletions(-) diff --git a/R/one_source_priors_params.R b/R/one_source_priors_params.R index 531dbe2..bbb4a7f 100644 --- a/R/one_source_priors_params.R +++ b/R/one_source_priors_params.R @@ -55,120 +55,35 @@ one_source_priors_params <- function( sigma_lb = NULL, sigma_ub = NULL, bp = FALSE) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } - - # ----- n1 ----- - - # set n1 to 9 - if (is.null(n1)) { - n1 <- 9 - } - - # create error message for n1 priros - if (!is.numeric(n1)) { - cli::cli_abort(c( - "`n1` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set n1_sigma to 1 - if (is.null(n1_sigma)) { - n1_sigma <- 1 - } - # create error message for n1 priors - if (!is.numeric(n1_sigma)) { - cli::cli_abort(c( - "`n1_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # create error message for dn priros - - - if (is.null(dn)) { - dn <- 3.4 - } - - if (!is.numeric(dn)) { - cli::cli_abort(c( - "`dn` argument must be a numerical value", - "i" = "Please provide a numerical value as a pirorr" - )) - } - - # create error message for dn priors - if (is.null(dn_sigma)) { - dn_sigma <- 0.25 - } - - if (!is.numeric(dn_sigma)) { - cli::cli_abort(c( - "`dn_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - # ----- tp ----- - - # set piror for tp - if (is.null(tp_lb)) { - tp_lb <- 2 - } - - # create error message for tp priros - - if (!is.numeric(tp_lb)) { - cli::cli_abort(c( - "`tp_lb` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - if (is.null(tp_ub)) { - tp_ub <- 10 - } - - # create error message for n1 priors - if (!is.numeric(tp_ub)) { - cli::cli_abort(c( - "`tp_ub` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ----- sigma ----- - - # set piror for tp - if (is.null(sigma_lb)) { - sigma_lb <- 0 - } - - # create error message for tp priros - - if (!is.numeric(sigma_lb)) { - cli::cli_abort(c( - "`sigma_lb` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - if (is.null(sigma_ub)) { - sigma_ub <- 10 - } - - # create error message for n1 priors - if (!is.numeric(sigma_ub)) { - cli::cli_abort(c( - "`sigma_ub` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - + check_prior_params + check_logical(bp) + +# ---- defualt values + defaults <- list( + n1 = 9, + n1_sigma = 1, + dn = 3.4, + dn_sigma = 0.25, + tp_lb = 2, + tp_ub = 10, + sigma_lb = 0, + sigma_ub = 10 + ) + # nulls + supplied <- list( + n1 = n1, + n1_sigma = n1_sigma, + dn = dn, + dn_sigma = dn_sigma, + tp_lb = tp_lb, + tp_ub = tp_ub, + sigma_lb = sigma_lb, + sigma_ub = sigma_ub + ) + + lapply(supplied, check_numerical) + + params <- Map(function(x, d) if (is.null(x)) d else x, supplied, defaults) if (isTRUE(bp)) { priors_params <- brms::stanvar(n1, name = "n1") + From 4a9d5460b0a5afdf4090cd2a92e53de2d6ed9460 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:51:47 -0500 Subject: [PATCH 17/42] More steramlined default values --- R/one_source_priors_params.R | 67 ++++++++++++++++++++---------------- 1 file changed, 38 insertions(+), 29 deletions(-) diff --git a/R/one_source_priors_params.R b/R/one_source_priors_params.R index bbb4a7f..ce13bf4 100644 --- a/R/one_source_priors_params.R +++ b/R/one_source_priors_params.R @@ -55,19 +55,19 @@ one_source_priors_params <- function( sigma_lb = NULL, sigma_ub = NULL, bp = FALSE) { - check_prior_params + check_logical(bp) -# ---- defualt values + # ---- defualt values defaults <- list( - n1 = 9, - n1_sigma = 1, - dn = 3.4, - dn_sigma = 0.25, - tp_lb = 2, - tp_ub = 10, - sigma_lb = 0, - sigma_ub = 10 + n1 = 9, + n1_sigma = 1, + dn = 3.4, + dn_sigma = 0.25, + tp_lb = 2, + tp_ub = 10, + sigma_lb = 0, + sigma_ub = 10 ) # nulls supplied <- list( @@ -81,34 +81,43 @@ one_source_priors_params <- function( sigma_ub = sigma_ub ) - lapply(supplied, check_numerical) params <- Map(function(x, d) if (is.null(x)) d else x, supplied, defaults) - if (isTRUE(bp)) { - priors_params <- brms::stanvar(n1, name = "n1") + - brms::stanvar(n1_sigma, "n1_sigma") + - brms::stanvar(dn, "dn") + - brms::stanvar(dn_sigma, "dn_sigma") + - brms::stanvar(tp_lb, "tp_lb") + - brms::stanvar(tp_ub, "tp_ub") + - brms::stanvar(sigma_lb, "sigma_lb") + - brms::stanvar(sigma_ub, "sigma_ub") + lapply(names(params), function(nm) { + check_numerical(params[[nm]], arg_name = nm) + }) + + params_env <- list2env(params, parent = environment()) + priors_params <- with(params_env, { + if (isTRUE(bp)) { + brms::stanvar(n1, name = "n1") + + brms::stanvar(n1_sigma, "n1_sigma") + + brms::stanvar(dn, "dn") + + brms::stanvar(dn_sigma, "dn_sigma") + + brms::stanvar(tp_lb, "tp_lb") + + brms::stanvar(tp_ub, "tp_ub") + + brms::stanvar(sigma_lb, "sigma_lb") + + brms::stanvar(sigma_ub, "sigma_ub") + } } + ) # ----- dn ----- + priors_params <- with(params_env, { + if (isFALSE(bp)) { + # ----- set prirors ----- - if (isFALSE(bp)) { - # ----- set prirors ----- - - priors_params <- brms::stanvar(dn, "dn") + - brms::stanvar(dn_sigma, "dn_sigma") + - brms::stanvar(tp_lb, "tp_lb") + - brms::stanvar(tp_ub, "tp_ub") + - brms::stanvar(sigma_lb, "sigma_lb") + - brms::stanvar(sigma_ub, "sigma_ub") + brms::stanvar(dn, "dn") + + brms::stanvar(dn_sigma, "dn_sigma") + + brms::stanvar(tp_lb, "tp_lb") + + brms::stanvar(tp_ub, "tp_ub") + + brms::stanvar(sigma_lb, "sigma_lb") + + brms::stanvar(sigma_ub, "sigma_ub") + } } + ) return(priors_params) } From 73e9db84fa71cac3165ec39c216ec0af67bc402d Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:52:35 -0500 Subject: [PATCH 18/42] check_logic and reformat --- R/two_source_priors_ar.R | 39 +++++++++++++++++---------------------- 1 file changed, 17 insertions(+), 22 deletions(-) diff --git a/R/two_source_priors_ar.R b/R/two_source_priors_ar.R index 5a07572..e9d6ee2 100644 --- a/R/two_source_priors_ar.R +++ b/R/two_source_priors_ar.R @@ -21,12 +21,7 @@ #' @export two_source_priors_ar <- function(bp = FALSE) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } + check_logical(bp = bp) if (isFALSE(bp)) { @@ -41,17 +36,17 @@ two_source_priors_ar <- function(bp = FALSE) { brms::prior(normal(dn, dn_sigma), resp = "d15n", nlpar = "dn"), # Trophic Position (tp) brms::prior(uniform(tp_lb, tp_ub), - lb = tp_lb, ub = tp_ub, resp = "d15n", - nlpar = "tp" + lb = tp_lb, ub = tp_ub, resp = "d15n", + nlpar = "tp" ), # Standard deviation prior brms::prior(uniform(sigma_lb, sigma_ub), - resp = "alpha", - class = "sigma", ub = sigma_ub + resp = "alpha", + class = "sigma", ub = sigma_ub ), brms::prior(uniform(sigma_lb, sigma_ub), - resp = "d15n", - class = "sigma", ub = sigma_ub + resp = "d15n", + class = "sigma", ub = sigma_ub ) ) } @@ -66,29 +61,29 @@ two_source_priors_ar <- function(bp = FALSE) { # Baseline 1 δ15N (n1) brms::prior(normal(n1, n1_sigma), - resp = "d15n", - nlpar = "n1" + resp = "d15n", + nlpar = "n1" ), # Baseline 2 δ15N (n2) brms::prior(normal(n2, n2_sigma), - resp = "d15n", - nlpar = "n2" + resp = "d15n", + nlpar = "n2" ), # Trophic enrichment factor (ΔN) brms::prior(normal(dn, dn_sigma), resp = "d15n", nlpar = "dn"), # Trophic Position (tp) brms::prior(uniform(tp_lb, tp_ub), - lb = tp_lb, ub = tp_ub, resp = "d15n", - nlpar = "tp" + lb = tp_lb, ub = tp_ub, resp = "d15n", + nlpar = "tp" ), # Standard deviation prior brms::prior(uniform(sigma_lb, sigma_ub), - resp = "alpha", - class = "sigma", ub = sigma_ub + resp = "alpha", + class = "sigma", ub = sigma_ub ), brms::prior(uniform(sigma_lb, sigma_ub), - resp = "d15n", - class = "sigma", ub = sigma_ub + resp = "d15n", + class = "sigma", ub = sigma_ub ) ) } From ca242b682f0ac63f65db944bc221a1d3d09bf852 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:54:07 -0500 Subject: [PATCH 19/42] Fix arg_name issue and add to manual --- R/utils.R | 21 +++++++++++++++++---- 1 file changed, 17 insertions(+), 4 deletions(-) diff --git a/R/utils.R b/R/utils.R index e4d04f5..b575e07 100644 --- a/R/utils.R +++ b/R/utils.R @@ -32,33 +32,46 @@ check_data_frame <- function(x) { } #' @param x prior to check +#' @param arg_name the name of the argument to check. #' #' @name error_functions #' @keywords internal -check_logical <- function(x) { +check_logical <- function(x, arg_name = NULL) { + + if (is.null(arg_name)) { + arg_name <- rlang::as_label(rlang::enexpr(x)) + } + if (!(is.logical(x))) { cli::cli_abort(c( - "`{x}` argument must be a logical value", + "`{arg_name}` argument must be a logical value", "i" = "Please provide TRUE or FALSE" )) } } #' @param x prior to check +#' @param arg_name the name of the argument to check. #' #' @name error_functions -check_numerical <- function(x) { +check_numerical <- function(x, arg_name = NULL) { + + if (is.null(arg_name)) { + arg_name <- rlang::as_label(rlang::enexpr(x)) + } if (!is.numeric(x) || length(x) != 1) { cli::cli_abort(c( - "`{x}` argument must be a numerical value.", + "`{arg_name}` argument must be a numerical value.", "i" = "Please provide a numerical value" )) } } + + # args <- list(...) # # for (arg_name in names(args)) { From 4973909348485bdafa9a481053f3904a1448acfe Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Thu, 20 Nov 2025 21:54:22 -0500 Subject: [PATCH 20/42] Add arg_name to manual --- man/error_functions.Rd | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/man/error_functions.Rd b/man/error_functions.Rd index 07e96e0..54b110b 100644 --- a/man/error_functions.Rd +++ b/man/error_functions.Rd @@ -12,12 +12,15 @@ check_column_names(x) check_data_frame(x) -check_logical(x) +check_logical(x, arg_name = NULL) -check_numerical(x) +check_numerical(x, arg_name = NULL) } \arguments{ -\item{x}{prior to check} +\item{x}{prior to check +@param arg_name the name of the argument to check.} + +\item{arg_name}{the name of the argument to check.} } \description{ Error functions From 4f0e8564da194cf6ce3e61652d326e4162480100 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Fri, 21 Nov 2025 06:32:16 -0500 Subject: [PATCH 21/42] Put if else statemnt on the outside of the with and then have with inside --- R/one_source_priors_params.R | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/R/one_source_priors_params.R b/R/one_source_priors_params.R index ce13bf4..987c7c4 100644 --- a/R/one_source_priors_params.R +++ b/R/one_source_priors_params.R @@ -89,8 +89,11 @@ one_source_priors_params <- function( }) params_env <- list2env(params, parent = environment()) - priors_params <- with(params_env, { - if (isTRUE(bp)) { + + # ---- set prior + priors_params <- if (isTRUE(bp)) { + with(params_env, { + brms::stanvar(n1, name = "n1") + brms::stanvar(n1_sigma, "n1_sigma") + brms::stanvar(dn, "dn") + @@ -100,15 +103,10 @@ one_source_priors_params <- function( brms::stanvar(sigma_lb, "sigma_lb") + brms::stanvar(sigma_ub, "sigma_ub") } - } - ) - - - # ----- dn ----- - priors_params <- with(params_env, { - if (isFALSE(bp)) { - # ----- set prirors ----- + ) + } else { + with(params_env, { brms::stanvar(dn, "dn") + brms::stanvar(dn_sigma, "dn_sigma") + brms::stanvar(tp_lb, "tp_lb") + @@ -116,8 +114,9 @@ one_source_priors_params <- function( brms::stanvar(sigma_lb, "sigma_lb") + brms::stanvar(sigma_ub, "sigma_ub") } + ) } - ) + return(priors_params) } From 248dcedda45606886853387a6db0c822dc00cbe5 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Fri, 21 Nov 2025 06:32:29 -0500 Subject: [PATCH 22/42] change to using chekc_logical --- R/two_source_priors.R | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/R/two_source_priors.R b/R/two_source_priors.R index fd2d02a..b7c5489 100644 --- a/R/two_source_priors.R +++ b/R/two_source_priors.R @@ -20,13 +20,8 @@ #' @export two_source_priors <- function(bp = FALSE) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } + check_logical(bp) if (isFALSE(bp)) { # set priors From fd71f1a179719e017ed5d1ddd7eb865605b756de Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Fri, 21 Nov 2025 06:32:38 -0500 Subject: [PATCH 23/42] change to check logiicla --- R/two_source_priors_ar.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/two_source_priors_ar.R b/R/two_source_priors_ar.R index e9d6ee2..d76a41f 100644 --- a/R/two_source_priors_ar.R +++ b/R/two_source_priors_ar.R @@ -21,7 +21,7 @@ #' @export two_source_priors_ar <- function(bp = FALSE) { - check_logical(bp = bp) + check_logical(bp) if (isFALSE(bp)) { From 8cf90a7184e4bb384701b2db16122ecc42b6fd43 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Fri, 21 Nov 2025 06:32:52 -0500 Subject: [PATCH 24/42] Updated error mesage for add_alpha --- tests/testthat/test-add_alpha.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-add_alpha.R b/tests/testthat/test-add_alpha.R index ad734ec..256f734 100644 --- a/tests/testthat/test-add_alpha.R +++ b/tests/testthat/test-add_alpha.R @@ -31,7 +31,7 @@ test_that("test check if alpha errors ", { test_that("test check if alpha errors ", { expect_error( add_alpha(data = combined_iso[-c(4, 10, 12)]), - "The data.frame is missing: d13c, c1, and c2" + "`data` is missing: d13c, c1, and c2" ) }) From d7704fc6456d09725158816c401e23e827f1899f Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Fri, 21 Nov 2025 06:33:42 -0500 Subject: [PATCH 25/42] add in arg_name argument --- R/utils.R | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index b575e07..a3b05c3 100644 --- a/R/utils.R +++ b/R/utils.R @@ -4,7 +4,13 @@ #' @name error_functions #' @keywords internal -check_column_names <- function(x) { +check_column_names <- function(x, + arg_name = NULL) { + + if (is.null(arg_name)) { + arg_name <- rlang::as_label(rlang::enexpr(x)) + } + rv <- c("d13c", "c1", "c2") if (!all(rv %in% names(x))) { @@ -24,8 +30,16 @@ check_column_names <- function(x) { check_data_frame <- function(x) { if (!(inherits(data, c("data.frame", "tibble", "data.table")))) { +check_data_frame <- function(x, + arg_name = NULL) { + + if (is.null(arg_name)) { + arg_name <- rlang::as_label(rlang::enexpr(x)) + } + + if (!(inherits(x, c("data.frame", "tibble", "data.table")))) { cli::cli_abort(c( - "`{x}` must be a data.frame, tibble, or data.table", + "`{arg_name}` must be a data.frame, tibble, or data.table", "i" = "Please provide data.frame" )) } From 47e9db34cd8d3153be20d47ad8c77ba4ce2d157b Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Fri, 21 Nov 2025 06:34:03 -0500 Subject: [PATCH 26/42] This kept erroring as it kept checkking for data instead of x --- R/utils.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index a3b05c3..031c911 100644 --- a/R/utils.R +++ b/R/utils.R @@ -28,8 +28,6 @@ check_column_names <- function(x, #' @name error_functions #' @keywords internal -check_data_frame <- function(x) { - if (!(inherits(data, c("data.frame", "tibble", "data.table")))) { check_data_frame <- function(x, arg_name = NULL) { From 5bd36777de276ca77b3067010e3704f4631b8e53 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Fri, 21 Nov 2025 06:34:25 -0500 Subject: [PATCH 27/42] updated arg_names for manual --- R/utils.R | 5 +++-- man/error_functions.Rd | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/R/utils.R b/R/utils.R index 031c911..6c2f92c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,5 +1,6 @@ #' Error functions #' @param x prior to check +#' @param arg_name the name of the argument to check. #' #' @name error_functions #' @keywords internal @@ -17,14 +18,14 @@ check_column_names <- function(x, mv <- setdiff(rv, names(x)) cli::cli_abort(c( - "The `{x}` is missing: {mv}", + "`{arg_name}` is missing: {mv}", "i" = "Please provide {mv}" )) } } #' @param x prior to check -#' +#' @param arg_name the name of the argument to check. #' @name error_functions #' @keywords internal diff --git a/man/error_functions.Rd b/man/error_functions.Rd index 54b110b..6f3b429 100644 --- a/man/error_functions.Rd +++ b/man/error_functions.Rd @@ -8,9 +8,9 @@ \alias{check_numerical} \title{Error functions} \usage{ -check_column_names(x) +check_column_names(x, arg_name = NULL) -check_data_frame(x) +check_data_frame(x, arg_name = NULL) check_logical(x, arg_name = NULL) From fe5536c48391213fdfe85b5b46d6f69e63b75201 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Fri, 21 Nov 2025 16:48:17 -0500 Subject: [PATCH 28/42] Inital commit of check_lambda this is a specific type of numerical argument --- R/utils.R | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/R/utils.R b/R/utils.R index 6c2f92c..ef370ba 100644 --- a/R/utils.R +++ b/R/utils.R @@ -44,6 +44,27 @@ check_data_frame <- function(x, } } + +#' @param x prior to check +#' @param arg_name the name of the argument to check. +#' @name error_functions +#' @keywords internal +check_lambda <- function(x, + arg_name = NULL) { + + if (is.null(arg_name)) { + arg_name <- rlang::as_label(rlang::enexpr(x)) + } + + if (!(is.numeric(x)) || !(x %in% c(1, 2))) { + cli::cli_abort(c( + "`{arg_name}` argument must be a numeric value and either `1` or `2`", + "i" = "Please provide `1` or `2`" + )) + } +} + + #' @param x prior to check #' @param arg_name the name of the argument to check. #' From 13d49c9af9456f7f4c8f22b6a045eb144e883ba3 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Fri, 21 Nov 2025 16:48:29 -0500 Subject: [PATCH 29/42] Add in check_logical and check_lambda --- R/two_source_model.R | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) diff --git a/R/two_source_model.R b/R/two_source_model.R index 1a6074b..abea3b3 100644 --- a/R/two_source_model.R +++ b/R/two_source_model.R @@ -63,23 +63,15 @@ two_source_model <- function(bp = FALSE, lambda = NULL) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } + + + check_logical(bp) if (is.null(lambda)) { lambda <- 1 } - if (!(is.numeric(lambda)) || !(lambda %in% c(1, 2))) { - cli::cli_abort(c( - "`lambda` argument must be a numeric value and either `1` or `2`", - "i" = "Please provide `1` or `2`" - )) - } + check_lambda(lambda) if (lambda == 1) { if (isFALSE(bp)) { From 6d699f95392c0fd4ee207b08001128e5bc462291 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Sun, 23 Nov 2025 15:43:08 -0500 Subject: [PATCH 30/42] Add in check_logical and check_lambda --- R/two_source_model_ar.R | 16 +++------------- R/two_source_model_arc.R | 15 +++------------ 2 files changed, 6 insertions(+), 25 deletions(-) diff --git a/R/two_source_model_ar.R b/R/two_source_model_ar.R index 9de3c9f..0f2ea5f 100644 --- a/R/two_source_model_ar.R +++ b/R/two_source_model_ar.R @@ -82,24 +82,14 @@ two_source_model_ar <- function( bp = FALSE, lambda = NULL) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } + + check_logical(bp) if (is.null(lambda)) { lambda <- 1 } - if (!(is.numeric(lambda)) || !(lambda %in% c(1, 2))) { - cli::cli_abort(c( - "`lambda` argument must be a numeric value and either `1` or `2`", - "i" = "Please provide `1` or `2`" - )) - } - + check_lambda(lambda) # ---- singe lambda ---- if (lambda == 1) { # ---- no baseline priors ----- diff --git a/R/two_source_model_arc.R b/R/two_source_model_arc.R index 311ee09..5787f18 100644 --- a/R/two_source_model_arc.R +++ b/R/two_source_model_arc.R @@ -84,23 +84,14 @@ two_source_model_arc <- function( bp = FALSE, lambda = NULL) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } + + check_logical(bp) if (is.null(lambda)) { lambda <- 1 } - if (!(is.numeric(lambda)) || !(lambda %in% c(1, 2))) { - cli::cli_abort(c( - "`lambda` argument must be a numeric value and either `1` or `2`", - "i" = "Please provide `1` or `2`" - )) - } + check_lambda(lambda) # ---- singe lambda ---- if (lambda == 1) { From 25f4ed831907f17237b6d2b783cd27a020e24d3b Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Sun, 23 Nov 2025 15:43:18 -0500 Subject: [PATCH 31/42] add check_logical --- R/two_source_priors_arc.R | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/R/two_source_priors_arc.R b/R/two_source_priors_arc.R index d548f87..d8580c1 100644 --- a/R/two_source_priors_arc.R +++ b/R/two_source_priors_arc.R @@ -21,12 +21,8 @@ #' @export two_source_priors_arc <- function(bp = FALSE) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } + + check_logical(bp) if (isFALSE(bp)) { From 90424b1cb214418ae9628012c4aa25ccbcd60bc2 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Sun, 23 Nov 2025 15:43:50 -0500 Subject: [PATCH 32/42] change default how they are being handeled --- R/two_source_priors_params.R | 336 ++++++++----------------------- R/two_source_priors_params_ar.R | 268 +++++++----------------- R/two_source_priors_params_arc.R | 289 ++++++-------------------- 3 files changed, 216 insertions(+), 677 deletions(-) diff --git a/R/two_source_priors_params.R b/R/two_source_priors_params.R index fa665ba..da8f65a 100644 --- a/R/two_source_priors_params.R +++ b/R/two_source_priors_params.R @@ -100,261 +100,93 @@ two_source_priors_params <- function( sigma_lb = NULL, sigma_ub = NULL, bp = FALSE) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } - - # ----- a ----- - - # set a to 1 - if (is.null(a)) { - a <- 1 - } - - # create error message for a priros - if (!is.numeric(a)) { - cli::cli_abort(c( - "`a` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set b to 1 - if (is.null(b)) { - b <- 1 - } - # create error message for b priors - if (!is.numeric(b)) { - cli::cli_abort(c( - "`b` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - # ----- c1 ----- - - # set c1 to 21 - if (is.null(c1)) { - c1 <- -21 - } - - # create error message for n1 priros - if (!is.numeric(c1)) { - cli::cli_abort(c( - "`c1` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set c1_sigma to 1 - if (is.null(c1_sigma)) { - c1_sigma <- 1 - } - # create error message for c1 priors - if (!is.numeric(c1_sigma)) { - cli::cli_abort(c( - "`c1_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ----- c2 ----- - - # set c2 to -25 - if (is.null(c2)) { - c2 <- -26 - } - - # create error message for n1 priros - if (!is.numeric(c2)) { - cli::cli_abort(c( - "`c2` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set c1_sigma to 1 - if (is.null(c2_sigma)) { - c2_sigma <- 1 - } - # create error message for c1 priors - if (!is.numeric(c2_sigma)) { - cli::cli_abort(c( - "`c2_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ----- n1 ----- - - # set n1 to 9 - if (is.null(n1)) { - n1 <- 8 - } - - # create error message for n1 priros - if (!is.numeric(n1)) { - cli::cli_abort(c( - "`n1` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set n1_sigma to 1 - if (is.null(n1_sigma)) { - n1_sigma <- 1 - } - # create error message for n1 priors - if (!is.numeric(n1_sigma)) { - cli::cli_abort(c( - "`n1_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ----- n2 ----- - - # set n1 to 9 - if (is.null(n2)) { - n2 <- 9.5 - } - - # create error message for n1 priros - if (!is.numeric(n2)) { - cli::cli_abort(c( - "`n2` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set n1_sigma to 1 - if (is.null(n2_sigma)) { - n2_sigma <- 1 - } - # create error message for n1 priors - if (!is.numeric(n2_sigma)) { - cli::cli_abort(c( - "`n2_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # create error message for dn priros - - - if (is.null(dn)) { - dn <- 3.4 - } - - if (!is.numeric(dn)) { - cli::cli_abort(c( - "`dn` argument must be a numerical value", - "i" = "Please provide a numerical value as a pirorr" - )) - } - - # create error message for dn priors - if (is.null(dn_sigma)) { - dn_sigma <- 0.25 - } - - if (!is.numeric(dn_sigma)) { - cli::cli_abort(c( - "`dn_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - # ----- tp ----- - - # set piror for tp - if (is.null(tp_lb)) { - tp_lb <- 2 - } - - # create error message for tp priros - - if (!is.numeric(tp_lb)) { - cli::cli_abort(c( - "`tp_lb` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - if (is.null(tp_ub)) { - tp_ub <- 10 - } - - # create error message for n1 priors - if (!is.numeric(tp_ub)) { - cli::cli_abort(c( - "`tp_ub` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ----- sigma ----- - - # set piror for tp - if (is.null(sigma_lb)) { - sigma_lb <- 0 - } - - # create error message for tp priros - - if (!is.numeric(sigma_lb)) { - cli::cli_abort(c( - "`sigma_lb` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - if (is.null(sigma_ub)) { - sigma_ub <- 10 - } - - # create error message for n1 priors - if (!is.numeric(sigma_ub)) { - cli::cli_abort(c( - "`sigma_ub` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - if (isTRUE(bp)) { - priors_params <- + check_logical(bp) + # set defualts + defaults <- list( + a = 1, + b = 1, + c1 = -21, + c1_sigma = 1, + c2 = -26, + c2_sigma = 1, + n1 = 8, + n1_sigma = 1, + n2 = 9.5, + n2_sigma = 1, + dn = 3.4, + dn_sigma = 0.25, + tp_lb = 2, + tp_ub = 10, + sigma_lb = 0, + sigma_ub = 10 + ) + + + # ---- suplied + supplied <- list( + a = a, + b = b, + c1 = c1, + c1_sigma = c1_sigma, + c2 = c2, + c2_sigma = c2_sigma, + n1 = n1, + n1_sigma = n1_sigma, + n2 = n2, + n2_sigma = n2_sigma, + dn = dn, + dn_sigma = dn_sigma, + tp_lb = tp_lb, + tp_ub = tp_ub, + sigma_lb = sigma_lb, + sigma_ub = sigma_ub + ) + + # ---- either set defaults or supplied ------ + params <- Map(function(x, d) if (is.null(x)) d else x, supplied, defaults) + + # check them + lapply(names(params), function(nm) { + check_numerical(params[[nm]], arg_name = nm) + }) + # ----- put them in to function envo + params_env <- list2env(params, parent = environment()) + + + + priors_params <- if (isTRUE(bp)) { + with(params_env, { brms::stanvar(a, name = "a") + - brms::stanvar(b, "b") + - brms::stanvar(c1, name = "c1") + - brms::stanvar(c1_sigma, "c1_sigma") + - brms::stanvar(c2, name = "c2") + - brms::stanvar(c2_sigma, "c2_sigma") + - brms::stanvar(n1, name = "n1") + - brms::stanvar(n1_sigma, "n1_sigma") + - brms::stanvar(n2, name = "n2") + - brms::stanvar(n2_sigma, "n2_sigma") + - brms::stanvar(dn, "dn") + - brms::stanvar(dn_sigma, "dn_sigma") + - brms::stanvar(tp_lb, "tp_lb") + - brms::stanvar(tp_ub, "tp_ub") + - brms::stanvar(sigma_lb, "sigma_lb") + - brms::stanvar(sigma_ub, "sigma_ub") - } - - - # ----- dn ----- - - if (isFALSE(bp)) { - # ----- set prirors ----- - - priors_params <- + brms::stanvar(b, "b") + + brms::stanvar(c1, name = "c1") + + brms::stanvar(c1_sigma, "c1_sigma") + + brms::stanvar(c2, name = "c2") + + brms::stanvar(c2_sigma, "c2_sigma") + + brms::stanvar(n1, name = "n1") + + brms::stanvar(n1_sigma, "n1_sigma") + + brms::stanvar(n2, name = "n2") + + brms::stanvar(n2_sigma, "n2_sigma") + + brms::stanvar(dn, "dn") + + brms::stanvar(dn_sigma, "dn_sigma") + + brms::stanvar(tp_lb, "tp_lb") + + brms::stanvar(tp_ub, "tp_ub") + + brms::stanvar(sigma_lb, "sigma_lb") + + brms::stanvar(sigma_ub, "sigma_ub") + } + ) + } else { + with(params_env, { brms::stanvar(a, name = "a") + - brms::stanvar(b, "b") + - brms::stanvar(dn, "dn") + - brms::stanvar(dn_sigma, "dn_sigma") + - brms::stanvar(tp_lb, "tp_lb") + - brms::stanvar(tp_ub, "tp_ub") + - brms::stanvar(sigma_lb, "sigma_lb") + - brms::stanvar(sigma_ub, "sigma_ub") + brms::stanvar(b, "b") + + brms::stanvar(dn, "dn") + + brms::stanvar(dn_sigma, "dn_sigma") + + brms::stanvar(tp_lb, "tp_lb") + + brms::stanvar(tp_ub, "tp_ub") + + brms::stanvar(sigma_lb, "sigma_lb") + + brms::stanvar(sigma_ub, "sigma_ub") + } + ) } return(priors_params) diff --git a/R/two_source_priors_params_ar.R b/R/two_source_priors_params_ar.R index 386f7f6..792462a 100644 --- a/R/two_source_priors_params_ar.R +++ b/R/two_source_priors_params_ar.R @@ -119,205 +119,81 @@ two_source_priors_params_ar <- function( sigma_lb = NULL, sigma_ub = NULL, bp = FALSE) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } - - # ----- a ----- - - # set a to 1 - if (is.null(a)) { - a <- 1 - } - - # create error message for a priros - if (!is.numeric(a)) { - cli::cli_abort(c( - "`a` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set b to 1 - if (is.null(b)) { - b <- 1 - } - # create error message for b priors - if (!is.numeric(b)) { - cli::cli_abort(c( - "`b` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - # ----- n1 ----- - - # set n1 to 9 - if (is.null(n1)) { - n1 <- 8.0 - } - - # create error message for n1 priros - if (!is.numeric(n1)) { - cli::cli_abort(c( - "`n1` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set n1_sigma to 1 - if (is.null(n1_sigma)) { - n1_sigma <- 1 - } - # create error message for n1 priors - if (!is.numeric(n1_sigma)) { - cli::cli_abort(c( - "`n1_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ----- n2 ----- - - # set n1 to 9 - if (is.null(n2)) { - n2 <- 9.5 - } - - # create error message for n1 priros - if (!is.numeric(n2)) { - cli::cli_abort(c( - "`n2` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set n1_sigma to 1 - if (is.null(n2_sigma)) { - n2_sigma <- 1 - } - # create error message for n1 priors - if (!is.numeric(n2_sigma)) { - cli::cli_abort(c( - "`n2_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ---- dn priors ----- - - - if (is.null(dn)) { - dn <- 3.4 - } - - if (!is.numeric(dn)) { - cli::cli_abort(c( - "`dn` argument must be a numerical value", - "i" = "Please provide a numerical value as a pirorr" - )) - } - # create error message for dn priors - if (is.null(dn_sigma)) { - dn_sigma <- 0.25 - } - - if (!is.numeric(dn_sigma)) { - cli::cli_abort(c( - "`dn_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - # ----- tp ----- - - # set piror for tp - if (is.null(tp_lb)) { - tp_lb <- 2 - } - - # create error message for tp priros - - if (!is.numeric(tp_lb)) { - cli::cli_abort(c( - "`tp_lb` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - if (is.null(tp_ub)) { - tp_ub <- 10 - } - - # create error message for n1 priors - if (!is.numeric(tp_ub)) { - cli::cli_abort(c( - "`tp_ub` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ----- sigma ----- - - # set piror for tp - if (is.null(sigma_lb)) { - sigma_lb <- 0 - } - - # create error message for tp priros - - if (!is.numeric(sigma_lb)) { - cli::cli_abort(c( - "`sigma_lb` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - if (is.null(sigma_ub)) { - sigma_ub <- 10 - } - - # create error message for n1 priors - if (!is.numeric(sigma_ub)) { - cli::cli_abort(c( - "`sigma_ub` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - - if (isTRUE(bp)) { - priors_params <- + check_logical(bp) + + # ----- set defaults ----- + defaults <- list( + a = 1, + b = 1, + n1 = 8.0, + n1_sigma = 1, + n2 = 9.5, + n2_sigma = 1, + dn = 3.4, + dn_sigma = 0.25, + tp_lb = 2, + tp_ub = 10, + sigma_lb = 0, + sigma_ub = 10 + ) + + + # ---- suplied ----- + supplied <- list( + a = a, + b = b, + n1 = n1, + n1_sigma = n1_sigma, + n2 = n2, + n2_sigma = n2_sigma, + dn = dn, + dn_sigma = dn_sigma, + tp_lb = tp_lb, + tp_ub = tp_ub, + sigma_lb = sigma_lb, + sigma_ub = sigma_ub + ) + + + # ---- either set defaults or supplied ------ + params <- Map(function(x, d) if (is.null(x)) d else x, supplied, defaults) + + # check them + lapply(names(params), function(nm) { + check_numerical(params[[nm]], arg_name = nm) + }) + # ----- put them in to function envo + params_env <- list2env(params, parent = environment()) + + priors_params <- if (isTRUE(bp)) { + with(params_env, { brms::stanvar(a, name = "a") + - brms::stanvar(b, "b") + - brms::stanvar(n1, name = "n1") + - brms::stanvar(n1_sigma, "n1_sigma") + - brms::stanvar(n2, name = "n2") + - brms::stanvar(n2_sigma, "n2_sigma") + - brms::stanvar(dn, "dn") + - brms::stanvar(dn_sigma, "dn_sigma") + - brms::stanvar(tp_lb, "tp_lb") + - brms::stanvar(tp_ub, "tp_ub") + - brms::stanvar(sigma_lb, "sigma_lb") + - brms::stanvar(sigma_ub, "sigma_ub") - } - - - # ----- dn ----- - - if (isFALSE(bp)) { - # ----- set prirors ----- - - priors_params <- + brms::stanvar(b, "b") + + brms::stanvar(n1, name = "n1") + + brms::stanvar(n1_sigma, "n1_sigma") + + brms::stanvar(n2, name = "n2") + + brms::stanvar(n2_sigma, "n2_sigma") + + brms::stanvar(dn, "dn") + + brms::stanvar(dn_sigma, "dn_sigma") + + brms::stanvar(tp_lb, "tp_lb") + + brms::stanvar(tp_ub, "tp_ub") + + brms::stanvar(sigma_lb, "sigma_lb") + + brms::stanvar(sigma_ub, "sigma_ub") + } + ) + } else { + with(params_env, { brms::stanvar(a, name = "a") + - brms::stanvar(b, "b") + - brms::stanvar(dn, "dn") + - brms::stanvar(dn_sigma, "dn_sigma") + - brms::stanvar(tp_lb, "tp_lb") + - brms::stanvar(tp_ub, "tp_ub") + - brms::stanvar(sigma_lb, "sigma_lb") + - brms::stanvar(sigma_ub, "sigma_ub") + brms::stanvar(b, "b") + + brms::stanvar(dn, "dn") + + brms::stanvar(dn_sigma, "dn_sigma") + + brms::stanvar(tp_lb, "tp_lb") + + brms::stanvar(tp_ub, "tp_ub") + + brms::stanvar(sigma_lb, "sigma_lb") + + brms::stanvar(sigma_ub, "sigma_ub") + } + ) } return(priors_params) diff --git a/R/two_source_priors_params_arc.R b/R/two_source_priors_params_arc.R index 8cbc623..7ddf099 100644 --- a/R/two_source_priors_params_arc.R +++ b/R/two_source_priors_params_arc.R @@ -138,230 +138,64 @@ two_source_priors_params_arc <- function( sigma_lb = NULL, sigma_ub = NULL, bp = FALSE) { - if (!(is.logical(bp))) { - cli::cli_abort(c( - "`bp` argument must be a logical value", - "i" = "Please provide TRUE or FALSE" - )) - } + + check_logical(bp) # ----- a ----- # set a to 1 - if (is.null(a)) { - a <- 1 - } - - # create error message for a priros - if (!is.numeric(a)) { - cli::cli_abort(c( - "`a` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set b to 1 - if (is.null(b)) { - b <- 1 - } - # create error message for b priors - if (!is.numeric(b)) { - cli::cli_abort(c( - "`b` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - # ----- n1 ----- - - # set n1 to 9 - if (is.null(n1)) { - n1 <- 8.0 - } - - # create error message for n1 priros - if (!is.numeric(n1)) { - cli::cli_abort(c( - "`n1` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set n1_sigma to 1 - if (is.null(n1_sigma)) { - n1_sigma <- 1 - } - # create error message for n1 priors - if (!is.numeric(n1_sigma)) { - cli::cli_abort(c( - "`n1_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ----- n2 ----- - - # set n1 to 9 - if (is.null(n2)) { - n2 <- 9.5 - } - - # create error message for n1 priros - if (!is.numeric(n2)) { - cli::cli_abort(c( - "`n2` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set n1_sigma to 1 - if (is.null(n2_sigma)) { - n2_sigma <- 1 - } - # create error message for n1 priors - if (!is.numeric(n2_sigma)) { - cli::cli_abort(c( - "`n2_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ----- c1 ----- - - # set c1 to -21 - if (is.null(c1)) { - c1 <- -21 - } - - # create error message for c1 priros - if (!is.numeric(c1)) { - cli::cli_abort(c( - "`c1` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set c1_sigma to 1 - if (is.null(c1_sigma)) { - c1_sigma <- 1 - } - # create error message for n1 priors - if (!is.numeric(c1_sigma)) { - cli::cli_abort(c( - "`c1_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - # ----- c2 ----- - - # set c2 to -26 - if (is.null(c2)) { - c2 <- -26 - } - - # create error message for c1 priros - if (!is.numeric(c2)) { - cli::cli_abort(c( - "`c2` argument must be a numerical value.", - "i" = "Please provide a numerical value as a piror." - )) - } - - # set c1_sigma to 1 - if (is.null(c2_sigma)) { - c2_sigma <- 1 - } - # create error message for n1 priors - if (!is.numeric(c2_sigma)) { - cli::cli_abort(c( - "`c2_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - # ---- dn priors ----- - - - if (is.null(dn)) { - dn <- 3.4 - } - - if (!is.numeric(dn)) { - cli::cli_abort(c( - "`dn` argument must be a numerical value", - "i" = "Please provide a numerical value as a pirorr" - )) - } - - # create error message for dn priors - if (is.null(dn_sigma)) { - dn_sigma <- 0.25 - } - - if (!is.numeric(dn_sigma)) { - cli::cli_abort(c( - "`dn_sigma` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - # ----- tp ----- - - # set piror for tp - if (is.null(tp_lb)) { - tp_lb <- 2 - } - - # create error message for tp priros - - if (!is.numeric(tp_lb)) { - cli::cli_abort(c( - "`tp_lb` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - if (is.null(tp_ub)) { - tp_ub <- 10 - } - - # create error message for n1 priors - if (!is.numeric(tp_ub)) { - cli::cli_abort(c( - "`tp_ub` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - # ----- sigma ----- - - # set piror for tp - if (is.null(sigma_lb)) { - sigma_lb <- 0 - } - - # create error message for tp priros - - if (!is.numeric(sigma_lb)) { - cli::cli_abort(c( - "`sigma_lb` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - if (is.null(sigma_ub)) { - sigma_ub <- 10 - } - - # create error message for n1 priors - if (!is.numeric(sigma_ub)) { - cli::cli_abort(c( - "`sigma_ub` argument must be a numerical value", - "i" = "Please provide a numerical value as a piror" - )) - } - - - if (isTRUE(bp)) { - priors_params <- + defaults <- list( + a = 1, + b = 1, + n1 = 8, + n1_sigma = 1, + n2 = 9.5, + n2_sigma = 1, + c1 = -21, + c1_sigma = 1, + c2 = -26, + c2_sigma = 1, + dn = 3.4, + dn_sigma = 0.25, + tp_lb = 2, + tp_ub = 10, + sigma_lb = 0, + sigma_ub = 10 + + ) + + + supplied <- list( + a = a, + b = b, + n1 = n1, + n1_sigma = n1_sigma, + n2 = n2, + n2_sigma = n2_sigma, + c1 = c1, + c1_sigma = c1_sigma, + c2 = c2, + c2_sigma = c2_sigma, + dn = dn, + dn_sigma = dn_sigma, + tp_lb = tp_lb, + tp_ub = tp_ub, + sigma_lb = sigma_lb, + sigma_ub = sigma_ub + ) + + # ---- either set defaults or supplied ------ + params <- Map(function(x, d) if (is.null(x)) d else x, supplied, defaults) + + # check them + lapply(names(params), function(nm) { + check_numerical(params[[nm]], arg_name = nm) + }) + # ----- put them in to function envo + params_env <- list2env(params, parent = environment()) + + priors_params <- if (isTRUE(bp)) { + with(params_env, { brms::stanvar(a, name = "a") + brms::stanvar(b, "b") + brms::stanvar(n1, name = "n1") + @@ -378,15 +212,10 @@ two_source_priors_params_arc <- function( brms::stanvar(tp_ub, "tp_ub") + brms::stanvar(sigma_lb, "sigma_lb") + brms::stanvar(sigma_ub, "sigma_ub") - } - - - # ----- dn ----- - - if (isFALSE(bp)) { - # ----- set prirors ----- - - priors_params <- + } + ) + } else { + with(params_env, { brms::stanvar(a, name = "a") + brms::stanvar(b, "b") + brms::stanvar(dn, "dn") + @@ -395,6 +224,8 @@ two_source_priors_params_arc <- function( brms::stanvar(tp_ub, "tp_ub") + brms::stanvar(sigma_lb, "sigma_lb") + brms::stanvar(sigma_ub, "sigma_ub") + } + ) } return(priors_params) From 85d21c1ce44b234d905ed8d84bd665a018080114 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Sun, 23 Nov 2025 16:08:44 -0500 Subject: [PATCH 33/42] Remove commented code --- R/utils.R | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/R/utils.R b/R/utils.R index ef370ba..8f64f2d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -106,22 +106,4 @@ check_numerical <- function(x, arg_name = NULL) { -# args <- list(...) -# -# for (arg_name in names(args)) { -# value <- args[[arg_name]] -# -# # Skip NULLs if allowed -# if (.allow_null && is.null(value)) { -# next -# } -# -# # Check numeric scalar -# if (!is.numeric(value) || length(value) != 1) { -# cli::cli_abort(c( -# "`{arg_name}` must be a numeric value of length 1.", -# "i" = "Please provide a numeric scalar as a prior." -# )) -# } -# } From 7926707a55cea4a0f06977e0443f27d9f459e139 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Sun, 23 Nov 2025 16:26:19 -0500 Subject: [PATCH 34/42] Add check lambda --- man/error_functions.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/error_functions.Rd b/man/error_functions.Rd index 6f3b429..5106d80 100644 --- a/man/error_functions.Rd +++ b/man/error_functions.Rd @@ -4,6 +4,7 @@ \alias{error_functions} \alias{check_column_names} \alias{check_data_frame} +\alias{check_lambda} \alias{check_logical} \alias{check_numerical} \title{Error functions} @@ -12,6 +13,8 @@ check_column_names(x, arg_name = NULL) check_data_frame(x, arg_name = NULL) +check_lambda(x, arg_name = NULL) + check_logical(x, arg_name = NULL) check_numerical(x, arg_name = NULL) From c5c24f2cc45604f8c986519ffbc120fdf57cef46 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Sun, 23 Nov 2025 16:26:30 -0500 Subject: [PATCH 35/42] Add set_priors functions --- R/utils.R | 155 ++++++++++++++++++++++++++++++++++++++++++++++ man/set_priors.Rd | 39 ++++++++++++ 2 files changed, 194 insertions(+) create mode 100644 man/set_priors.Rd diff --git a/R/utils.R b/R/utils.R index 8f64f2d..e110cdc 100644 --- a/R/utils.R +++ b/R/utils.R @@ -103,7 +103,162 @@ check_numerical <- function(x, arg_name = NULL) { } } +#' Set default priors +#' @param model model type +#' @name set_priors +#' @keywords internal + +default_priors <- function(model = c( + "one_source", + "two_source", + "two_source_ar", + "two_source_arc" +)) { + + model <- match.arg(model) + + base_defaults <- list( + dn = 3.4, + dn_sigma = 0.25, + tp_lb = 2, + tp_ub = 10, + sigma_lb = 0, + sigma_ub = 10 + ) + + model_specific <- list( + one_source = list( + n1 = 9, + n1_sigma = 1 + ), + + two_source = list( + a = 1, + b = 1, + c1 = -21, + c1_sigma = 1, + c2 = -26, + c2_sigma = 1, + n1 = 8, + n1_sigma = 1, + n2 = 9.5, + n2_sigma = 1 + ), + + two_source_ar = list( + a = 1, + b = 1, + n1 = 8, + n1_sigma = 1, + n2 = 9.5, + n2_sigma = 1 + ), + + two_source_arc = list( + a = 1, + b = 1, + n1 = 8, + n1_sigma = 1, + n2 = 9.5, + n2_sigma = 1, + c1 = -21, + c1_sigma = 1, + c2 = -26, + c2_sigma = 1 + ) + ) + + # Merge: specific overrides base + c(model_specific[[model]], + base_defaults) +} +#' @param model model type +#' @name set_priors +#' @keywords internal +supplied_priors <- function(model = c( + "one_source", + "two_source", + "two_source_ar", + "two_source_arc" +), +a = NULL, +b = NULL, +n1 = NULL, +n1_sigma = NULL, +n2 = NULL, +n2_sigma = NULL, +c1 = NULL, +c1_sigma = NULL, +c2 = NULL, +c2_sigma = NULL, +dn = NULL, +dn_sigma = NULL, +tp_lb = NULL, +tp_ub = NULL, +sigma_lb = NULL, +sigma_ub = NULL +) { + model <- match.arg(model) + + # ---- shared variables across all models ---- + base_supplied <- list( + dn = dn, + dn_sigma = dn_sigma, + tp_lb = tp_lb, + tp_ub = tp_ub, + sigma_lb = sigma_lb, + sigma_ub = sigma_ub + ) + + # ---- model-specific supplied variables ---- + model_specific <- list( + + one_source = list( + n1 = n1, + n1_sigma = n1_sigma + ), + + two_source = list( + a = a, + b = b, + c1 = c1, + c1_sigma = c1_sigma, + c2 = c2, + c2_sigma = c2_sigma, + n1 = n1, + n1_sigma = n1_sigma, + n2 = n2, + n2_sigma = n2_sigma + ), + + two_source_ar = list( + a = a, + b = b, + n1 = n1, + n1_sigma = n1_sigma, + n2 = n2, + n2_sigma = n2_sigma + ), + + two_source_arc = list( + a = a, + b = b, + c1 = c1, + c1_sigma = c1_sigma, + c2 = c2, + c2_sigma = c2_sigma, + n1 = n1, + n1_sigma = n1_sigma, + n2 = n2, + n2_sigma = n2_sigma + ) + ) + + # merge them (model-specific overrides base) + c(model_specific[[model]], + base_supplied) +} diff --git a/man/set_priors.Rd b/man/set_priors.Rd new file mode 100644 index 0000000..08b14bd --- /dev/null +++ b/man/set_priors.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{set_priors} +\alias{set_priors} +\alias{default_priors} +\alias{supplied_priors} +\title{Set default priors} +\usage{ +default_priors( + model = c("one_source", "two_source", "two_source_ar", "two_source_arc") +) + +supplied_priors( + model = c("one_source", "two_source", "two_source_ar", "two_source_arc"), + a = NULL, + b = NULL, + n1 = NULL, + n1_sigma = NULL, + n2 = NULL, + n2_sigma = NULL, + c1 = NULL, + c1_sigma = NULL, + c2 = NULL, + c2_sigma = NULL, + dn = NULL, + dn_sigma = NULL, + tp_lb = NULL, + tp_ub = NULL, + sigma_lb = NULL, + sigma_ub = NULL +) +} +\arguments{ +\item{model}{model type} +} +\description{ +Set default priors +} +\keyword{internal} From 3fd3b54fbf920e28f15b2f0c4f125ed689682756 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Sun, 23 Nov 2025 16:30:36 -0500 Subject: [PATCH 36/42] Change to default_priors --- R/one_source_priors_params.R | 15 ++++----------- R/two_source_priors_params.R | 20 +------------------- R/two_source_priors_params_ar.R | 15 +-------------- R/two_source_priors_params_arc.R | 23 ++--------------------- 4 files changed, 8 insertions(+), 65 deletions(-) diff --git a/R/one_source_priors_params.R b/R/one_source_priors_params.R index 987c7c4..247df01 100644 --- a/R/one_source_priors_params.R +++ b/R/one_source_priors_params.R @@ -59,17 +59,10 @@ one_source_priors_params <- function( check_logical(bp) # ---- defualt values - defaults <- list( - n1 = 9, - n1_sigma = 1, - dn = 3.4, - dn_sigma = 0.25, - tp_lb = 2, - tp_ub = 10, - sigma_lb = 0, - sigma_ub = 10 - ) - # nulls + + defaults <- default_priors("one_source") + + # supplied <- supplied_priors("one_source") supplied <- list( n1 = n1, n1_sigma = n1_sigma, diff --git a/R/two_source_priors_params.R b/R/two_source_priors_params.R index da8f65a..3b8093c 100644 --- a/R/two_source_priors_params.R +++ b/R/two_source_priors_params.R @@ -103,25 +103,7 @@ two_source_priors_params <- function( check_logical(bp) # set defualts - defaults <- list( - a = 1, - b = 1, - c1 = -21, - c1_sigma = 1, - c2 = -26, - c2_sigma = 1, - n1 = 8, - n1_sigma = 1, - n2 = 9.5, - n2_sigma = 1, - dn = 3.4, - dn_sigma = 0.25, - tp_lb = 2, - tp_ub = 10, - sigma_lb = 0, - sigma_ub = 10 - ) - + defaults <- default_priors("two_source") # ---- suplied supplied <- list( diff --git a/R/two_source_priors_params_ar.R b/R/two_source_priors_params_ar.R index 792462a..6674141 100644 --- a/R/two_source_priors_params_ar.R +++ b/R/two_source_priors_params_ar.R @@ -123,20 +123,7 @@ two_source_priors_params_ar <- function( check_logical(bp) # ----- set defaults ----- - defaults <- list( - a = 1, - b = 1, - n1 = 8.0, - n1_sigma = 1, - n2 = 9.5, - n2_sigma = 1, - dn = 3.4, - dn_sigma = 0.25, - tp_lb = 2, - tp_ub = 10, - sigma_lb = 0, - sigma_ub = 10 - ) + defaults <- default_priors("two_source_ar") # ---- suplied ----- diff --git a/R/two_source_priors_params_arc.R b/R/two_source_priors_params_arc.R index 7ddf099..ac67419 100644 --- a/R/two_source_priors_params_arc.R +++ b/R/two_source_priors_params_arc.R @@ -144,27 +144,8 @@ two_source_priors_params_arc <- function( # ----- a ----- # set a to 1 - defaults <- list( - a = 1, - b = 1, - n1 = 8, - n1_sigma = 1, - n2 = 9.5, - n2_sigma = 1, - c1 = -21, - c1_sigma = 1, - c2 = -26, - c2_sigma = 1, - dn = 3.4, - dn_sigma = 0.25, - tp_lb = 2, - tp_ub = 10, - sigma_lb = 0, - sigma_ub = 10 - - ) - - + defaults <- default_priors("two_source_arc") + # supplied supplied <- list( a = a, b = b, From 567fe6218ee3f8d965f40a8f87da24432104f04f Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Sun, 23 Nov 2025 16:57:48 -0500 Subject: [PATCH 37/42] Add rlang --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index ffdbe40..6c60f4a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,7 +23,8 @@ Imports: brms, cli, dplyr, - lifecycle + lifecycle, + rlang Suggests: bayesplot, ggdist, From df2599550c0baec7c268fa5866d4a5d483a73643 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Sun, 23 Nov 2025 17:27:50 -0500 Subject: [PATCH 38/42] This is suppose to be nb1 --- .../article/estimate_trophic_position_two_source_model_ar.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/article/estimate_trophic_position_two_source_model_ar.Rmd b/vignettes/article/estimate_trophic_position_two_source_model_ar.Rmd index 95308c9..2da9716 100644 --- a/vignettes/article/estimate_trophic_position_two_source_model_ar.Rmd +++ b/vignettes/article/estimate_trophic_position_two_source_model_ar.Rmd @@ -56,7 +56,7 @@ from above, $\alpha_{min}$ is the minimum value of $\alpha$ calculated above, an $$ \text{Trophic Position} = \lambda + \frac{(\delta^{15}N_c - -[(\delta^{15}N_{b1} \times \alpha_r) - (\delta^{15}N_{b1} \times (1 - \alpha_r))]}{\Delta N} +[(\delta^{15}N_{b1} \times \alpha_r) - (\delta^{15}N_{b2} \times (1 - \alpha_r))]}{\Delta N} $$ From 0fc95b8a02dd9303cec78e2926e342c1fd55c407 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Sun, 23 Nov 2025 17:35:56 -0500 Subject: [PATCH 39/42] Change - to + --- .../article/estimate_trophic_position_two_source_model_ar.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/article/estimate_trophic_position_two_source_model_ar.Rmd b/vignettes/article/estimate_trophic_position_two_source_model_ar.Rmd index 2da9716..24eee9a 100644 --- a/vignettes/article/estimate_trophic_position_two_source_model_ar.Rmd +++ b/vignettes/article/estimate_trophic_position_two_source_model_ar.Rmd @@ -56,7 +56,7 @@ from above, $\alpha_{min}$ is the minimum value of $\alpha$ calculated above, an $$ \text{Trophic Position} = \lambda + \frac{(\delta^{15}N_c - -[(\delta^{15}N_{b1} \times \alpha_r) - (\delta^{15}N_{b2} \times (1 - \alpha_r))]}{\Delta N} +[(\delta^{15}N_{b1} \times \alpha_r) + (\delta^{15}N_{b2} \times (1 - \alpha_r))]}{\Delta N} $$ From 13f156c7c700753cfb16ad77037065a7bcae20c3 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Mon, 24 Nov 2025 07:21:52 -0500 Subject: [PATCH 40/42] Fix numerical value test --- tests/testthat/test-one_source_priors_params.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-one_source_priors_params.R b/tests/testthat/test-one_source_priors_params.R index 602834c..6065962 100644 --- a/tests/testthat/test-one_source_priors_params.R +++ b/tests/testthat/test-one_source_priors_params.R @@ -306,9 +306,9 @@ test_that("test one-source priors sigma_ub", { test_that("test priors fails sigma_ub ", { expect_error( - one_source_priors_params(, + one_source_priors_params( sigma_ub = "test" ), - regexp = "`sigma_ub` argument must be a numerical value" + regexp = "`sigma_ub` argument must be a numerical value." ) }) From f4da29d3b8787943a2164f58d36155b4271c4fc0 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Mon, 24 Nov 2025 11:11:57 -0500 Subject: [PATCH 41/42] Remove supplied_priors for now --- R/utils.R | 87 ------------------------------------------------------- 1 file changed, 87 deletions(-) diff --git a/R/utils.R b/R/utils.R index e110cdc..c42dcb5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -174,91 +174,4 @@ default_priors <- function(model = c( base_defaults) } -#' @param model model type -#' @name set_priors -#' @keywords internal -supplied_priors <- function(model = c( - "one_source", - "two_source", - "two_source_ar", - "two_source_arc" -), -a = NULL, -b = NULL, -n1 = NULL, -n1_sigma = NULL, -n2 = NULL, -n2_sigma = NULL, -c1 = NULL, -c1_sigma = NULL, -c2 = NULL, -c2_sigma = NULL, -dn = NULL, -dn_sigma = NULL, -tp_lb = NULL, -tp_ub = NULL, -sigma_lb = NULL, -sigma_ub = NULL -) { - model <- match.arg(model) - - # ---- shared variables across all models ---- - base_supplied <- list( - dn = dn, - dn_sigma = dn_sigma, - tp_lb = tp_lb, - tp_ub = tp_ub, - sigma_lb = sigma_lb, - sigma_ub = sigma_ub - ) - - # ---- model-specific supplied variables ---- - model_specific <- list( - - one_source = list( - n1 = n1, - n1_sigma = n1_sigma - ), - - two_source = list( - a = a, - b = b, - c1 = c1, - c1_sigma = c1_sigma, - c2 = c2, - c2_sigma = c2_sigma, - n1 = n1, - n1_sigma = n1_sigma, - n2 = n2, - n2_sigma = n2_sigma - ), - - two_source_ar = list( - a = a, - b = b, - n1 = n1, - n1_sigma = n1_sigma, - n2 = n2, - n2_sigma = n2_sigma - ), - - two_source_arc = list( - a = a, - b = b, - c1 = c1, - c1_sigma = c1_sigma, - c2 = c2, - c2_sigma = c2_sigma, - n1 = n1, - n1_sigma = n1_sigma, - n2 = n2, - n2_sigma = n2_sigma - ) - ) - - # merge them (model-specific overrides base) - c(model_specific[[model]], - base_supplied) -} - From aa838f0b5958a10a380e06dd2dc94bd283fbed22 Mon Sep 17 00:00:00 2001 From: benjaminhlina Date: Mon, 24 Nov 2025 12:02:16 -0500 Subject: [PATCH 42/42] Updated supplied pirors manual --- man/set_priors.Rd | 21 --------------------- 1 file changed, 21 deletions(-) diff --git a/man/set_priors.Rd b/man/set_priors.Rd index 08b14bd..2f3b865 100644 --- a/man/set_priors.Rd +++ b/man/set_priors.Rd @@ -3,32 +3,11 @@ \name{set_priors} \alias{set_priors} \alias{default_priors} -\alias{supplied_priors} \title{Set default priors} \usage{ default_priors( model = c("one_source", "two_source", "two_source_ar", "two_source_arc") ) - -supplied_priors( - model = c("one_source", "two_source", "two_source_ar", "two_source_arc"), - a = NULL, - b = NULL, - n1 = NULL, - n1_sigma = NULL, - n2 = NULL, - n2_sigma = NULL, - c1 = NULL, - c1_sigma = NULL, - c2 = NULL, - c2_sigma = NULL, - dn = NULL, - dn_sigma = NULL, - tp_lb = NULL, - tp_ub = NULL, - sigma_lb = NULL, - sigma_ub = NULL -) } \arguments{ \item{model}{model type}