Make functions DRY

DESCRIPTION

@@ -1,7 +1,7 @@
 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(
       "Benjamin L.", "Hlina",
@@ -23,7 +23,8 @@ Imports:
     brms,
     cli,
     dplyr,
-    lifecycle
+    lifecycle,
+    rlang
 Suggests: 
     bayesplot,
     ggdist,
@@ -37,7 +38,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)

R/add_alpha.R

@@ -32,36 +32,12 @@
 
 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}"
-    ))
-  }
-
+    abs = FALSE
+) {
 
-
-  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 |>

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(

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)
 }

R/one_source_priors_params.R

@@ -55,145 +55,61 @@ 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
-  }
+  check_logical(bp)
 
-  # create error message for tp priros
+  # ---- defualt values
 
-  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
-  }
+  defaults <- default_priors("one_source")
 
-  # 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 -----
+  # supplied <- supplied_priors("one_source")
+  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
+  )
 
-  # set piror for tp
-  if (is.null(sigma_lb)) {
-    sigma_lb <- 0
-  }
 
-  # create error message for tp priros
+  params <- Map(function(x, d) if (is.null(x)) d else x, supplied, defaults)
 
-  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"
-    ))
-  }
+  lapply(names(params), function(nm) {
+    check_numerical(params[[nm]], arg_name = nm)
+  })
 
-  if (is.null(sigma_ub)) {
-    sigma_ub <- 10
-  }
+  params_env <- list2env(params, parent = environment())
 
-  # 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"
-    ))
-  }
+  # ---- 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") +
+        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 {
 
-  if (isTRUE(bp)) {
-    priors_params <- brms::stanvar(n1, name = "n1") +
-      brms::stanvar(n1_sigma, "n1_sigma") +
+    with(params_env, {
       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_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(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)
 }

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)) {

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 -----

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) {

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