R/gibble.R

In lionel-/gibble: What the Package Does (One Line, Title Case)

# gibble -------------------------------------------------------------

#' @export
new_gibble <- function(data, groups) {
  # Compute groups in dplyr format
  if (is.numeric(groups)) {
    groups_vars <- names(data)[groups]
    grouped <- dplyr::grouped_df(data, groups_vars)
  } else {
    grouped <- dplyr::grouped_df(data, groups)
  }
  dplyr_groups <- attr(grouped, "groups")

  out <- new_sticky(
    data,
    sticky = groups,
    groups = dplyr_groups,
    class = "gibble_df"
  )

  # As a workaround, insert `grouped_df` after `sticky_df` so dplyr
  # methods do not take over. That shouldn't be necessary, but we are
  # kind of merging two classes together for experimentation purposes.
  class <- class(out)
  class <- append(
    class,
    "grouped_df",
    after = match("data.frame", class) - 1L
  )
  class(out) <- class

  out
}

#' @export
print.gibble_df <- function(x, ...) {
  cat("<gibble>\n")
  groups <- names(sticky_pos(x))
  print(dplyr::grouped_df(x, groups))
}


# vctrs --------------------------------------------------------------

#' @export
vec_restore.gibble_df <- function(x, to, ...) {
  sticky <- sticky_pos(to)
  still_there <- intersect(names(sticky), names(x))

  if (length(still_there)) {
    new_gibble(x, groups = still_there)
  } else {
    vctrs::new_data_frame(x)
  }
}


# sticky -------------------------------------------------------------

#' @export
restore_sticky_names.gibble_df <- function(x, to, new) {
  groups <- names(x)[sticky_pos(to)]
  new_gibble(x, groups)
}