Nothing
context("problem")
test_that("valid arguments (include_baseline = FALSE)", {
# data
data(sim_projects, sim_actions, sim_features)
p <- problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name", FALSE)
# tests
## display methods
expect_is(print(p), "NULL")
expect_is(show(p), "NULL")
expect_equal(p$repr(), "ProjectProblem object")
## getters
expect_equal(p$get_data("projects"), sim_projects)
expect_equal(p$get_data("actions"), sim_actions)
expect_equal(p$get_data("features"), sim_features)
expect_equal(p$get_data("project_name_column"), "name")
expect_equal(p$get_data("project_success_column"), "success")
expect_equal(p$get_data("action_name_column"), "name")
expect_equal(p$get_data("action_cost_column"), "cost")
expect_equal(p$get_data("feature_name_column"), "name")
expect_equal(number_of_projects(p), nrow(sim_projects))
expect_equal(number_of_actions(p), nrow(sim_actions))
expect_equal(number_of_features(p), nrow(sim_features))
expect_equal(project_names(p), sim_projects$name)
expect_equal(action_names(p), sim_actions$name)
expect_equal(feature_names(p), sim_features$name)
expect_equal(p$action_costs(), setNames(sim_actions$cost, sim_actions$name))
expect_equal(p$project_success_probabilities(),
setNames(sim_projects$success, sim_projects$name))
expect_true(all(p$pf_matrix() ==
as_Matrix(as.matrix(sim_projects[, sim_features$name]),
"dgCMatrix"),
na.rm = TRUE))
expect_equal(rownames(p$pf_matrix()), sim_projects$name)
expect_equal(colnames(p$pf_matrix()), sim_features$name)
expect_true(all(p$epf_matrix() ==
as_Matrix(
as.matrix(sim_projects[, sim_features$name]) *
matrix(p$project_success_probabilities(),
ncol = p$number_of_features(),
nrow = p$number_of_projects()),
"dgCMatrix"),
na.rm = TRUE))
expect_equal(rownames(p$epf_matrix()), sim_projects$name)
expect_equal(colnames(p$epf_matrix()), sim_features$name)
expect_true(
all(p$pa_matrix() ==
as_Matrix(as.matrix(sim_projects[, sim_actions$name]), "dgCMatrix")))
expect_equal(rownames(p$pa_matrix()), sim_projects$name)
expect_equal(colnames(p$pa_matrix()), sim_actions$name)
expect_error(p$feature_targets())
## setters
p$set_data("feature_name_column", "test")
expect_equal(p$get_data("feature_name_column"), "test")
p$set_data("feature_name_column", "name")
})
test_that("valid arguments (include_baseline = TRUE)", {
# data
data(sim_projects, sim_actions, sim_features)
p <- problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name", TRUE)
# tests
## display methods
expect_is(print(p), "NULL")
expect_is(show(p), "NULL")
expect_equal(p$repr(), "ProjectProblem object")
## getters
expect_equal(p$get_data("projects"), sim_projects)
expect_equal(p$get_data("actions"), sim_actions)
expect_equal(p$get_data("features"), sim_features)
expect_equal(p$get_data("project_name_column"), "name")
expect_equal(p$get_data("project_success_column"), "success")
expect_equal(p$get_data("action_name_column"), "name")
expect_equal(p$get_data("action_cost_column"), "cost")
expect_equal(p$get_data("feature_name_column"), "name")
expect_equal(number_of_projects(p), nrow(sim_projects))
expect_equal(number_of_actions(p), nrow(sim_actions))
expect_equal(number_of_features(p), nrow(sim_features))
expect_equal(project_names(p), sim_projects$name)
expect_equal(action_names(p), sim_actions$name)
expect_equal(feature_names(p), sim_features$name)
expect_equal(p$action_costs(), setNames(sim_actions$cost, sim_actions$name))
expect_equal(p$project_success_probabilities(),
setNames(sim_projects$success, sim_projects$name))
expect_true(all(p$pf_matrix() ==
as_Matrix(as.matrix(sim_projects[, sim_features$name]),
"dgCMatrix"),
na.rm = TRUE))
expect_equal(rownames(p$pf_matrix()), sim_projects$name)
expect_equal(colnames(p$pf_matrix()), sim_features$name)
sim_epf_matrix <-
as_Matrix(as.matrix(sim_projects[, sim_features$name]) *
matrix(p$project_success_probabilities(),
ncol = p$number_of_features(),
nrow = p$number_of_projects()),
"dgCMatrix")
for (i in seq_len(ncol(sim_epf_matrix))) {
j <- which(sim_epf_matrix[-nrow(sim_epf_matrix), i] > 1e-10)
curr_p <- sim_epf_matrix[j, i]
curr_bp <- sim_epf_matrix[nrow(sim_epf_matrix), i]
curr_p <- curr_p + ((1 - curr_p) * curr_bp)
sim_epf_matrix[j, i] <- curr_p
}
expect_true(all(p$epf_matrix() == sim_epf_matrix, na.rm = TRUE))
expect_equal(rownames(p$epf_matrix()), sim_projects$name)
expect_equal(colnames(p$epf_matrix()), sim_features$name)
expect_true(
all(p$pa_matrix() ==
as_Matrix(as.matrix(sim_projects[, sim_actions$name]), "dgCMatrix")))
expect_equal(rownames(p$pa_matrix()), sim_projects$name)
expect_equal(colnames(p$pa_matrix()), sim_actions$name)
expect_error(p$feature_targets())
## setters
p$set_data("feature_name_column", "test")
expect_equal(p$get_data("feature_name_column"), "test")
p$set_data("feature_name_column", "name")
})
test_that("invalid arguments", {
# verify that function works using built-in dataset
data(sim_projects, sim_actions, sim_features)
expect_is(problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name"),
"ProjectProblem")
# invalid names
expect_error({
data(sim_projects, sim_actions, sim_features)
problem(sim_projects, sim_actions, sim_features,
"name1", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
problem(sim_projects, sim_actions, sim_features,
"name", "success1", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name1", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost1", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name1")
})
# invalid success
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_projects$success[1] <- NA_real_
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_projects$success[1] <- -1
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_projects$success[1] <- 2
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_projects$success <- as.character(sim_projects$success)
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
# invalid costs
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_actions$cost[1] <- NA_real_
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_actions$cost[1] <- -5
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_actions$cost <- "2"
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
# invalid species probabilities
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_projects$F1[1] <- NA_real_
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_projects$F1[1] <- -1
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_projects$F1[1] <- 2
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_projects$F1 <- as.character(sim_projects$F1)
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
problem(sim_projects[, -3], sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
problem(sim_projects[, -8], sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
# feature columns
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_features$name[1] <- NA_character_
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_features$name <- 5
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_features$name <- TRUE
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_projects[nrow(sim_projects), sim_features$name[1]] <- 1e-12
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
expect_error({
data(sim_projects, sim_actions, sim_features)
sim_projects[nrow(sim_projects), sim_features$name[1]] <- NA_real_
problem(sim_projects, sim_actions, sim_features,
"name", "success", "name", "cost", "name")
})
})
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.