docs: Update documentation for most functions

Switch to `@importFrom` tags from `@import` Add `@seealso`, `@details` and some `@examples` Reorganise index manual grouping structure with `@family` and `@describeIn` tags `devtools::document()` Refs: #97 #102
egouldo · Aug 24, 2024 · 7dabe6d · 7dabe6d
1 parent 02d058e
commit 7dabe6d
Show file tree

Hide file tree

Showing 78 changed files with 1,190 additions and 328 deletions.
diff --git a/R/assign_transformation_type.R b/R/assign_transformation_type.R
@@ -9,7 +9,7 @@
 #' @export
 #' @import dplyr
 #' @import rlang
-#' @family back-transformation functions
+#' back-transformation
 #' @seealso [prepare_response_variables_yi(), standardise_response()]. To be called prior to [clean_response_transformation()].
 assign_transformation_type <- function(response_transformation = character(1L),
                                        link_fun = character(1L)) {

diff --git a/R/back_transformations.R b/R/back_transformations.R
@@ -9,13 +9,16 @@
 #' or out-of-sample prediction estimate \eqn{y_i}.
 #' @param sim numeric vector of length 1. number of simulations.
 #' @return data frame containing the mean estimate, its standard error, and quantiles.
-#' @family back transformation
+#' @family Back-transformation
+#' @importFrom purrr map_lgl flatten_dbl
+#' @importFrom cli cli_alert_danger cli_alert_success cli_alert_info
 #' @name back
 NULL
 #> NULL
 
 #' @describeIn back Back transform beta estimates for models with log-link
 #' @export
+#' @family Back-transformation
 log_back <- function(beta, se, sim) {
   simulated <- rnorm(sim, beta, se)
   original <- exp(simulated) %>% # exponential = inverse of log
@@ -35,6 +38,7 @@ log_back <- function(beta, se, sim) {
 
 #' @describeIn back Back transform beta estimates for models with logit-link
 #' @export
+#' @family Back-transformation
 logit_back <- function(beta, se, sim) {
   simulated <- rnorm(sim, beta, se)
   original <- plogis(simulated) %>% # invlogit
@@ -54,6 +58,7 @@ logit_back <- function(beta, se, sim) {
 
 #' @describeIn back Back transform beta estimates for models with probit-link
 #' @export
+#' @family Back-transformation
 probit_back <- function(beta, se, sim) {
   simulated <- rnorm(sim, beta, se)
   original <- pnorm(simulated) %>% # inv-probit
@@ -73,6 +78,7 @@ probit_back <- function(beta, se, sim) {
 
 #' @describeIn back Back transform beta estimates for models with \eqn{1/x} link
 #' @export
+#' @family Back-transformation
 inverse_back <- function(beta, se, sim) {
   simulated <- rnorm(sim, beta, se)
   original <- 1 / simulated %>% # inverse
@@ -92,6 +98,7 @@ inverse_back <- function(beta, se, sim) {
 
 #' @describeIn back Back transform beta estimates for models with \eqn{x^2}-link
 #' @export
+#' @family Back-transformation
 square_back <- function(beta, se, sim) {
   simulated <- rnorm(sim, beta, se)
   original <- sqrt(simulated) %>% # inverse of x^2
@@ -111,6 +118,7 @@ square_back <- function(beta, se, sim) {
 
 #' @describeIn back Back transform beta estimates for models with \eqn{x^3}-link
 #' @export
+#' @family Back-transformation
 cube_back <- function(beta, se, sim) {
   simulated <- rnorm(sim, beta, se)
   original <- pracma::nthroot(simulated, n = 3) %>% # inverse of x^3, use non-base to allow for -ve numbers
@@ -130,6 +138,7 @@ cube_back <- function(beta, se, sim) {
 
 #' @describeIn back Back transform beta estimates for models with identity-link
 #' @export
+#' @family Back-transformation
 identity_back <- function(beta, se, sim) { # identity (typo) TODO
   simulated <- rnorm(sim, beta, se)
   original <- simulated %>% #  no transformation
@@ -150,6 +159,7 @@ identity_back <- function(beta, se, sim) { # identity (typo) TODO
 
 #' @describeIn back Back transform beta estimates for models with power-link
 #' @export
+#' @family Back-transformation
 power_back <- function(beta, se, sim, n) {
   simulated <- rnorm(sim, beta, se)
   original <- pracma::nthroot(simulated, n = n) %>% # inverse of x^n, use non-base to allow for -ve numbers
@@ -170,6 +180,7 @@ power_back <- function(beta, se, sim, n) {
 #' @describeIn back Back transform beta estimates or out-of-sample predictions from models whose response variable has been divided by some number, `n`.
 #' @param n Denominator used by analyst to divide the response variable.
 #' @export
+#' @family Back-transformation
 divide_back <- function(beta, se, sim, n) {
   simulated <- rnorm(sim, beta, se)
   original <- simulated * n %>%
@@ -200,6 +211,7 @@ divide_back <- function(beta, se, sim, n) {
 
 #' @describeIn back Back transform beta estimates or out-of-sample predictions from models whose response variable has been transformed by the square root
 #' @export
+#' @family Back-transformation
 square_root_back <- function(beta, se, sim) {
   simulated <- rnorm(sim, beta, se)
   original <- simulated^2 %>%

diff --git a/R/box_cox_transform.R b/R/box_cox_transform.R
@@ -2,80 +2,68 @@
 #'
 #' @param data Dataset for model fitting, must contain columns `"abs_deviation_score_estimate"` and standard error
 #' @param dataset character string of either "blue tit" or "eucalyptus"
-#'
+#' @family Box-Cox transformation
+#' @family Analysis-level functions
 #' @return data with additional columns of box-cox transformed deviation scores and variance
 #' @export
 #' @import dplyr
-#' @importFrom purrr map2
-#' @import rlang
+#' @importFrom rlang is_na is_null
 #' @importFrom glue glue
-#' @importFrom cli cli_alert_warning
-#' @importFrom cli cli_h2
-#' @import recipes
+#' @importFrom recipes prep tidy juice recipe
 #' @importFrom timetk step_box_cox
-#' @importFrom cli cli_alert_info
-#' @importFrom purrr keep
+#' @importFrom cli cli_alert_info cli_h2 cli_alert_warning
+#' @importFrom purrr keep map2
+#' @importFrom stringr str_starts
 #' @importFrom tidyr hoist
-#'
+#' @seealso [variance_boxcox()], [folded_params()]
 box_cox_transform <- function(data, dataset) {
-  if (rlang::is_na(data) | rlang::is_null(data)) {
+  if ( any(rlang::is_na(data), rlang::is_null(data))) {
     cli::cli_alert_warning(text = glue::glue(
       "Cannot box-cox transform data for",
       paste(names(dplyr::cur_group()),
-        dplyr::cur_group(),
-        sep = " = ",
-        collapse = ", "
+            dplyr::cur_group(),
+            sep = " = ",
+            collapse = ", "
       )
     ))
     result <- NA
   } else {
-    cli::cli_h2(glue::glue("Box-cox transforming absolute deviation scores for ", {
-      dataset
-    }))
-
+    cli::cli_h2(
+      glue::glue("Box-cox transforming absolute deviation scores for {.val {dataset}}.")
+    )
+    
     box_cox_recipe <- recipes::recipe(~.,
-      data = select(
-        data,
-        starts_with("abs_deviation_score_")
-      )
+                                      data = select(
+                                        data,
+                                        starts_with("abs_deviation_score_")
+                                      )
     ) %>%
       timetk::step_box_cox(everything(), limits = c(0, 10)) %>%
       recipes::prep(training = data, retain = TRUE) # estimate lambda + box cox transform vars
-
+    
     if (box_cox_recipe %>%
-      recipes::tidy(number = 1) %>% nrow() > 0) { # TODO pull execution of if/else and check result in if() so not executing twice (next line)
+        recipes::tidy(number = 1) %>% nrow() > 0) { # TODO pull execution of if/else and check result in if() so not executing twice (next line)
       lambda <- box_cox_recipe %>%
         recipes::tidy(number = 1) %>%
         pull(., lambda) %>%
         `names<-`(., pull(box_cox_recipe %>%
-          recipes::tidy(number = 1), terms))
-
+                            recipes::tidy(number = 1), terms))
+      
       if (!is.null(dataset)) {
-        cli::cli_alert_info(c(
-          "Optimised Lambda used in Box-Cox Transformation of ",
-          "{dataset} dataset variables ",
-          "is {round(lambda, 4)} for `{names(lambda)}`."
-        ))
-      }
-
-      variance_box_cox <- function(folded_mu, folded_v, lambda) {
-        variance_bc <- folded_v * (lambda * folded_mu^(lambda - 1))^2 # delta method
-        return(variance_bc)
-      }
-
-      folded_params <- function(abs_dev_score, VZr) {
-        mu <- abs_dev_score
-        sigma <- sqrt(VZr)
-        fold_mu <- sigma * sqrt(2 / pi) * exp((-mu^2) / (2 * sigma^2)) + mu * (1 - 2 * pnorm(-mu / sigma)) # folded abs_dev_score
-        fold_se <- sqrt(mu^2 + sigma^2 - fold_mu^2)
-        fold_v <- fold_se^2 # folded VZr
-        return(list(fold_mu = fold_mu, fold_v = fold_v))
+        cli::cli_alert_info(
+          c(
+            "Optimised Lambda used in Box-Cox Transformation of ",
+            "{dataset} dataset variables ",
+            "is {round(lambda, 4)} for `{names(lambda)}`."
+          )
+        )
       }
-
+      
       # Z_colname <- data %>% colnames %>% keep(., str_starts(., "Z"))
       VZ_colname <- data %>%
         colnames() %>%
         keep(., str_starts(., "VZ"))
+
       result <- recipes::juice(box_cox_recipe) %>%
         rename_with(.fn = ~ paste0("box_cox_", .x)) %>%
         bind_cols(data, .) %>%
@@ -90,6 +78,35 @@ box_cox_transform <- function(data, dataset) {
       cli::cli_alert_warning(text = glue::glue("Lambda cannot be computed."))
     }
   }
-
+  
   return(result)
 }
+
+#' Calculate the variance of the Box-Cox transformed absolute deviation scores
+#' @param folded_mu The mean of the folded absolute deviation scores
+#' @param folded_v The variance of the folded VZr
+#' @param lambda The lambda value used in the Box-Cox transformation
+#' @return The variance of the Box-Cox transformed absolute deviation scores
+#' @export
+#' @family Box-Cox transformation
+#' @family Analysis-level functions
+variance_box_cox <- function(folded_mu, folded_v, lambda) {
+  variance_bc <- folded_v * (lambda * folded_mu^(lambda - 1))^2 # delta method
+  return(variance_bc)
+}
+
+#' Calculate the folded parameters for the Box-Cox transformation
+#' @param abs_dev_score The absolute deviation score
+#' @param VZr The variance of the standardised effect size
+#' @return A list containing the mean and variance of the folded parameters
+#' @export
+#' @family Box-Cox transformation
+#' @family Analysis-level functions
+folded_params <- function(abs_dev_score, VZr) {
+  mu <- abs_dev_score
+  sigma <- sqrt(VZr)
+  fold_mu <- sigma * sqrt(2 / pi) * exp((-mu^2) / (2 * sigma^2)) + mu * (1 - 2 * pnorm(-mu / sigma)) # folded abs_dev_score
+  fold_se <- sqrt(mu^2 + sigma^2 - fold_mu^2)
+  fold_v <- fold_se^2 # folded VZr
+  return(list(fold_mu = fold_mu, fold_v = fold_v))
+}
diff --git a/R/clean_response_transformation.R b/R/clean_response_transformation.R
@@ -12,7 +12,7 @@
 #' names `cleaned_transformation`. The `transformation_orig` values are the original response transformation values
 #' used by the analyst. The `cleaned_transformation` values are the cleaned response transformation values that are equal to the required `transformation` values in [conversion()]. 
 #' The user can supply an alternate table of transformations depending on what is required for the back-transformation functions.
-#' @family back-transformation functions
+#' back-transformation
 #' @seealso To be called after to [assign_transformation_type()]
 #' @examples
 #' clean_response_transformation("power2", ManyEcoEvo:::transformation_tbl) 

diff --git a/R/conversion.R b/R/conversion.R
@@ -7,7 +7,7 @@
 #' @param sim Number of simulations to use during back-transformation. Defaults to $10000$.
 #'
 #' @return The outputs of a back-transformation function, see family back-transformations
-#' @family back transformation
+#' back-transformation
 #' @details `transformation` character strings may take the values:
 #' * "log"
 #' * "logit"
@@ -22,31 +22,36 @@
 #' * "divided.by.X", where `X` is a numeric
 #' @export
 #' @import dplyr
-#' @import purrr
-#' @import cli
-#' @import rlang
-#' @import stringr
+#' @importFrom purrr discard is_scalar_vector pluck
+#' @importFrom cli cli_alert_danger cli_alert_warning cli_ol cli_alert_success
+#' @importFrom rlang is_na
+#' @importFrom stringr str_detect str_split
+#' @family Back-transformation
+#' @seealso [conversion_2()], [back()]
 conversion <- function(beta, se, transformation, sim = 10000) {
-  # Ensure Correct Number of Arguments Supplied
+  # ----- Argument Checking -----
   na_args <- purrr::discard(c(beta, se, transformation), is.na) %>%
     length()
-
+  
   if (na_args < 3) {
     cli::cli_alert_danger("Required values for back-transformation missing:")
     cli::cli_alert_warning("Returning {.val NA} for tupple:")
     cli::cli_ol(c(
-      "beta_estimate {.val {beta}},",
-      "beta_se {.val {se}},",
+      "beta {.val {beta}},",
+      "se {.val {se}},",
       "with {.val {transformation}} transformation."
     ))
     return(NA)
   }
-  # Ensure Correct Type of Arguments Supplied
-  stopifnot(purrr::is_scalar_vector(sim))
-  stopifnot(is.numeric(beta))
-  stopifnot(is.numeric(se))
-
-  # Apply Back Transformations
+
+  stopifnot(
+    purrr::is_scalar_vector(sim),
+    is.numeric(beta),
+    is.numeric(se),
+    is.character(transformation)
+  )
+
+  # ----- Apply Back Transformations -----
   if (transformation == "log") {
     log_back(beta, se, sim)
   } else if (transformation == "logit") {

diff --git a/R/conversion_2.R b/R/conversion_2.R
@@ -8,25 +8,35 @@
 #' @param sim Number of simulations to use during back-transformation. Defaults to $10000$.
 #'
 #' @return The outputs of a back-transformation function, see family back-transformations
-#' @family back transformation
 #' @export
+#' @family Back-transformation
+#' @seealso [conversion()]
 conversion_2 <- function(beta, se, response_transformation, link_fun, sim = 10000) {
+  # ----- Argument Checking -----
   na_args <- purrr::discard(c(beta, se, response_transformation, link_fun), is.na) %>%
     length()
 
-
   if (na_args < 4) {
     cli::cli_alert_danger("Required values for back-transformation missing:")
     cli::cli_alert_warning("Returning {.val NA} for quadruple:")
     cli::cli_ol(c(
-      "beta_estimate {.val {beta}},",
-      "beta_se {.val {se}},",
-      "with {.val {response_transformation}} response transformation and",
-      "link function {.val {link_fun}}."
+      "{.arg beta} {.val {beta}},",
+      "{.arg se} {.val {se}},",
+      "with {.val {response_transformation}} response {.arg transformation} and",
+      "{.arg link_function }{.val {link_fun}}."
     ))
     return(NA)
   }
-
+
+  stopifnot(
+    purrr::is_scalar_vector(sim),
+    is.numeric(beta),
+    is.numeric(se),
+    is.character(response_transformation),
+    is.character(link_fun)
+  )
+
+  # ----- Back-transformation -----
   set <- if (link_fun == "log") {
     log_back(set$beta, set$se, sim)
   } else if (link_fun == "logit") {