From d14d669781f00ec7f38f17547d1062b089215704 Mon Sep 17 00:00:00 2001 From: Elliot Gould Date: Wed, 21 Aug 2024 04:36:45 +0000 Subject: [PATCH 1/2] fix double-checking calculation of out-of-sample estimates pipeline #99 --- R/back_transformations.R | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/R/back_transformations.R b/R/back_transformations.R index 0bb1f82..93e1ce3 100644 --- a/R/back_transformations.R +++ b/R/back_transformations.R @@ -16,12 +16,12 @@ NULL #' @describeIn back Back transform beta estimates for models with log-link #' @export -log_back <- function(beta, se, sim) { +log <- function(beta, se, sim) { simulated <- rnorm(sim, beta, se) original <- exp(simulated) %>% # exponential = inverse of log na.omit() m_est <- mean(original) - se_est <- sd(original) + se_est <- sd(original)/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]]) if (flatten_dbl(set) %>% @@ -35,12 +35,12 @@ log_back <- function(beta, se, sim) { #' @describeIn back Back transform beta estimates for models with logit-link #' @export -logit_back <- function(beta, se, sim) { +logit <- function(beta, se, sim) { simulated <- rnorm(sim, beta, se) original <- plogis(simulated) %>% # invlogit na.omit() m_est <- mean(original) - se_est <- sd(original) + se_est <- sd(original)/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]]) if (flatten_dbl(set) %>% @@ -54,12 +54,12 @@ logit_back <- function(beta, se, sim) { #' @describeIn back Back transform beta estimates for models with probit-link #' @export -probit_back <- function(beta, se, sim) { +probit <- function(beta, se, sim) { simulated <- rnorm(sim, beta, se) original <- pnorm(simulated) %>% # inv-probit na.omit() m_est <- mean(original) - se_est <- sd(original) + se_est <- sd(original)/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]]) if (flatten_dbl(set) %>% @@ -73,12 +73,12 @@ probit_back <- function(beta, se, sim) { #' @describeIn back Back transform beta estimates for models with \eqn{1/x} link #' @export -inverse_back <- function(beta, se, sim) { +inverse <- function(beta, se, sim) { simulated <- rnorm(sim, beta, se) original <- 1 / simulated %>% # inverse na.omit() m_est <- mean(original) - se_est <- sd(original) + se_est <- sd(original)/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]]) if (flatten_dbl(set) %>% @@ -92,12 +92,12 @@ inverse_back <- function(beta, se, sim) { #' @describeIn back Back transform beta estimates for models with \eqn{x^2}-link #' @export -square_back <- function(beta, se, sim) { +square <- function(beta, se, sim) { simulated <- rnorm(sim, beta, se) original <- sqrt(simulated) %>% # inverse of x^2 na.omit() m_est <- mean(original) - se_est <- sd(original) + se_est <- sd(original)/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]]) if (flatten_dbl(set) %>% @@ -111,12 +111,12 @@ square_back <- function(beta, se, sim) { #' @describeIn back Back transform beta estimates for models with \eqn{x^3}-link #' @export -cube_back <- function(beta, se, sim) { +cube <- 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 na.omit() m_est <- mean(original) - se_est <- sd(original) + se_est <- sd(original)/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]]) if (flatten_dbl(set) %>% @@ -130,12 +130,12 @@ cube_back <- function(beta, se, sim) { #' @describeIn back Back transform beta estimates for models with identity-link #' @export -identity_back <- function(beta, se, sim) { # identity (typo) TODO +identity <- function(beta, se, sim) { # identity (typo) TODO simulated <- rnorm(sim, beta, se) original <- simulated %>% # no transformation na.omit() m_est <- mean(original) - se_est <- sd(original) + se_est <- sd(original)/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]]) if (flatten_dbl(set) %>% @@ -150,12 +150,12 @@ identity_back <- function(beta, se, sim) { # identity (typo) TODO #' @describeIn back Back transform beta estimates for models with power-link #' @export -power_back <- function(beta, se, sim, n) { +power <- 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 na.omit() m_est <- mean(original) - se_est <- sd(original) + se_est <- sd(original)/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]]) if (flatten_dbl(set) %>% @@ -170,12 +170,12 @@ 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 -divide_back <- function(beta, se, sim, n) { +divide <- function(beta, se, sim, n) { simulated <- rnorm(sim, beta, se) original <- simulated * n %>% na.omit() m_est <- mean(original, na.rm = TRUE) - se_est <- sd(original, na.rm = TRUE) + se_est <- sd(original, na.rm = TRUE)/sqrt(length(original)) quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE @@ -200,12 +200,12 @@ 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 -square_root_back <- function(beta, se, sim) { +square_root <- function(beta, se, sim) { simulated <- rnorm(sim, beta, se) original <- simulated^2 %>% na.omit() m_est <- mean(original) - se_est <- sd(original) + se_est <- sd(original)/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]]) if (flatten_dbl(set) %>% From 4afcc7169ef655fb735796cb6db829c4f40e3e6a Mon Sep 17 00:00:00 2001 From: Elliot Gould Date: Wed, 21 Aug 2024 04:44:25 +0000 Subject: [PATCH 2/2] #99 lintr put spaces around infix operators --- R/back_transformations.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/R/back_transformations.R b/R/back_transformations.R index 93e1ce3..097a775 100644 --- a/R/back_transformations.R +++ b/R/back_transformations.R @@ -21,7 +21,7 @@ log <- 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) / 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]]) if (flatten_dbl(set) %>% @@ -40,7 +40,7 @@ logit <- 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) / 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]]) if (flatten_dbl(set) %>% @@ -59,7 +59,7 @@ probit <- 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) / 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]]) if (flatten_dbl(set) %>% @@ -78,7 +78,7 @@ inverse <- 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) / 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]]) if (flatten_dbl(set) %>% @@ -97,7 +97,7 @@ square <- 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) / 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]]) if (flatten_dbl(set) %>% @@ -116,7 +116,7 @@ cube <- 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) / 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]]) if (flatten_dbl(set) %>% @@ -135,7 +135,7 @@ identity <- 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) / 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]]) if (flatten_dbl(set) %>% @@ -155,7 +155,7 @@ power <- 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) / 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]]) if (flatten_dbl(set) %>% @@ -175,7 +175,7 @@ divide <- 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) / sqrt(length(original)) quantiles <- quantile(original, c(0.025, 0.975), na.rm = TRUE @@ -205,7 +205,7 @@ square_root <- function(beta, se, sim) { original <- simulated^2 %>% na.omit() m_est <- mean(original) - se_est <- sd(original)/sqrt(length(original)) + se_est <- sd(original) / 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]]) if (flatten_dbl(set) %>%