Nothing
if (isTRUE(as.logical(Sys.getenv("CI")))){
# If on CI
env_test <- "CI"
}else if (!identical(Sys.getenv("NOT_CRAN"), "true")){
# If on CRAN
env_test <- "CRAN"
set.seed(1351) # CRAN SEED
}else{
# If on local machine
env_test <- 'local'
}
test_that("test calculate_interactions function", {
# from mgcv example
n <- 100
dat <- gamSim(2, n=n)
dat <- dat$data
dat$y <- round(exp(dat$y))
b <- gam(y~s(x, z, bs = 'gKRLS'),
family=poisson, data=dat, method="REML")
fit_inter <- calculate_interactions(
b, variables = list(c("x", "z")),
continuous_type = 'onesd'
)
fit_main <- calculate_effects(b, variables = c('x', 'z', list(c('x', 'z'))),
individual = TRUE, continuous_type = 'onesd')
range_x <- mean(dat$x) + c(-1, 1) * sd(dat$x)
range_z <- mean(dat$z) + c(-1, 1) * sd(dat$z)
avg_x <- sapply(range_x, FUN=function(i){
mean(predict(b, newdata = data.frame(x = i, z = dat$z), type = 'response'))
})
avg_z <- sapply(range_z, FUN=function(i){
mean(predict(b, newdata = data.frame(z = i, x = dat$x), type = 'response'))
})
expect_equal(fit_main$est[1], diff(avg_x))
expect_equal(fit_main$est[2], diff(avg_z))
grid_test <- expand.grid(x = range_x, z = range_z)
grid_test$predict <- predict(b, grid_test, type = 'response')
expect_equal(grid_test$predict[4] - grid_test$predict[1], fit_main$est[3])
expect_equal(fit_inter[1:3, c('est', 'se', 't')], fit_main[, c('est', 'se', 't')])
expect_equal(fit_inter$est[4], grid_test$predict[4] - grid_test$predict[1] - diff(avg_x) - diff(avg_z))
})
test_that("test calculate_interactions function for complex families", {
# from mgcv example
n <- 100
dat <- gamSim(eg = 2, n = n, scale = 0.05)
dat <- dat$data
dat$w <- rnorm(nrow(dat))
dat$y <- dat$y * dat$w + dat$x * dat$z
dat$w <- as.logical(dat$w > median(dat$w))
dat$y <- cut(dat$y, 4, labels = FALSE)
dat$fake <- rnorm(nrow(dat))
b <- gam(y ~ w + s(x, z, fake, bs = 'gKRLS'),
family=ocat(R=4), data=dat, method="REML")
fake_cond <- data.frame(fake = rnorm(2))
grid_type <- list(x = c(0, 0.5), z = c(0, 0.25))
fit_inter <- calculate_interactions(
b, conditional = fake_cond,
variables = list(c("x", "z"), c("x", "w")),
continuous_type = grid_type
)
fit_main <- calculate_effects(b,
variables = c('x', 'z', 'w'),
conditional = fake_cond,
continuous_type = grid_type,
individual = TRUE)
orig_copy_dat <- dat[, c('x', 'z', 'w', 'fake')]
for (f in fake_cond$fake){
copy_dat <- orig_copy_dat
copy_dat$fake <- f
fake_grid <- c(grid_type, list(w = c(FALSE, TRUE)))
est_AME <- do.call('rbind', lapply(names(fake_grid), FUN=function(i){
copy_dat[[i]] <- fake_grid[[i]][1]
copy_low <- colMeans(predict(b, newdata = copy_dat, type = 'response'))
copy_dat[[i]] <- fake_grid[[i]][2]
copy_high <- colMeans(predict(b, newdata = copy_dat, type = 'response'))
return(data.frame(variable = i, AME = copy_high - copy_low, response = 1:length(copy_high)))
}))
expect_equal(est_AME$AME, fit_main$est[fit_main$fake == f])
est_ACE <- do.call('rbind', lapply(list(c('x', 'z'), c('x', 'w')), FUN=function(i){
copy_dat[[i[1]]] <- fake_grid[[i[1]]][1]
copy_dat[[i[2]]] <- fake_grid[[i[2]]][1]
copy_low <- colMeans(predict(b, newdata = copy_dat, type = 'response'))
copy_dat[[i[1]]] <- fake_grid[[i[1]]][2]
copy_dat[[i[2]]] <- fake_grid[[i[2]]][2]
copy_high <- colMeans(predict(b, newdata = copy_dat, type = 'response'))
return(data.frame(variable = paste(i, collapse=':'), AME = copy_high - copy_low, response = 1:length(copy_high)))
}))
expect_equal(est_ACE$AME, subset(fit_inter, QOI == 'ACE' & (fake == f))$est)
combine_manual <- merge(
subset(est_ACE, variable == 'x:w')[,-1],
merge(
subset(est_AME, variable == 'x')[,-1],
subset(est_AME, variable == 'w')[,-1], by = 'response'),
by = 'response'
)
combine_manual$AMIE <- combine_manual$AME - combine_manual$AME.x - combine_manual$AME.y
expect_equal(combine_manual$AMIE, subset(fit_inter, fake == f & variable == 'x:w' & QOI == 'AMIE')$est)
combine_manual <- merge(
subset(est_ACE, variable == 'x:z')[,-1],
merge(
subset(est_AME, variable == 'x')[,-1],
subset(est_AME, variable == 'z')[,-1], by = 'response'),
by = 'response'
)
combine_manual$AMIE <- combine_manual$AME - combine_manual$AME.x - combine_manual$AME.y
expect_equal(combine_manual$AMIE, subset(fit_inter, fake == f & variable == 'x:z' & QOI == 'AMIE')$est)
}
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.