##----------------------------------------------------------------------------## ## TxpResult/txpCalculateScores tests ##----------------------------------------------------------------------------## ##----------------------------------------------------------------------------## ## txpCalculateScores test_that("We can create TxpResult objects through txpCalculateScores", { data(txp_example_input, package = "toxpiR") data(txp_example_model, package = "toxpiR") expect_s4_class(res <- txpCalculateScores(model = txp_example_model, input = txp_example_input, id.var = "name"), "TxpResult") inf_example <- txp_example_input inf_example["chem4", "metric1"] <- Inf expect_warning(inf_res <- txpCalculateScores(model = txp_example_model, input = inf_example, id.var = "name")) expect_s4_class(inf_res, "TxpResult") txpValueNames(txpSlices(txp_example_model)[[2]]) <- "notInput" expect_error(txpCalculateScores(model = txp_example_model, input = txp_example_input)) txp_example_input$notInput <- "hello" expect_error(txpCalculateScores(model = txp_example_model, input = txp_example_input)) }) ##----------------------------------------------------------------------------## ## Accessors test_that("TxpResult accessors return expected slots", { data(txp_example_input, package = "toxpiR") data(txp_example_model, package = "toxpiR") expect_s4_class(res <- txpCalculateScores(model = txp_example_model, input = txp_example_input, id.var = "name"), "TxpResult") expect_s4_class(txpModel(res), "TxpModel") expect_type(txpScores(res), "double") expect_type(txpIDs(res), "character") expect_equal(txpIDs(res), sprintf("chem%02d", 1:10)) expect_type(txpSliceScores(res), "double") expect_true(is.matrix(txpSliceScores(res))) expect_equal(dim(txpSliceScores(res)), c(10, 4)) expect_equal(rowSums(txpSliceScores(res, adjusted = TRUE)), txpScores(res)) expect_equal(apply(txpSliceScores(res, adjusted = FALSE), 2, max), c(s1 = 1, s2 = 1, s3 = 1, s4 = 1)) expect_equal(txpRanks(sort(res)), 1:10) expect_equal(txpRanks(sort(res, decreasing = FALSE)), 10:1) expect_s4_class(txpSlices(res), "TxpSliceList") expect_length(txpSlices(res), 4) expect_equal(round(txpScores(res), 6), c(0.863316, 0.414845, 0.347997, 0.164044, 0.425231, 0.585716, 0.000000, 0.719512, 0.771979, 0.470999)) expect_equal(txpTransFuncs(res, level = "model"), txpTransFuncs(txpModel(res))) expect_equal(txpTransFuncs(res, level = "slices"), txpTransFuncs(txpSlices(txpModel(res)))) expect_equal(txpTransFuncs(res, level = "slices", simplify = TRUE), txpTransFuncs(txpSlices(txpModel(res)), simplify = TRUE)) expect_equal(txpValueNames(res), txpValueNames(txpSlices(txpModel(res)))) expect_equal(txpValueNames(res, simplify = TRUE), txpValueNames(txpSlices(txpModel(res)), simplify = TRUE)) expect_type(txpMissing(res), "double") expect_equal(length(txpMissing(res)), length(txpSlices(res))) expect_true(all(txpMissing(res) >=0 & txpMissing(res) <=1)) expect_equal(txpMissing(res), c(s1 = 0.1,s2 =0.1,s3 =0.125,s4 =0.1)) }) ##----------------------------------------------------------------------------## ## Replacement test_that("We can replace TxpResult names/txpIDs", { expect_silent({ data(txp_example_input, package = "toxpiR") data(txp_example_model, package = "toxpiR") res <- txpCalculateScores(model = txp_example_model, input = txp_example_input, id.var = "name") oldNms <- names(res) newNms <- as.character(sprintf("new%02d", 1:10)) }) expect_named({names(res) <- newNms; res}, newNms) expect_named({txpIDs(res) <- oldNms; res}, oldNms) expect_named({txpIDs(res)[1] <- "hello"; res[1]}, "hello") expect_named({names(res)[8:9] <- newNms[8:9]; res[8:9] }, newNms[8:9]) expect_error(names(res) <- letters) }) ##----------------------------------------------------------------------------## ## Subsetting test_that("TxpResult accessors return expected slots", { expect_silent({ data(txp_example_input, package = "toxpiR") data(txp_example_model, package = "toxpiR") res <- txpCalculateScores(model = txp_example_model, input = txp_example_input, id.var = "name") }) expect_s4_class(res[1], "TxpResult") expect_length(res[1], 1) expect_named(res[1], "chem01") expect_s4_class(res[c(rep(TRUE, 4), rep(FALSE, 6))], "TxpResult") expect_length(res[c(rep(TRUE, 4), rep(FALSE, 6))], 4) expect_named(res[c(rep(TRUE, 4), rep(FALSE, 6))], sprintf("chem%02d", 1:4)) expect_s4_class(res[c("chem04", "chem08")], "TxpResult") expect_length(res[c("chem04", "chem08")], 2) expect_named(res[c("chem04", "chem08")], c("chem04", "chem08")) expect_error(res[25]) expect_warning(expect_length(res[c(TRUE, FALSE)], 5)) expect_length(res["notAName"], 0) expect_silent(names(res) <- NULL) expect_error(res["hello"]) }) ##----------------------------------------------------------------------------## ## Coercion test_that("We can coerce TxpResult to data.frame", { expect_silent({ data(txp_example_input, package = "toxpiR") data(txp_example_model, package = "toxpiR") res <- txpCalculateScores(model = txp_example_model, input = txp_example_input, id.var = "name") }) expect_s3_class(as.data.frame(res), "data.frame") expect_equal(dim(as.data.frame(res)), c(10, 7)) expect_named(as.data.frame(res), c("id", "score", "rank", sprintf("s%d", 1:4))) expect_named(as.data.frame(res, id.name = "a", score.name = "b", rank.name = "c"), c("a", "b", "c", sprintf("s%d", 1:4))) txpIDs(res) <- NULL expect_warning(woID <- as.data.frame(res)) expect_s3_class(woID, "data.frame") expect_named(woID, c("score", "rank", sprintf("s%d", 1:4))) }) ##----------------------------------------------------------------------------## ## Show test_that("TxpResult show method displays correct information", { expect_silent({ data(txp_example_input, package = "toxpiR") data(txp_example_model, package = "toxpiR") res <- txpCalculateScores(model = txp_example_model, input = txp_example_input, id.var = "name") }) expect_output(print(res), "TxpResult of length 10") expect_output(print(res), "chem01 chem02 ... chem09 chem10") }) ##----------------------------------------------------------------------------## ## Plot -- TxpResult, missing test_that("We can make and edit ToxPi diagrams", { expect_silent({ data(txp_example_input, package = "toxpiR") data(txp_example_model, package = "toxpiR") res <- txpCalculateScores(model = txp_example_model, input = txp_example_input, id.var = "name") }) expect_silent(plot(res)) expect_silent(grid.edit("pie-1", fills = NULL)) grid.edit("pie-10::slice1", gp = gpar(fill = "#7DBC3D")) expect_silent(plot(res, package = "gg")) expect_silent(plot(res, package = "gg",fills = c("red","blue","green","magenta"))) expect_silent(plot(res, package = "gg",showScore = FALSE)) expect_silent(plot(res, package = "gg",ncol = 2)) expect_silent(plot(res, package = "gg",bgcolor = "white")) expect_silent(plot(res, package = "gg",sliceBorderColor = NULL)) expect_silent(plot(res, package = "gg",sliceValueColor = "#FF00FF",)) expect_silent(plot(res, package = "gg",sliceLineColor = "#FF00FF")) expect_silent(plot(res, package = "gg",showMissing = FALSE)) expect_silent(plot(res, package = "gg",showCenter = FALSE)) }) ##----------------------------------------------------------------------------## ## Plot -- TxpResult, numeric test_that("We can make ToxPi rank plot ", { expect_silent({ data(txp_example_input, package = "toxpiR") data(txp_example_model, package = "toxpiR") res <- txpCalculateScores(model = txp_example_model, input = txp_example_input, id.var = "name") }) expect_silent(plot(res, txpRanks(res))) expect_silent(plot(res, txpRanks(res), labels = 1:10)) })