/
list-svd-tidiers.R
85 lines (84 loc) · 2.09 KB
/
list-svd-tidiers.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
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
#' @templateVar class svd
#' @template title_desc_tidy_list
#'
#' @inherit tidy.prcomp return details params
#' @param x A list with components `u`, `d`, `v` returned by [base::svd()].
#'
#' @examplesIf rlang::is_installed(c("modeldata", "ggplot2"))
#'
#' library(modeldata)
#' data(hpc_data)
#'
#' mat <- scale(as.matrix(hpc_data[, 2:5]))
#' s <- svd(mat)
#'
#' tidy_u <- tidy(s, matrix = "u")
#' tidy_u
#'
#' tidy_d <- tidy(s, matrix = "d")
#' tidy_d
#'
#' tidy_v <- tidy(s, matrix = "v")
#' tidy_v
#'
#' library(ggplot2)
#' library(dplyr)
#'
#' ggplot(tidy_d, aes(PC, percent)) +
#' geom_point() +
#' ylab("% of variance explained")
#'
#' tidy_u %>%
#' mutate(class = hpc_data$class[row]) %>%
#' ggplot(aes(class, value)) +
#' geom_boxplot() +
#' facet_wrap(~PC, scale = "free_y")
#'
#' @seealso [base::svd()]
#' @aliases svd_tidiers
#' @family svd tidiers
#' @family list tidiers
tidy_svd <- function(x, matrix = "u", ...) {
if (length(matrix) > 1) {
stop("Must specify a single matrix to tidy.")
}
if (matrix == "u") {
ret <- x$u %>%
as_tibble(.name_repair = "unique_quiet") %>%
tibble::rowid_to_column("row") %>%
pivot_longer(
cols = c(dplyr::everything(), -row),
names_to = "PC",
values_to = "value"
) %>%
dplyr::mutate(
PC = stringr::str_remove(PC, "...") %>%
as.numeric()
) %>%
arrange(PC, row) %>%
as.data.frame()
} else if (matrix == "d") {
ret <- tibble(PC = seq_along(x$d), std.dev = x$d) %>%
mutate(
percent = std.dev^2 / sum(std.dev^2),
cumulative = cumsum(percent)
)
} else if (matrix == "v") {
# use unique_quiet to silence test in tidy_svd
ret <- x$v %>%
as_tibble(.name_repair = "unique_quiet") %>%
tibble::rowid_to_column("column") %>%
pivot_longer(
cols = c(dplyr::everything(), -column),
names_to = "PC",
values_to = "value"
) %>%
dplyr::mutate(
PC = stringr::str_remove(PC, "...") %>%
as.numeric()
) %>%
arrange(PC, column) %>%
as.data.frame()
}
as_tibble(ret)
}