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") }) })