Investigate and fix yi meta-analysis precision

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ManyEcoEvo
 Title: Meta-analyse data from 'Many-Analysts' style studies
-Version: 2.7.6
+Version: 2.7.6.9000
 Authors@R: c(
     person("Elliot", "Gould", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "https://orcid.org/0000-0002-6585-538X")),

NAMESPACE

@@ -88,7 +88,6 @@ export(preprocess_prediction_files)
 export(preprocess_updated_prediction_files)
 export(probit_back)
 export(read_submission_data)
-export(rename_prediction_cols)
 export(rm_inf_na)
 export(run_model_checks)
 export(split_yi_subsets)
@@ -182,7 +181,9 @@ importFrom(pointblank,vars)
 importFrom(pointblank,warn_on_fail)
 importFrom(purrr,discard)
 importFrom(purrr,exec)
+importFrom(purrr,flatten_chr)
 importFrom(purrr,flatten_dbl)
+importFrom(purrr,flatten_df)
 importFrom(purrr,is_scalar_vector)
 importFrom(purrr,keep)
 importFrom(purrr,keep_at)
@@ -204,6 +205,8 @@ importFrom(purrr,reduce2)
 importFrom(purrr,set_names)
 importFrom(purrr,simplify)
 importFrom(purrr,transpose)
+importFrom(readr,locale)
+importFrom(readr,parse_number)
 importFrom(readr,read_csv)
 importFrom(recipes,juice)
 importFrom(recipes,prep)
@@ -247,6 +250,7 @@ importFrom(stringr,str_starts)
 importFrom(tibble,as_tibble)
 importFrom(tibble,as_tibble_row)
 importFrom(tibble,column_to_rownames)
+importFrom(tibble,deframe)
 importFrom(tibble,enframe)
 importFrom(tibble,rownames_to_column)
 importFrom(tibble,tibble)

NEWS.md

@@ -1,3 +1,21 @@
+# ManyEcoEvo (development version)
+
+<!-- NEWS.md is maintained by https://cynkra.github.io/fledge, do not edit -->
+
+- #151 rm reprex and investigation script
+- fix!: #151 revert to taking sd() from normalised distribution prior to back-transformation and assigning as SE
+- analysis #151 add additional reprex chunk to quiet output
+- docs:! `devtools::document()`
+- analysis #151 add reprex chunk options to quiet messages, add headings
+- analysis: #151 investigate extreme precision after changing back-transformation fns
+- bug, refactor!: extract SD in addition to SE for analysis #151
+- refactor!: rm unnecessary arguments to `back_transform_response_vars_yi()`, update call of function within `prepare_response_variables_yi()` #97
+- refactor!: change method for renaming prediction columns (generalise beyond BT / Euc)
+- docs!: #102 add roxygen imports to function doc
+- #151 retain sample size
+- bug fix in arg checking #116
+- #97 rename first data argument #102 update roxygen doc, add imports
+
 # ManyEcoEvo 2.7.6
 
 <!-- NEWS.md is maintained by https://cynkra.github.io/fledge, do not edit -->

R/back_transformations.R

@@ -25,15 +25,20 @@ log_back <- function(beta, se, sim) {
   original <- exp(simulated) %>% # exponential = inverse of log
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  se_est <- sd(original)
   quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE)
-  set <- data.frame(mean_origin = m_est, se_origin = se_est, lower = quantiles[[1]], upper = quantiles[[2]])
+  set <- data.frame(mean_origin = m_est, 
+                    se_origin = se_est,
+                    lower = quantiles[[1]], 
+                    upper = quantiles[[2]])
+
   if (flatten_dbl(set) %>%
     map_lgl(.f = ~ is.na(.x) | is.nan(.x) | is.infinite(.x)) %>%
     any()) {
     cli::cli_alert_danger("{.val NA}, {.val Inf} or {.val NaN} returned during back-transformation of effect sizes and standard errors.")
   }
   cli::cli_alert_success("Applied back-transformation for log-transformed effect sizes or out-of-sample predictions, using {.val {sim}} simulations.")
+
   return(set)
 }
 
@@ -45,9 +50,12 @@ logit_back <- function(beta, se, sim) {
   original <- plogis(simulated) %>% # invlogit
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  se_est <- sd(original)
   quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE)
