R/dep-lazyeval.R

In hadley/tidyr: Tidy Messy Data

# nocov start

#' Deprecated SE versions of main verbs
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' tidyr used to offer twin versions of each verb suffixed with an
#' underscore. These versions had standard evaluation (SE) semantics:
#' rather than taking arguments by code, like NSE verbs, they took
#' arguments by value. Their purpose was to make it possible to
#' program with tidyr. However, tidyr now uses tidy evaluation
#' semantics. NSE verbs still capture their arguments, but you can now
#' unquote parts of these arguments. This offers full programmability
#' with NSE verbs. Thus, the underscored versions are now superfluous.
#'
#' Unquoting triggers immediate evaluation of its operand and inlines
#' the result within the captured expression. This result can be a
#' value or an expression to be evaluated later with the rest of the
#' argument. See `vignette("programming", "dplyr")` for more information.
#'
#' @param data A data frame
#' @param vars,cols,col Name of columns.
#' @name deprecated-se
#' @keywords internal
NULL

#' @rdname deprecated-se
#' @inheritParams complete
#' @export
complete_ <- function(data, cols, fill = list(), ...) {
  lifecycle::deprecate_warn("1.0.0", "complete_()", "complete()", always = TRUE)
  UseMethod("complete_")
}
#' @export
complete_.data.frame <- function(data, cols, fill = list(), ...) {
  cols <- compat_lazy_dots(cols, caller_env())
  complete(data, !!!cols, fill = fill)
}

#' @rdname deprecated-se
#' @export
drop_na_ <- function(data, vars) {
  lifecycle::deprecate_warn("1.0.0", "drop_na_()", "drop_na()", always = TRUE)
  UseMethod("drop_na_")
}
#' @export
drop_na_.data.frame <- function(data, vars) {
  drop_na(data, !!!vars)
}

#' @rdname deprecated-se
#' @export
expand_ <- function(data, dots, ...) {
  lifecycle::deprecate_warn("1.0.0", "expand_()", "expand()", always = TRUE)
  UseMethod("expand_")
}
#' @export
expand_.data.frame <- function(data, dots, ...) {
  dots <- compat_lazy_dots(dots, caller_env())
  expand(data, !!!dots)
}
#' @rdname deprecated-se
#' @param x For `nesting_` and `crossing_` a list of variables.
#' @export
crossing_ <- function(x) {
  lifecycle::deprecate_warn("1.0.0", "crossing_()", "crossing()", always = TRUE)
  x <- compat_lazy_dots(x, caller_env())
  crossing(!!!x)
}
#' @rdname deprecated-se
#' @export
nesting_ <- function(x) {
  lifecycle::deprecate_warn("1.2.0", "nesting_()", "nesting()", always = TRUE)
  x <- compat_lazy_dots(x, caller_env())
  nesting(!!!x)
}

#' @rdname deprecated-se
#' @inheritParams extract
#' @export
extract_ <- function(
  data,
  col,
  into,
  regex = "([[:alnum:]]+)",
  remove = TRUE,
  convert = FALSE,
  ...
) {
  lifecycle::deprecate_warn("1.0.0", "extract_()", "extract()", always = TRUE)
  UseMethod("extract_")
}
#' @export
extract_.data.frame <- function(
  data,
  col,
  into,
  regex = "([[:alnum:]]+)",
  remove = TRUE,
  convert = FALSE,
  ...
) {
  col <- compat_lazy(col, caller_env())
  extract(
    data,
    col = !!col,
    into = into,
    regex = regex,
    remove = remove,
    convert = convert,
    ...
  )
}

#' @rdname deprecated-se
#' @inheritParams fill
#' @param fill_cols Character vector of column names.
#' @export
fill_ <- function(data, fill_cols, .direction = c("down", "up")) {
  lifecycle::deprecate_warn("1.2.0", "fill_()", "fill()", always = TRUE)
  UseMethod("fill_")
}
#' @export
fill_.data.frame <- function(
  data,
  fill_cols,
  .direction = c("down", "up", "downup", "updown")
) {
  vars <- syms(fill_cols)
  fill(data, !!!vars, .direction = .direction)
}

