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
45
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
|
#' @export
bsfold <- function(object) object@fold
#' @export
bsdeferred <- function(object) object@deferred
bsargs <- function(object) object@args
#' @importFrom S4Vectors setValidity2
setValidity2("BiocSingularParam", function(object) {
msg <- character(0)
if (length(bsfold(object))!=1L) {
msg <- c(msg, "'fold' should be a numeric scalar")
}
if (bsfold(object) < 1) {
msg <- c(msg, "'fold' should be no less than 1")
}
if (length(bsdeferred(object))!=1L) {
msg <- c(msg, "'deferred' should be a numeric scalar")
}
if (length(msg)) {
return(msg)
}
return(TRUE)
})
#' @export
#' @importFrom methods show
setMethod("show", "BiocSingularParam", function(object) {
cat(sprintf("class: %s\n", class(object)))
cat(sprintf("cross-product fold-threshold: %.2f\n", bsfold(object)))
cat(sprintf("deferred centering/scaling: %s\n", ifelse(bsdeferred(object), "on", "off")))
})
#' @export
#' @importFrom methods new
ExactParam <- function(deferred=FALSE, fold=Inf) {
new("ExactParam", deferred=as.logical(deferred), fold=as.numeric(fold))
}
#' @export
#' @importFrom methods new
IrlbaParam <- function(deferred=FALSE, fold=Inf, extra.work=7, ...) {
new("IrlbaParam", deferred=as.logical(deferred), fold=as.numeric(fold), extra.work=as.integer(extra.work), args=list(...))
}
ip_extra <- function(object) object@extra.work
setValidity("IrlbaParam", function(object) {
msg <- character(0)
if (ip_extra(object) < 0L) {
msg <- c(msg, "'extra.work' should be non-negative")
}
if (length(msg)) {
return(msg)
}
return(TRUE)
})
#' @export
#' @importFrom methods show
setMethod("show", "IrlbaParam", function(object) {
callNextMethod()
cat(sprintf("extra workspace: %i\n", ip_extra(object)))
extra.names <- names(bsargs(object))
if (length(extra.names) > 3) extra.names <- c(extra.names[seq_len(3)], "...")
cat(sprintf("additional arguments(%i): %s\n", length(bsargs(object)), paste(extra.names, collapse=", ")))
})
#' @export
#' @importFrom methods new
RandomParam <- function(deferred=FALSE, fold=Inf, ...) {
new("RandomParam", deferred=as.logical(deferred), fold=as.numeric(fold), args=list(...))
}
#' @export
#' @importFrom methods show
setMethod("show", "RandomParam", function(object) {
callNextMethod()
extra.names <- names(bsargs(object))
if (length(extra.names) > 3) extra.names <- c(extra.names[seq_len(3)], "...")
cat(sprintf("additional arguments(%i): %s\n", length(bsargs(object)), paste(extra.names, collapse=", ")))
})
#' @export
#' @importFrom methods new
FastAutoParam <- function(deferred=FALSE, fold=Inf) {
new("FastAutoParam", deferred=as.logical(deferred), fold=as.numeric(fold))
}
|
