Skip to content

Commit

Permalink
fix double-checking calculation of out-of-sample estimates pipeline #99
Browse files Browse the repository at this point in the history
  • Loading branch information
@egouldo
egouldo committed Aug 21, 2024
1 parent 6d156d1 commit d14d669
Showing 1 changed file with 20 additions and 20 deletions.
40 changes: 20 additions & 20 deletions R/back_transformations.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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))

Check notice on line 24 in R/back_transformations.R

View check run for this annotation

codefactor.io / CodeFactor

R/back_transformations.R#L24 

Put spaces around all infix operators. (infix_spaces_linter)
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) %>%
Expand All @@ -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))

Check notice on line 43 in R/back_transformations.R

View check run for this annotation

codefactor.io / CodeFactor

R/back_transformations.R#L43 

Put spaces around all infix operators. (infix_spaces_linter)
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) %>%
Expand All @@ -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))

Check notice on line 62 in R/back_transformations.R

View check run for this annotation

codefactor.io / CodeFactor

R/back_transformations.R#L62 

Put spaces around all infix operators. (infix_spaces_linter)
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) %>%
Expand All @@ -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))

Check notice on line 81 in R/back_transformations.R

View check run for this annotation

codefactor.io / CodeFactor

R/back_transformations.R#L81 

Put spaces around all infix operators. (infix_spaces_linter)
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) %>%
Expand All @@ -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))

Check notice on line 100 in R/back_transformations.R

View check run for this annotation

codefactor.io / CodeFactor

R/back_transformations.R#L100 

Put spaces around all infix operators. (infix_spaces_linter)
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) %>%
Expand All @@ -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))

Check notice on line 119 in R/back_transformations.R

View check run for this annotation

codefactor.io / CodeFactor

R/back_transformations.R#L119 

Put spaces around all infix operators. (infix_spaces_linter)
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) %>%
Expand All @@ -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))

Check notice on line 138 in R/back_transformations.R

View check run for this annotation

codefactor.io / CodeFactor

R/back_transformations.R#L138 

Put spaces around all infix operators. (infix_spaces_linter)
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) %>%
Expand All @@ -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))

Check notice on line 158 in R/back_transformations.R

View check run for this annotation

codefactor.io / CodeFactor

R/back_transformations.R#L158 

Put spaces around all infix operators. (infix_spaces_linter)
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) %>%
Expand All @@ -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))

Check notice on line 178 in R/back_transformations.R

View check run for this annotation

codefactor.io / CodeFactor

R/back_transformations.R#L178 

Put spaces around all infix operators. (infix_spaces_linter)
quantiles <- quantile(original,
c(0.025, 0.975),
na.rm = TRUE
Expand All @@ -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))

Check notice on line 208 in R/back_transformations.R

View check run for this annotation

codefactor.io / CodeFactor

R/back_transformations.R#L208 

Put spaces around all infix operators. (infix_spaces_linter)
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) %>%
Expand Down

0 comments on commit d14d669

Please sign in to comment.