Nothing
context("Test output from glmsmurf function")
test_that("Test output class", {
# Check if class of output object is "glmsmurf"
expect_equal(class(munich.fit)[1],
"glmsmurf")
# Check if class of output object inherits from list, glm and lm classes
expect_is(munich.fit,
"list")
expect_is(munich.fit,
"glm")
expect_is(munich.fit,
"lm")
})
test_that("Test coefficients in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$coefficients))
# Check length
expect_length(munich.fit$coefficients,
63L)
})
test_that("Test residuals in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$residuals))
# Check length
expect_length(munich.fit$residuals,
nrow(rent))
})
test_that("Test fitted values in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$fitted.values))
# Check length
expect_length(munich.fit$fitted.values,
nrow(rent))
})
test_that("Test rank in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$rank))
# Check length
expect_length(munich.fit$rank,
1L)
# Check if strictly positive
expect_true(munich.fit$rank > 0)
# Check if integer
expect_true(.is.wholenumber(munich.fit$rank))
})
test_that("Test family in output", {
# Check class
expect_true(class(munich.fit$family) == "family")
})
test_that("Test linear predictors in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$linear.predictors))
# Check length
expect_length(munich.fit$linear.predictors,
nrow(rent))
# Check if can be transformed to fitted values using link function
expect_equal(munich.fit$family$linkfun(munich.fit$linear.predictors),
munich.fit$fitted.values)
})
test_that("Test deviance in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$deviance))
# Check length
expect_length(munich.fit$deviance,
1L)
})
test_that("Test AIC in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$aic))
# Check length
expect_length(munich.fit$aic,
1L)
})
test_that("Test BIC in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$bic))
# Check length
expect_length(munich.fit$bic,
1L)
# Check if BIC can be obtained from AIC
expect_equal(munich.fit$aic + (log(sum(munich.fit$weights != 0)) - 2) * munich.fit$rank,
munich.fit$bic)
})
test_that("Test GCV in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$gcv))
# Check length
expect_length(munich.fit$gcv,
1L)
# Check if GCV can be obtained from deviance
n2 <- sum(munich.fit$weights != 0)
expect_equal(munich.fit$deviance / (n2 * (1 - munich.fit$rank / n2) ^ 2),
munich.fit$gcv)
})
test_that("Test null deviance in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$null.deviance))
# Check length
expect_length(munich.fit$null.deviance,
1L)
})
test_that("Test residual DoF in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$df.residual))
# Check length
expect_length(munich.fit$df.residual,
1L)
# Check if can be obtained using weights and rank
expect_equal(sum(munich.fit$weights != 0) - munich.fit$rank,
munich.fit$df.residual)
})
test_that("Test null DoF in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$df.null))
# Check length
expect_length(munich.fit$df.null,
1L)
# Check if can be obtained using weights and rank of null model (1)
expect_equal(sum(munich.fit$weights != 0) - 1,
munich.fit$df.null)
})
test_that("Test objective function in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$obj.fun))
# Check length
expect_length(munich.fit$obj.fun,
1L)
})
test_that("Test weights in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$weights))
# Check length
expect_length(munich.fit$weights,
nrow(rent))
# Check if positive
expect_true(all(munich.fit$weights >= 0))
})
test_that("Test offset in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$offset))
# Check length
expect_length(munich.fit$offset,
nrow(rent))
})
test_that("Test lambda in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$lambda))
# Check length
expect_length(munich.fit$lambda,
1L)
# Check if positive
expect_true(munich.fit$lambda >= 0)
})
test_that("Test lambda1 in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$lambda1))
# Check length
expect_length(munich.fit$lambda1,
1L)
# Check if positive
expect_true(munich.fit$lambda1 >= 0)
})
test_that("Test lambda2 in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$lambda2))
# Check length
expect_length(munich.fit$lambda2,
1L)
# Check if positive
expect_true(munich.fit$lambda2 >= 0)
})
test_that("Test iter in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$iter))
# Check length
expect_length(munich.fit$iter,
1L)
# Check if strictly positive
expect_true(munich.fit$iter > 0)
# Check if integer
expect_true(.is.wholenumber(munich.fit$iter))
})
test_that("Test converged in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$converged))
# Check length
expect_length(munich.fit$converged,
1L)
# Check if 0, 1, 2 or 3
expect_true(munich.fit$converged %in% 0:3)
})
test_that("Test final stepsize in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$final.stepsize))
# Check length
expect_length(munich.fit$final.stepsize,
1L)
# Check if larger than minimum stepsize
expect_true(munich.fit$final.stepsize >= 1e-14)
})
test_that("Test n.par.cov in output", {
# Check if list
expect_true(is.list(munich.fit$n.par.cov))
# Check length
expect_length(munich.fit$n.par.cov,
11L)
# Check if all numeric
expect_true(all(sapply(munich.fit$n.par.cov, is.numeric)))
# Check lengths
expect_true(all(sapply(munich.fit$n.par.cov, length) == 1L))
# Check if all strictly positive
expect_true(all(unlist(munich.fit$n.par.cov, length) > 0))
# Check if all integers
expect_true(all(sapply(munich.fit$n.par.cov, .is.wholenumber)))
})
test_that("Test pen.cov in output", {
# Check if list
expect_true(is.list(munich.fit$pen.cov))
# Check length
expect_length(munich.fit$pen.cov,
11L)
# Check if all character
expect_true(all(sapply(munich.fit$pen.cov, is.character)))
# Check lengths
expect_true(all(sapply(munich.fit$pen.cov, length) == 1L))
# Check if all correct penalty types
expect_true(all(sapply(munich.fit$pen.cov, function(x) x %in% c("none", "lasso", "grouplasso",
"flasso", "gflasso", "2dflasso", "ggflasso"))))
})
test_that("Test group.cov in output", {
# Check if list
expect_true(is.list(munich.fit$group.cov))
# Check length
expect_length(munich.fit$group.cov,
11L)
# Check lengths
expect_true(all(sapply(munich.fit$group.cov, length) == 1L))
# Check if all numeric
expect_true(all(sapply(munich.fit$group.cov, is.numeric)))
# Check if all positive
expect_true(all(unlist(munich.fit$group.cov) >= 0))
# Check if all integers
expect_true(all(sapply(munich.fit$group.cov, .is.wholenumber)))
})
test_that("Test refcat.cov in output", {
# Check if list
expect_true(is.list(munich.fit$refcat.cov))
# Check length
expect_length(munich.fit$refcat.cov,
11L)
# Check lengths
expect_true(all(sapply(munich.fit$refcat.cov, length) == 1L))
# Check if all numeric
expect_true(all(sapply(munich.fit$refcat.cov, is.numeric)))
# Check if all positive
expect_true(all(unlist(munich.fit$refcat.cov) >= 0))
# Check if all integers
expect_true(all(sapply(munich.fit$refcat.cov, .is.wholenumber)))
})
test_that("Test control in output", {
# Check if list
expect_true(is.list(munich.fit$control))
# Check length
expect_length(munich.fit$control,
16L)
# Check if no error
expect_error(do.call("glmsmurf.control", munich.fit$control), NA)
})
test_that("Test lambda.method in output", {
# Check if character
expect_true(is.character(munich.fit.is$lambda.method))
expect_true(is.character(munich.fit.oos$lambda.method))
expect_true(is.character(munich.fit.cv$lambda.method))
expect_true(is.character(munich.fit.cv1se$lambda.method))
# Check name
expect_equal(munich.fit.is$lambda.method, "is.aic")
expect_equal(munich.fit.oos$lambda.method, "oos.dev")
expect_equal(munich.fit.cv$lambda.method, "cv.mse")
expect_equal(munich.fit.cv1se$lambda.method, "cv1se.mse")
})
test_that("Test lambda.vector in output", {
# Check if numeric
expect_true(is.numeric(munich.fit.is$lambda.vector))
expect_true(is.numeric(munich.fit.oos$lambda.vector))
expect_true(is.numeric(munich.fit.cv$lambda.vector))
expect_true(is.numeric(munich.fit.cv1se$lambda.vector))
# Check length
expect_length(munich.fit.is$lambda.vector,
3L)
expect_length(munich.fit.oos$lambda.vector,
3L)
expect_length(munich.fit.cv$lambda.vector,
3L)
expect_length(munich.fit.cv1se$lambda.vector,
3L)
})
test_that("Test lambda.measures in output", {
# Check if list
expect_true(is.list(munich.fit.is$lambda.measures))
expect_true(is.list(munich.fit.oos$lambda.measures))
expect_true(is.list(munich.fit.cv$lambda.measures))
expect_true(is.list(munich.fit.cv1se$lambda.measures))
# Check length
expect_length(munich.fit.is$lambda.measures,
3L)
expect_length(munich.fit.oos$lambda.measures,
3L)
expect_length(munich.fit.cv$lambda.measures,
3L)
expect_length(munich.fit.cv1se$lambda.measures,
3L)
# Check names
expect_equal(names(munich.fit.is$lambda.measures),
c("aic", "bic", "gcv"))
expect_equal(names(munich.fit.oos$lambda.measures),
c("dev", "mse", "dss"))
expect_equal(names(munich.fit.cv$lambda.measures),
c("dev", "mse", "dss"))
expect_equal(names(munich.fit.cv1se$lambda.measures),
c("dev", "mse", "dss"))
# Check dimensions
expect_equal(as.numeric(sapply(munich.fit.is$lambda.measures, dim)),
rep(c(3, 1), 3L))
expect_equal(as.numeric(sapply(munich.fit.oos$lambda.measures, dim)),
rep(c(3, 1), 3L))
expect_equal(as.numeric(sapply(munich.fit.cv$lambda.measures, dim)),
rep(c(3, 5), 3L))
expect_equal(as.numeric(sapply(munich.fit.cv1se$lambda.measures, dim)),
rep(c(3, 5), 3L))
# Check column names
expect_equal(as.character(sapply(munich.fit.is$lambda.measures, colnames)),
rep("In-sample", 3L))
expect_equal(as.character(sapply(munich.fit.oos$lambda.measures, colnames)),
rep("Out-of-sample", 3L))
expect_equal(as.character(sapply(munich.fit.cv$lambda.measures, colnames)),
rep(paste("Fold", 1:5), 3L))
expect_equal(as.character(sapply(munich.fit.cv1se$lambda.measures, colnames)),
rep(paste("Fold", 1:5), 3L))
# Check row names
expect_equal(as.numeric(sapply(munich.fit.is$lambda.measures, rownames)),
rep(round(munich.fit.is$lambda.vector, 4), 3L))
expect_equal(as.numeric(sapply(munich.fit.oos$lambda.measures, rownames)),
rep(round(munich.fit.oos$lambda.vector, 4), 3L))
expect_equal(as.numeric(sapply(munich.fit.cv$lambda.measures, rownames)),
rep(round(munich.fit.cv$lambda.vector, 4), 3L))
expect_equal(as.numeric(sapply(munich.fit.cv1se$lambda.measures, rownames)),
rep(round(munich.fit.cv1se$lambda.vector, 4), 3L))
})
test_that("Test lambda.coefficients in output", {
# Check if matrix
expect_true(is.matrix(munich.fit.is$lambda.coefficients))
expect_true(is.matrix(munich.fit.oos$lambda.coefficients))
# Check if NULL
expect_true(is.null(munich.fit.cv$lambda.coefficients))
expect_true(is.null(munich.fit.cv1se$lambda.coefficients))
# Check dimensions
expect_equal(dim(munich.fit.is$lambda.coefficients),
c(length(munich.fit.is$lambda.vector), length(coef(munich.fit.is))))
expect_equal(dim(munich.fit.oos$lambda.coefficients),
c(length(munich.fit.oos$lambda.vector), length(coef(munich.fit.is))))
# Check column names
expect_equal(colnames(munich.fit.is$lambda.coefficients),
names(coef(munich.fit.is)))
expect_equal(colnames(munich.fit.oos$lambda.coefficients),
names(coef(munich.fit.oos)))
# Check row names
expect_equal(as.numeric(sapply(munich.fit.is$lambda.measures, rownames)),
rep(round(munich.fit.is$lambda.vector, 4), 3L))
expect_equal(as.numeric(sapply(munich.fit.oos$lambda.measures, rownames)),
rep(round(munich.fit.oos$lambda.vector, 4), 3L))
})
test_that("Test X in output", {
# Check if matrix
expect_true((class(munich.fit$X)[1] %in% c("Matrix", "dgeMatrix", "dgCMatrix")) |
(is.matrix(munich.fit$X) & is.numeric(munich.fit$X)))
# Check dimension
expect_equal(dim(munich.fit$X),
c(nrow(rent), 63L))
# Check if null (not present)
expect_null(munich.fit2$X)
})
test_that("Test re-estimated coefficients in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$coefficients.reest))
# Check length
expect_length(munich.fit$coefficients.reest,
length(munich.fit$coefficients))
# Check if NULL (not present)
expect_null(munich.fit2$coefficients.reest)
})
test_that("Test re-estimated residuals in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$residuals.reest))
# Check length
expect_length(munich.fit$residuals.reest,
length(munich.fit$residuals))
# Check if NULL (not present)
expect_null(munich.fit2$residuals.reest)
})
test_that("Test re-estimated fitted values in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$fitted.values.reest))
# Check length
expect_length(munich.fit$fitted.values.reest,
length(munich.fit$fitted.values))
# Check if NULL (not present)
expect_null(munich.fit2$fitted.values.reest)
})
test_that("Test re-estimated rank in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$rank.reest))
# Check length
expect_length(munich.fit$rank.reest,
1L)
# Check if strictly positive
expect_true(munich.fit$rank.reest > 0)
# Check if integer
expect_true(.is.wholenumber(munich.fit$rank.reest))
# Check if NULL (not present)
expect_null(munich.fit2$rank.reest)
})
test_that("Test re-estimated linear predictors in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$linear.predictors.reest))
# Check length
expect_length(munich.fit$linear.predictors.reest,
length(munich.fit$linear.predictors))
# Check if can be transformed to fitted values using link function
expect_equal(munich.fit$family$linkfun(munich.fit$linear.predictors.reest),
munich.fit$fitted.values.reest)
# Check if NULL (not present)
expect_null(munich.fit2$linear.predictors.reest)
})
test_that("Test re-estimated deviance in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$deviance.reest))
# Check length
expect_length(munich.fit$deviance.reest,
1L)
# Check if NULL (not present)
expect_null(munich.fit2$deviance.reest)
})
test_that("Test re-estimated AIC in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$aic.reest))
# Check length
expect_length(munich.fit$aic.reest,
1L)
# Check if NULL (not present)
expect_null(munich.fit2$aic.reest)
})
test_that("Test re-estimated BIC in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$bic.reest))
# Check length
expect_length(munich.fit$bic.reest,
1L)
# Check if BIC can be obtained from AIC
expect_equal(munich.fit$aic.reest + (log(sum(munich.fit$weights != 0)) - 2) * munich.fit$rank.reest,
munich.fit$bic.reest)
# Check if NULL (not present)
expect_null(munich.fit2$bic.reest)
})
test_that("Test re-estimated GCV in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$gcv.reest))
# Check length
expect_length(munich.fit$gcv,
1L)
# Check if GCV can be obtained from deviance
n2 <- sum(munich.fit$weights != 0)
expect_equal(munich.fit$deviance.reest / (n2 * (1 - munich.fit$rank.reest / n2) ^ 2),
munich.fit$gcv.reest)
# Check if NULL (not present)
expect_null(munich.fit2$gcv.reest)
})
test_that("Test re-estimated residual DoF in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$df.residual.reest))
# Check length
expect_length(munich.fit$df.residual.reest,
1L)
# Check if can be obtained using weights and rank
expect_equal(sum(munich.fit$weights != 0) - munich.fit$rank.reest,
munich.fit$df.residual.reest)
# Check if NULL (not present)
expect_null(munich.fit2$df.residual.reest)
})
test_that("Test re-estimated objective function in output", {
# Check if numeric
expect_true(is.numeric(munich.fit$obj.fun.reest))
# Check length
expect_length(munich.fit$obj.fun.reest,
1L)
# Check if NULL (not present)
expect_null(munich.fit2$obj.fun.reest)
})
test_that("Test X.reest in output", {
# Check if matrix
expect_true((class(munich.fit$X.reest)[1] %in% c("Matrix", "dgeMatrix", "dgCMatrix")) |
(is.matrix(munich.fit$X.reest) & is.numeric(munich.fit$X.reest)))
# Check dimension
expect_equal(dim(munich.fit$X.reest),
c(nrow(rent), munich.fit$rank.reest))
# Check if null (not present)
expect_null(munich.fit2$X.reest)
})
test_that("Test call in output", {
# Check class
expect_true(is.call(munich.fit$call))
})
test_that("Test formula in output", {
# Check class
expect_true(class(munich.fit$formula) == "formula")
})
test_that("Test terms in output", {
# Check class
expect_true(class(munich.fit$terms)[1] == "terms")
})
test_that("Test contrasts in output", {
# Check class
expect_true(is.list(munich.fit$contrasts))
# Check length
expect_length(munich.fit$contrasts,
5L)
})
test_that("Test xlevels in output", {
# Check class
expect_true(is.list(munich.fit$xlevels))
# Check length
expect_length(munich.fit$xlevels,
10L)
})
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.