#' @rdname deprecated-se
#' @inheritParams gather
#' @param key_col,value_col Strings giving names of key and value columns to
#'   create.
#' @param gather_cols Character vector giving column names to be gathered into
#'   pair of key-value columns.
#' @keywords internal
#' @export
gather_ <- function(
  data,
  key_col,
  value_col,
  gather_cols,
  na.rm = FALSE,
  convert = FALSE,
  factor_key = FALSE
) {
  lifecycle::deprecate_warn("1.2.0", "gather_()", "gather()", always = TRUE)
  UseMethod("gather_")
}
#' @export
gather_.data.frame <- function(
  data,
  key_col,
  value_col,
  gather_cols,
  na.rm = FALSE,
  convert = FALSE,
  factor_key = FALSE
) {
  key_col <- sym(key_col)
  value_col <- sym(value_col)
  gather_cols <- syms(gather_cols)

  gather(
    data,
    key = !!key_col,
    value = !!value_col,
    !!!gather_cols,
    na.rm = na.rm,
    convert = convert,
    factor_key = factor_key
  )
}

#' @rdname deprecated-se
#' @inheritParams nest
#' @keywords internal
#' @export
nest_ <- function(...) {
  lifecycle::deprecate_stop("1.0.0", "nest_()", "nest()", always = TRUE)
}

#' @rdname deprecated-se
#' @inheritParams separate_rows
#' @export
separate_rows_ <- function(
  data,
  cols,
  sep = "[^[:alnum:].]+",
  convert = FALSE
) {
  lifecycle::deprecate_warn("1.2.0", "separate_rows_()", "separate_rows()")
  UseMethod("separate_rows_")
}
#' @export
separate_rows_.data.frame <- function(
  data,
  cols,
  sep = "[^[:alnum:].]+",
  convert = FALSE
) {
  cols <- syms(cols)
  separate_rows(data, !!!cols, sep = sep, convert = convert)
}

#' @rdname deprecated-se
#' @inheritParams separate
#' @export
separate_ <- function(
  data,
  col,
  into,
  sep = "[^[:alnum:]]+",
  remove = TRUE,
  convert = FALSE,
  extra = "warn",
  fill = "warn",
  ...
) {
  lifecycle::deprecate_warn("1.2.0", "separate_()", "separate()", always = TRUE)
  UseMethod("separate_")
}
#' @export
separate_.data.frame <- function(
  data,
  col,
  into,
  sep = "[^[:alnum:]]+",
  remove = TRUE,
  convert = FALSE,
  extra = "warn",
  fill = "warn",
  ...
) {
  col <- sym(col)
  separate(
    data,
    col = !!col,
    into = into,
    sep = sep,
    remove = remove,
    convert = convert,
    extra = extra,
    fill = fill,
    ...
  )
}
#' @rdname deprecated-se
#' @inheritParams spread
#' @param key_col,value_col Strings giving names of key and value cols.
#' @export
spread_ <- function(
  data,
  key_col,
  value_col,
  fill = NA,
  convert = FALSE,
  drop = TRUE,
  sep = NULL
) {
  lifecycle::deprecate_warn("1.2.0", "spread_()", "spread()", always = TRUE)
  UseMethod("spread_")
}
#' @export
spread_.data.frame <- function(
  data,
  key_col,
  value_col,
  fill = NA,
  convert = FALSE,
  drop = TRUE,
  sep = NULL
) {
  key_col <- sym(key_col)
  value_col <- sym(value_col)

  spread(
    data,
    key = !!key_col,
    value = !!value_col,
    fill = fill,
    convert = convert,
    drop = drop,
    sep = sep
  )
}

#' @rdname deprecated-se
#' @inheritParams unite
#' @param from Names of existing columns as character vector
#' @export
unite_ <- function(data, col, from, sep = "_", remove = TRUE) {
  lifecycle::deprecate_warn("1.2.0", "unite_()", "unite()", always = TRUE)
  UseMethod("unite_")
}
#' @export
unite_.data.frame <- function(data, col, from, sep = "_", remove = TRUE) {
  col <- quo_get_expr(compat_lazy(col, caller_env()))
  from <- syms(from)
  unite(data, !!col, !!!from, sep = sep, remove = remove)
}

#' @rdname deprecated-se
#' @inheritParams unnest
#' @export
unnest_ <- function(...) {
  lifecycle::deprecate_stop("1.0.0", "unnest_()", "unnest()")
}

# nocov end