context("Creating simulated dataset of similar observations")
set.seed(1)
X <- as.data.frame(matrix(runif(5500), ncol = 11, nrow = 500))
count_diffs_in_rows <- function(table, row, explained_var) {
col_no <- which(colnames(row) == explained_var)
lapply(1:nrow(table), function(x) {
row_of_table <- table[x, ]
sum(row_of_table != row[, -col_no])
}) %>%
unlist() %>%
sum()
}
test_that("Any changes are made", {
expect_gt(
count_diffs_in_rows((live::sample_locally(data = X,
explained_instance = X[3, ],
explained_var = "V1",
size = 50)$data), X[3, ], "V1"), 0)
})
test_that("Not too many changes are made", {
expect_lte(
count_diffs_in_rows((live::sample_locally(data = X,
explained_instance = X[3, ],
explained_var = "V1",
size = 50)$data), X[3, ], "V1"), 50)
expect_lte(
count_diffs_in_rows((live::sample_locally(data = X,
explained_instance = X[3, ],
explained_var = "V1",
size = 100)$data), X[3, ], "V1"), 100)
expect_lte(
count_diffs_in_rows((live::sample_locally(data = X,
explained_instance = X[3, ],
explained_var = "V1",
size = 20)$data), X[3, ], "V1"), 100)
})
test_that("Other sampling methods are okay", {
expect_is(sample_locally(X, X[3, ], "V1", 50, method = "permute"), "live_explorer")
Xtmp <- X
expect_is(normal_neighbourhood(Xtmp, Xtmp[3, ], 50, NULL,
mu = rep(1, 11), Sigma = diag(1, 11)),
"data.frame")
Xtmp$cat <- sample(letters, nrow(Xtmp), replace = T)
expect_is(normal_neighbourhood(Xtmp, Xtmp[3, ], 50, NULL,
mu = rep(1, 11), Sigma = diag(1, 11)),
"data.frame")
expect_is(normal_neighbourhood(Xtmp, Xtmp[3, ], 2000, NULL,
mu = rep(1, 11), Sigma = diag(1, 11)),
"data.frame")
expect_is(sample_locally(X, X[3, ], "V1", 50, method = "normal",
NULL, mu = rep(1, 10), Sigma = diag(1, 10)),
"live_explorer")
})
test_that("Missing data are detected warning is given", {
Y <- X
Y[1, 1] <- NA
expect_warning(live:::check_for_na(Y, Y[1, ]))
expect_warning(live:::check_for_na(X, X[4, ]), regexp = NA)
})
test_that("Checks are performed, variables are set constant", {
expect_error(live:::check_conditions(X[10, FALSE], X[4, ], 50))
expect_error(live:::check_conditions(X, X[4, ], -10))
expect_error(live:::check_conditions(X[FALSE, 10, drop = F], X[4, ], 50))
expect_error(live:::check_conditions(X[, -5, drop = F], X[4, -6], 50))
expect_silent(sample_locally(X, X[4, ], "V1", 50, fixed_variables = c("V5", "V6")))
})
test_that("Predictions are added", {
local_dataset <- live::sample_locally(data = X,
explained_instance = X[3, ],
explained_var = "V1",
size = 50)
local_dataset1 <- add_predictions(local_dataset, "regr.lm", X)
expect_output(add_predictions(local_dataset, "regr.lm", X), regexp = NA)
expect_is(local_dataset1$data[[local_dataset1$target]], "numeric")
expect_is(local_dataset1$target, "character")
local_dataset2 <- add_predictions(local_dataset, lm(V1 ~., data = X))
expect_output(add_predictions(local_dataset, lm(V1 ~., data = X)), regexp = NA)
expect_is(local_dataset2$data[[local_dataset2$target]], "numeric")
expect_is(local_dataset2$target, "character")
expect_error(add_predictions(local_dataset, "regr.lm"))
})
test_that("Results are reproducible", {
expect_true(any(sample_locally(X, X[3, ], "V1", 50)$data != sample_locally(X, X[3, ], "V1", 50)$data))
expect_true(all(sample_locally(X, X[3, ], "V1", 50, seed = 17)$data == sample_locally(X, X[3, ], "V1", 50, seed = 17)$data))
expect_true(all(sample_locally(X, X[3, ], "V1", 50, method = "permute", seed = 17)$data == sample_locally(X, X[3, ], "V1", 50, method = "permute", seed = 17)$data))
expect_true(all(sample_locally(X, X[3, ], "V1", 50, method = "normal", seed = 17, mu = rep(0, 10), Sigma = diag(1, 10))$data == sample_locally(X, X[3, ], "V1", 50, method = "normal", seed = 17, mu = rep(0, 10), Sigma = diag(1, 10))$data))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.