1
#' Pivot data from long to wide
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 widen
9
#' @param id_cols A set of columns that uniquely identifies each observation. Defaults to all columns in the data table except for the columns specified in `names_from` and `values_from`. Typically used when you have additional variables that is directly related.
10
#' @param names_from A pair of arguments describing which column (or columns) to get the name of the output column (`name_from`), and which column (or columns) to get the cell values from (`values_from`).
11
#' @param names_sep the separator between the names of the columns
12
#' @param values_from A pair of arguments describing which column (or columns) to get the name of the output column (`name_from`), and which column (or columns) to get the cell values from (`values_from`).
13
#' @param drop will cast by including all missing combinations. c(FALSE, TRUE) will only include all missing combinations of formula LHS; c(TRUE, FALSE) will only include all missing combinations of formula RHS.
14
#'
15
#' @examples
16
#'
17
#' library(data.table)
18
#' example_dt <- data.table(z = rep(c("a", "b", "c"), 2),
19
#'                          stuff = c(rep("x", 3), rep("y", 3)),
20
#'                          things = 1:6)
21
#'
22
#' dt_pivot_wider(example_dt, names_from = stuff, values_from = things)
23
#'
24
#' @importFrom data.table dcast
25
#' @importFrom stats as.formula
26
#'
27
#' @export
28
dt_pivot_wider <- function(dt_,
29
                           id_cols = NULL,
30
                           names_from,
31
                           names_sep = "_",
32
                           values_from,
33
                           drop = FALSE){
34
  UseMethod("dt_pivot_wider", dt_)
35
}
36

37
#' @export
38
dt_pivot_wider <- function(dt_,
39
                           id_cols = NULL,
40
                           names_from,
41
                           names_sep = "_",
42
                           values_from,
43
                           drop = FALSE) {
44

45 1
  is.data.frame(dt_) || is.data.table(dt_) || stop("data must be a data.frame or data.table")
46

47 1
  if (!is.data.table(dt_)) dt_ <- as.data.table(dt_)
48

49 1
  names_from <- characterize(substitute(names_from))
50 1
  values_from <- characterize(substitute(values_from))
51

52 1
  if (missing(id_cols)) {
53 1
    id_cols <- colnames(dt_)[!colnames(dt_) %in% c(names_from, values_from)]
54
  } else {
55 1
    id_cols <- characterize(substitute(id_cols))
56
  }
57

58 1
  if (length(id_cols) == 0) {
59 1
    dcast_form <- as.formula(paste("...",
60 1
                                   paste(names_from, collapse = " + "),
61 1
                                   sep = " ~ "))
62
  } else {
63 1
    dcast_form <- as.formula(paste(paste(id_cols, collapse = " + "),
64 1
                                   paste(names_from, collapse=" + "),
65 1
                                   sep=" ~ "))
66
  }
67

68 1
  if (length(id_cols) == 0) {
69 1
    dcast(dt_,
70 1
          formula = dcast_form,
71 1
          value.var = values_from,
72 1
          fun.aggregate = NULL,
73 1
          sep = names_sep,
74 1
          drop = drop)[, . := NULL][]
75
  } else {
76 1
    dcast(dt_,
77 1
          formula = dcast_form,
78 1
          value.var = values_from,
79 1
          fun.aggregate = NULL,
80 1
          sep = names_sep,
81 1
          drop = drop)
82
  }
83
}

Read our documentation on viewing source code .

Loading