-  set <- data.frame(mean_origin = m_est, se_origin = se_est, lower = quantiles[[1]], upper = quantiles[[2]])
+  set <- data.frame(mean_origin = m_est, 
+                    se_origin = se_est, 
+                    lower = quantiles[[1]], 
+                    upper = quantiles[[2]])
   if (flatten_dbl(set) %>%
     map_lgl(.f = ~ is.na(.x) | is.nan(.x) | is.infinite(.x)) %>%
     any()) {
@@ -65,9 +73,13 @@ probit_back <- function(beta, se, sim) {
   original <- pnorm(simulated) %>% # inv-probit
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  se_est <- sd(original)
   quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE)
-  set <- data.frame(mean_origin = m_est, se_origin = se_est, lower = quantiles[[1]], upper = quantiles[[2]])
+  set <- data.frame(mean_origin = m_est, 
+                    se_origin = se_est, 
+                    lower = quantiles[[1]], 
+                    upper = quantiles[[2]])
+
   if (flatten_dbl(set) %>%
     map_lgl(.f = ~ is.na(.x) | is.nan(.x) | is.infinite(.x)) %>%
     any()) {
@@ -85,9 +97,12 @@ inverse_back <- function(beta, se, sim) {
   original <- 1 / simulated %>% # inverse
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  se_est <- sd(original)
   quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE)
-  set <- data.frame(mean_origin = m_est, se_origin = se_est, lower = quantiles[[1]], upper = quantiles[[2]])
+  set <- data.frame(mean_origin = m_est, 
+                    se_origin = se_est, 
+                    lower = quantiles[[1]], 
+                    upper = quantiles[[2]])
   if (flatten_dbl(set) %>%
     map_lgl(.f = ~ is.na(.x) | is.nan(.x) | is.infinite(.x)) %>%
     any()) {
@@ -105,9 +120,13 @@ square_back <- function(beta, se, sim) {
   original <- sqrt(simulated) %>% # inverse of x^2
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  se_est <- sd(original)
   quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE)
-  set <- data.frame(mean_origin = m_est, se_origin = se_est, lower = quantiles[[1]], upper = quantiles[[2]])
+  set <- data.frame(mean_origin = m_est, 
+                    se_origin = se_est, 
+                    lower = quantiles[[1]], 
+                    upper = quantiles[[2]])
+
   if (flatten_dbl(set) %>%
     map_lgl(.f = ~ is.na(.x) | is.nan(.x) | is.infinite(.x)) %>%
     any()) {
@@ -125,9 +144,12 @@ cube_back <- function(beta, se, sim) {
   original <- pracma::nthroot(simulated, n = 3) %>% # inverse of x^3, use non-base to allow for -ve numbers
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  se_est <- sd(original)
   quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE)
-  set <- data.frame(mean_origin = m_est, se_origin = se_est, lower = quantiles[[1]], upper = quantiles[[2]])
+  set <- data.frame(mean_origin = m_est, 
+                    se_origin = se_est, 
+                    lower = quantiles[[1]], 
+                    upper = quantiles[[2]])
   if (flatten_dbl(set) %>%
     map_lgl(.f = ~ is.na(.x) | is.nan(.x) | is.infinite(.x)) %>%
     any()) {
@@ -145,9 +167,12 @@ identity_back <- function(beta, se, sim) { # identity (typo) TODO
   original <- simulated %>% #  no transformation
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  se_est <- sd(original)
   quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE)
-  set <- data.frame(mean_origin = m_est, se_origin = se_est, lower = quantiles[[1]], upper = quantiles[[2]])
+  set <- data.frame(mean_origin = m_est, 
+                    se_origin = se_est, 
+                    lower = quantiles[[1]], 
+                    upper = quantiles[[2]])
   if (flatten_dbl(set) %>%
     map_lgl(.f = ~ is.na(.x) | is.nan(.x) | is.infinite(.x)) %>%
     any()) {
@@ -166,9 +191,12 @@ power_back <- function(beta, se, sim, n) {
   original <- pracma::nthroot(simulated, n = n) %>% # inverse of x^n, use non-base to allow for -ve numbers
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  se_est <- sd(original)
   quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE)
-  set <- data.frame(mean_origin = m_est, se_origin = se_est, lower = quantiles[[1]], upper = quantiles[[2]])
+  set <- data.frame(mean_origin = m_est, 
+                    se_origin = se_est, 
+                    lower = quantiles[[1]], 
+                    upper = quantiles[[2]])
   if (flatten_dbl(set) %>%
     map_lgl(.f = ~ is.na(.x) | is.nan(.x) | is.infinite(.x)) %>%
     any()) {
@@ -187,7 +215,7 @@ divide_back <- function(beta, se, sim, n) {
   original <- simulated * n %>%
     na.omit()
   m_est <- mean(original, na.rm = TRUE)
-  se_est <- sd(original, na.rm = TRUE) / sqrt(length(original))
+  se_est <- sd(original, na.rm = TRUE)
   quantiles <- quantile(original,
     c(0.025, 0.975),
     na.rm = TRUE
@@ -218,9 +246,12 @@ square_root_back <- function(beta, se, sim) {
   original <- simulated^2 %>%
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  se_est <- sd(original)
   quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE)
-  set <- data.frame(mean_origin = m_est, se_origin = se_est, lower = quantiles[[1]], upper = quantiles[[2]])
+  set <- data.frame(mean_origin = m_est, 
+                    se_origin = se_est, 
+                    lower = quantiles[[1]], 
+                    upper = quantiles[[2]])
   if (flatten_dbl(set) %>%
     map_lgl(.f = ~ is.na(.x) | is.nan(.x) | is.infinite(.x)) %>%
     any()) {

R/conversion.R

@@ -67,13 +67,16 @@ conversion <- function(beta, se, transformation, sim = 10000) {
     square_root_back(beta, se, sim)
   } else if (transformation == "(power3)/100") {
     x100 <- divide_back(beta, se, sim, 100)
-    cube_back(x100$mean_origin, x100$se_origin, sim = 1000)
+    cube_back(x100$mean_origin, x100$se_origin, sim)
   } else if (stringr::str_detect(transformation, "power")) {
     n <- str_split(transformation, "power") %>%
       pluck(1, 2) %>%
       as.numeric()
     if (rlang::is_na(n)) {
-      return(data.frame(mean_origin = NA, m_est = NA, se_origin = NA, lower = NA, upper = NA))
+      return(data.frame(mean_origin = NA, 
+                        se_origin = NA, 
+                        lower = NA, 
+                        upper = NA))
     } else {
       power_back(beta, se, sim, n)
     }
@@ -82,12 +85,18 @@ conversion <- function(beta, se, transformation, sim = 10000) {
       pluck(1, 3) %>%
       as.numeric()
     if (rlang::is_na(n)) {
-      return(data.frame(mean_origin = NA, m_est = NA, se_origin = NA, lower = NA, upper = NA))
+      return(data.frame(mean_origin = NA, 
+                        se_origin = NA, 
+                        lower = NA, 
+                        upper = NA))
     } else {
       divide_back(beta, se, sim, n)
     }
   } else if (transformation == "double_transformation") {
-    return(data.frame(mean_origin = NA, m_est = NA, se_origin = NA, lower = NA, upper = NA))
+    return(data.frame(mean_origin = NA, 
+                      se_origin = NA, 
+                      lower = NA, 
+                      upper = NA))
   } else {
     identity_back(beta, se, sim) # TODO change conditional logic to ensure strange transformations not put through here
   }

R/log_transform.R

@@ -19,11 +19,11 @@ log_transform <- function(estimate = numeric(1L),
     na.omit()
 
   m_est <- mean(log_simulated)
-  std.error_est <- sd(log_simulated) / sqrt(length(log_simulated))
+  se_est <- sd(log_simulated)
   quantiles <- quantile(log_simulated, c(0.025, 0.975), na.rm = TRUE)
 
   out <- data.frame(mean_log = m_est, 
-                    se_log = std.error_est, 
+                    se_log = se_est, 
                     lower = quantiles[[1]], 
                     upper = quantiles[[2]])
 

R/standardise_response.R

@@ -181,7 +181,7 @@ process_response <- function(data, ...){
 #' ManyEcoEvo_yi %>%
 #' filter(dataset == "eucalyptus") %>%
 #'   pluck("data", 1) %>%
-#'   back_transform_response_vars_yi("yi", "eucalyptus") %>%
+#'   back_transform_response_vars_yi() %>%
 #'   log_transform_response()
 #' @export
 #' @import dplyr