Skip to content

Commit

Permalink
- fix!: #151 revert to taking sd() from normalised distribution prior…
Browse files Browse the repository at this point in the history 
… to back-transformation and assigning as SE

And update wrapper functions so that NA's return dataframes matched to dim and str from _back functions
  • Loading branch information
@egouldo
egouldo committed Sep 9, 2024
1 parent 98b1c27 commit 4c405ec
Show file tree
Hide file tree
Showing 3 changed files with 25 additions and 38 deletions.
40 changes: 10 additions & 30 deletions R/back_transformations.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,12 +25,10 @@ log_back <- function(beta, se, sim) {
original <- exp(simulated) %>% # exponential = inverse of log
na.omit()
m_est <- mean(original)
sd_est <- sd(original)
se_est <- sd_est / 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,
sd_origin = sd_est,
lower = quantiles[[1]],
upper = quantiles[[2]])

Expand All @@ -52,12 +50,10 @@ logit_back <- function(beta, se, sim) {
original <- plogis(simulated) %>% # invlogit
na.omit()
m_est <- mean(original)
sd_est <- sd(original)
se_est <- sd_est / 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,
sd_origin = sd_est,
lower = quantiles[[1]],
upper = quantiles[[2]])
if (flatten_dbl(set) %>%
Expand All @@ -77,12 +73,10 @@ probit_back <- function(beta, se, sim) {
original <- pnorm(simulated) %>% # inv-probit
na.omit()
m_est <- mean(original)
sd_est <- sd(original)
se_est <- sd_est / 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,
sd_origin = sd_est,
lower = quantiles[[1]],
upper = quantiles[[2]])

Expand All @@ -103,12 +97,10 @@ inverse_back <- function(beta, se, sim) {
original <- 1 / simulated %>% # inverse
na.omit()
m_est <- mean(original)
sd_est <- sd(original)
se_est <- sd_est / 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,
sd_origin = sd_est,
lower = quantiles[[1]],
upper = quantiles[[2]])
if (flatten_dbl(set) %>%
Expand All @@ -128,12 +120,10 @@ square_back <- function(beta, se, sim) {
original <- sqrt(simulated) %>% # inverse of x^2
na.omit()
m_est <- mean(original)
sd_est <- sd(original)
se_est <- sd_est / 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,
sd_origin = sd_est,
lower = quantiles[[1]],
upper = quantiles[[2]])

Expand All @@ -154,12 +144,10 @@ 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)
sd_est <- sd(original)
se_est <- sd_est / 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,
sd_origin = sd_est,
lower = quantiles[[1]],
upper = quantiles[[2]])
if (flatten_dbl(set) %>%
Expand All @@ -179,12 +167,10 @@ identity_back <- function(beta, se, sim) { # identity (typo) TODO
original <- simulated %>% # no transformation
na.omit()
m_est <- mean(original)
sd_est <- sd(original)
se_est <- sd_est / 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,
sd_origin = sd_est,
lower = quantiles[[1]],
upper = quantiles[[2]])
if (flatten_dbl(set) %>%
Expand All @@ -205,12 +191,10 @@ 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)
sd_est <- sd(original)
se_est <- sd_est/ 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,
sd_origin = sd_est,
lower = quantiles[[1]],
upper = quantiles[[2]])
if (flatten_dbl(set) %>%
Expand All @@ -231,16 +215,14 @@ divide_back <- function(beta, se, sim, n) {
original <- simulated * n %>%
na.omit()
m_est <- mean(original, na.rm = TRUE)
sd_est <- sd(original, na.rm = TRUE)
se_est <- sd_est / sqrt(length(original))
se_est <- sd(original, na.rm = TRUE)
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]]
)
Expand All @@ -264,12 +246,10 @@ square_root_back <- function(beta, se, sim) {
original <- simulated^2 %>%
na.omit()
m_est <- mean(original)
sd_est <- sd(original)
se_est <- sd_est / 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,
sd_origin = sd_est,
lower = quantiles[[1]],
upper = quantiles[[2]])
if (flatten_dbl(set) %>%
Expand Down
17 changes: 13 additions & 4 deletions R/conversion.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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, sd_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)
}
Expand All @@ -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, sd_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, sd_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
}
Expand Down
6 changes: 2 additions & 4 deletions R/log_transform.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,13 +19,11 @@ log_transform <- function(estimate = numeric(1L),
na.omit()

m_est <- mean(log_simulated)
sd_est <- sd(log_simulated)
std.error_est <- sd_est / 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,
sd_log = sd_est,
se_log = se_est,
lower = quantiles[[1]],
upper = quantiles[[2]])

Expand Down

0 comments on commit 4c405ec

Please sign in to comment.