library(testthat) # data.frame # dataframe without missing data set.seed(123) sample_Data <- round(runif(10, 1, 3), digits = 0) sample_Data <- cbind(sample_Data, round(runif(10, 1, 2), digits = 0)) sample_Data <- cbind(sample_Data, round(runif(10, 1, 5), digits = 0)) sample_Data <- cbind(sample_Data, round(runif(10, 100, 100), digits = 0)) sample_Data <- as.data.frame(sample_Data) colnames(sample_Data) <- c("Var1", "Var2", "Var3", "weights") sample_Data[,1] <- factor(sample_Data[,1], levels = 1:3, labels = LETTERS[1:3]) sample_Data[,2] <- factor(sample_Data[,2]) sample_Data[,3] <- factor(sample_Data[,3]) sample_Data[,4] <- as.numeric(sample_Data[,4]) formula <- ~Var1+Var2+Var3 w <- "weights" # bound = none test_that("data.frame, default method, bound = no", { fr <- modRisk(sample_Data, method="default", formulaM=formula, weights = w) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.553) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.705) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.1, 0.1, 0.2, 0.1, 0.1, 0.1, 0.2, 0.1, 0.5, 0.5, 1.0, 0.5, 0.5, 0.5, 1.0, 0.5, 0.4, 0.4, 0.8, 0.4, 0.4, 0.4, 0.8, 0.4))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.02, 0.01))) }) test_that("data.frame, default method, bound = no", { fr <- modRisk(sample_Data, method="CE", formulaM=formula, weights = w) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.542) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.699) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.10, 0.10, 0.20, 0.10, 0.10, 0.10, 0.21, 0.10, 0.52, 0.52, 0.95, 0.47, 0.52, 0.47, 1.03, 0.52, 0.39, 0.43, 0.85, 0.39, 0.38, 0.38, 0.76, 0.42))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.02, 0.01))) }) test_that("data.frame, default method, bound = no", { fr <- modRisk(sample_Data, method="PML", formulaM=formula, weights = w) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.553) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.705) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.1, 0.1, 0.2, 0.1, 0.1, 0.1, 0.2, 0.1, 0.5, 0.5, 1.0, 0.5, 0.5, 0.5, 1.0, 0.5, 0.4, 0.4, 0.8, 0.4, 0.4, 0.4, 0.8, 0.4))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.02, 0.01))) }) test_that("data.frame, default method, bound = no", { fr <- modRisk(sample_Data, method="weightedLLM", formulaM=formula, weights = w) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.408) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.613) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.03, 0.05, 0.01, 0.02, 0.06, 0.13, 0.63, 0.06, 0.53, 1.07, 0.01, 0.02, 1.34, 0.13, 0.65, 1.25, 0.01, 0.55, 2.68, 0.01, 0.03, 0.07, 0.02, 0.63))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.02, 0.01))) }) test_that("data.frame, default method, bound = no", { fr <- modRisk(sample_Data, method="IPF", formulaM=formula, weights = w) expect_true(round(as.numeric(unclass(fr[1])), digits=6)==0.552916) expect_true(round(as.numeric(unclass(fr[2])), digits=7)==0.7053842) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.1, 0.5, 0.4, 0.1, 0.5, 0.4, 0.1, 0.5, 0.4, 0.1, 0.5, 0.4, 0.2, 1, 0.8, 0.2, 1, 0.8, 0.1, 0.5, 0.4, 0.1, 0.5, 0.4))) }) # bound = yes test_that("data.frame, default method, bound = yes", { fr <- modRisk(sample_Data, method="default", formulaM=formula, weights = w, bound = 1.5) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.622) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.794) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.1, 0.1, 0.2, 0.1, 0.1, 0.1, 0.2, 0.1, 0.5, 0.5, 1.0, 0.5, 0.5, 0.5, 1.0, 0.5, 0.4, 0.4, 0.8, 0.4, 0.4, 0.4, 0.8, 0.4))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01))) }) test_that("data.frame, CE method, bound = yes", { fr <- modRisk(sample_Data, method="CE", formulaM=formula, weights = w, bound = 1.5) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.609) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.786) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.10, 0.10, 0.20, 0.10, 0.10, 0.10, 0.21, 0.10, 0.52, 0.52, 0.95, 0.47, 0.52, 0.47, 1.03, 0.52, 0.39, 0.43, 0.85, 0.39, 0.38, 0.38, 0.76, 0.42))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01))) }) test_that("data.frame, PML method, bound = yes", { fr <- modRisk(sample_Data, method="PML", formulaM=formula, weights = w, bound = 1.5) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.622) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.794) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.1, 0.1, 0.2, 0.1, 0.1, 0.1, 0.2, 0.1, 0.5, 0.5, 1.0, 0.5, 0.5, 0.5, 1.0, 0.5, 0.4, 0.4, 0.8, 0.4, 0.4, 0.4, 0.8, 0.4))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01))) }) test_that("data.frame, weightedLLM method, bound = yes", { fr <- modRisk(sample_Data, method="weightedLLM", formulaM=formula, weights = w, bound = 1.5) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.459) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.69) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.03, 0.05, 0.01, 0.02, 0.06, 0.13, 0.63, 0.06, 0.53, 1.07, 0.01, 0.02, 1.34, 0.13, 0.65, 1.25, 0.01, 0.55, 2.68, 0.01, 0.03, 0.07, 0.02, 0.63))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01))) }) test_that("data.frame, IPF method, bound = yes", { fr <- modRisk(sample_Data, method="IPF", formulaM=formula, weights = w, bound = 1.5) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.622) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.794) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01))) }) # with missing values set.seed(123) sample_Data <- round(runif(10, 1, 3), digits = 0) sample_Data[c(2,7,9)] <- NA sample_Data <- cbind(sample_Data, round(runif(10, 1, 2), digits = 0)) sample_Data[c(3,5,10),2] <- NA sample_Data <- cbind(sample_Data, round(runif(10, 1, 5), digits = 0)) sample_Data[c(2,8),3] <- NA sample_Data <- cbind(sample_Data, round(runif(10, 100, 100), digits = 0)) sample_Data[c(4,6,7),4] <- NA sample_Data <- as.data.frame(sample_Data) colnames(sample_Data) <- c("Var1", "Var2", "Var3", "weights") sample_Data[,1] <- factor(sample_Data[,1], levels = 1:3, labels = LETTERS[1:3]) sample_Data[,2] <- as.factor(sample_Data[,2]) sample_Data[,3] <- as.factor(sample_Data[,3]) sample_Data[,4] <- as.numeric(sample_Data[,4]) formula <- ~Var1+Var2+Var3 w <- "weights" # bound = none test_that("data.frame, default method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="default", formulaM=formula, weights = w), "glm.fit: fitted rates numerically 0 occurred") expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.582) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.771) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.00, 0.01, 0.00))) }) test_that("data.frame, PML method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="PML", formulaM=formula, weights = w), "glm.fit: fitted rates numerically 0 occurred") expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.791) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.878) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.00, 0.01, 0.00))) }) test_that("data.frame, weightedLLM method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="weightedLLM", formulaM=formula, weights = w), "glm.fit: fitted rates numerically 0 occurred") expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.528) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.736) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.5))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.00, 0.01, 0.00))) }) test_that("data.frame, IPF method, bound = no", { fr <- modRisk(sample_Data, method="IPF", formulaM=formula, weights = w) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.582) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.771) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.00, 0.01, 0.00))) expect_warning(modRisk(sample_Data, method="default", formulaM=formula, weights = w), "glm.fit: fitted rates numerically 0 occurred") }) # bound = yes test_that("data.frame, default method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="default", formulaM=formula, weights = w, bound = 1.5), "glm.fit: fitted rates numerically 0 occurred") expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.582) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.771) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.00, 0.01, 0.00))) }) test_that("data.frame, PML method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="PML", formulaM=formula, weights = w, bound = 1.5), "glm.fit: fitted rates numerically 0 occurred") expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.791) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.878) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.00, 0.01, 0.00))) }) test_that("data.frame, weightedLLM method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="weightedLLM", formulaM=formula, weights = w, bound = 1.5), "glm.fit: fitted rates numerically 0 occurred") expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.528) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.736) expect_true(all(round(as.numeric(unlist(fr[7])), digits=2)==c(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.5, 0.5))) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.00, 0.01, 0.00))) }) test_that("data.frame, IPF method, bound = no", { fr <- modRisk(sample_Data, method="IPF", formulaM=formula, weights = w, bound = 1.5) expect_true(round(as.numeric(unclass(fr[1])), digits=3)==0.582) expect_true(round(as.numeric(unclass(fr[2])), digits=3)==0.771) expect_true(all(round(as.numeric(unlist(fr[8])), digits=2)==c(0.00, 0.01, 0.00))) expect_warning(modRisk(sample_Data, method="default", formulaM=formula, weights = w), "glm.fit: fitted rates numerically 0 occurred") }) set.seed(123) sample_Data <- round(runif(10, 1, 3), digits = 0) sample_Data <- cbind(sample_Data, round(runif(10, 1, 2), digits = 0)) sample_Data <- cbind(sample_Data, round(runif(10, 1, 5), digits = 0)) sample_Data <- cbind(sample_Data, round(runif(10, 100, 100), digits = 0)) sample_Data <- as.data.frame(sample_Data) colnames(sample_Data) <- c("Var1", "Var2", "Var3", "weights") sample_Data[,1] <- factor(sample_Data[,1], levels = 1:3, labels = LETTERS[1:3]) sample_Data[,2] <- as.factor(sample_Data[,2]) sample_Data[,3] <- as.factor(sample_Data[,3]) sample_Data[,4] <- as.numeric(sample_Data[,4]) sample_Data <- createSdcObj(sample_Data, keyVars = c("Var1", "Var2", "Var3"), w = "weights") formula <- ~Var1+Var2+Var3 w <- "weights" # no missing value # bound no test_that("sdc, default method, bound = no", { fr <- modRisk(sample_Data, method="default", formulaM=formula) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.553) expect_true(round(as.numeric(unclass(fr@risk$model[2])), digits=3)==0.705) expect_true(all(round(as.numeric(unlist(fr@risk$model[7])), digits=2)==c(0.1, 0.1, 0.2, 0.1, 0.1, 0.1, 0.2, 0.1, 0.5, 0.5, 1.0, 0.5, 0.5, 0.5, 1.0, 0.5, 0.4, 0.4, 0.8, 0.4, 0.4, 0.4, 0.8, 0.4))) expect_true(all(round(as.numeric(unlist(fr@risk$model[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.02, 0.01))) }) test_that("sdc, CE method, bound = no", { fr <- modRisk(sample_Data, method="CE", formulaM=formula) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.542) expect_true(round(as.numeric(unclass(fr@risk$model[2])), digits=3)==0.699) expect_true(all(round(as.numeric(unlist(fr@risk$model[7])), digits=2)==c(0.10, 0.10, 0.20, 0.10, 0.10, 0.10, 0.21, 0.10, 0.52, 0.52, 0.95, 0.47, 0.52, 0.47, 1.03, 0.52, 0.39, 0.43, 0.85, 0.39, 0.38, 0.38, 0.76, 0.42))) expect_true(all(round(as.numeric(unlist(fr@risk$model[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.02, 0.01))) }) test_that("sdc, PML method, bound = no", { fr <- modRisk(sample_Data, method="PML", formulaM=formula) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.553) expect_true(round(as.numeric(unclass(fr@risk$model[2])), digits=3)==0.705) expect_true(all(round(as.numeric(unlist(fr@risk$model[7])), digits=2)==c(0.1, 0.1, 0.2, 0.1, 0.1, 0.1, 0.2, 0.1, 0.5, 0.5, 1.0, 0.5, 0.5, 0.5, 1.0, 0.5, 0.4, 0.4, 0.8, 0.4, 0.4, 0.4, 0.8, 0.4))) expect_true(all(round(as.numeric(unlist(fr@risk$model[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.02, 0.01))) }) test_that("sdc, weightedLLM method, bound = no", { fr <- modRisk(sample_Data, method="weightedLLM", formulaM=formula) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.408) expect_true(round(as.numeric(unclass(fr@risk$model[2])), digits=3)==0.613) expect_true(all(round(as.numeric(unlist(fr@risk$model[7])), digits=2)==c(0.03, 0.05, 0.01, 0.02, 0.06, 0.13, 0.63, 0.06, 0.53, 1.07, 0.01, 0.02, 1.34, 0.13, 0.65, 1.25, 0.01, 0.55, 2.68, 0.01, 0.03, 0.07, 0.02, 0.63))) expect_true(all(round(as.numeric(unlist(fr@risk$model[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.02, 0.01))) }) test_that("sdc, IPF method, bound = no", { fr <- modRisk(sample_Data, method="IPF", formulaM=formula) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.553) expect_true(round(as.numeric(unclass(fr@risk$model[2])), digits=3)==0.705) expect_true(all(round(as.numeric(unlist(fr@risk$model[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.02, 0.01))) }) # bound yes test_that("sdc, default method, bound = yes", { fr <- modRisk(sample_Data, method="default", formulaM=formula, bound = 1.5) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.622) expect_true(round(as.numeric(unclass(fr@risk$model[2])), digits=3)==0.794) expect_true(all(round(as.numeric(unlist(fr@risk$model[7])), digits=2)==c(0.1, 0.1, 0.2, 0.1, 0.1, 0.1, 0.2, 0.1, 0.5, 0.5, 1.0, 0.5, 0.5, 0.5, 1.0, 0.5, 0.4, 0.4, 0.8, 0.4, 0.4, 0.4, 0.8, 0.4))) expect_true(all(round(as.numeric(unlist(fr@risk$model[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01))) }) test_that("sdc, CE method, bound = yes", { fr <- modRisk(sample_Data, method="CE", formulaM=formula, bound = 1.5) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.609) expect_true(round(as.numeric(unclass(fr@risk$model[2])), digits=3)==0.786) expect_true(all(round(as.numeric(unlist(fr@risk$model[7])), digits=2)==c(0.10, 0.10, 0.20, 0.10, 0.10, 0.10, 0.21, 0.10, 0.52, 0.52, 0.95, 0.47, 0.52, 0.47, 1.03, 0.52, 0.39, 0.43, 0.85, 0.39, 0.38, 0.38, 0.76, 0.42))) expect_true(all(round(as.numeric(unlist(fr@risk$model[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01))) }) test_that("sdc, PML method, bound = yes", { fr <- modRisk(sample_Data, method="PML", formulaM=formula, bound = 1.5) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.622) expect_true(round(as.numeric(unclass(fr@risk$model[2])), digits=3)==0.794) expect_true(all(round(as.numeric(unlist(fr@risk$model[7])), digits=2)==c(0.1, 0.1, 0.2, 0.1, 0.1, 0.1, 0.2, 0.1, 0.5, 0.5, 1.0, 0.5, 0.5, 0.5, 1.0, 0.5, 0.4, 0.4, 0.8, 0.4, 0.4, 0.4, 0.8, 0.4))) expect_true(all(round(as.numeric(unlist(fr@risk$model[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01))) }) test_that("sdc, weightedLLM method, bound = yes", { fr <- modRisk(sample_Data, method="weightedLLM", formulaM=formula, bound = 1.5) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.459) expect_true(round(as.numeric(unclass(fr@risk$model[2])), digits=3)==0.690) expect_true(all(round(as.numeric(unlist(fr@risk$model[7])), digits=2)==c(0.03, 0.05, 0.01, 0.02, 0.06, 0.13, 0.63, 0.06, 0.53, 1.07, 0.01, 0.02, 1.34, 0.13, 0.65, 1.25, 0.01, 0.55, 2.68, 0.01, 0.03, 0.07, 0.02, 0.63))) expect_true(all(round(as.numeric(unlist(fr@risk$model[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01))) }) test_that("sdc, IPF method, bound = yes", { fr <- modRisk(sample_Data, method="IPF", formulaM=formula, bound = 1.5) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.622) expect_true(round(as.numeric(unclass(fr@risk$model[2])), digits=3)==0.794) expect_true(all(round(as.numeric(unlist(fr@risk$model[8])), digits=2)==c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01, 0.01))) }) # missing value set.seed(123) sample_Data <- round(runif(10, 1, 3), digits = 0) sample_Data[c(2,7,9)] <- NA sample_Data <- cbind(sample_Data, round(runif(10, 1, 2), digits = 0)) sample_Data[c(3,5,10),2] <- NA sample_Data <- cbind(sample_Data, round(runif(10, 1, 5), digits = 0)) sample_Data[c(2,8),3] <- NA sample_Data <- cbind(sample_Data, round(runif(10, 100, 100), digits = 0)) sample_Data <- as.data.frame(sample_Data) colnames(sample_Data) <- c("Var1", "Var2", "Var3", "weights") sample_Data[,1] <- factor(sample_Data[,1], levels = 1:3, labels = LETTERS[1:3]) sample_Data[,2] <- as.factor(sample_Data[,2]) sample_Data[,3] <- as.factor(sample_Data[,3]) sample_Data[,4] <- as.numeric(sample_Data[,4]) sample_Data <- createSdcObj(sample_Data, keyVars = c("Var1", "Var2", "Var3"), w = "weights") formula <- ~Var1+Var2+Var3 w <- "weights" # bound no test_that("sdc, default method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="default", formulaM=formula), "glm.fit: fitted rates numerically 0 occurred") expect_true(all(round(as.numeric(unlist(fr@risk$model[7])), digits=2)==c(0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.33, 0.67))) expect_warning(modRisk(sample_Data, method="default", formulaM=formula, weights = w), "glm.fit: fitted rates numerically 0 occurred") }) test_that("sdc, CE method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="CE", formulaM=formula), "glm.fit: fitted rates numerically 0 occurred") }) test_that("sdc, PML method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="PML", formulaM=formula), "glm.fit: fitted rates numerically 0 occurred") }) test_that("sdc, weightedLLM method, bound = no", { fr <- modRisk(sample_Data, method="weightedLLM", formulaM=formula) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.372) }) test_that("sdc, IPF method, bound = no", { fr <- modRisk(sample_Data, method="IPF", formulaM=formula) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.584) }) # bound yes test_that("sdc, default method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="default", formulaM=formula, bound = 1.5), "glm.fit: fitted rates numerically 0 occurred") expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.584) }) test_that("sdc, CE method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="CE", formulaM=formula, bound = 1.5), "glm.fit: fitted rates numerically 0 occurred") expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.573) }) test_that("sdc, PML method, bound = no", { expect_warning(fr <- modRisk(sample_Data, method="PML", formulaM=formula, bound = 1.5), "glm.fit: fitted rates numerically 0 occurred") expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.584) }) test_that("sdc, weightedLLM method, bound = no", { fr <- modRisk(sample_Data, method="weightedLLM", formulaM=formula, bound = 1.5) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.372) }) test_that("sdc, IPF method, bound = no", { fr <- modRisk(sample_Data, method="IPF", formulaM=formula, bound = 1.5) expect_true(round(as.numeric(unclass(fr@risk$model[1])), digits=3)==0.584) })