|
1
|
|
#' Pivot data from wide to long
|
|
2
|
|
#'
|
|
3
|
|
#'
|
|
4
|
|
#' \code{dt_pivot_wider()} "widens" data, increasing the number of columns and
|
|
5
|
|
#' decreasing the number of rows. The inverse transformation is
|
|
6
|
|
#' \code{dt_pivot_longer()}. Syntax based on the \code{tidyr} equivalents.
|
|
7
|
|
#'
|
|
8
|
|
#' @param dt_ The data table to pivot longer
|
|
9
|
|
#' @param cols Column selection. If empty, uses all columns. Can use -colname to unselect column(s)
|
|
10
|
|
#' @param names_to Name of the new "names" column. Must be a string.
|
|
11
|
|
#' @param values_to Name of the new "values" column. Must be a string.
|
|
12
|
|
#' @param values_drop_na If TRUE, rows will be dropped that contain NAs.
|
|
13
|
|
#' @param ... Additional arguments to pass to `melt.data.table()`
|
|
14
|
|
#'
|
|
15
|
|
#'
|
|
16
|
|
#' @examples
|
|
17
|
|
#'
|
|
18
|
|
#' library(data.table)
|
|
19
|
|
#' example_dt <- data.table(x = c(1,2,3), y = c(4,5,6), z = c("a", "b", "c"))
|
|
20
|
|
#'
|
|
21
|
|
#' dt_pivot_longer(example_dt,
|
|
22
|
|
#' cols = c(x, y),
|
|
23
|
|
#' names_to = "stuff",
|
|
24
|
|
#' values_to = "things")
|
|
25
|
|
#'
|
|
26
|
|
#' @importFrom data.table melt
|
|
27
|
|
#'
|
|
28
|
|
#' @export
|
|
29
|
|
dt_pivot_longer <- function(dt_,
|
|
30
|
|
cols = NULL,
|
|
31
|
|
names_to = "name",
|
|
32
|
|
values_to = "value",
|
|
33
|
|
values_drop_na = FALSE,
|
|
34
|
|
...){
|
|
35
|
1
|
UseMethod("dt_pivot_longer", dt_)
|
|
36
|
|
}
|
|
37
|
|
|
|
38
|
|
#' @export
|
|
39
|
|
dt_pivot_longer.default <- function(dt_,
|
|
40
|
|
cols = NULL,
|
|
41
|
|
names_to = "name",
|
|
42
|
|
values_to = "value",
|
|
43
|
|
values_drop_na = FALSE,
|
|
44
|
|
...) {
|
|
45
|
|
|
|
46
|
1
|
is.data.frame(dt_) || is.data.table(dt_) || stop("data must be a data.frame or data.table")
|
|
47
|
|
|
|
48
|
0
|
if (!is.data.table(dt_)) dt_ <- as.data.table(dt_)
|
|
49
|
|
|
|
50
|
1
|
if (missing(cols)) {
|
|
51
|
|
# All columns if cols = NULL
|
|
52
|
1
|
cols <- colnames(dt_)
|
|
53
|
|
} else {
|
|
54
|
1
|
cols <- characterize(substitute(cols))
|
|
55
|
|
}
|
|
56
|
|
|
|
57
|
1
|
names <- colnames(dt_)
|
|
58
|
|
|
|
59
|
1
|
if (cols[1] == "-") {
|
|
60
|
|
# If cols is a single "unselected" column
|
|
61
|
|
# Ex: cols = -z
|
|
62
|
1
|
drop_cols <- cols[2]
|
|
63
|
1
|
cols <- names[!names %in% drop_cols]
|
|
64
|
|
|
|
65
|
1
|
} else if (all(grepl("-", cols))) {
|
|
66
|
|
# If cols is a vector of columns to drop
|
|
67
|
|
# Ex: cols = c(-y, -z)
|
|
68
|
1
|
drop_cols <- gsub("-", "", cols)
|
|
69
|
1
|
cols <- names[!names %in% drop_cols]
|
|
70
|
1
|
if (length(cols) == 0)
|
|
71
|
1
|
warning("No columns remaining after removing", paste(drop_cols, collapse = ", "))
|
|
72
|
|
|
|
73
|
1
|
} else if (any(grepl("-", cols)) && any(!grepl("-", cols))) {
|
|
74
|
|
# Ex: cols = c(x, -z)
|
|
75
|
1
|
stop("cols must only contain columns to drop OR columns to add, not both")
|
|
76
|
|
}
|
|
77
|
|
|
|
78
|
1
|
id_vars <- names[!names %in% cols]
|
|
79
|
|
|
|
80
|
1
|
melt(data = dt_,
|
|
81
|
1
|
id.vars = id_vars,
|
|
82
|
1
|
measure.vars = cols,
|
|
83
|
1
|
variable.name = names_to,
|
|
84
|
1
|
value.name = values_to,
|
|
85
|
|
...,
|
|
86
|
1
|
na.rm = values_drop_na,
|
|
87
|
1
|
variable.factor = FALSE,
|
|
88
|
1
|
value.factor = FALSE)
|
|
89
|
|
}
|
|
90
|
|
|
|
91
|
|
|
|
92
|
|
characterize <- function(vec_list_expr) {
|
|
93
|
1
|
vle_length <- length(vec_list_expr)
|
|
94
|
1
|
if (vle_length == 1) {
|
|
95
|
1
|
as.character(vec_list_expr)
|
|
96
|
1
|
} else if (as.character(vec_list_expr)[1] == "-"){
|
|
97
|
1
|
as.character(vec_list_expr)
|
|
98
|
|
} else {
|
|
99
|
1
|
as.character(vec_list_expr)[-1]
|
|
100
|
|
}
|
|
101
|
|
}
|
TysonStanley