Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
#' @rdname newParams
#' @export
newLun2Params <- function(...) {
params <- new("Lun2Params")
params <- setParams(params, ...)
return(params)
}
#' @importFrom checkmate checkInt checkIntegerish checkNumber checkNumeric
#' checkLogical
setValidity("Lun2Params", function(object) {
v <- getParams(object, slotNames(object))
nCells <- v$nCells
nGenes <- v$nGenes
nPlates <- v$nPlates
checks <- c(nGenes = checkInt(v$nGenes, lower = 1),
nCells = checkInt(v$nCells, lower = 1),
seed = checkInt(v$seed, lower = 0),
nPlates = checkInt(v$nPlates, lower = 1),
plate.ingroup = checkIntegerish(v$plate.ingroup, lower = 1,
upper = nPlates, min.len = 1,
max.len = nPlates),
plate.mod = checkNumber(v$plate.mod, lower = 0),
plate.var = checkNumber(v$plate.var, lower = 0),
gene.means = checkNumeric(v$gene.means, lower = 0,
len = nGenes),
gene.disps = checkNumeric(v$gene.disps, lower = 0,
len = nGenes),
gene.ziMeans = checkNumeric(v$gene.ziMeans, lower = 0,
len = nGenes),
gene.ziDisps = checkNumeric(v$gene.ziDisps, lower = 0,
len = nGenes),
gene.ziProps = checkNumeric(v$gene.ziProps, lower = 0,
len = nGenes),
cell.plates = checkIntegerish(v$cell.plates, lower = 0,
upper = nPlates, len = nCells),
cell.libSizes = checkIntegerish(v$cell.libSizes, lower = 0,
len = nCells),
cell.libMod = checkNumber(v$cell.libMod, lower = 0),
de.nGene = checkInt(v$de.nGenes, lower = 0),
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
if (all(checks == TRUE)) {
valid <- TRUE
} else {
valid <- checks[checks != TRUE]
valid <- paste(names(valid), valid, sep = ": ")
}
return(valid)
})
#' @rdname setParam
setMethod("setParam", "Lun2Params", function(object, name, value) {
checkmate::assertString(name)
if (name == "nCells" || name == "nPlates") {
stop(name, " cannot be set directly, set cell.plates instead")
}
if (name == "cell.plates") {
old.nCells <- getParam(object, "nCells")
object <- setParamUnchecked(object, "nCells", length(value))
object <- setParamUnchecked(object, "nPlates", length(unique(value)))
if (length(value) != old.nCells) {
warning("nCells has been changed. cell.libSizes will be sampled ",
"to length nCells")
selected <- sample(1:old.nCells, length(value), replace = TRUE)
old.libSizes <- getParam(object, "cell.libSizes")
object <- setParamUnchecked(object, "cell.libSizes",
old.libSizes[selected])
}
}
if (name == "nGenes") {
old.nGenes <- getParam(object, "nGenes")
if (value != old.nGenes) {
warning("nGenes has been changed. Gene parameter vectors will be ",
"sampled to length new nGenes.")
selected <- sample(1:old.nGenes, size = value, replace = TRUE)
for (parameter in grep("gene", slotNames(object), value = TRUE)) {
old.value <- getParam(object, parameter)
object <- setParamUnchecked(object, parameter,
old.value[selected])
}
}
}
object <- callNextMethod()
return(object)
})
setMethod("show", "Lun2Params", function(object) {
pp <- list("Global:" = c("[Plates]" = "nPlates",
"[Use ZINB]" = "useZINB"),
"Plates:" = c("[Modifier]" = "plate.mod",
"(Variance)" = "plate.var"),
"Genes:" = c("(Means)" = "gene.means",
"(Dispersions)" = "gene.disps",
"(ZI Means)" = "gene.ziMeans",
"(ZI Disps)" = "gene.ziDisps",
"(ZI Props)" = "gene.ziProps"),
"Cells:" = c("[Plates]" = "cell.plates",
"(Library Sizes)" = "cell.libSizes",
"[Lib Size Mod]" = "cell.libMod"),
"Diff Expr:" = c("[Genes]" = "de.nGenes",
"[Fold change]" = "de.fc"))
callNextMethod()
showPP(object, pp)
})