## ---- Constructor ----
test_that("ScpModel", {
x <- ScpModel()
expect_true(inherits(x, "ScpModel"))
expect_true(inherits(x@scpModelFormula, "formula"))
expect_identical(x@scpModelInputIndex, numeric())
expect_identical(x@scpModelFilterThreshold, numeric())
expect_identical(x@scpModelFitList, List())
x2 <- new("ScpModel")
x2@scpModelFitList <- List()
expect_identical(x, x2)
})
## ---- Test exported getters ----
## Internal function that creates a minimal SE object as expected by
## scplainer for unit testing ScpModel class methods
## @param nr Number of rows
## @param nc Number of columns
.createMinimalData <- function(nr = 10, nc = 5) {
require("SummarizedExperiment")
a <- matrix(1, nr, nc)
rownames(a) <- letters[1:nr]
colnames(a) <- LETTERS[1:nc]
se <- SummarizedExperiment(assays = List(assay = a))
list(se = se, a = a)
}
## Internal function that creates a mock List of ScpModelFit objects
## for unit testing ScpModel class methods
## @param model An ScpModel object
## @param features A character() with the names of the features for
## which to create mock ScpModelFit objects
.addScpModelFitList <- function(model, features) {
fitList <- as(lapply(1L:length(features), function(i) {
ScpModelFit(n = i * i, p = i)
}), "List")
names(fitList) <- features
model@scpModelFitList <- fitList
model
}
test_that("scpModelFormula", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## When no model = error
expect_error(
scpModelFormula(se),
regexp = "No 'ScpModel'"
)
## When no formula = error
model <- ScpModel()
metadata(se)[["test1"]] <- model
expect_error(
scpModelFormula(se),
regexp = "scpModelFormula.*test1.*scpModelWorkflow"
)
## Retrieve formula
model@scpModelFormula <- ~ var1 + var2
metadata(se)[["test1"]] <- model
expect_identical(
scpModelFormula(se),
~ var1 + var2
)
})
test_that("scpModelInput", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## No model = error
expect_error(
scpModelInput(se),
regexp = "No 'ScpModel'.*scpModelWorkflow"
)
## No input = error
model <- ScpModel()
metadata(se)[["test1"]] <- model
expect_error(
scpModelInput(se),
regexp = "No available scpModelInputIndex for model 'test1'.*scpModelWorkflow"
)
## Retrieve model input
l <- .createMinimalData(); se <- l$se; a <- l$a
model@scpModelInputIndex <- 1
metadata(se)[["test1"]] <- model
expect_identical(scpModelInput(se, filtered = FALSE), a)
## Test the 'filtered' argument
model <- .addScpModelFitList(model, rownames(se))
## Filter = 5 => remove half of the featutres
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(scpModelInput(se, filtered = TRUE), a[5:nrow(a), ])
## Same but with 1 row (test drop = FALSE)
model@scpModelFilterThreshold <- nrow(a)
metadata(se)[["test1"]] <- model
expect_identical(scpModelInput(se, filtered = TRUE), a[nrow(a), , drop = FALSE])
## Test when filtering is disabled
expect_identical(scpModelInput(se, filtered = FALSE), a)
})
test_that("scpModelFilterThreshold", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## No model = error
expect_error(
scpModelFilterThreshold(se),
regexp = "scpModelFilterThreshold.*test1.*scpModelWorkflow"
)
## No threshold = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelFilterThreshold(se),
regexp = "scpModelFilterThreshold.*test1.*scpModelWorkflow"
)
## Retrieve threshold
model@scpModelFilterThreshold <- 3
metadata(se)[["test1"]] <- model
expect_identical(scpModelFilterThreshold(se), 3)
})
test_that("scpModelFilterNPRatio", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## When no fit object = error
expect_error(
scpModelFilterNPRatio(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## Retrieve NP ratio
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
exp <- as.numeric(1:nrow(a))
names(exp) <- rownames(a)
## No filtering (threshold = 0), filtered = FALSE
model@scpModelFilterThreshold <- 0
metadata(se)[["test1"]] <- model
expect_identical(scpModelFilterNPRatio(se, filtered = FALSE), exp)
## No filtering (threshold = 0), filtered = TRUE
expect_identical(scpModelFilterNPRatio(se, filtered = TRUE), exp)
## With filtering, filtered = TRUE
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(scpModelFilterNPRatio(se, filtered = TRUE),
exp[5:nrow(a)])
## With filtering, filtered = FALSE
expect_identical(scpModelFilterNPRatio(se, filtered = FALSE), exp)
})
test_that("scpModelResiduals", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## no model = error
expect_error(
scpModelResiduals(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## No residuals = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelResiduals(se),
regexp = "Residuals.*test1.*scpModelWorkflow"
)
## Retrieve residuals
resids <- lapply(seq_len(nrow(se)), function(x) {
structure(rep(0, ncol(se)), .Names = colnames(se))
})
names(resids) <- rownames(se)
resids <- as(resids, "List")
model@scpModelFitList <- mendoapply(function(fl, res) {
names(res) <- colnames(se)
fl@residuals <- res
fl
}, model@scpModelFitList, resids)
## No filtering, no joining
metadata(se)[["test1"]] <- model
expect_identical(
scpModelResiduals(se, join = FALSE, filtered = FALSE),
resids
)
## No filtering, with joining
expect_identical(
scpModelResiduals(se, join = TRUE, filtered = FALSE),
BiocGenerics::do.call(rbind, resids)
)
## With filtering, no joining
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(
scpModelResiduals(se, join = FALSE, filtered = TRUE),
resids[5:nrow(se)]
)
## With filtering, with joining
expect_identical(
scpModelResiduals(se, join = TRUE, filtered = TRUE),
BiocGenerics::do.call(rbind, resids[5:nrow(se)])
)
## Test drop = FALSE
model@scpModelFilterThreshold <- 10
metadata(se)[["test1"]] <- model
exp <- t(resids[[10]])
rownames(exp) <- rownames(se)[10]
expect_identical(
scpModelResiduals(se, join = TRUE, filtered = TRUE),
exp
)
})
test_that("scpModelEffects", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## No model = error
model <- ScpModel()
metadata(se)[["test1"]] <- model
expect_error(
scpModelEffects(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## No effects in model assays = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelEffects(se),
regexp = "Effect.*test1.*scpModelWorkflow"
)
## Retrieve effects
effects <- lapply(seq_len(nrow(se)), function(i) {
out <- lapply(c("Var1", "Var2"), function(j) {
structure(rep(0, ncol(se)), .Names = colnames(se))
})
names(out) <- c("Var1", "Var2")
as(out, "List")
})
names(effects) <- rownames(se)
effects <- as(effects, "List")
model@scpModelFitList <- mendoapply(function(fl, eff) {
fl@effects <- eff
fl
}, model@scpModelFitList, effects)
## No filtering, no joining
metadata(se)[["test1"]] <- model
expect_identical(
scpModelEffects(se, join = FALSE, filtered = FALSE),
effects
)
## No filtering, with joining
model@scpModelFormula <- ~ 1 + Var1 + Var2
metadata(se)[["test1"]] <- model
eff_mat <- matrix(
0, ncol = ncol(se), nrow = nrow(se), dimnames = dimnames(se)
)
expect_identical(
scpModelEffects(se, join = TRUE, filtered = FALSE),
List(Var1 = eff_mat, Var2 = eff_mat)
)
## With filtering, no joining
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(
scpModelEffects(se, join = FALSE, filtered = TRUE),
effects[5:nrow(se)]
)
## With filtering, with joining
expect_identical(
scpModelEffects(se, join = TRUE, filtered = TRUE),
List(Var1 = eff_mat[5:nrow(se), ], Var2 = eff_mat[5:nrow(se), ])
)
## Test drop = FALSE
model@scpModelFilterThreshold <- 10
metadata(se)[["test1"]] <- model
expect_identical(
scpModelEffects(se, join = TRUE, filtered = TRUE),
List(Var1 = eff_mat[10, , drop = FALSE],
Var2 = eff_mat[10, , drop = FALSE])
)
})
test_that("scpModelNames", {
require(SummarizedExperiment)
## SE metadata is empty = error
se <- SummarizedExperiment()
expect_error(
scpModelNames(se),
regexp = "No 'ScpModel' found in object.*scpModelWorkflow"
)
## SE metadata does not contain an ScpModel = error
metadata(se)$foo <- "bar"
expect_error(
scpModelNames(se),
regexp = "No 'ScpModel' found in object.*scpModelWorkflow"
)
## SE metadata contains empty model
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["model1"]] <- model
expect_identical(scpModelNames(se), "model1")
## Additional element in SE metadata does not change output
metadata(se)[["foo"]] <- "bar"
expect_identical(scpModelNames(se), "model1")
## Works with multiple models
metadata(se)[["model2"]] <- model
expect_identical(scpModelNames(se), c("model1", "model2"))
})
## ---- Test internal getters ----
test_that("scpModel", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## There is no metadata = error
expect_error(
scpModel(se),
regexp = "No 'ScpModel' found in object"
)
## There is no ScpModel in metadata = error
metadata(se)$foo <- "bar"
expect_error(
scpModel(se),
regexp = "No 'ScpModel' found in object"
)
## Retrieving more than one model = error
model <- ScpModel()
metadata(se)[["test1"]] <- model
model@scpModelInputIndex <- 1
metadata(se)[["test2"]] <- model
expect_error(
scpModel(se, c("test1", "test2")),
regexp = "length.*1.*not TRUE"
)
## Retrieving an assay that does not exist = error
expect_error(
scpModel(se, "test3"),
regexp = "test3.*not found.*scpModelWorkflow"
)
## Retrieving an assay without a name default to first assay
expect_identical(scpModel(se), scpModel(se, "test1"))
expect_identical(scpModel(se)@scpModelInputIndex, numeric())
## Retrieving an assay with a string
expect_identical(scpModel(se, "test2")@scpModelInputIndex, 1)
})
test_that("scpModelInputIndex", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## No model = error
model <- ScpModel()
metadata(se)[["test1"]] <- model
expect_error(
scpModelEffects(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## When no input index = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelInputIndex(se),
regexp = "scpModelInputIndex.*test1.*scpModelWorkflow"
)
## Retrieve model input
model@scpModelInputIndex <- 1
metadata(se)[["test1"]] <- model
expect_identical(
scpModelInputIndex(se),
1
)
})
test_that("scpModelFitList", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## No model = error
expect_error(
scpModelFitList(se),
regexp = "ScpModel.*object.*scpModelWorkflow"
)
## When no scpModelFitList index = error
model <- ScpModel()
metadata(se)[["test1"]] <- model
expect_error(
scpModelFitList(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## Retrieve scpModelFitList
## No filtering
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
fl <- model@scpModelFitList
metadata(se)[["test1"]] <- model
expect_identical(
scpModelFitList(se, filtered = FALSE),
fl
)
## With filtering
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(
scpModelFitList(se, filtered = TRUE),
fl[(5:nrow(se))]
)
})
test_that("scpModelFitElement", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## No model = error
expect_error(
scpModelFitElement(se),
regexp = "ScpModel.*object.*scpModelWorkflow"
)
## When no scpModelFitList = error
model <- ScpModel()
metadata(se)[["test1"]] <- model
expect_error(
scpModelFitElement(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## Unknown element = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelFitElement(se, what = "foo"),
regexp = "foo.*not a slot of an ScpModelFit"
)
## Empty element = error
expect_error(
scpModelFitElement(se, what = "Residuals"),
regexp = "Residuals.*ScpModelFit.*model 'test1'[.]"
)
## Test improving error message
expect_error(
scpModelFitElement(se, what = "Residuals", helpMessage = "foo!"),
regexp = "Residuals.*ScpModelFit.*model 'test1'[.] foo!"
)
## Retrieve element
resids <- lapply(seq_len(nrow(se)), function(x) {
structure(rep(0, ncol(se)), .Names = colnames(se))
})
names(resids) <- rownames(se)
resids <- as(resids, "List")
model@scpModelFitList <- mendoapply(function(fl, res) {
names(res) <- colnames(se)
fl@residuals <- res
fl
}, model@scpModelFitList, resids)
## No filtering
metadata(se)[["test1"]] <- model
expect_identical(
scpModelFitElement(se, what = "Residuals", filtered = FALSE),
resids
)
## With filtering
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(
scpModelFitElement(se, what = "Residuals", filtered = TRUE),
resids[5:nrow(se)]
)
})
test_that("scpModelN", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## no model = error
expect_error(
scpModelN(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## note the 'n' slot can never be missing, so no error possible
## Retrieve N
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
n <- as.integer(seq_len(nrow(se))^2)
names(n) <- rownames(se)
## No filtering
expect_identical(scpModelN(se, filtered = FALSE), n)
## With filtering, no joining
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(scpModelN(se, filtered = TRUE), n[5:nrow(se)])
})
test_that("scpModelP", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## no model = error
expect_error(
scpModelP(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## note the 'n' slot can never be missing, so no error possible
## Retrieve N
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
p <- as.integer(seq_len(nrow(se)))
names(p) <- rownames(se)
## No filtering
expect_identical(scpModelP(se, filtered = FALSE), p)
## With filtering, no joining
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(scpModelP(se, filtered = TRUE), p[5:nrow(se)])
})
test_that("scpModelCoefficients", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## no model = error
expect_error(
scpModelCoefficients(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## No coefficients = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelCoefficients(se),
regexp = "Coefficients.*test1.*scpModelWorkflow"
)
## Retrieve coefficients
coefs <- lapply(seq_len(nrow(se)), function(x) {
structure(rep(0, 3), .Names = paste0("param", 1:3))
})
names(coefs) <- rownames(se)
coefs <- as(coefs, "List")
model@scpModelFitList <- mendoapply(function(fl, coef) {
fl@coefficients <- coef
fl
}, model@scpModelFitList, coefs)
## No filtering
metadata(se)[["test1"]] <- model
expect_identical(
scpModelCoefficients(se, filtered = FALSE),
coefs
)
## With filtering
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(
scpModelCoefficients(se, filtered = TRUE),
coefs[5:nrow(se)]
)
})
test_that("scpModelDf", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## no model = error
expect_error(
scpModelDf(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## No df = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelDf(se),
regexp = "Df.*test1.*scpModelWorkflow"
)
## Retrieve df
for (i in seq_len(nrow(se))) {
model@scpModelFitList[[i]]@df <- i
}
df <- structure(1:nrow(se), .Names = rownames(se))
## No filtering
metadata(se)[["test1"]] <- model
expect_identical(scpModelDf(se, filtered = FALSE), df)
## With filtering
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(scpModelDf(se, filtered = TRUE), df[5:nrow(se)])
})
test_that("scpModelVar", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## no model = error
expect_error(
scpModelVar(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## No var = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelVar(se),
regexp = "Var.*test1.*scpModelWorkflow"
)
## Retrieve var
for (i in seq_len(nrow(se))) {
model@scpModelFitList[[i]]@var <- i
}
## No filtering
metadata(se)[["test1"]] <- model
expect_identical(
scpModelVar(se, filtered = FALSE),
structure(1:nrow(se), .Names = rownames(se))
)
## With filtering
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(
scpModelVar(se, filtered = TRUE),
structure(1:nrow(se), .Names = rownames(se))[5:nrow(se)]
)
})
test_that("scpModelUvcov", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## no model = error
expect_error(
scpModelUvcov(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## No Uvcov = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelUvcov(se),
regexp = "Uvcov.*test1.*scpModelWorkflow"
)
## Retrieve Uvcov
p <- 3
uvcov <- lapply(seq_len(nrow(se)), function(x) {
matrix(0, p, p, dimnames = list(paste0("param", 1:p), paste0("param", 1:p)))
})
names(uvcov) <- rownames(se)
uvcov <- as(uvcov, "List")
model@scpModelFitList <- mendoapply(function(fl, u) {
fl@uvcov <- u
fl
}, model@scpModelFitList, uvcov)
## No filtering
metadata(se)[["test1"]] <- model
expect_identical(
scpModelUvcov(se, filtered = FALSE),
uvcov
)
## With filtering
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(
scpModelUvcov(se, filtered = TRUE),
uvcov[5:nrow(se)]
)
})
test_that("scpModelVcov", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## no model = error
expect_error(
scpModelVcov(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## No Uvcov = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelVcov(se),
regexp = "Vcov.*test1.*scpModelWorkflow"
)
## Retrieve Vcov
p <- 3
uvcov <- lapply(seq_len(nrow(se)), function(x) {
out <- matrix(0, p, p, dimnames = list(paste0("param", 1:p), paste0("param", 1:p)))
diag(out) <- 1
out
})
names(uvcov) <- rownames(se)
uvcov <- as(uvcov, "List")
var <- 2
model@scpModelFitList <- mendoapply(function(fl, u) {
fl@uvcov <- u
fl@var <- var
fl
}, model@scpModelFitList, uvcov)
## No filtering
metadata(se)[["test1"]] <- model
expect_identical(
scpModelVcov(se, filtered = FALSE),
endoapply(uvcov, function(x) x * var)
)
## With filtering
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(
scpModelVcov(se, filtered = TRUE),
endoapply(uvcov[5:10], function(x) x * var)
)
})
test_that("scpModelIntercept", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## no model = error
expect_error(
scpModelIntercept(se),
regexp = "scpModelFitList.*test1.*scpModelWorkflow"
)
## No coefficients = error
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
metadata(se)[["test1"]] <- model
expect_error(
scpModelIntercept(se),
regexp = "Coefficients.*test1.*scpModelWorkflow"
)
## Retrieve coefficients
coefs <- lapply(seq_len(nrow(se)), function(x) {
structure(c(1, 0, 0), .Names = c("(Intercept)", paste0("param", 2:3)))
})
names(coefs) <- rownames(se)
coefs <- as(coefs, "List")
model@scpModelFitList <- mendoapply(function(fl, coef) {
fl@coefficients <- coef
fl
}, model@scpModelFitList, coefs)
## No filtering
metadata(se)[["test1"]] <- model
exp <- structure(rep(1, nrow(se)), .Names = rownames(se))
expect_identical(
scpModelIntercept(se, filtered = FALSE),
exp
)
## With filtering
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(
scpModelIntercept(se, filtered = TRUE),
exp[5:nrow(se)]
)
})
test_that("scpModelFeatureNames", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
metadata(se)[["test1"]] <- model
## no model = error
expect_error(
scpModelFeatureNames(se),
regexp = "scpModelFilterThreshold.*test1.*scpModelWorkflow"
)
## Retrieve feature names
l <- .createMinimalData(); se <- l$se; a <- l$a
model <- .addScpModelFitList(model, rownames(se))
model@scpModelFilterThreshold <- 0
metadata(se)[["test1"]] <- model
expect_identical(
scpModelFeatureNames(se),
rownames(se)
)
model@scpModelFilterThreshold <- 5
metadata(se)[["test1"]] <- model
expect_identical(
scpModelFeatureNames(se),
rownames(se)[5:10]
)
})
test_that("scpModelEffectNames", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## When no model = error
expect_error(
scpModelEffectNames(se),
regexp = "No 'ScpModel'"
)
## When no formula = error
model <- ScpModel()
metadata(se)[["test1"]] <- model
expect_error(
scpModelEffectNames(se),
regexp = "scpModelFormula.*test1.*scpModelWorkflow"
)
## Retrieve effect names: one var
model@scpModelFormula <- ~ var1
metadata(se)[["test1"]] <- model
expect_identical(scpModelEffectNames(se), "var1")
## Retrieve effect names: multiple var
model@scpModelFormula <- ~ var1 + var2 + var3
metadata(se)[["test1"]] <- model
expect_identical(scpModelEffectNames(se), c("var1", "var2", "var3"))
## Retrieve effect names: no var
model@scpModelFormula <- ~ 1
metadata(se)[["test1"]] <- model
expect_identical(scpModelEffectNames(se), character())
## Retrieve effect names: interaction
model@scpModelFormula <- ~ var1 * var2
metadata(se)[["test1"]] <- model
expect_identical(scpModelEffectNames(se), c("var1", "var2", "var1:var2"))
})
## ---- Test exported setters ----
test_that("scpModelFilterThreshold<-", {
require(SummarizedExperiment)
se <- SummarizedExperiment(assays = List(a = matrix(1, 5, 5)))
model <- ScpModel()
metadata(se)[["model"]] <- model
## Value is not of class numeric = error
expect_error(
scpModelFilterThreshold(se) <- "foo",
regexp = "scpModelFilterThreshold.*numeric.*not TRUE"
)
## Value has length > 1 = error
expect_error(
scpModelFilterThreshold(se) <- 1:3,
regexp = "length.value. == 1 is not TRUE"
)
## Value is < 1 = error
expect_error(
scpModelFilterThreshold(se) <- 0,
regexp = "value >= 1 is not TRUE"
)
## Value is NULL = length 0 = error
expect_error(
scpModelFilterThreshold(se) <- NULL,
regexp = "length.value. == 1 is not TRUE"
)
## Correct case
scpModelFilterThreshold(se) <- 1
expect_identical(metadata(se)$model@scpModelFilterThreshold, 1)
})
## ---- Test internal setters ----
test_that("scpModel<-", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
model <- ScpModel()
## 'value' is not an ScpModel object
expect_error(
scpModel(se) <- matrix(),
regexp = "ScpModel.*is not TRUE"
)
## Add model
## name is not provided and there is no model to replace = error
expect_error(
scpModel(se) <- model,
regexp = "No 'ScpModel'"
)
## name is provided and model not initialised = create
scpModel(se, "test") <- model
expect_identical(
metadata(se)[["test"]],
model
)
## Replace model
## name is not provided and model initialised = replace
model2 <- model
model2@scpModelInputIndex <- 1
scpModel(se) <- model
expect_identical(
metadata(se)[["test"]],
model
)
## name is provided and model initialised = replace
model2@scpModelInputIndex <- 2
scpModel(se, "test") <- model2
expect_identical(
metadata(se)[["test"]],
model2
)
## Remove model (ie value is NULL)
## name is provided and model not initialised = nothing happens
se <- SummarizedExperiment()
se2 <- se
scpModel(se2, "test") <- NULL
expect_identical(se, se2)
## name is provided and model initialised = remove
scpModel(se2, "test") <- model ## add a model to immediately remove
scpModel(se2, "test") <- NULL
expect_identical(se, se2)
## name is not provided and model initialised = remove the default model
se <- SummarizedExperiment()
scpModel(se, "test1") <- model ## this is the default model
scpModel(se, "test2") <- model
expect_identical(
names(metadata(se)),
c("test1", "test2")
)
scpModel(se) <- NULL
expect_identical(metadata(se), list(test2 = model))
## name is not provided and model not initialised = error
se <- SummarizedExperiment()
expect_error(
scpModel(se) <- NULL,
regexp = "No 'ScpModel'"
)
})
test_that("scpModelFormula<-", {
require(SummarizedExperiment)
se <- SummarizedExperiment(assays = List(a = matrix(1, 5, 5)))
model <- ScpModel()
metadata(se)[["test"]] <- model
## Value is not of class formula = error
expect_error(
scpModelFormula(se) <- matrix(),
regexp = "formula.*not TRUE"
)
## Variable in model formula are absent from colData = error
expect_error(
scpModelFormula(se, "test") <- ~ 1 + var1,
regexp = "empty"
)
se$var1 <- 1
se$var2 <- 2
## Replace model formula for missing model = error
expect_error(
scpModelFormula(se, "missingModel") <- ~ 1 + var1,
regexp = "missingModel.*not found.*scpModelWorkflow"
)
## Variable in model is not in colData = error
expect_error(
scpModelFormula(se, "test") <- ~ 1 + var3,
regexp = "missing.*var3"
)
## The formula has no intercept = warning
expect_warning(
scpModelFormula(se, "test") <- ~ 0 + var1,
regexp = "No intercept in the formula. It is added automatically."
)
## Replace model formula for existing empty model = add
scpModelFormula(se) <- ~ 1 + var1
expect_identical(
metadata(se)[["test"]]@scpModelFormula,
~ 1 + var1
)
## Replace model formula for existing non-empty model = replace
scpModelFormula(se) <- ~ 1 + var1 + var2
expect_identical(
metadata(se)[["test"]]@scpModelFormula,
~ 1 + var1 + var2
)
## If model contains response variable = remove response + warning
expect_warning(
scpModelFormula(se) <- y + x ~ 1 + var1,
regexp = "The formula contains a response variable and is ignored"
)
expect_identical(
metadata(se)[["test"]]@scpModelFormula,
~ 1 + var1
)
## dot works
scpModelFormula(se) <- ~ 1 + .
expect_identical(
metadata(se)[["test"]]@scpModelFormula,
~ 1 + var1 + var2
)
scpModelFormula(se) <- ~ 1 + var1 + .
expect_identical(
metadata(se)[["test"]]@scpModelFormula,
~ 1 + var1 + var2
)
})
test_that("scpModelInputIndex<-", {
require(SummarizedExperiment)
se <- SummarizedExperiment(assays = list(
assay1 = matrix(1, 2, 2),
assay2 = matrix(1, 2, 2)
))
model <- ScpModel()
metadata(se)[["test"]] <- model
## Object has no dimension names = error
expect_error(
scpModelInputIndex(se) <- NA,
regexp = "!is.null.colnames.object.. is not TRUE"
)
colnames(se) <- LETTERS[1:2]
expect_error(
scpModelInputIndex(se) <- NA,
regexp = "!is.null.rownames.object.. is not TRUE"
)
rownames(se) <- letters[1:2]
## Value has wrong type = error
expect_error(
scpModelInputIndex(se) <- NA,
regexp = "must be a character, numeric or logical"
)
expect_error(
scpModelInputIndex(se) <- factor(1),
regexp = "must be a character, numeric or logical"
)
expect_error(
scpModelInputIndex(se) <- data.frame(assay = 1),
regexp = "must be a character, numeric or logical"
)
expect_error(
scpModelInputIndex(se) <- matrix(1),
regexp = "must be a character, numeric or logical"
)
## Value points to multiple assays = error
expect_error(
scpModelInputIndex(se) <- c(TRUE, TRUE),
regexp = "'i' points to multiple input assays."
)
expect_error(
scpModelInputIndex(se) <- 1:2,
regexp = "'i' points to multiple input assays."
)
expect_error(
scpModelInputIndex(se) <- c("assay1", "assay2"),
regexp = "'i' points to multiple input assays."
)
## Value points to out of bound index = error
expect_error(
scpModelInputIndex(se) <- c(FALSE, FALSE, TRUE),
regexp = "out of bounds"
)
expect_error(
scpModelInputIndex(se) <- 3,
regexp = "out of bounds"
)
expect_error(
scpModelInputIndex(se) <- "assay3",
regexp = "'assay3' not found"
)
## Replace input assay for missing model = error
expect_error(
scpModelInputIndex(se, "missingModel") <- 1,
regexp = "missingModel.*not found.*scpModelWorkflow"
)
## Replace input assay for empty model = add
scpModelInputIndex(se) <- 1
expect_identical(
metadata(se)[["test"]]@scpModelInputIndex,
1
)
## Replace input assay for non-empty model = replace
scpModelInputIndex(se) <- 2
expect_identical(
metadata(se)[["test"]]@scpModelInputIndex,
2
)
## Make sure it still works when assays in SE are not named
assays(se) <- unname(assays(se))
scpModelInputIndex(se) <- 1
expect_identical(
metadata(se)[["test"]]@scpModelInputIndex,
1
)
})
test_that("scpModelFitList<-", {
require(SummarizedExperiment)
se <- SummarizedExperiment(assays = list(
assay1 = matrix(1, 2, 2),
assay2 = matrix(1, 2, 2)
))
dimnames(se) <- list(LETTERS[1:2], letters[1:2])
model <- ScpModel()
metadata(se)[["test"]] <- model
smFit <- ScpModelFit(n = 2L, p = 1L)
## Value has wrong type = is not a List = error
expect_error(
scpModelFitList(se) <- smFit,
"inherits.value, .List.. is not TRUE"
)
expect_error(
scpModelFitList(se) <- list(smFit), ## base list does not work
"inherits.value, .List.. is not TRUE"
)
expect_error(
scpModelFitList(se) <- "smFit",
"inherits.value, .List.. is not TRUE"
)
expect_error(
scpModelFitList(se) <- 1L,
"inherits.value, .List.. is not TRUE"
)
expect_error(
scpModelFitList(se) <- matrix(),
"inherits.value, .List.. is not TRUE"
)
## Value is a List with elements that are not ScpModelFit
## objects = error
expect_error(
scpModelFitList(se) <- List(A = "foo", B = 1L),
"all.*value.*inherits.*ScpModelFit.* not TRUE"
)
expect_error(
scpModelFitList(se) <- List(A = smFit, B = 1L),
"all.*value.*inherits.*ScpModelFit.* not TRUE"
)
## Value has wrong length = error
expect_error(
scpModelFitList(se) <- List(),
"identical.rownames.object., names.value.. is not TRUE"
)
expect_error(
scpModelFitList(se) <- List(A = smFit),
"identical.rownames.object., names.value.. is not TRUE"
)
expect_error(
scpModelFitList(se) <- List(A = smFit, B = smFit, C = smFit),
"identical.rownames.object., names.value.. is not TRUE"
)
## Value has wrong names = error
expect_error(
scpModelFitList(se) <- List(A = smFit, C = smFit),
"identical.rownames.object., names.value.. is not TRUE"
)
expect_error(
scpModelFitList(se) <- List(smFit, smFit),
"identical.rownames.object., names.value.. is not TRUE"
)
## Value has correct names but wrong order = error
expect_error(
scpModelFitList(se) <- List(B = smFit, A = smFit),
"identical.rownames.object., names.value.. is not TRUE"
)
## Replace scpModelFitList for empty model = add
scpModelFitList(se) <- List(A = smFit, B = smFit)
expect_identical(
metadata(se)[["test"]]@scpModelFitList,
List(A = smFit, B = smFit)
)
## Replace input assay for non-empty model = replace
smFit2 <- ScpModelFit(n = 2L, p = 2L)
scpModelFitList(se) <- List(A = smFit, B = smFit2)
expect_identical(
metadata(se)[["test"]]@scpModelFitList,
List(A = smFit, B = smFit2)
)
})
## ---- Test internal utility functions ----
test_that(".defaultModelName", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## Error when no model
expect_error(
.defaultModelName(se),
regexp = "No 'ScpModel' found in object. Use 'scpModelWorkflow"
)
## When 1 model, return first name
metadata(se)[["test"]] <- ScpModel()
expect_identical(.defaultModelName(se), "test")
## When 2 (or more) models, return first name
metadata(se)[["test2"]] <- ScpModel()
expect_identical(.defaultModelName(se), "test")
})
test_that(".checkModelName", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## No model in object = error
expect_error(
.checkModelName(se, "foo"),
"No 'ScpModel' found in object. Use 'scpModelWorkflow"
)
metadata(se)$foo <- "bar"
metadata(se)$model1 <- ScpModel()
metadata(se)$model2 <- ScpModel()
metadata(se)$foo2 <- "bar"
## Name points to multiple models = error
expect_error(
.checkModelName(se, c("model1", "model2")),
"length.name.*1 is not TRUE"
)
## Name not in metadata = error
expect_error(
.checkModelName(se, "bar"),
"Model name 'bar' not found in object.*scpModelWorkflow"
)
## Name points to element that is not an ScpModel = error
expect_error(
.checkModelName(se, "foo"),
"Model name 'foo' not found in object.*scpModelWorkflow"
)
## Name points to a valid element
expect_identical(
.checkModelName(se, "model1"),
"model1"
)
expect_identical(
.checkModelName(se, "model2"),
"model2"
)
## No name = default model
expect_identical(
.checkModelName(se, "model1"),
"model1"
)
})
test_that(".checkModelElement", {
model <- ScpModel()
## NULL
expect_error(
.checkModelElement(NULL, "model1", "element1", "More info."),
regexp = "element1.*model1.*More info."
)
## Empty scpModelFormula = error
expect_error(
.checkModelElement(
model@scpModelFormula,
"model1", "element1", "More info."
),
regexp = "element1.*model1.*More info."
)
## Empty scpModelInputIndex = error
expect_error(
.checkModelElement(
model@scpModelInputIndex,
"model1", "element1", "More info."
),
regexp = "element1.*model1.*More info."
)
## Empty scpModelFilterThreshold = error
expect_error(
.checkModelElement(
model@scpModelFilterThreshold,
"model1", "element1", "More info."
),
regexp = "element1.*model1.*More info."
)
## Empty scpModelFitList = error
expect_error(
.checkModelElement(
model@scpModelFitList,
"model1", "element1", "More info."
),
regexp = "element1.*model1.*More info."
)
## x is an empty array = error
expect_error(
.checkModelElement(
c(),
"model1", "element1", "More info."
),
regexp = "element1.*model1.*More info."
)
## x is an empty List = error
expect_error(
.checkModelElement(
List(),
"model1", "element1", "More info."
),
regexp = "element1.*model1.*More info."
)
## x is a List or list with empty elements
expect_error(
.checkModelElement(
List(a = c(), b = c()),
"model1", "element1", "More info."
),
regexp = "element1.*model1.*More info."
)
expect_error(
.checkModelElement(
list(a = c(), b = c()),
"model1", "element1", "More info."
),
regexp = "element1.*model1.*More info."
)
## x is an non empty vector = NULL
expect_identical(
.checkModelElement(
1:10,
"model1", "element1", "More info."
),
NULL
)
## x is an non empty List or list = NULL
expect_identical(
.checkModelElement(
List(a = 1:10, b = 1:10),
"model1", "element1", "More info."
),
NULL
)
expect_identical(
.checkModelElement(
list(a = 1:10, b = 1:10),
"model1", "element1", "More info."
),
NULL
)
})
test_that(".checkScpModelFormula", {
require(SummarizedExperiment)
se <- SummarizedExperiment(assays = List(a = matrix(1, 5, 5)))
## The formula has no variables = error
expect_error(
.checkScpModelFormula(~ NULL, se),
regexp = "You provided a formula with no variable to model."
)
expect_error(
.checkScpModelFormula(~ 1, se),
regexp = "You provided a formula with no variable to model."
)
## The colData is empty = error
expect_error(
.checkScpModelFormula(~ 1 + var1, se),
regexp = "colData\\(object\\) is empty."
)
## The colData is missing 1 variable = error
se$var1 <- 1
se$var2 <- 2
expect_error(
.checkScpModelFormula(~ 1 + var1 + var2 + var3, se),
regexp = "missing one or more variables.*var3"
)
## The colData is missing 2 variables = error
expect_error(
.checkScpModelFormula(~ 1 + var1 + var2 + var3 + var4, se),
regexp = "missing one or more variables.*var3, var4"
)
## The formula has no intercept = warning
expect_warning(
.checkScpModelFormula(~ 0 + var1, se),
regexp = "No intercept in the formula. It is added automatically."
)
## The formula has a response variable = removed
expect_warning(
test <- .checkScpModelFormula(y ~ 1 + var1, se),
regexp = "contains a response"
)
expect_warning(
test <- .checkScpModelFormula(y + x ~ 1 + var1 + var2, se),
regexp = "contains a response"
)
expect_identical(test, ~ 1 + var1 + var2)
## same but without intercept
expect_warning(
test <- .checkScpModelFormula(y ~ var1, se),
regexp = "contains a response"
)
expect_identical(test, ~ 1 + var1)
## 1 variable is present in colData
expect_identical(
.checkScpModelFormula(~ 1 + var1, se),
~ 1 + var1
)
## 2 variables are present in colData
expect_identical(
.checkScpModelFormula(~ 1 + var1 + var2, se),
~ 1 + var1 + var2
)
## dot assignment works
expect_identical(
.checkScpModelFormula(~ 1 + ., se),
~ 1 + var1 + var2
)
})
test_that(".removeResponseVariables", {
## response variable = warning
## response and no explanatory variable
expect_warning(
test <- .removeResponseVariables(y ~ 1, terms(y ~ 1)),
"The formula contains a response variable and is ignored."
)
expect_identical(test, ~ 1)
## explanatory variable is retained
expect_warning(
test <- .removeResponseVariables(y ~ 1 + var1, terms(y ~ 1 + var1)),
"The formula contains a response variable and is ignored."
)
expect_identical(test, ~ 1 + var1)
## dot "." variable is retained
expect_warning(
test <- .removeResponseVariables(y ~ 1 + ., terms(y ~ 1 + ., data = list(foo = 1))),
"The formula contains a response variable and is ignored."
)
expect_identical(test, ~ 1 + .)
## There are multiple responses and explanatory variables
expect_warning(
test <- .removeResponseVariables(
y + x ~ 1 + var1 + var2, terms(y + x ~ 1 + var1 + var2)
),
regexp = "The formula contains a response variable"
)
expect_identical(test, ~ 1 + var1 + var2)
## When no response variable, input = output
expect_identical(
.removeResponseVariables(
~ 1 + var1 + var2, terms(~ 1 + var1 + var2)
),
~ 1 + var1 + var2
)
})
test_that(".checkExplanatoryVariables", {
## No model variables = error
f <- ~ NULL
expect_error(
.checkExplanatoryVariables(f, terms(f), "var1"),
regexp = "You provided a formula with no variable to model."
)
## The colData is empty = error
f <- ~ 1 + var1
expect_error(
.checkExplanatoryVariables(f, terms(f), character()),
regexp = "colData\\(object\\) is empty."
)
## The colData is missing 1 variable = error
f <- ~ 1 + var1 + var2 + var3
expect_error(
.checkExplanatoryVariables(f, terms(f), c("var1", "var2")),
regexp = "missing one or more variables.*var3"
)
## The colData is missing 2 variables = error
f <- ~ 1 + var1 + var2 + var3 + var4
expect_error(
.checkExplanatoryVariables(f, terms(f), c("var1", "var2")),
regexp = "missing one or more variables.*var3, var4.$"
)
## 1 variable is present in colData
f <- ~ 1 + var1
expect_identical(
.checkExplanatoryVariables(f, terms(f), c("var1", "var2")),
~ 1 + var1
)
## 2 variables are present in colData
f <- ~ 1 + var1 + var2
expect_identical(
.checkExplanatoryVariables(f, terms(f), c("var1", "var2")),
~ 1 + var1 + var2
)
## dot assignment works
f <- ~ 1 + .
expect_identical(
.checkExplanatoryVariables(
f, terms(f, data = list(var1 = 1, var2 = 1)),
c("var1", "var2")
),
~ 1 + var1 + var2
)
})
test_that(".replaceDotVariable", {
## No dot = no effect
expect_identical(
.replaceDotVariable(letters[1:2], c()),
letters[1:2]
)
expect_identical(
## .replaceDotVariable should not receive numeric but I here
## tested that modelVars is "untouched"
.replaceDotVariable(1:2, c()),
1:2
)
## only dot = returns available vars
expect_identical(
.replaceDotVariable(".", letters[1:3]),
letters[1:3]
)
## dot + other non overlapping vars
expect_identical(
.replaceDotVariable(c(".", letters[1]), letters[2:3]),
letters[1:3]
)
## dot + other overlapping vars
expect_identical(
.replaceDotVariable(c(".", letters[1]), letters[1:3]),
letters[1:3]
)
})
test_that(".checkInputIndex", {
## Value has wrong type = error
expect_error(
.checkInputIndex(NA, c("test1", "test2"), "mock"),
regexp = "'mock' must be a character, numeric or logical"
)
expect_error(
.checkInputIndex(factor(1), c("test1", "test2"), "mock"),
regexp = "'mock' must be a character, numeric or logical"
)
expect_error(
.checkInputIndex(data.frame(assay = 1), c("test1", "test2"), "mock"),
regexp = "'mock' must be a character, numeric or logical"
)
expect_error(
.checkInputIndex(matrix(1), c("test1", "test2"), "mock"),
regexp = "'mock' must be a character, numeric or logical"
)
## Value points to multiple assays = error
expect_error(
.checkInputIndex(c(TRUE, TRUE), c("test1", "test2"), "mock"),
regexp = "'mock' points to multiple input assays."
)
expect_error(
.checkInputIndex(1:2, c("test1", "test2"), "mock"),
regexp = "'mock' points to multiple input assays."
)
expect_error(
.checkInputIndex(c("test1", "test2"), c("test1", "test2"), "mock"),
regexp = "'mock' points to multiple input assays."
)
## Value points to out of bound index = error
expect_error(
.checkInputIndex(c(FALSE, FALSE, TRUE), c("test1", "test2"), "mock"),
regexp = "out of bounds"
)
expect_error(
.checkInputIndex(3, c("test1", "test2"), "mock"),
regexp = "out of bounds"
)
expect_error(
.checkInputIndex("test3", c("test1", "test2"), "mock"),
regexp = "'test3' not found."
)
## Valid numeric = no conversion
expect_identical(
.checkInputIndex(1, c("test1", "test2"), "mock"),
1
)
## Convert from character
expect_identical(
.checkInputIndex("test2", c("test1", "test2"), "mock"),
2L
)
## Convert from logical
expect_identical(
.checkInputIndex(c(FALSE, TRUE), c("test1", "test2"), "mock"),
2L
)
})
test_that(".joinScpModelOutput", {
require(SummarizedExperiment)
se <- SummarizedExperiment()
## x is empty = error
expect_error(
.joinScpModelOutput(c(), se),
"length.names.x.*not TRUE"
)
## Complete case
se <- SummarizedExperiment(assays = matrix(1, 2, 2))
colnames(se) <- letters[1:2]
x <- list(A = c(a = 1L, b = 3L), B = c(a = 2L, b = 4L))
expect_identical(
.joinScpModelOutput(x, se),
matrix(1:4, 2, 2, dimnames = list(LETTERS[1:2], letters[1:2]))
)
## With NA case
x <- list(A = c(a = 1, b = NA), B = c(a = NA, b = 4))
expect_identical(
.joinScpModelOutput(x, se),
matrix(c(1, NA, NA, 4), 2, 2, dimnames = list(LETTERS[1:2], letters[1:2]))
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.