/R/pivot_wider.R

https://github.com/TysonStanley/tidyfast · R · 89 lines · 52 code · 6 blank · 31 comment · 10 complexity · 9380b4f43f4203245b2506f9581e456c MD5 · raw file

  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 \code{names_from} and \code{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 (\code{name_from}), and which column (or columns) to get the cell values from (\code{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 (\code{name_from}), and which column (or columns) to get the cell values from (\code{values_from}).
  13. #'
  14. #' @return A reshaped data.table into wider format
  15. #'
  16. #' @examples
  17. #'
  18. #' library(data.table)
  19. #' example_dt <- data.table(
  20. #' z = rep(c("a", "b", "c"), 2),
  21. #' stuff = c(rep("x", 3), rep("y", 3)),
  22. #' things = 1:6
  23. #' )
  24. #'
  25. #' dt_pivot_wider(example_dt, names_from = stuff, values_from = things)
  26. #' dt_pivot_wider(example_dt, names_from = stuff, values_from = things, id_cols = z)
  27. #' @importFrom data.table dcast
  28. #' @importFrom stats as.formula
  29. #'
  30. #' @export
  31. dt_pivot_wider <- function(dt_,
  32. id_cols = NULL,
  33. names_from,
  34. names_sep = "_",
  35. values_from) {
  36. UseMethod("dt_pivot_wider", dt_)
  37. }
  38. #' @export
  39. dt_pivot_wider.default <- function(dt_,
  40. id_cols = NULL,
  41. names_from,
  42. names_sep = "_",
  43. values_from) {
  44. if (!is.data.frame(dt_)) stop("dt_ must be a data.frame or data.table")
  45. if (!is.data.table(dt_)) dt_ <- as.data.table(dt_)
  46. names_from <- column_selector(dt_, substitute(c(names_from)))
  47. values_from <- column_selector(dt_, substitute(c(values_from)))
  48. if (is.null(substitute(id_cols))) {
  49. id_cols <- colnames(dt_)[!colnames(dt_) %in% c(names_from, values_from)]
  50. } else {
  51. id_cols <- column_selector(dt_, substitute(c(id_cols)))
  52. }
  53. if (length(id_cols) == 0) {
  54. dcast_form <- as.formula(paste("...",
  55. paste(names_from, collapse = " + "),
  56. sep = " ~ "
  57. ))
  58. } else {
  59. dcast_form <- as.formula(paste(paste(id_cols, collapse = " + "),
  60. paste(names_from, collapse = " + "),
  61. sep = " ~ "
  62. ))
  63. }
  64. if (length(id_cols) == 0) {
  65. dcast.data.table(
  66. dt_,
  67. formula = dcast_form,
  68. value.var = values_from,
  69. fun.aggregate = NULL,
  70. sep = names_sep,
  71. drop = TRUE
  72. )[, . := NULL][]
  73. } else {
  74. dcast.data.table(
  75. dt_,
  76. formula = dcast_form,
  77. value.var = values_from,
  78. fun.aggregate = NULL,
  79. sep = names_sep,
  80. drop = TRUE
  81. )
  82. }
  83. }