context("Test input for glmsmurf function") test_that("Test input for family", { expect_error(glmsmurf(formu, data = rent, family = "Pareto"), "object 'Pareto' of mode 'function' was not found", fixed = TRUE) }) test_that("Test input for weights", { # Check if error for length expect_error(glmsmurf(formu, data = rent, family = gaussian(), weights = 1), paste0("'weights' must be a numeric vector of length ", nrow(rent), " or NULL."), fixed = TRUE) # Check if error for length expect_error(glmsmurf(formu, data = rent, family = gaussian(), weights = 1:10), paste0("'weights' must be a numeric vector of length ", nrow(rent), " or NULL."), fixed = TRUE) # Check if error for numeric vector expect_error(glmsmurf(formu, data = rent, family = gaussian(), weights = rep("a", nrow(rent))), "'weights' must be a numeric vector or NULL.", fixed = TRUE) # Check if error for non-numerics expect_error(glmsmurf(formu, data = rent, family = gaussian(), weights = NA), "'weights' must be a numeric vector or NULL.", fixed = TRUE) # Check if error for NaN expect_error(glmsmurf(formu, data = rent, family = gaussian(), weights = NaN), "'weights' must be a vector of finite numbers.", fixed = TRUE) # Check if error for infinite numbers expect_error(glmsmurf(formu, data = rent, family = gaussian(), weights = Inf), "'weights' must be a vector of finite numbers.", fixed = TRUE) # Check if warning in standardisation when weights sum to one expect_warning(glmsmurf(formu, data = rent, family = gaussian(), weights = rep(1/nrow(rent), nrow(rent)), lambda = 1), "Weights sum to one, biased weighted standard deviation is used in standardization.", fixed = TRUE) # Check default n <- 10 expect_equal(.check_input_weights(n = n), rep(1, n)) }) test_that("Test input for start", { # Check if error for length expect_error(glmsmurf(formu, data = rent, family = gaussian(), start = 1), "'start' must be a numeric vector of length 63 or NULL.", fixed = TRUE) # Check if error for length expect_error(glmsmurf(formu, data = rent, family = gaussian(), start = 1:10), "'start' must be a numeric vector of length 63 or NULL.", fixed = TRUE) # Check if error for numeric vector expect_error(glmsmurf(formu, data = rent, family = gaussian(), start = rep("a", 63L)), "'start' must be a numeric vector or NULL.", fixed = TRUE) # Check if error for non-numerics expect_error(glmsmurf(formu, data = rent, family = gaussian(), start = NA), "'start' must be a numeric vector or NULL.", fixed = TRUE) # Check if error for NaN expect_error(glmsmurf(formu, data = rent, family = gaussian(), start = NaN), "'start' must be a vector of finite numbers.", fixed = TRUE) # Check if error for infinite numbers expect_error(glmsmurf(formu, data = rent, family = gaussian(), start = Inf), "'start' must be a vector of finite numbers.", fixed = TRUE) # Check default expect_equal(.check_input_start(y = munich.fit$y, weights = munich.fit$weights, family = munich.fit$family, n = nrow(rent), p = length(coef(munich.fit)) - 1, inter = TRUE), c(munich.fit$family$linkfun(weighted.mean(munich.fit$y, w = munich.fit$weights)), rep(0, length(coef(munich.fit)) - 1))) }) test_that("No offset in formula", { rent2 <- rent rent2$of <- runif(nrow(rent2)) formu2 <- rentm ~ p(area) + offset(of) expect_error(glmsmurf(formu2, data = rent2, family = gaussian()), "No offset(s) can be given in the formula. Please use the 'offset' argument to specify the offset.", fixed = TRUE) }) test_that("Test input for offset", { # Check if error for length expect_error(glmsmurf(formu, data = rent, family = gaussian(), offset = 1), paste0("'offset' must be a numeric vector of length ", nrow(rent), " or NULL."), fixed = TRUE) # Check if error for length expect_error(glmsmurf(formu, data = rent, family = gaussian(), offset = 1:10), paste0("'offset' must be a numeric vector of length ", nrow(rent), " or NULL."), fixed = TRUE) # Check if error for numeric vector expect_error(glmsmurf(formu, data = rent, family = gaussian(), offset = rep("a", nrow(rent))), "'offset' must be a numeric vector or NULL.", fixed = TRUE) # Check if error for non-numerics expect_error(glmsmurf(formu, data = rent, family = gaussian(), offset = NA), "'offset' must be a numeric vector or NULL.", fixed = TRUE) # Check if error for NaN expect_error(glmsmurf(formu, data = rent, family = gaussian(), offset = NaN), "'offset' must be a vector of finite numbers.", fixed = TRUE) # Check if error for infinite numbers expect_error(glmsmurf(formu, data = rent, family = gaussian(), offset = Inf), "'offset' must be a vector of finite numbers.", fixed = TRUE) # Check default n <- 10 expect_equal(.check_input_offset(n = n), rep(0, n)) }) test_that("Test input for lambda", { # Check if error for length expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda = 1:10), "'lambda' must be a numeric of length 1.", fixed = TRUE) # Check if error for numeric vector expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda = "a"), paste0("'lambda' must be a numeric, NULL, or one of 'cv.dev', 'cv.mse', 'cv.dss',", " 'cv1se.dev', 'cv1se.mse', 'cv1se.dss', 'is.aic', 'is.bic', 'is.gcv',", " 'oos.dev', 'oos.mse' or 'oos.dss'."), fixed = TRUE) # Check if error for non-numerics expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda = NA), "'lambda' must be numeric.", fixed = TRUE) # Check if error for NaN expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda = NaN), "'lambda' must be a finite number.", fixed = TRUE) # Check if error for infinite numbers expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda = Inf), "'lambda' must be a finite number.", fixed = TRUE) # Check default expect_equal(.check_input_lambda(), "cv1se.dev") }) test_that("Test input for lambda1", { # Check if error for length expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda1 = 1:10), "'lambda1' must be a numeric of length 1.", fixed = TRUE) # Check if error for numeric vector expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda1 = "a"), paste0("'lambda1' must be numeric."), fixed = TRUE) # Check if error for non-numerics expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda1 = NA), "'lambda1' must be numeric.", fixed = TRUE) # Check if error for NaN expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda1 = NaN), "'lambda1' must be a finite number.", fixed = TRUE) # Check if error for infinite numbers expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda1 = Inf), "'lambda1' must be a finite number.", fixed = TRUE) }) test_that("Test input for lambda2", { # Check if error for length expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda2 = 1:10), "'lambda2' must be a numeric of length 1.", fixed = TRUE) # Check if error for numeric vector expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda2 = "a"), paste0("'lambda2' must be numeric."), fixed = TRUE) # Check if error for non-numerics expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda2 = NA), "'lambda2' must be numeric.", fixed = TRUE) # Check if error for NaN expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda2 = NaN), "'lambda2' must be a finite number.", fixed = TRUE) # Check if error for infinite numbers expect_error(glmsmurf(formu, data = rent, family = gaussian(), lambda2 = Inf), "'lambda2' must be a finite number.", fixed = TRUE) }) test_that("Test input for penalty weights", { # Check if error for list expect_error(glmsmurf(formu, data = rent, family = gaussian(), pen.weights = 1:10), "'pen.weights' must be a list of numeric vectors.", fixed = TRUE) # Check if error for numeric vector expect_error(glmsmurf(formu, data = rent, family = gaussian(), pen.weights = "a"), paste0("'pen.weights' must be a list of numerics, NULL,", " or one of 'eq', 'stand', 'glm', 'glm.stand', 'gam' or 'gam.stand'."), fixed = TRUE) L <- munich.fit$n.par.cov # Check if error for non-numerics L[[1]] <- c(1, NA) expect_error(glmsmurf(formu, data = rent, family = gaussian(), pen.weights = L), "'pen.weights' must be a list of finite numeric vectors.", fixed = TRUE) # Check if error for NaN L[[1]] <- c(1, NaN) expect_error(glmsmurf(formu, data = rent, family = gaussian(), pen.weights = L), "'pen.weights' must be a list of finite numeric vectors.", fixed = TRUE) # Check if error for infinite numbers L[[1]] <- c(1, Inf) expect_error(glmsmurf(formu, data = rent, family = gaussian(), pen.weights = L), "'pen.weights' must be a list of finite numeric vectors.", fixed = TRUE) # Check if error for length L <- munich.fit$n.par.cov[-1] expect_error(glmsmurf(formu, data = rent, family = gaussian(), pen.weights = L), "'pen.weights' must be a list of length 11.", fixed = TRUE) # Check if error for lengths of elements L <- suppressWarnings(glmsmurf(formu, data = rent, family = gaussian(), pen.weights.return = TRUE, pen.weights = "stand", lambda = 10, control = list(maxiter = 1))$pen.weights) L2 <- L # One wrong length L$area <- L$area[-1] expect_error(glmsmurf(formu, data = rent, family = gaussian(), pen.weights = L), "Element 'area' of 'pen.weights' has the wrong length.", fixed = TRUE) # Two wrong lengths L$year <- L$year[-2] expect_error(glmsmurf(formu, data = rent, family = gaussian(), pen.weights = L), "Elements 'area', 'year' of 'pen.weights' have the wrong length.", fixed = TRUE) # Check if error for names of elements # One wrong name names(L2)[2] <- "b" expect_error(glmsmurf(formu, data = rent, family = gaussian(), pen.weights = L2, lambda = 10), "Element 'b' of 'pen.weights' should have name 'area'.", fixed = TRUE) # Two wrong names names(L2)[3] <- "c" expect_error(glmsmurf(formu, data = rent, family = gaussian(), pen.weights = L2, lambda = 10), "Elements 'b', 'c' of 'pen.weights' should have names 'area', 'year', respectively.", fixed = TRUE) }) test_that("Test input for adjacency matrices", { formu2 <- rentm ~ p(area, pen = "ggflasso") formu3 <- rentm ~ p(area, pen = "ggflasso") + p(year, pen = "ggflasso") # Check that no error when single adjacency matrix not in a list expect_error(glmsmurf(formu2, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = munich_adj, control = list(maxiter = 1)), NA) # Check for error since no list expect_error(glmsmurf(formu3, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = munich_adj, control = list(maxiter = 1)), "'adj.matrix' needs to be a named list or NULL.", fixed = TRUE) # Check for error since wrong list length expect_error(glmsmurf(formu3, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = list(area = munich_adj), control = list(maxiter = 1)), paste0("The number of elements of 'adj.matrix' needs to be the same as the number of predictors that", " is penalized using the Graph-Guided Fused Lasso, i.e. 2."), fixed = TRUE) # Check for correct name of list expect_error(glmsmurf(formu2, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = list(year = munich_adj), control = list(maxiter = 1)), "Element 1 of 'adj.matrix' needs to have name 'area'.", fixed = TRUE) # Check for correct list names expect_error(glmsmurf(formu3, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = list(area = munich_adj, b = munich_adj), control = list(maxiter = 1)), "Element 2 of 'adj.matrix' needs to have name 'year'.", fixed = TRUE) # Check if error for number of levels expect_error(glmsmurf(formu3, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = list(area = munich_adj, year = munich_adj), control = list(maxiter = 1)), paste0("Element 2 of 'adj.matrix' needs to be a square matrix with 10", " rows (the number of levels of the corresponding predictor)."), fixed = TRUE) # Check if error for matrix expect_error(glmsmurf(formu2, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = 1:10, control = list(maxiter = 1)), "A numeric matrix or element of class Matrix was expected in element 1 of 'adj.matrix'.", fixed = TRUE) # Check if error for matrix since wrong rownames rownames(munich_adj) <- 0:24 expect_error(glmsmurf(formu2, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = munich_adj, control = list(maxiter = 1)), paste0("The rownames of element 1 of 'adj.matrix' are not the same as the level names", " of the corresponding predictor. Note that the order of the names is also important."), fixed = TRUE) # Check if error for matrix since wrong rownames rownames(munich_adj) <- 25:1 expect_error(glmsmurf(formu2, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = munich_adj, control = list(maxiter = 1)), paste0("The rownames of element 1 of 'adj.matrix' are not the same as the level names", " of the corresponding predictor. Note that the order of the names is also important."), fixed = TRUE) # No adjacency matrix is provided expect_error(glmsmurf(formu2, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", control = list(maxiter = 1)), paste0("The number of elements of 'adj.matrix' needs to be the same as the number of predictors that", " is penalized using the Graph-Guided Fused Lasso, i.e. 1."), fixed = TRUE) # Non-symmetric adjacency matrix rownames(munich_adj) <- 1:25 munich_adj2 <- munich_adj_orig munich_adj2[1, 10] <- 1 expect_error(glmsmurf(formu2, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = munich_adj2), "An adjacency matrix needs to be symmetric.") # No zero-one adjacency matrix munich_adj2 <- munich_adj munich_adj2[1, 2] <- 2; munich_adj2[2, 1] <- 2 expect_error(glmsmurf(formu2, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = munich_adj2), "All elements of an adjacency matrix need to be zero or one.") # No rownames for adjacency matrix rownames(munich_adj) <- NULL expect_error(glmsmurf(formu2, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = munich_adj), paste0("The rownames of element 1 of 'adj.matrix' are not the same as the level names", " of the corresponding predictor. Note that the order of the names is also important."), fixed = TRUE) # No colnames for adjacency matrix rownames(munich_adj) <- 1:25 colnames(munich_adj) <- NULL expect_error(glmsmurf(formu2, data = rent, lambda = 10, family = gaussian(), pen.weights = "stand", adj.matrix = munich_adj), paste0("An adjacency matrix needs to be symmetric (including row and column names)."), fixed = TRUE) })