- bug, refactor!: extract SD in addition to SE for analysis #151

egouldo · Sep 9, 2024 · e626e56 · e626e56
1 parent bc8ae03
commit e626e56
Show file tree

Hide file tree

Showing 3 changed files with 76 additions and 23 deletions.
diff --git a/R/back_transformations.R b/R/back_transformations.R
@@ -25,15 +25,22 @@ 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))
+  sd_est <- sd(original)
+  se_est <- sd_est / sqrt(length(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,
+                    sd_origin = sd_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 +52,14 @@ logit_back <- function(beta, se, sim) {
   original <- plogis(simulated) %>% # invlogit
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  sd_est <- sd(original)
+  se_est <- sd_est / sqrt(length(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, 
+                    sd_origin = sd_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 +77,15 @@ probit_back <- function(beta, se, sim) {
   original <- pnorm(simulated) %>% # inv-probit
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  sd_est <- sd(original)
+  se_est <- sd_est / sqrt(length(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, 
+                    sd_origin = sd_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 +103,14 @@ inverse_back <- function(beta, se, sim) {
   original <- 1 / simulated %>% # inverse
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  sd_est <- sd(original)
+  se_est <- sd_est / sqrt(length(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, 
+                    sd_origin = sd_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 +128,15 @@ 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))
+  sd_est <- sd(original)
+  se_est <- sd_est / sqrt(length(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, 
+                    sd_origin = sd_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 +154,14 @@ 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))
+  sd_est <- sd(original)
+  se_est <- sd_est / sqrt(length(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, 
+                    sd_origin = sd_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 +179,14 @@ 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))
+  sd_est <- sd(original)
+  se_est <- sd_est / sqrt(length(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, 
+                    sd_origin = sd_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 +205,14 @@ 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))
+  sd_est <- sd(original)
+  se_est <- sd_est/ sqrt(length(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, 
+                    sd_origin = sd_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,14 +231,16 @@ 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))
+  sd_est <- sd(original, na.rm = TRUE)
+  se_est <- sd_est / sqrt(length(original))
   quantiles <- quantile(original,
     c(0.025, 0.975),
     na.rm = TRUE
   )
   set <- data.frame(
     mean_origin = m_est,
     se_origin = se_est,
+    sd_origin = sd_est,
     lower = quantiles[[1]],
     upper = quantiles[[2]]
   )
@@ -218,9 +264,14 @@ square_root_back <- function(beta, se, sim) {
   original <- simulated^2 %>%
     na.omit()
   m_est <- mean(original)
-  se_est <- sd(original) / sqrt(length(original))
+  sd_est <- sd(original)
+  se_est <- sd_est / sqrt(length(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, 
+                    sd_origin = sd_est,
+                    lower = quantiles[[1]], 
+                    upper = quantiles[[2]])
   if (flatten_dbl(set) %>%
     map_lgl(.f = ~ is.na(.x) | is.nan(.x) | is.infinite(.x)) %>%
     any()) {

diff --git a/R/conversion.R b/R/conversion.R
@@ -73,7 +73,7 @@ conversion <- function(beta, se, transformation, sim = 10000) {
       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, m_est = NA, se_origin = NA, sd_origin = NA, lower = NA, upper = NA))
     } else {
       power_back(beta, se, sim, n)
     }
@@ -82,12 +82,12 @@ 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, m_est = NA, se_origin = NA, sd_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, m_est = NA, se_origin = NA, sd_origin = NA, lower = NA, upper = NA))
   } else {
     identity_back(beta, se, sim) # TODO change conditional logic to ensure strange transformations not put through here
   }

diff --git a/R/log_transform.R b/R/log_transform.R
@@ -19,11 +19,13 @@ log_transform <- function(estimate = numeric(1L),
     na.omit()
 
   m_est <- mean(log_simulated)
-  std.error_est <- sd(log_simulated) / sqrt(length(log_simulated))
+  sd_est <- sd(log_simulated)
+  std.error_est <- sd_est / sqrt(length(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, 
+                    sd_log = sd_est,
                     lower = quantiles[[1]], 
                     upper = quantiles[[2]])