From c2d1bb646f1339c78ac0de46b7f2450c8ddbf560 Mon Sep 17 00:00:00 2001 From: jaredhuling Date: Tue, 18 Sep 2018 06:54:35 -0400 Subject: [PATCH] reduced tests --- tests/testthat/test-fitsubgroup.R | 477 +++++++++++++------------ tests/testthat/test-validatesubgroup.R | 38 +- tests/testthat/test-wksvm.R | 49 +-- 3 files changed, 291 insertions(+), 273 deletions(-) diff --git a/tests/testthat/test-fitsubgroup.R b/tests/testthat/test-fitsubgroup.R index f13a0c3..62e3415 100644 --- a/tests/testthat/test-fitsubgroup.R +++ b/tests/testthat/test-fitsubgroup.R @@ -513,43 +513,46 @@ test_that("test fit.subgroup for continuous outcomes and various losses", { expect_is(subgrp.model, "subgroup_fitted") - subgrp.model <- fit.subgroup(x = x, y = y, - trt = as.factor(trt01), - propensity.func = prop.func, - loss = "owl_logistic_loss_lasso", - nfolds = 5) + if (Sys.info()[[1]] != "windows") + { + subgrp.model <- fit.subgroup(x = x, y = y, + trt = as.factor(trt01), + propensity.func = prop.func, + loss = "owl_logistic_loss_lasso", + nfolds = 5) - expect_is(subgrp.model, "subgroup_fitted") + expect_is(subgrp.model, "subgroup_fitted") - expect_warning(fit.subgroup(x = x, y = y, - trt = as.factor(trt01), - propensity.func = prop.func, - reference.trt = 2, - loss = "owl_logistic_loss_lasso", - nfolds = 5)) + expect_warning(fit.subgroup(x = x, y = y, + trt = as.factor(trt01), + propensity.func = prop.func, + reference.trt = 2, + loss = "owl_logistic_loss_lasso", + nfolds = 5)) - ## only 1 trt level - expect_error(fit.subgroup(x = x, y = y, - trt = as.factor(rep(1, NROW(y))), - propensity.func = prop.func, - loss = "owl_logistic_loss_lasso", - nfolds = 5)) + ## only 1 trt level + expect_error(fit.subgroup(x = x, y = y, + trt = as.factor(rep(1, NROW(y))), + propensity.func = prop.func, + loss = "owl_logistic_loss_lasso", + nfolds = 5)) - ## too many trt levels - expect_error(fit.subgroup(x = x, y = y, - trt = as.factor(1:NROW(y)), - propensity.func = prop.func, - loss = "owl_logistic_loss_lasso", - nfolds = 5)) + ## too many trt levels + expect_error(fit.subgroup(x = x, y = y, + trt = as.factor(1:NROW(y)), + propensity.func = prop.func, + loss = "owl_logistic_loss_lasso", + nfolds = 5)) - subgrp.model <- fit.subgroup(x = x, y = y, - trt = as.factor(trt01), - propensity.func = prop.func, - loss = "owl_logistic_flip_loss_lasso", - nfolds = 5) + subgrp.model <- fit.subgroup(x = x, y = y, + trt = as.factor(trt01), + propensity.func = prop.func, + loss = "owl_logistic_flip_loss_lasso", + nfolds = 5) - expect_is(subgrp.model, "subgroup_fitted") + expect_is(subgrp.model, "subgroup_fitted") + } if (Sys.info()[[1]] != "windows") @@ -687,51 +690,55 @@ test_that("test fit.subgroup for continuous outcomes and various losses", { expect_is(subgrp.model, "subgroup_fitted") - # test if pi.x is a matrix with 1 column - subgrp.model <- fit.subgroup(x = x, y = y, - trt = trt01, - propensity.func = prop.func2, - loss = "sq_loss_lasso", - nfolds = 5) # option for cv.glmnet + if (Sys.info()[[1]] != "windows") + { + # test if pi.x is a matrix with 1 column + subgrp.model <- fit.subgroup(x = x, y = y, + trt = trt01, + propensity.func = prop.func2, + loss = "sq_loss_lasso", + nfolds = 5) # option for cv.glmnet - expect_is(subgrp.model, "subgroup_fitted") + expect_is(subgrp.model, "subgroup_fitted") - # test if pi.x is a matrix with 1 column - subgrp.model <- fit.subgroup(x = x, y = y, - trt = trt01, - propensity.func = prop.func3, - loss = "sq_loss_lasso", - nfolds = 5) # option for cv.glmnet + # test if pi.x is a matrix with 1 column + subgrp.model <- fit.subgroup(x = x, y = y, + trt = trt01, + propensity.func = prop.func3, + loss = "sq_loss_lasso", + nfolds = 5) # option for cv.glmnet - expect_is(subgrp.model, "subgroup_fitted") + expect_is(subgrp.model, "subgroup_fitted") - # no prop func - subgrp.model <- fit.subgroup(x = x, y = y, - trt = trt01, - loss = "sq_loss_lasso", - nfolds = 5) # option for cv.glmnet + # no prop func + subgrp.model <- fit.subgroup(x = x, y = y, + trt = trt01, + loss = "sq_loss_lasso", + nfolds = 5) # option for cv.glmnet - expect_is(subgrp.model, "subgroup_fitted") + expect_is(subgrp.model, "subgroup_fitted") - subgrp.model <- fit.subgroup(x = x, y = y, - trt = trt01, - propensity.func = prop.func, - loss = "sq_loss_gam") + subgrp.model <- fit.subgroup(x = x, y = y, + trt = trt01, + propensity.func = prop.func, + loss = "sq_loss_gam") - expect_is(subgrp.model, "subgroup_fitted") - invisible(capture.output(print(subgrp.model))) - invisible(capture.output(summary(subgrp.model))) + expect_is(subgrp.model, "subgroup_fitted") + invisible(capture.output(print(subgrp.model))) + invisible(capture.output(summary(subgrp.model))) - subgrp.model <- fit.subgroup(x = x, y = y, - trt = trt01, - propensity.func = prop.func, - loss = "sq_loss_lasso_gam", - nfolds = 5) # option for cv.glmnet + subgrp.model <- fit.subgroup(x = x, y = y, + trt = trt01, + propensity.func = prop.func, + loss = "sq_loss_lasso_gam", + nfolds = 5) # option for cv.glmnet - expect_is(subgrp.model, "subgroup_fitted") + expect_is(subgrp.model, "subgroup_fitted") + + invisible(capture.output(print(subgrp.model))) + invisible(capture.output(summary(subgrp.model))) + } - invisible(capture.output(print(subgrp.model))) - invisible(capture.output(summary(subgrp.model))) if (Sys.info()[[1]] != "windows") { @@ -868,23 +875,27 @@ test_that("test fit.subgroup for time-to-event outcomes and various losses", { expect_is(subgrp.model, "subgroup_fitted") - subgrp.model <- fit.subgroup(x = x, y = Surv(y.time.to.event, status), - trt = trt01, - larger.outcome.better = FALSE, - propensity.func = prop.func, - loss = "cox_loss_lasso", - nfolds = 5) # option for cv.glmnet + if (Sys.info()[[1]] != "windows") + { - expect_is(subgrp.model, "subgroup_fitted") + subgrp.model <- fit.subgroup(x = x, y = Surv(y.time.to.event, status), + trt = trt01, + larger.outcome.better = FALSE, + propensity.func = prop.func, + loss = "cox_loss_lasso", + nfolds = 5) # option for cv.glmnet - # test if pi.x is a matrix with 1 column - subgrp.model <- fit.subgroup(x = x, y = Surv(y.time.to.event, status), - trt = trt01, - propensity.func = prop.func2, - loss = "cox_loss_lasso", - nfolds = 5) # option for cv.glmnet + expect_is(subgrp.model, "subgroup_fitted") - expect_is(subgrp.model, "subgroup_fitted") + # test if pi.x is a matrix with 1 column + subgrp.model <- fit.subgroup(x = x, y = Surv(y.time.to.event, status), + trt = trt01, + propensity.func = prop.func2, + loss = "cox_loss_lasso", + nfolds = 5) # option for cv.glmnet + + expect_is(subgrp.model, "subgroup_fitted") + } }) @@ -1008,84 +1019,87 @@ test_that("test fit.subgroup with augment.func for continuous outcomes and vario nfolds = 5)) - subgrp.model <- fit.subgroup(x = x, y = y, - trt = trt01, - propensity.func = prop.func, - augment.func = augment.func, - loss = "sq_loss_gam") - - expect_is(subgrp.model, "subgroup_fitted") - invisible(capture.output(print(subgrp.model))) - invisible(capture.output(summary(subgrp.model))) - - subgrp.model <- fit.subgroup(x = x, y = y, - trt = trt01, - propensity.func = prop.func, - augment.func = augment.func, - loss = "sq_loss_lasso_gam", - nfolds = 5) # option for cv.glmnet + if (Sys.info()[[1]] != "windows") + { + subgrp.model <- fit.subgroup(x = x, y = y, + trt = trt01, + propensity.func = prop.func, + augment.func = augment.func, + loss = "sq_loss_gam") - expect_is(subgrp.model, "subgroup_fitted") + expect_is(subgrp.model, "subgroup_fitted") + invisible(capture.output(print(subgrp.model))) + invisible(capture.output(summary(subgrp.model))) - invisible(capture.output(print(subgrp.model))) - invisible(capture.output(summary(subgrp.model))) + subgrp.model <- fit.subgroup(x = x, y = y, + trt = trt01, + propensity.func = prop.func, + augment.func = augment.func, + loss = "sq_loss_lasso_gam", + nfolds = 5) # option for cv.glmnet - subgrp.model <- fit.subgroup(x = x, y = y, - trt = trt01, - propensity.func = prop.func, - loss = "sq_loss_gbm", - n.trees = 5, - n.cores = 1) + expect_is(subgrp.model, "subgroup_fitted") - invisible(capture.output(print(subgrp.model))) - invisible(capture.output(summary(subgrp.model))) - expect_is(subgrp.model, "subgroup_fitted") + invisible(capture.output(print(subgrp.model))) + invisible(capture.output(summary(subgrp.model))) - # subgrp.model <- fit.subgroup(x = x, y = y, - # trt = trt01, - # propensity.func = prop.func, - # loss = "abs_loss_gbm", - # n.trees = 5, - # n.cores = 1) - # - # invisible(capture.output(print(subgrp.model))) - # invisible(capture.output(summary(subgrp.model))) - # expect_is(subgrp.model, "subgroup_fitted") + subgrp.model <- fit.subgroup(x = x, y = y, + trt = trt01, + propensity.func = prop.func, + loss = "sq_loss_gbm", + n.trees = 5, + n.cores = 1) - expect_warning(fit.subgroup(x = x, y = y, - trt = trt01, - propensity.func = prop.func, - loss = "sq_loss_gbm", - n.trees = 5, - cv.folds = 1, - n.cores = 1)) - - # expect_warning(fit.subgroup(x = x, y = y, - # trt = trt01, - # propensity.func = prop.func, - # loss = "abs_loss_gbm", - # n.trees = 5, - # cv.folds = 1, - # n.cores = 1)) + invisible(capture.output(print(subgrp.model))) + invisible(capture.output(summary(subgrp.model))) + expect_is(subgrp.model, "subgroup_fitted") - subgrp.model <- fit.subgroup(x = x, y = y.binary, - trt = trt01, - propensity.func = prop.func, - loss = "logistic_loss_gbm", - n.trees = 5, - n.cores = 1) + # subgrp.model <- fit.subgroup(x = x, y = y, + # trt = trt01, + # propensity.func = prop.func, + # loss = "abs_loss_gbm", + # n.trees = 5, + # n.cores = 1) + # + # invisible(capture.output(print(subgrp.model))) + # invisible(capture.output(summary(subgrp.model))) + # expect_is(subgrp.model, "subgroup_fitted") + + expect_warning(fit.subgroup(x = x, y = y, + trt = trt01, + propensity.func = prop.func, + loss = "sq_loss_gbm", + n.trees = 5, + cv.folds = 1, + n.cores = 1)) + + # expect_warning(fit.subgroup(x = x, y = y, + # trt = trt01, + # propensity.func = prop.func, + # loss = "abs_loss_gbm", + # n.trees = 5, + # cv.folds = 1, + # n.cores = 1)) + + subgrp.model <- fit.subgroup(x = x, y = y.binary, + trt = trt01, + propensity.func = prop.func, + loss = "logistic_loss_gbm", + n.trees = 5, + n.cores = 1) - invisible(capture.output(print(subgrp.model))) - invisible(capture.output(summary(subgrp.model))) - expect_is(subgrp.model, "subgroup_fitted") + invisible(capture.output(print(subgrp.model))) + invisible(capture.output(summary(subgrp.model))) + expect_is(subgrp.model, "subgroup_fitted") - expect_warning(fit.subgroup(x = x, y = y.binary, - trt = trt01, - propensity.func = prop.func, - loss = "logistic_loss_gbm", - n.trees = 5, - cv.folds = 1, - n.cores = 1)) + expect_warning(fit.subgroup(x = x, y = y.binary, + trt = trt01, + propensity.func = prop.func, + loss = "logistic_loss_gbm", + n.trees = 5, + cv.folds = 1, + n.cores = 1)) + } if (Sys.info()[[1]] != "windows") { @@ -1216,125 +1230,128 @@ test_that("test fit.subgroup for binary outcomes and various losses", { invisible(capture.output(summary(subgrp.model))) - subgrp.model <- fit.subgroup(x = x, y = y.count, - trt = trt01, - propensity.func = prop.func, - loss = "poisson_loss_lasso", - nfolds = 5) # option for cv.glmnet - - expect_is(subgrp.model, "subgroup_fitted") - - invisible(capture.output(print(subgrp.model, digits = 2))) + if (Sys.info()[[1]] != "windows") + { + subgrp.model <- fit.subgroup(x = x, y = y.count, + trt = trt01, + propensity.func = prop.func, + loss = "poisson_loss_lasso", + nfolds = 5) # option for cv.glmnet - invisible(capture.output(summary(subgrp.model))) + expect_is(subgrp.model, "subgroup_fitted") + invisible(capture.output(print(subgrp.model, digits = 2))) - subgrp.model <- fit.subgroup(x = x, y = y.count, - trt = trt01, - propensity.func = prop.func, - loss = "poisson_loss_gam", - nfolds = 5) # option for cv.glmnet + invisible(capture.output(summary(subgrp.model))) - expect_is(subgrp.model, "subgroup_fitted") - invisible(capture.output(print(subgrp.model, digits = 2))) + subgrp.model <- fit.subgroup(x = x, y = y.count, + trt = trt01, + propensity.func = prop.func, + loss = "poisson_loss_gam", + nfolds = 5) # option for cv.glmnet - invisible(capture.output(summary(subgrp.model))) + expect_is(subgrp.model, "subgroup_fitted") + invisible(capture.output(print(subgrp.model, digits = 2))) - subgrp.model <- fit.subgroup(x = x, y = y.count, - trt = trt01, - propensity.func = prop.func, - loss = "poisson_loss_lasso_gam") + invisible(capture.output(summary(subgrp.model))) - expect_is(subgrp.model, "subgroup_fitted") - invisible(capture.output(print(subgrp.model, digits = 2))) + subgrp.model <- fit.subgroup(x = x, y = y.count, + trt = trt01, + propensity.func = prop.func, + loss = "poisson_loss_lasso_gam") - invisible(capture.output(summary(subgrp.model))) + expect_is(subgrp.model, "subgroup_fitted") - # subgrp.model <- fit.subgroup(x = x, y = y.count, - # trt = trt01, - # propensity.func = prop.func, - # loss = "poisson_loss_gbm") - # - # expect_is(subgrp.model, "subgroup_fitted") - # - # invisible(capture.output(print(subgrp.model, digits = 2))) - # - # invisible(capture.output(summary(subgrp.model))) + invisible(capture.output(print(subgrp.model, digits = 2))) + invisible(capture.output(summary(subgrp.model))) - augment.func <- function(x, y) { - lmod <- glm(y ~ x, family = binomial()); - return(predict(lmod, type = "link")) - } + # subgrp.model <- fit.subgroup(x = x, y = y.count, + # trt = trt01, + # propensity.func = prop.func, + # loss = "poisson_loss_gbm") + # + # expect_is(subgrp.model, "subgroup_fitted") + # + # invisible(capture.output(print(subgrp.model, digits = 2))) + # + # invisible(capture.output(summary(subgrp.model))) + + + augment.func <- function(x, y) { + lmod <- glm(y ~ x, family = binomial()); + return(predict(lmod, type = "link")) + } - subgrp.modela <- fit.subgroup(x = x, y = y.binary, - trt = trt01, - propensity.func = prop.func, - augment.func = augment.func, - loss = "logistic_loss_lasso", - nfolds = 5) # option for cv.glmnet + subgrp.modela <- fit.subgroup(x = x, y = y.binary, + trt = trt01, + propensity.func = prop.func, + augment.func = augment.func, + loss = "logistic_loss_lasso", + nfolds = 5) # option for cv.glmnet - expect_is(subgrp.modela, "subgroup_fitted") + expect_is(subgrp.modela, "subgroup_fitted") - invisible(capture.output(print(subgrp.modela, digits = 2))) + invisible(capture.output(print(subgrp.modela, digits = 2))) - invisible(capture.output(summary(subgrp.modela))) + invisible(capture.output(summary(subgrp.modela))) - subgrp.modela <- fit.subgroup(x = x, y = y.binary, - trt = trt01, - propensity.func = prop.func, - augment.func = augment.func, - loss = "logistic_loss_gam", - nfolds = 5) # option for cv.glmnet + subgrp.modela <- fit.subgroup(x = x, y = y.binary, + trt = trt01, + propensity.func = prop.func, + augment.func = augment.func, + loss = "logistic_loss_gam", + nfolds = 5) # option for cv.glmnet - expect_is(subgrp.modela, "subgroup_fitted") + expect_is(subgrp.modela, "subgroup_fitted") - invisible(capture.output(print(subgrp.modela, digits = 2))) + invisible(capture.output(print(subgrp.modela, digits = 2))) - invisible(capture.output(summary(subgrp.modela))) + invisible(capture.output(summary(subgrp.modela))) - subgrp.modelg <- fit.subgroup(x = x, y = y.binary, - trt = trt01, - propensity.func = prop.func, - loss = "logistic_loss_lasso_gam", - nfolds = 5) # option for cv.glmnet + subgrp.modelg <- fit.subgroup(x = x, y = y.binary, + trt = trt01, + propensity.func = prop.func, + loss = "logistic_loss_lasso_gam", + nfolds = 5) # option for cv.glmnet - expect_is(subgrp.modelg, "subgroup_fitted") + expect_is(subgrp.modelg, "subgroup_fitted") - invisible(capture.output(print(subgrp.modelg, digits = 2))) + invisible(capture.output(print(subgrp.modelg, digits = 2))) - invisible(capture.output(summary(subgrp.modelg))) + invisible(capture.output(summary(subgrp.modelg))) - subgrp.modelga <- fit.subgroup(x = x, y = y.binary, - trt = trt01, - propensity.func = prop.func, - augment.func = augment.func, - loss = "logistic_loss_lasso_gam", - nfolds = 5) # option for cv.glmnet + subgrp.modelga <- fit.subgroup(x = x, y = y.binary, + trt = trt01, + propensity.func = prop.func, + augment.func = augment.func, + loss = "logistic_loss_lasso_gam", + nfolds = 5) # option for cv.glmnet - expect_is(subgrp.modelga, "subgroup_fitted") + expect_is(subgrp.modelga, "subgroup_fitted") - invisible(capture.output(print(subgrp.modelga, digits = 2))) + invisible(capture.output(print(subgrp.modelga, digits = 2))) - invisible(capture.output(summary(subgrp.modelga))) + invisible(capture.output(summary(subgrp.modelga))) - # subgrp.model <- fit.subgroup(x = x, y = y.binary, - # trt = trt01, - # propensity.func = prop.func, - # loss = "logistic_loss_gam") - # - # expect_is(subgrp.model, "subgroup_fitted") + # subgrp.model <- fit.subgroup(x = x, y = y.binary, + # trt = trt01, + # propensity.func = prop.func, + # loss = "logistic_loss_gam") + # + # expect_is(subgrp.model, "subgroup_fitted") - invisible(capture.output(print(subgrp.model, digits = 2))) + invisible(capture.output(print(subgrp.model, digits = 2))) - invisible(capture.output(summary(subgrp.model))) + invisible(capture.output(summary(subgrp.model))) + } # subgrp.model <- fit.subgroup(x = x, y = y.binary, # trt = trt01, diff --git a/tests/testthat/test-validatesubgroup.R b/tests/testthat/test-validatesubgroup.R index 73bfa2c..891b071 100644 --- a/tests/testthat/test-validatesubgroup.R +++ b/tests/testthat/test-validatesubgroup.R @@ -63,7 +63,7 @@ test_that("test validate.subgroup for continuous outcomes with various options", invisible(capture.output(print(summarize.subgroups(subgrp.model), digits = 2, p.value = 0.25))) - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, method = "training") expect_is(subgrp.val, "subgroup_validated") @@ -72,7 +72,7 @@ test_that("test validate.subgroup for continuous outcomes with various options", invisible(capture.output(print(subgrp.val, digits = 2, sample.pct = TRUE))) - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, method = "boot") expect_is(subgrp.val, "subgroup_validated") @@ -80,19 +80,19 @@ test_that("test validate.subgroup for continuous outcomes with various options", invisible(capture.output(print(subgrp.val, digits = 2))) - expect_error(validate.subgroup(x, B = 10, + expect_error(validate.subgroup(x, B = 3, method = "training")) ## parallel - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, parallel = TRUE, method = "training") expect_is(subgrp.val, "subgroup_validated") - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, parallel = TRUE, method = "boot") @@ -169,32 +169,32 @@ test_that("test validate.subgroup for binary outcomes and various losses", { loss = "sq_loss_lasso", nfolds = 5) # option for cv.glmnet - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, benefit.score.quantiles = NULL, method = "training") - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, benefit.score.quantiles = numeric(0), method = "training") if (Sys.info()[[1]] != "windows") { - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, method = "training") - subgrp.val2 <- validate.subgroup(subgrp.model2, B = 10, + subgrp.val2 <- validate.subgroup(subgrp.model2, B = 3, method = "training") print(subgrp.val) print(subgrp.val2) - expect_error(validate.subgroup(subgrp.val, B = 10, method = "training")) + expect_error(validate.subgroup(subgrp.val, B = 3, method = "training")) - expect_error(validate.subgroup(subgrp.model, B = 10, train.fraction = -1, + expect_error(validate.subgroup(subgrp.model, B = 3, train.fraction = -1, method = "training")) - expect_error(validate.subgroup(subgrp.model, B = 10, train.fraction = 2, + expect_error(validate.subgroup(subgrp.model, B = 3, train.fraction = 2, method = "training")) expect_error(print(subgrp.val, which.quant = 99)) @@ -214,7 +214,7 @@ test_that("test validate.subgroup for binary outcomes and various losses", { nfolds = 5) # retcall must be true - expect_error(validate.subgroup(subgrp.model2, B = 10, + expect_error(validate.subgroup(subgrp.model2, B = 3, method = "training")) expect_is(subgrp.val, "subgroup_validated") @@ -222,12 +222,12 @@ test_that("test validate.subgroup for binary outcomes and various losses", { invisible(capture.output(print(subgrp.val, digits = 2))) - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, method = "train") expect_is(subgrp.val, "subgroup_validated") - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, method = "boot") expect_is(subgrp.val, "subgroup_validated") @@ -245,7 +245,7 @@ test_that("test validate.subgroup for binary outcomes and various losses", { expect_is(subgrp.model, "subgroup_fitted") - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, method = "train") expect_is(subgrp.val, "subgroup_validated") @@ -253,7 +253,7 @@ test_that("test validate.subgroup for binary outcomes and various losses", { print(subgrp.val) - subgrp.val <- validate.subgroup(subgrp.model, B = 10, + subgrp.val <- validate.subgroup(subgrp.model, B = 3, method = "boot") expect_is(subgrp.val, "subgroup_validated") @@ -329,7 +329,7 @@ test_that("test validate.subgroup for binary outcomes and various losses", { print(subgrp.model) - subgrp.val <- validate.subgroup(subgrp.model, B = 4, + subgrp.val <- validate.subgroup(subgrp.model, B = 2, method = "train") expect_is(subgrp.val, "subgroup_validated") @@ -350,7 +350,7 @@ test_that("test validate.subgroup for binary outcomes and various losses", { print(subgrp.model) - subgrp.val <- validate.subgroup(subgrp.model, B = 4, + subgrp.val <- validate.subgroup(subgrp.model, B = 2, method = "train") expect_is(subgrp.val, "subgroup_validated") diff --git a/tests/testthat/test-wksvm.R b/tests/testthat/test-wksvm.R index 19b9fee..597f6bf 100644 --- a/tests/testthat/test-wksvm.R +++ b/tests/testthat/test-wksvm.R @@ -42,45 +42,46 @@ test_that("weighted.ksvm fitting", { expect_is(wk, "wksvm") + if (Sys.info()[[1]] != "windows") + { - expect_error(weighted.ksvm(x = x[1:100,], y = y[1:100], C = c(0.1), - nfolds = 150, - weights = weights[1:100])) + expect_error(weighted.ksvm(x = x[1:100,], y = y[1:100], C = c(0.1), + nfolds = 150, + weights = weights[1:100])) - wk <- weighted.ksvm(x = x[1:100,], y = as.factor(y[1:100]), C = c(1, 3), - foldid = foldid, - weights = weights[1:100]) + wk <- weighted.ksvm(x = x[1:100,], y = as.factor(y[1:100]), C = c(1, 3), + foldid = foldid, + weights = weights[1:100]) - expect_is(wk, "wksvm") + expect_is(wk, "wksvm") - expect_error(weighted.ksvm(x = x[1:100,], y = c(1:5, y[5:100]), C = c(0.1), - weights = weights[1:100])) + expect_error(weighted.ksvm(x = x[1:100,], y = c(1:5, y[5:100]), C = c(0.1), + weights = weights[1:100])) - wk <- weighted.ksvm(x = x[1:100,], y = as.character(y[1:100]), C = c(1, 3), - foldid = foldid, - weights = weights[1:100]) + wk <- weighted.ksvm(x = x[1:100,], y = as.character(y[1:100]), C = c(1, 3), + foldid = foldid, + weights = weights[1:100]) - expect_is(wk, "wksvm") + expect_is(wk, "wksvm") - wk <- weighted.ksvm(x = x[1:100,], y = as.factor(y[1:100]), C = c(1, 3), - foldid = foldid, - weights = weights[1:100]) + wk <- weighted.ksvm(x = x[1:100,], y = as.factor(y[1:100]), C = c(1, 3), + foldid = foldid, + weights = weights[1:100]) - expect_is(wk, "wksvm") + expect_is(wk, "wksvm") - expect_warning(weighted.ksvm(x = x[1:100,], y = as.character(y[1:100]), C = c(1, 3), - nfolds = -5, - weights = weights[1:100])) + expect_warning(weighted.ksvm(x = x[1:100,], y = as.character(y[1:100]), C = c(1, 3), + nfolds = -5, + weights = weights[1:100])) + + expect_error(weighted.ksvm(x = x[1:100,], y = y[1:100]/2 + 0.5, C = c(0.1), + weights = weights[1:100])) - expect_error(weighted.ksvm(x = x[1:100,], y = y[1:100]/2 + 0.5, C = c(0.1), - weights = weights[1:100])) - if (Sys.info()[[1]] != "windows") - { wk <- weighted.ksvm(x = x[1:100,], y = as.character(y[1:100]), C = c(1, 10), foldid = foldid, kernel = "polydot",