-
Notifications
You must be signed in to change notification settings - Fork 2
/
model_RGCCA.R
57 lines (52 loc) · 1.82 KB
/
model_RGCCA.R
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
#' Prepare metadata data for RGCCA.
#'
#' Prepares factors into their vectors. Each level of a factor is converted
#' to a column, numeric columns are left as is.
#' @param data A data.frame with the information about the samples
#' @param columns The name of the columns to be used to build the matrix
#' @param intercept A logical value if you want one column with all 1 or not.
#' @return A matrix with each factor is decomposed in as much columns as
#' factors has minus 1 and with the numeric values as they were.
#' @export
#' @seealso [fastDummies::dummy_cols()]
#' @examples
#' block <- model_RGCCA(iris, c("Petal.Width", "Species"))
model_RGCCA <- function(data, columns, intercept = FALSE){
m <- data[, columns, drop = FALSE]
num <- vapply(m, is.numeric, logical(1L))
if (any(!num)) { # For categorical data
if (sum(!num) > 1) { # When multiple columns are present
o <- sapply(m[, !num, drop = FALSE], function(x){
levels <- unique(x)
levels <- levels[!is.na(levels)]
o <- vapply(levels, function(level) {
as.numeric(x %in% level)
}, numeric(nrow(data)))
colnames(o) <- levels
o[, -1, drop = FALSE]
})
o <- do.call(cbind, o)
} else { # Just one categorical column (we must not drop the dimensions)
levels <- unique(m[, !num])
levels <- levels[!is.na(levels)]
o <- vapply(levels, function(level) {
as.numeric(m[, !num] %in% level)
}, numeric(nrow(data)))
colnames(o) <- levels
o <- o[, -1, drop = FALSE]
}
}
if (any(!num) & any(num)) {
out <- cbind(o, m[, num, drop = FALSE])
} else if (any(!num)) {
out <- o
} else {
out <- m[, num, drop = FALSE]
}
colnames(out)[colnames(out) == ""] <- seq_len(sum(colnames(out) == ""))
if (intercept) {
cbind(1, out)
} else {
out
}
}