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
}

Read our documentation on viewing source code .

Loading