context("compare coefficent estimates to CVX (manual penalty)")
##### Code used to generate data files for all tests #####
# set.seed(123)
# n <- 100
# p <- 50
# q <- 5
# meanx_true <- rep(0, p)
# covx_true <- matrix(NA, nrow = p, ncol = p)
# for (i in 1:p) {
# for (j in 1:p) {
# covx_true[i, j] <- 0.5^abs(i-j)
# }
# }
# meanz_true <- rep(0, q)
# covz_true <- matrix(NA, nrow = q, ncol = q)
# for (i in 1:q) {
# for (j in 1:q) {
# covz_true[i, j] <- 0.5^abs(i-j)
# }
# }
# a0 <- 0.01
# a <- c(0.1, -0.1, rep(0, q - 2))
# z <- mvrnorm(n = p, mu = meanz_true, Sigma = covz_true)
# b <- drop(a0 + z %*% a + 0.2*rnorm(p))
# x <- mvrnorm(n = n, mu = meanx_true, Sigma = covx_true)
# y <- drop(x %*% b + rnorm(n))
# mean_x <- colMeans(x)
# var_x <- apply(x, 2, var) * (n-1) / n
# sd_x <- sqrt(var_x)
# xscaled <- matrix(NA, nrow = n, ncol = p)
# for (i in 1:p) {
# xscaled[, i] <- (x[, i] - mean_x[i]) / sd_x[i]
# }
# mean_z <- colMeans(z)
# sd_z <- sqrt(apply(z, 2, var) * (p-1) / p)
# zscaled <- matrix(NA, nrow = p, ncol = q)
# for (i in 1:q) {
# zscaled[, i] <- (z[, i] - mean_z[i]) / sd_z[i]
# }
test_that("x and ext standardized, both intercepts", {
test_control <- list(tolerance = 1e-20)
expect_equal(
alphas_cvx_mat[, 1],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
intercept = c(T, T),
standardize = c(T, T),
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 1],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
intercept = c(T, T),
standardize = c(T, T),
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
alphas_cvx_mat[, 1],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
intercept = c(T, T),
standardize = c(T, T),
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 1],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
intercept = c(T, T),
standardize = c(T, T),
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x NOT standardized, ext standardized, both intercepts", {
test_control <- list(tolerance = 1e-20)
expect_equal(
alphas_cvx_mat[, 2],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(F, T),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 2],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(F, T),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
alphas_cvx_mat[, 2],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(F, T),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 2],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(F, T),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x standardized, ext NOT standardized, both intercepts", {
test_control <- list(tolerance = 1e-20)
expect_equal(
alphas_cvx_mat[, 3],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(T, F),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 3],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(T, F),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
alphas_cvx_mat[, 3],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(T, F),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 3],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(T, F),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x NOT standardized, ext NOT standardized, both intercepts", {
test_control <- list(tolerance = 1e-20)
expect_equal(
alphas_cvx_mat[, 4],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(F, F),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 4],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(F, F),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
alphas_cvx_mat[, 4],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(F, F),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 4],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(T, T),
standardize = c(F, F),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x standardized, ext standardized, no 2nd level intercept", {
test_control <- list(tolerance = 1e-20)
expect_equal(
alphas_cvx_mat[, 5],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(TRUE, TRUE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 5],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(TRUE, TRUE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
alphas_cvx_mat[, 5],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(TRUE, TRUE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 5],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(TRUE, TRUE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x NOT standardized, ext standardized, no 2nd level intercept", {
test_control <- list(tolerance = 1e-20)
expect_equal(
alphas_cvx_mat[, 6],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(FALSE, TRUE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 6],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(FALSE, TRUE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
alphas_cvx_mat[, 6],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(FALSE, TRUE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 6],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(FALSE, TRUE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x standardized, ext NOT standardized, no 2nd level intercept", {
test_control <- list(tolerance = 1e-20)
expect_equal(
alphas_cvx_mat[, 7],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(TRUE, FALSE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 7],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(TRUE, FALSE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
alphas_cvx_mat[, 7],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(TRUE, FALSE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 7],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(TRUE, FALSE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x NOT standardized, ext NOT standardized, no 2nd level intercept", {
test_control <- list(tolerance = 1e-20)
expect_equal(
alphas_cvx_mat[, 8],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(FALSE, FALSE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 8],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(FALSE, FALSE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
alphas_cvx_mat[, 8],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(FALSE, FALSE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(
betas_cvx_mat[, 8],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(TRUE, FALSE),
standardize = c(FALSE, FALSE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x standardized, ext standardized, no 1st level intercept", {
test_control <- list(tolerance = 1e-20)
expect_equal(alphas_cvx_mat[, 9],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(TRUE, TRUE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(betas_cvx_mat[, 9],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(TRUE, TRUE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(alphas_cvx_mat[, 9],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(TRUE, TRUE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(betas_cvx_mat[, 9],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(TRUE, TRUE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x NOT standardized, ext standardized, no 1st level intercept", {
test_control <- list(tolerance = 1e-20)
expect_equal(alphas_cvx_mat[, 10],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(FALSE, TRUE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(betas_cvx_mat[, 10],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(FALSE, TRUE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(alphas_cvx_mat[, 10],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(FALSE, TRUE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(betas_cvx_mat[, 10],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(FALSE, TRUE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x standardized, ext NOT standardized, no 1st level intercept", {
test_control <- list(tolerance = 1e-20)
expect_equal(alphas_cvx_mat[, 11],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(TRUE, FALSE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(betas_cvx_mat[, 11],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(TRUE, FALSE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(alphas_cvx_mat[, 11],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(TRUE, FALSE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(betas_cvx_mat[, 11],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(TRUE, FALSE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
test_that("x NOT standardized, ext NOT standardized, no 1st level intercept", {
test_control <- list(tolerance = 1e-20)
expect_equal(alphas_cvx_mat[, 12],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(FALSE, FALSE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(betas_cvx_mat[, 12],
xrnet(
x = xtest,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(FALSE, FALSE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(alphas_cvx_mat[, 12],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(FALSE, FALSE),
control = test_control
)$alphas[1:5, 1, 1] * sd_y,
tolerance = 1e-5
)
expect_equal(betas_cvx_mat[, 12],
xrnet(
x = xsparse,
y = ytest_scaled,
external = ztest,
family = "gaussian",
penalty_main = define_penalty(0, user_penalty = 1),
penalty_external = define_penalty(1, user_penalty = 0.1),
intercept = c(FALSE, TRUE),
standardize = c(FALSE, FALSE),
control = test_control
)$betas[1:50, 1, 1] * sd_y,
tolerance = 1e-5
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.