R/data-edit.R

In R4VN: Health Data Analysis and Publication-Ready Reporting

# ============================================================================
# R4VN variable inspection and data-editing commands
# ============================================================================

# ----------------------------------------------------------------------------
# Consolidated from: dataedit-utils.R
# ----------------------------------------------------------------------------
# Internal utilities for R4VN data-editing functions.
# Not exported.

.r4vn_scalar <- function(x) {
  if (length(x) != 1L) stop("A single value was expected.", call. = FALSE)
  if (is.factor(x)) x <- as.character(x)
  if (is.logical(x)) return(as.integer(x))
  x
}

.r4vn_code <- function(x) {
  if (length(x) != 1L) stop("A code must contain one value.", call. = FALSE)
  if (is.na(x)) return(NA_character_)
  if (is.numeric(x) && is.finite(x) && x == trunc(x)) return(format(x, scientific = FALSE, trim = TRUE, nsmall = 0L))
  as.character(x)
}

.r4vn_glob_parts <- function(pattern) {
  loc <- gregexpr("*", pattern, fixed = TRUE)[[1L]]
  if (identical(loc, -1L)) return(list(has = FALSE, prefix = pattern, suffix = ""))
  if (length(loc) > 1L) stop("Only one `*` wildcard is supported in each pattern.", call. = FALSE)
  p <- loc[1L]
  list(
    has = TRUE,
    prefix = if (p > 1L) substr(pattern, 1L, p - 1L) else "",
    suffix = if (p < nchar(pattern)) substr(pattern, p + 1L, nchar(pattern)) else ""
  )
}

.r4vn_glob_regex <- function(pattern, capture = FALSE) {
  parts <- .r4vn_glob_parts(pattern)
  esc <- function(z) gsub("([][{}()+?.^$|\\\\])", "\\\\\\1", z, perl = TRUE)
  if (!parts$has) return(paste0("^", esc(pattern), "$"))
  paste0("^", esc(parts$prefix), if (capture) "(.*)" else ".*", esc(parts$suffix), "$")
}

.r4vn_literal_names <- function(expr) {
  if (is.symbol(expr)) return(as.character(expr))
  if (is.character(expr)) {
    z <- trimws(unlist(strsplit(expr, "[,[:space:]]+", perl = TRUE), use.names = FALSE))
    return(z[nzchar(z)])
  }
  if (is.call(expr) && as.character(expr[[1L]]) %in% c("vars", "c")) {
    args <- as.list(expr)[-1L]
    return(unlist(lapply(args, .r4vn_literal_names), use.names = FALSE))
  }
  stop("Use bare variable names, `vars(x, y, ...)`, quoted names, or a quoted wildcard pattern.", call. = FALSE)
}

.r4vn_selector <- function(expr, data_names) {
  if (is.call(expr) && identical(as.character(expr[[1L]]), ":")) {
    ends <- as.list(expr)[-1L]
    if (length(ends) != 2L) stop("Invalid variable range.", call. = FALSE)
    a <- .r4vn_literal_names(ends[[1L]])
    b <- .r4vn_literal_names(ends[[2L]])
    if (length(a) != 1L || length(b) != 1L || !a %in% data_names || !b %in% data_names) {
      stop("Both ends of a variable range must exist.", call. = FALSE)
    }
    ia <- match(a, data_names)
    ib <- match(b, data_names)
    return(data_names[seq.int(ia, ib)])
  }

  tokens <- .r4vn_literal_names(expr)
  out <- character()
  for (token in tokens) {
    if (grepl("*", token, fixed = TRUE)) {
      hit <- grep(.r4vn_glob_regex(token), data_names, value = TRUE)
      if (!length(hit)) stop("No variables matched `", token, "`.", call. = FALSE)
      out <- c(out, hit)
    } else {
      if (!token %in% data_names) stop("Variable `", token, "` was not found.", call. = FALSE)
      out <- c(out, token)
    }
  }
  unique(out)
}

.r4vn_select_dots <- function(exprs, data_names) {
  if (!length(exprs)) return(character())
  unique(unlist(lapply(exprs, .r4vn_selector, data_names = data_names), use.names = FALSE))
}

.r4vn_eval <- function(expr, data, env) {
  mask <- list2env(as.list(data), parent = env)
  assign("missing", function(x) is.na(x), envir = mask)
  eval(expr, envir = mask, enclos = env)
}

.r4vn_labels <- function(label, variables) {
  n <- length(variables)
  if (is.null(label)) return(rep(list(NULL), n))
  if (!is.character(label)) stop("`label` must be a character value or character vector.", call. = FALSE)

  if (!is.null(names(label)) && any(nzchar(names(label)))) {
    missing_names <- setdiff(variables, names(label))
    if (length(missing_names)) {
      stop("Named `label` is missing: ", paste(missing_names, collapse = ", "), ".", call. = FALSE)
    }
    return(as.list(unname(label[variables])))
  }

  if (length(label) == 1L) return(rep(as.list(label), n))
  if (length(label) != n) stop("`label` must have length 1 or match the number of variables.", call. = FALSE)
  as.list(label)
}

.r4vn_values_map <- function(values) {
  if (is.null(values)) return(NULL)
  if (!is.atomic(values) || is.null(names(values)) || any(!nzchar(names(values)))) {
    stop("`values` must be a named vector, for example c(\"0\" = \"No\", \"1\" = \"Yes\").", call. = FALSE)
  }
  map <- as.character(values)
  names(map) <- names(values)
  if (anyDuplicated(names(map))) stop("Each value code may appear only once in `values`.", call. = FALSE)
  if (anyDuplicated(unname(map))) stop("Each displayed value label must be unique.", call. = FALSE)
  map
}

.r4vn_recode_rules <- function(recode) {
  if (is.null(recode)) return(NULL)
  if (!is.atomic(recode) || is.null(names(recode)) || any(!nzchar(names(recode)))) {
    stop("`recode` must be a named vector, for example c(\"min:12\" = 1, \"13:17\" = 2, \"18:max\" = 3).", call. = FALSE)
  }
  lapply(seq_along(recode), function(i) list(from = names(recode)[i], to = recode[[i]]))
}

.r4vn_raw_codes <- function(x) {
  if (is.logical(x)) return(as.integer(x))
  map <- attr(x, "r4vn_values", exact = TRUE)
  if (is.factor(x) && !is.null(map)) {
    inv <- setNames(names(map), unname(map))
    shown <- as.character(x)
    ans <- unname(inv[shown])
    miss <- is.na(ans) & !is.na(shown)
    ans[miss] <- shown[miss]
    return(ans)
  }
  if (is.factor(x)) return(as.character(x))
  x
}

.r4vn_source_condition <- function(x, source) {
  source <- trimws(source)

  if (tolower(source) %in% c(".", "missing", "na")) return(is.na(x))

  if (grepl(":", source, fixed = TRUE)) {
    bits <- trimws(strsplit(source, ":", fixed = TRUE)[[1L]])
    if (length(bits) != 2L) stop("Invalid recode range `", source, "`.", call. = FALSE)

    xn <- suppressWarnings(as.numeric(as.character(x)))
    if (any(!is.na(x) & is.na(xn))) stop("Range recoding can only be used with numeric values.", call. = FALSE)

    lower <- if (tolower(bits[1L]) == "min") -Inf else suppressWarnings(as.numeric(bits[1L]))
    upper <- if (tolower(bits[2L]) == "max") Inf else suppressWarnings(as.numeric(bits[2L]))
    if (is.na(lower) || is.na(upper)) stop("Invalid numeric range `", source, "`.", call. = FALSE)

    return(!is.na(xn) & xn >= lower & xn <= upper)
  }

  bits <- trimws(unlist(strsplit(source, "[,[:space:]]+", perl = TRUE), use.names = FALSE))
  bits <- bits[nzchar(bits)]
  numeric_bits <- suppressWarnings(as.numeric(bits))

  if (length(bits) && all(!is.na(numeric_bits))) {
    xn <- suppressWarnings(as.numeric(as.character(x)))
    return(!is.na(xn) & xn %in% numeric_bits)
  }

  !is.na(x) & as.character(x) %in% bits
}

.r4vn_recode <- function(x, recode) {
  rules <- .r4vn_recode_rules(recode)
  if (is.null(rules)) return(x)

  raw <- .r4vn_raw_codes(x)
  targets <- lapply(rules, `[[`, "to")
  raw_numeric <- is.numeric(raw) || all(is.na(raw) | !is.na(suppressWarnings(as.numeric(as.character(raw)))))
  target_numeric <- all(vapply(targets, function(z) is.na(z) || is.numeric(z) || is.logical(z), logical(1)))

  if (raw_numeric && target_numeric) out <- suppressWarnings(as.numeric(raw)) else out <- as.character(raw)

  matched <- rep(FALSE, length(raw))
  for (rule in rules) {
    take <- .r4vn_source_condition(raw, rule$from)
    take[is.na(take)] <- FALSE
    take <- take & !matched
    if (any(take)) {
      value <- rule$to
      if (is.logical(value)) value <- as.integer(value)
      out[take] <- value
      matched[take] <- TRUE
    }
  }
  out
}

.r4vn_set_reference <- function(x, ref) {
  if (is.null(ref)) return(x)
  if (!is.factor(x)) stop("`ref` can only be used when the variable is a factor.", call. = FALSE)

  ref_code <- .r4vn_code(.r4vn_scalar(ref))
  map <- attr(x, "r4vn_values", exact = TRUE)
  ref_label <- ref_code
  if (!is.null(map) && !is.na(ref_code) && ref_code %in% names(map)) ref_label <- unname(map[ref_code])

  if (!ref_label %in% levels(x)) stop("Reference category `", ref_label, "` was not found.", call. = FALSE)

  old_label <- attr(x, "label", exact = TRUE)
  old_map <- attr(x, "r4vn_values", exact = TRUE)
  out <- factor(as.character(x), levels = c(ref_label, setdiff(levels(x), ref_label)), ordered = is.ordered(x))
  if (!is.null(old_label)) attr(out, "label") <- old_label
  if (!is.null(old_map)) attr(out, "r4vn_values") <- old_map
  out
}

.r4vn_apply_lab <- function(x, label = NULL, values = NULL, recode = NULL, ref = NULL, ordered = FALSE) {
  old_label <- attr(x, "label", exact = TRUE)
  old_map <- attr(x, "r4vn_values", exact = TRUE)

  if (!is.null(recode)) x <- .r4vn_recode(x, recode)
  if (is.logical(x)) x <- as.integer(x)

  map <- .r4vn_values_map(values)

  if (!is.null(map)) {
    raw <- as.character(.r4vn_raw_codes(x))
    extra <- unique(raw[!is.na(raw) & !raw %in% names(map)])
    levels_code <- c(names(map), extra)
    levels_label <- c(unname(map), extra)

    x <- factor(raw, levels = levels_code, labels = levels_label, ordered = isTRUE(ordered))
    attr(x, "r4vn_values") <- map
  } else if (isTRUE(ordered)) {
    if (!is.factor(x)) stop("`ordered = TRUE` requires `values` or an existing factor.", call. = FALSE)
    x <- ordered(x, levels = levels(x))
    if (!is.null(old_map) && is.null(recode)) attr(x, "r4vn_values") <- old_map
  } else if (!is.null(old_map) && is.null(recode)) {
    attr(x, "r4vn_values") <- old_map
  }

  final_label <- if (!is.null(label)) as.character(label)[1L] else old_label
  if (!is.null(final_label) && nzchar(final_label)) attr(x, "label") <- final_label

  .r4vn_set_reference(x, ref)
}

.r4vn_is_dot <- function(expr) is.symbol(expr) && identical(as.character(expr), ".")

.r4vn_eval_value <- function(expr, data, env) {
  if (.r4vn_is_dot(expr)) return(NA)
  value <- .r4vn_eval(expr, data, env)
  if (is.logical(value)) value <- as.integer(value)
  value
}

.r4vn_condition_exprs <- function(expr) {
  if (is.call(expr) && identical(as.character(expr[[1L]]), "condition")) return(as.list(expr)[-1L])
  list(expr)
}

.r4vn_value_exprs <- function(expr, number_conditions) {
  if (number_conditions > 1L) {
    if (!is.call(expr) || !identical(as.character(expr[[1L]]), "c")) {
      stop("For several conditions, supply parallel values with `c(...)`.", call. = FALSE)
    }
    return(as.list(expr)[-1L])
  }
  list(expr)
}

.r4vn_replace_factor <- function(x, index, value) {
  old_label <- attr(x, "label", exact = TRUE)
  old_map <- attr(x, "r4vn_values", exact = TRUE)
  shown <- as.character(x)

  if (length(value) == length(x)) value <- value[index]
  if (length(value) != 1L && length(value) != sum(index)) {
    stop("Replacement values must have length 1, the number of selected observations, or the number of rows.", call. = FALSE)
  }

  if (!is.null(old_map)) {
    key <- as.character(value)
    mapped <- unname(old_map[key])
    use <- !is.na(mapped)
    value[use] <- mapped[use]
  }

  shown[index] <- as.character(value)
  levels_new <- unique(c(levels(x), shown[!is.na(shown)]))
  out <- factor(shown, levels = levels_new, ordered = is.ordered(x))
  if (!is.null(old_label)) attr(out, "label") <- old_label
  if (!is.null(old_map)) attr(out, "r4vn_values") <- old_map
  out
}

.r4vn_rows <- function(expr, data, env, action = c("keep", "drop")) {
  action <- match.arg(action)
  rows <- .r4vn_eval(expr, data, env)

  if (is.logical(rows)) {
    if (length(rows) == 1L) rows <- rep(rows, nrow(data))
    if (length(rows) != nrow(data)) stop("`obs` must return one logical value per observation.", call. = FALSE)
    rows[is.na(rows)] <- FALSE
    return(if (action == "keep") rows else !rows)
  }

  if (is.numeric(rows)) {
    if (any(is.na(rows)) || any(rows < 1 | rows > nrow(data))) stop("Numeric observation indices are out of range.", call. = FALSE)
    selected <- rep(FALSE, nrow(data))
    selected[as.integer(rows)] <- TRUE
    return(if (action == "keep") selected else !selected)
  }

  stop("`obs` must be a logical condition or numeric observation indices.", call. = FALSE)
}

.r4vn_html <- function(x) {
  x <- as.character(x)
  x <- gsub("&", "&amp;", x, fixed = TRUE)
  x <- gsub("<", "&lt;", x, fixed = TRUE)
  x <- gsub(">", "&gt;", x, fixed = TRUE)
  x <- gsub('"', "&quot;", x, fixed = TRUE)
  x
}

.r4vn_var_type <- function(x) {
  if (is.ordered(x)) "ordered factor"
  else if (is.factor(x)) "factor"
  else if (inherits(x, "Date")) "Date"
  else if (inherits(x, "POSIXt")) "date-time"
  else typeof(x)
}

.r4vn_value_text <- function(x) {
  map <- attr(x, "r4vn_values", exact = TRUE)
  if (!is.null(map)) return(paste0(names(map), "=", unname(map), collapse = "; "))
  if (is.factor(x)) return(paste(levels(x), collapse = "; "))
  ""
}

.r4vn_summary_text <- function(x) {
  if (is.numeric(x)) {
    z <- x[!is.na(x)]
    if (!length(z)) return("")
    q <- stats::quantile(z, c(.25, .5, .75), names = FALSE, type = 2)
    s <- stats::sd(z)
    return(paste0(
      "Mean=", format(round(mean(z), 2), trim = TRUE),
      "; SD=", if (is.na(s)) "" else format(round(s, 2), trim = TRUE),
      "; Median=", format(round(q[2L], 2), trim = TRUE),
      "; Q1-Q3=", format(round(q[1L], 2), trim = TRUE), "-", format(round(q[3L], 2), trim = TRUE),
      "; Min-Max=", format(round(min(z), 2), trim = TRUE), "-", format(round(max(z), 2), trim = TRUE)
    ))
  }

  tab <- sort(table(x, useNA = "no"), decreasing = TRUE)
  if (!length(tab)) return("")
  tab <- head(tab, 10L)
  paste0(names(tab), "=", as.integer(tab), collapse = "; ")
}

# ----------------------------------------------------------------------------
# Consolidated from: dict.R
# ----------------------------------------------------------------------------
#' Create an HTML data dictionary
#'
#' Creates a dictionary from an explicit data frame or active R4VN data.
#'
#' @param ... Optional variable selectors. For backward compatibility, an
#'   explicit data frame may be supplied first.
#' @param data Optional explicit data frame. When omitted, active data is used.
#' @param describe Logical; include compact descriptive summaries.
#' @param file Output HTML file.
#' @param title Dictionary title.
#' @param open Logical; open the generated file.
#'
#' @return The HTML path invisibly.
#' @export
#'
#' @examples
#' d <- data.frame(sex = c(1, 2), age = c(20, NA))
#' usedf(d, quiet = TRUE)
#' path <- dict(file = tempfile(fileext = ".html"), open = FALSE)
#' file.exists(path)
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(sex = c(1, 2, 1), age = c(20, 30, NA), bmi = c(21, 24, 26))
#' labvar(d, sex, label = "Sex", values = c("1" = "Male", "2" = "Female"))
#' labvar(d, age, label = "Age in years")
#'
#' # Dictionary for every variable
#' f1 <- dict(d, file = tempfile(fileext = ".html"), open = FALSE)
#'
#' # Dictionary for selected variables
#' f2 <- dict(d, sex, age, file = tempfile(fileext = ".html"), open = FALSE)
#'
#' # Omit descriptive summaries
#' f3 <- dict(d, describe = FALSE, file = tempfile(fileext = ".html"), open = FALSE)
#'
#' # Active-data syntax
#' usedf(d, quiet = TRUE)
#' f4 <- dict(file = tempfile(fileext = ".html"), open = FALSE)
#' }
dict <- function(..., data = NULL, describe = TRUE, file = NULL,
                 title = "Data dictionary", open = TRUE) {
  env <- parent.frame()
  exprs <- as.list(substitute(list(...)))[-1L]

  context <- .r4vn_read_context(
    exprs = exprs,
    data_expr = substitute(data),
    data_supplied = !missing(data),
    env = env
  )

  data <- context$data
  exprs <- context$args

  variables <- .r4vn_select_dots(exprs, names(data))
  if (!length(variables)) variables <- names(data)

  d <- data[variables]
  if (!ncol(d)) stop("No variables are available for the dictionary.", call. = FALSE)

  rows <- lapply(names(d), function(variable) {
    x <- d[[variable]]

    c(
      Variable = variable,
      Label = if (is.null(attr(x, "label", exact = TRUE))) {
        ""
      } else {
        as.character(attr(x, "label", exact = TRUE))
      },
      Type = .r4vn_var_type(x),
      Values = .r4vn_value_text(x),
      Missing = as.character(sum(is.na(x))),
      Distinct = as.character(length(unique(x[!is.na(x)]))),
      Summary = if (isTRUE(describe)) .r4vn_summary_text(x) else ""
    )
  })

  table_data <- do.call(rbind, rows)

  if (is.null(file)) {
    file <- tempfile("r4vn_dictionary_", fileext = ".html")
  }
  if (!grepl("\\.html?$", file, ignore.case = TRUE)) {
    file <- paste0(file, ".html")
  }

  file <- normalizePath(file, winslash = "/", mustWork = FALSE)
  dir.create(dirname(file), recursive = TRUE, showWarnings = FALSE)

  header_html <- paste0(
    "<th>", .r4vn_html(colnames(table_data)), "</th>",
    collapse = ""
  )

  body_html <- paste(
    apply(table_data, 1L, function(z) {
      paste0(
        "<tr>",
        paste0("<td>", .r4vn_html(z), "</td>", collapse = ""),
        "</tr>"
      )
    }),
    collapse = "\n"
  )

  css <- paste0(
    "body{font-family:Arial,sans-serif;margin:24px;color:#222}",
    "h1{font-size:24px;margin-bottom:8px}",
    ".meta{color:#666;margin-bottom:18px}",
    "table{border-collapse:collapse;width:100%;font-size:14px}",
    "th,td{border:1px solid #d9d9d9;padding:8px;",
    "vertical-align:top;text-align:left}",
    "th{background:#f2f2f2;position:sticky;top:0}",
    "tr:nth-child(even){background:#fafafa}"
  )

  html <- paste0(
    "<!doctype html><html><head><meta charset=\"utf-8\"><title>",
    .r4vn_html(title),
    "</title><style>", css,
    "</style></head><body><h1>",
    .r4vn_html(title),
    "</h1><div class=\"meta\">",
    nrow(d), " observations; ", ncol(d),
    " variables</div><table><thead><tr>",
    header_html,
    "</tr></thead><tbody>",
    body_html,
    "</tbody></table></body></html>"
  )

  writeLines(html, file, useBytes = TRUE)
  if (isTRUE(open)) utils::browseURL(file)

  invisible(file)
}

# ----------------------------------------------------------------------------
# Consolidated from: keepvar.R
# ----------------------------------------------------------------------------
#' Keep variables and/or observations
#'
#' Keeps variables or observations in an explicit data frame or active data.
#'
#' @param ... Variable selectors. For backward compatibility, an explicit data
#'   frame may be the first unnamed argument.
#' @param data Optional explicit data frame object.
#' @param obs Optional observations to keep.
#'
#' @return The edited data frame invisibly.
#' @export
#'
#' @examples
#' d <- data.frame(
#'   id = 1:5,
#'   age = c(10, 20, NA, 40, 50),
#'   sex = c("M", "F", "F", "M", "F"),
#'   score_a = 1:5,
#'   score_b = 6:10
#' )
#'
#' # Each explicit-data example uses its own copy because keepvar()
#' # intentionally edits the supplied object.
#' d1 <- d
#' keepvar(d1, id, age, sex)
#'
#' d2 <- d
#' keepvar(d2, id:sex)
#'
#' d3 <- d
#' keepvar(d3, id, "score_*")
#'
#' d4 <- d
#' keepvar(d4, obs = age >= 18)
#'
#' d5 <- d
#' keepvar(d5, id, age, obs = !missing(age))
#'
#' d6 <- d
#' keepvar(d6, obs = c(1, 3, 5))
#'
#' # Active-data syntax
#' active_d <- d
#' usedf(active_d, quiet = TRUE)
#' keepvar(id, age, obs = age >= 18)
#' usedf(clear = TRUE, quiet = TRUE)
keepvar <- function(..., data = NULL, obs = NULL) {
  env <- parent.frame()
  exprs <- as.list(substitute(list(...)))[-1L]

  context <- .r4vn_edit_context(
    exprs = exprs,
    data_expr = substitute(data),
    data_supplied = !missing(data),
    env = env
  )

  d <- context$data
  exprs <- context$args

  variables <- .r4vn_select_dots(exprs, names(d))
  has_obs <- !missing(obs)

  if (has_obs) {
    rows <- .r4vn_rows(substitute(obs), d, env, action = "keep")
    d <- d[rows, , drop = FALSE]
  }

  if (length(variables)) d <- d[variables]

  .r4vn_commit_context(context$target, d)
}

# ----------------------------------------------------------------------------
# Consolidated from: dropvar.R
# ----------------------------------------------------------------------------
#' Drop variables and/or observations
#'
#' Drops variables or observations from an explicit data frame or active data.
#'
#' @param ... Variable selectors. For backward compatibility, an explicit data
#'   frame may be the first unnamed argument.
#' @param data Optional explicit data frame object.
#' @param obs Optional observations to drop.
#'
#' @return The edited data frame invisibly.
#' @export
#'
#' @examples
#' d <- data.frame(id = 1:4, age = c(10, 20, NA, 40), note_kt = letters[1:4])
#' usedf(d, quiet = TRUE)
#' dropvar("*_kt")
#' dropvar(obs = age < 18)
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(id = 1:5, age = c(10, 20, NA, 40, 50),
#'                 temp_a = 1:5, temp_b = 6:10, note = letters[1:5])
#'
#' # Drop one or more variables
#' d1 <- d; dropvar(d1, note)
#' d2 <- d; dropvar(d2, temp_a, temp_b)
#'
#' # Drop variables with a wildcard
#' d3 <- d; dropvar(d3, "temp_*")
#'
#' # Drop observations satisfying a condition
#' d4 <- d; dropvar(d4, obs = age < 18)
#' d5 <- d; dropvar(d5, obs = missing(age))
#'
#' # Drop variables and observations together
#' d6 <- d; dropvar(d6, note, obs = age < 18)
#'
#' # Active-data syntax
#' usedf(d, quiet = TRUE); dropvar("temp_*"); dropvar(obs = missing(age))
#' }
dropvar <- function(..., data = NULL, obs = NULL) {
  env <- parent.frame()
  exprs <- as.list(substitute(list(...)))[-1L]

  context <- .r4vn_edit_context(
    exprs = exprs,
    data_expr = substitute(data),
    data_supplied = !missing(data),
    env = env
  )

  d <- context$data
  exprs <- context$args

  variables <- .r4vn_select_dots(exprs, names(d))
  has_obs <- !missing(obs)

  if (!length(variables) && !has_obs) {
    stop("Specify variables, `obs`, or both.", call. = FALSE)
  }

  if (has_obs) {
    rows <- .r4vn_rows(substitute(obs), d, env, action = "drop")
    d <- d[rows, , drop = FALSE]
  }

  if (length(variables)) {
    d <- d[setdiff(names(d), variables)]
  }

  .r4vn_commit_context(context$target, d)
}

# ----------------------------------------------------------------------------
# Consolidated from: ordervar.R
# ----------------------------------------------------------------------------
#' Reorder variables
#'
#' Reorders variables in an explicit data frame or the active R4VN data frame.
#'
#' @param ... Variables to move. For backward compatibility, an explicit data
#'   frame may be the first unnamed argument.
#' @param data Optional explicit data frame object.
#' @param before Optional anchor variable.
#' @param after Optional anchor variable.
#' @param last Logical; move variables to the end.
#'
#' @return The edited data frame invisibly.
#' @export
#'
#' @examples
#' d <- data.frame(age = 1, sex = 2, id = 3, bmi = 4)
#' usedf(d, quiet = TRUE)
#' ordervar(id, sex)
#' ordervar(bmi, after = age)
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(age = 1, sex = 2, id = 3, bmi = 4, outcome = 5)
#'
#' # Move variables to the beginning
#' d1 <- d; ordervar(d1, id, outcome)
#'
#' # Move before or after an anchor
#' d2 <- d; ordervar(d2, outcome, before = age)
#' d3 <- d; ordervar(d3, bmi, after = age)
#'
#' # Move to the end
#' d4 <- d; ordervar(d4, id, last = TRUE)
#'
#' # Use a range or wildcard
#' d5 <- data.frame(id = 1, q1 = 2, q2 = 3, q3 = 4, age = 5)
#' ordervar(d5, q1:q3, last = TRUE)
#'
#' # Active-data syntax
#' usedf(d, quiet = TRUE); ordervar(id, outcome)
#' }
ordervar <- function(..., data = NULL, before = NULL,
                     after = NULL, last = FALSE) {
  env <- parent.frame()
  exprs <- as.list(substitute(list(...)))[-1L]

  context <- .r4vn_edit_context(
    exprs = exprs,
    data_expr = substitute(data),
    data_supplied = !missing(data),
    env = env
  )

  d <- context$data
  exprs <- context$args

  variables <- .r4vn_select_dots(exprs, names(d))
  if (!length(variables)) stop("No variables were specified.", call. = FALSE)

  choices <- c(!missing(before), !missing(after), isTRUE(last))
  if (sum(choices) > 1L) {
    stop(
      "Use only one of `before`, `after`, or `last = TRUE`.",
      call. = FALSE
    )
  }

  remaining <- setdiff(names(d), variables)

  if (!missing(before)) {
    anchor <- .r4vn_selector(substitute(before), remaining)
    if (length(anchor) != 1L) {
      stop("`before` must identify one variable.", call. = FALSE)
    }
    position <- match(anchor, remaining)
    new_order <- append(remaining, variables, after = position - 1L)
  } else if (!missing(after)) {
    anchor <- .r4vn_selector(substitute(after), remaining)
    if (length(anchor) != 1L) {
      stop("`after` must identify one variable.", call. = FALSE)
    }
    position <- match(anchor, remaining)
    new_order <- append(remaining, variables, after = position)
  } else if (isTRUE(last)) {
    new_order <- c(remaining, variables)
  } else {
    new_order <- c(variables, remaining)
  }

  d <- d[new_order]
  .r4vn_commit_context(context$target, d)
}

# ----------------------------------------------------------------------------
# Consolidated from: renvar.R
# ----------------------------------------------------------------------------
#' Rename variables
#'
#' Renames variables in an explicit data frame or the active R4VN data frame.
#'
#' @param ... In active mode: `old, new`. In explicit mode: `data, old, new`.
#' @param data Optional explicit data frame object.
#'
#' @return The edited data frame invisibly.
#' @export
#'
#' @examples
#' d <- data.frame(sex = 1:2, age_kt = 3:4)
#' usedf(d, quiet = TRUE)
#' renvar(sex, gender)
#' renvar("*_kt", "*")
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(sex = 1:2, age = 3:4, score_pre = 5:6, bmi_pre = 7:8)
#'
#' # Rename one variable
#' d1 <- d; renvar(d1, sex, gender)
#'
#' # Rename parallel groups
#' d2 <- d; renvar(d2, vars(sex, age), vars(gender, age_year))
#'
#' # Space-separated names are also accepted
#' d3 <- d; renvar(d3, "sex age", "gender age_year")
#'
#' # Wildcard: remove or replace a common suffix
#' d4 <- d; renvar(d4, "*_pre", "*")
#' d5 <- d; renvar(d5, "*_pre", "baseline_*")
#'
#' # Active-data syntax
#' usedf(d, quiet = TRUE); renvar(sex, gender)
#' }
renvar <- function(..., data = NULL) {
  env <- parent.frame()
  exprs <- as.list(substitute(list(...)))[-1L]

  context <- .r4vn_edit_context(
    exprs = exprs,
    data_expr = substitute(data),
    data_supplied = !missing(data),
    env = env
  )

  d <- context$data
  exprs <- context$args

  if (length(exprs) != 2L) {
    stop(
      "Use `renvar(old, new)` with active data, or ",
      "`renvar(data, old, new)`.",
      call. = FALSE
    )
  }

  old_names <- .r4vn_literal_names(exprs[[1L]])
  new_names <- .r4vn_literal_names(exprs[[2L]])

  wildcard <- length(old_names) == 1L &&
    grepl("*", old_names, fixed = TRUE)

  if (wildcard) {
    if (length(new_names) != 1L) {
      stop("Wildcard renaming requires one new pattern.", call. = FALSE)
    }

    regex <- .r4vn_glob_regex(old_names, capture = TRUE)
    matched <- grep(regex, names(d), value = TRUE)

    if (!length(matched)) {
      stop("No variables matched `", old_names, "`.", call. = FALSE)
    }

    new_parts <- .r4vn_glob_parts(new_names)
    captured <- sub(regex, "\\1", matched, perl = TRUE)

    replacement <- if (!new_parts$has) {
      rep(new_names, length(matched))
    } else {
      paste0(new_parts$prefix, captured, new_parts$suffix)
    }

    old_names <- matched
    new_names <- replacement
  } else {
    if (length(old_names) != length(new_names)) {
      stop("Old and new variable groups must have equal lengths.", call. = FALSE)
    }

    not_found <- setdiff(old_names, names(d))
    if (length(not_found)) {
      stop(
        "Variables not found: ",
        paste(not_found, collapse = ", "),
        ".",
        call. = FALSE
      )
    }
  }

  if (any(!nzchar(new_names)) || anyDuplicated(new_names)) {
    stop("New variable names must be non-empty and unique.", call. = FALSE)
  }

  untouched <- setdiff(names(d), old_names)
  if (any(new_names %in% untouched)) {
    stop("A new variable name already exists in the data.", call. = FALSE)
  }

  names(d)[match(old_names, names(d))] <- new_names
  .r4vn_commit_context(context$target, d)
}

# ----------------------------------------------------------------------------
# Consolidated from: genvar.R
# ----------------------------------------------------------------------------
#' Generate one or more variables
#'
#' Creates variables in an explicit data frame or the active R4VN data frame.
#' Logical expressions are stored as `1` and `0`. If no active data exists,
#' `genvar()` can initialize a temporary active data frame from entered vectors.
#' A later vector may contain more observations than the current data; R4VN
#' expands the data frame and pads existing/shorter columns with missing values.
#'
#' @usage
#' genvar(
#'   ..., data = NULL, label = NULL, values = NULL, recode = NULL, ref = NULL,
#'   ordered = FALSE, times = NULL, each = NULL, fill = NA
#' )
#'
#' @param ... Named expressions in the form `new_variable = expression`. For
#'   backward compatibility, an explicit data frame may be supplied first.
#' @param data Optional explicit data frame object. When omitted, active data is
#'   used.
#' @param label A character label or one label per generated variable.
#' @param values A common named value-label vector.
#' @param recode An optional common named recode vector.
#' @param ref Optional reference category.
#' @param ordered Logical; create ordered factors.
#' @param times Optional repetition counts. For one variable, `genvar(smoking = c(1, 0), times = c(10, 10))` creates ten 1s followed by ten 0s without writing `rep()` manually. With several variables, use a named list.
#' @param each Optional compact repetition. For example, `genvar(group = c(1, 2, 3), each = 5)` creates five observations per group.
#' @param fill Value used to pad a generated variable when it is shorter than the current data. Default `NA`. If a new variable is longer than the data, existing columns are extended with missing values.
#'
#' @return The edited data frame invisibly.
#' @export
#'
#' @examples
#' d <- data.frame(sbp = c(120, 150), dbp = c(75, 95))
#' usedf(d, quiet = TRUE)
#' genvar(hypertension = sbp >= 140 | dbp >= 90,
#'        label = "Hypertension",
#'        values = c("0" = "No", "1" = "Yes"))
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(id = 1:4, age = c(17, 25, 40, 70),
#'                 sbp = c(118, 145, 132, 160),
#'                 dbp = c(75, 92, 80, 95), bmi = c(18, 22, 25, 30))
#' usedf(d, quiet = TRUE)
#'
#' # Arithmetic expression
#' genvar(age_decade = age / 10, label = "Age in decades")
#'
#' # Logical expression is stored as 0/1
#' genvar(hypertension = sbp >= 140 | dbp >= 90,
#'        label = "Hypertension",
#'        values = c("0" = "No", "1" = "Yes"), ref = "No")
#'
#' # Generate several variables in one call
#' genvar(adult = age >= 18, overweight = bmi >= 23,
#'        label = c("Adult", "Overweight or obesity"),
#'        values = c("0" = "No", "1" = "Yes"))
#'
#' # Generate and recode a grouped variable
#' genvar(age_group = age,
#'        recode = c("min:17" = 1, "18:59" = 2, "60:max" = 3),
#'        label = "Age group",
#'        values = c("1" = "<18", "2" = "18-59", "3" = "60+"),
#'        ordered = TRUE)
#'
#' # Explicit-data syntax remains available
#' genvar(d, pulse_pressure = sbp - dbp, label = "Pulse pressure")
#'
#' # Quick vector entry without creating a data frame first
#' genvar(weight = c(29, 26, 13, 23, 23, 25, 17, 22))
#' ghist(x = weight)
#'
#' # A later variable may be longer; existing columns are padded with NA
#' genvar(age = c(81, 65, 89, 70, 87, 61, 94, 98, 81, 70))
#'
#' # Compact repeated values
#' genvar(smoking = c(1, 0), times = c(10, 10),
#'        values = c("0" = "No", "1" = "Yes"))
#' }
genvar <- function(..., data = NULL, label = NULL, values = NULL,
                   recode = NULL, ref = NULL, ordered = FALSE,
                   times = NULL, each = NULL, fill = NA) {
  env <- parent.frame()
  exprs <- as.list(substitute(list(...)))[-1L]

  # Unlike most editing commands, genvar() may initialize a temporary active
  # data frame so quick vectors can immediately be used by R4VN analyses.
  data_supplied <- !missing(data)
  first_is_data <- FALSE
  if (!data_supplied && length(exprs) && !.r4vn_first_dot_is_named(exprs)) {
    first_is_data <- is.data.frame(.r4vn_try_data_frame(exprs[[1L]], env))
  }

  if (!data_supplied && !first_is_data && !.r4vn_has_active()) {
    context <- list(
      data = data.frame(),
      args = exprs,
      target = list(mode = "active", name = "<temporary>", source = "genvar",
                    object_name = NULL, object_env = NULL)
    )
  } else {
    context <- .r4vn_edit_context(
      exprs = exprs,
      data_expr = substitute(data),
      data_supplied = data_supplied,
      env = env
    )
  }

  d <- context$data
  exprs <- context$args
  if (!length(exprs)) stop("No new variables were specified.", call. = FALSE)

  variables <- names(exprs)
  if (is.null(variables) || any(!nzchar(variables))) {
    stop("Every generated variable must use `new_name = expression`.", call. = FALSE)
  }
  if (anyDuplicated(variables)) stop("Generated variable names must be unique.", call. = FALSE)
  labels <- .r4vn_labels(label, variables)

  repeat_arg <- function(arg, variable, i) {
    if (is.null(arg)) return(NULL)
    if (is.list(arg)) {
      if (!is.null(names(arg)) && variable %in% names(arg)) return(arg[[variable]])
      if (length(arg) == length(variables)) return(arg[[i]])
      if (length(variables) == 1L && length(arg) == 1L) return(arg[[1L]])
      stop("For multiple generated variables, `times`/`each` must be a named list or have one list element per variable.", call. = FALSE)
    }
    if (length(variables) > 1L) {
      stop("For multiple generated variables, use a list for `times` or `each`.", call. = FALSE)
    }
    arg
  }

  fill_arg <- function(variable, i) {
    if (is.list(fill)) {
      if (!is.null(names(fill)) && variable %in% names(fill)) return(fill[[variable]])
      if (length(fill) == length(variables)) return(fill[[i]])
      if (length(fill) == 1L) return(fill[[1L]])
      stop("`fill` must have one value, one list element per generated variable, or named list elements.", call. = FALSE)
    }
    if (length(fill) == 1L) return(fill)
    if (!is.null(names(fill)) && variable %in% names(fill)) return(fill[[variable]])
    if (length(fill) == length(variables)) return(fill[[i]])
    stop("`fill` must have length 1 or match the number of generated variables.", call. = FALSE)
  }

  resize_data <- function(dat, n) {
    if (nrow(dat) >= n) return(dat)
    if (!ncol(dat)) return(data.frame(row.names = seq_len(n)))
    dat[seq_len(n), , drop = FALSE]
  }

  pad_value <- function(value, n, pad) {
    if (length(value) >= n) return(value)
    need <- n - length(value)
    if (is.factor(value)) {
      if (length(pad) == 1L && !is.na(pad) && as.character(pad) %in% levels(value)) {
        extra <- factor(rep(as.character(pad), need), levels = levels(value), ordered = is.ordered(value))
      } else {
        extra <- factor(rep(NA_character_, need), levels = levels(value), ordered = is.ordered(value))
      }
      return(c(value, extra))
    }
    if (inherits(value, "Date")) {
      p <- if (inherits(pad, "Date")) pad else as.Date(NA)
      return(c(value, rep(p, need)))
    }
    if (inherits(value, "POSIXt")) {
      p <- if (inherits(pad, "POSIXt")) pad else as.POSIXct(NA)
      return(c(value, rep(p, need)))
    }
    c(value, rep(pad, need))
  }

  for (i in seq_along(exprs)) {
    value <- .r4vn_eval(exprs[[i]], d, env)
    ti <- repeat_arg(times, variables[i], i)
    ei <- repeat_arg(each, variables[i], i)
    if (!is.null(ti) && !is.null(ei)) stop("Use either `times` or `each`, not both.", call. = FALSE)
    if (!is.null(ti)) value <- rep(value, times = ti)
    if (!is.null(ei)) value <- rep(value, each = ei)

    if (length(value) == 1L && nrow(d) > 1L) value <- rep(value, nrow(d))
    target_n <- max(nrow(d), length(value), 1L)
    d <- resize_data(d, target_n)
    if (length(value) < target_n) value <- pad_value(value, target_n, fill_arg(variables[i], i))
    if (length(value) != nrow(d)) {
      stop("Generated variable `", variables[i], "` could not be aligned to the active data.", call. = FALSE)
    }
    if (is.logical(value)) value <- as.integer(value)

    d[[variables[i]]] <- .r4vn_apply_lab(
      value, label = labels[[i]], values = values, recode = recode,
      ref = ref, ordered = ordered
    )
  }

  .r4vn_commit_context(context$target, d)
}

# ----------------------------------------------------------------------------
# Consolidated from: replacevar.R
# ----------------------------------------------------------------------------
#' Replace values under one or more conditions
#'
#' Replaces values in an explicit data frame or the active R4VN data frame.
#'
#' @param ... In active mode: `variable, value, condition`. In explicit mode:
#'   `data, variable, value, condition`.
#' @param data Optional explicit data frame object.
#'
#' @details
#' `missing(x)` may be used inside conditions. Use `.` as a missing replacement.
#'
#' @return The edited data frame invisibly.
#' @export
#'
#' @examples
#' d <- data.frame(age = c(8, 15, 200, NA_real_))
#' usedf(d, quiet = TRUE)
#' replacevar(age, ., age > 120)
#' replacevar(age, 99, missing(age))
#'
#' # Extended usage examples
#' \donttest{
#' d <- data.frame(age = c(8, 15, 200, NA_real_),
#'                 sex = factor(c("M", "F", "M", "F")))
#' usedf(d, quiet = TRUE)
#'
#' # Replace an impossible value by missing
#' replacevar(age, ., age > 120)
#'
#' # Replace missing values
#' replacevar(age, 99, missing(age))
#'
#' # Replace a factor value under a condition
#' replacevar(sex, "Female", sex == "F")
#'
#' # Explicit-data syntax
#' replacevar(d, age, ., age > 120)
#' }
replacevar <- function(..., data = NULL) {
  env <- parent.frame()
  exprs <- as.list(substitute(list(...)))[-1L]

  context <- .r4vn_edit_context(
    exprs = exprs,
    data_expr = substitute(data),
    data_supplied = !missing(data),
    env = env
  )

  d <- context$data
  exprs <- context$args

  if (length(exprs) != 3L) {
    stop(
      "Use `replacevar(variable, value, condition)` with active data, or ",
      "`replacevar(data, variable, value, condition)`.",
      call. = FALSE
    )
  }

  variable_expr <- exprs[[1L]]
  value_expr <- exprs[[2L]]
  condition_expr <- exprs[[3L]]

  variables <- .r4vn_selector(variable_expr, names(d))
  if (length(variables) != 1L) {
    stop("`replacevar()` modifies one variable at a time.", call. = FALSE)
  }
  variable <- variables[1L]

  condition_exprs <- .r4vn_condition_exprs(condition_expr)
  value_exprs <- .r4vn_value_exprs(value_expr, length(condition_exprs))

  if (length(value_exprs) != length(condition_exprs)) {
    stop(
      "The numbers of replacement values and conditions must be equal.",
      call. = FALSE
    )
  }

  matched <- rep(FALSE, nrow(d))

  for (i in seq_along(condition_exprs)) {
    test <- .r4vn_eval(condition_exprs[[i]], d, env)

    if (length(test) == 1L) test <- rep(test, nrow(d))
    if (!is.logical(test) || length(test) != nrow(d)) {
      stop(
        "Each condition must return one logical value per observation.",
        call. = FALSE
      )
    }

    test[is.na(test)] <- FALSE
    take <- test & !matched

    if (any(take)) {
      replacement <- .r4vn_eval_value(value_exprs[[i]], d, env)

      if (is.factor(d[[variable]])) {
        d[[variable]] <- .r4vn_replace_factor(
          d[[variable]],
          take,
          replacement
        )
      } else {
        if (length(replacement) == nrow(d)) replacement <- replacement[take]

        if (length(replacement) != 1L &&
            length(replacement) != sum(take)) {
          stop(
            "Replacement values must have length 1, the number of selected ",
            "observations, or the number of rows.",
            call. = FALSE
          )
        }

        d[[variable]][take] <- replacement
      }

      matched[take] <- TRUE
    }
  }

  .r4vn_commit_context(context$target, d)
}

# ----------------------------------------------------------------------------
# Consolidated from: labvar.R
# ----------------------------------------------------------------------------
#' Label and recode existing variables
#'
#' Adds variable labels, value labels, recodes values, and sets reference
#' categories. The function can edit an explicit data frame or the active R4VN
#' data frame.
#'
#' @param ... Variables to process. For backward compatibility, an explicit data
#'   frame may be supplied as the first unnamed argument.
#' @param data Optional explicit data frame object. When omitted, active data is
#'   used.
#' @param label A character label or one label per selected variable.
#' @param values A named value-label vector such as
#'   `c("0" = "No", "1" = "Yes")`.
#' @param recode A named recode vector such as
#'   `c("min:12" = 1, "13:17" = 2, "18:max" = 3)`.
#' @param ref Optional reference category.
#' @param ordered Logical; create an ordered factor.
#'
#' @details
#' Explicit-data syntax remains valid:
#'
#' `labvar(data, sex, label = "Sex", values = c("1" = "Male", "2" = "Female"))`
#'
#' After `usedf(data)`, active-data syntax is:
#'
#' `labvar(sex, label = "Sex", values = c("1" = "Male", "2" = "Female"))`
#'
#' When active data were selected with `usedf(patient)`, edits update both
#' the active data and the linked `patient` object. For an unlinked active copy,
#' retrieve the result with `data <- usedf()`.
#'
#' @return The edited data frame invisibly.
#' @export
#'
#' @examples
#' d <- data.frame(sex = c(1, 2, 1), age = c(8, 15, 30))
#' usedf(d, quiet = TRUE)
#' labvar(sex, label = "Sex",
#'        values = c("1" = "Male", "2" = "Female"))
#' labvar(age,
#'        recode = c("min:12" = 1, "13:17" = 2, "18:max" = 3),
#'        label = "Age group",
#'        values = c("1" = "0-12", "2" = "13-17", "3" = "18+"))
#'
#' # Extended usage examples
#' \donttest{
#' # ------------------------------------------------------------------
#' # 1. Add only a variable label; numeric values remain numeric
#' d1 <- data.frame(age = c(18, 25, 40))
#' labvar(d1, age, label = "Age in years")
#' attr(d1$age, "label")
#'
#' # 2. Add value labels; the variable becomes a factor
#' d2 <- data.frame(sex = c(1, 2, 2, 1))
#' labvar(d2, sex, label = "Sex",
#'        values = c("1" = "Male", "2" = "Female"))
#' levels(d2$sex)
#'
#' # 3. Set the reference category by stored code
#' d3 <- data.frame(smoke = c(0, 1, 1, 0))
#' labvar(d3, smoke, label = "Current smoking",
#'        values = c("0" = "No", "1" = "Yes"), ref = 0)
#' levels(d3$smoke)
#'
#' # 4. Set the reference category by displayed label
#' d4 <- data.frame(treatment = c(1, 2, 3, 1))
#' labvar(d4, treatment,
#'        values = c("1" = "Standard", "2" = "Drug A", "3" = "Drug B"),
#'        ref = "Standard")
#'
#' # 5. Create an ordered factor
#' d5 <- data.frame(severity = c(1, 3, 2, 1))
#' labvar(d5, severity, label = "Disease severity",
#'        values = c("1" = "Mild", "2" = "Moderate", "3" = "Severe"),
#'        ordered = TRUE)
#' is.ordered(d5$severity)
#'
#' # 6. Recode inclusive numeric ranges and then label the new categories
#' d6 <- data.frame(age = c(8, 12, 13, 17, 18, 65))
#' labvar(d6, age,
#'        recode = c("min:12" = 1, "13:17" = 2, "18:max" = 3),
#'        label = "Age group",
#'        values = c("1" = "0-12", "2" = "13-17", "3" = "18+"))
#'
#' # 7. Collapse several exact values into one category
#' d7 <- data.frame(answer = c(1, 2, 3, 2, 1))
#' labvar(d7, answer,
#'        recode = c("1" = 1, "2 3" = 0),
#'        values = c("0" = "No/uncertain", "1" = "Yes"))
#'
#' # 8. Recode without value labels; the result remains numeric
#' d8 <- data.frame(score = c(2, 6, 9, 15))
#' labvar(d8, score,
#'        recode = c("min:4" = 1, "5:9" = 2, "10:max" = 3),
#'        label = "Score category code")
#' is.numeric(d8$score)
#'
#' # 9. Apply common value labels to several binary variables
#' d9 <- data.frame(smoke = c(0, 1), alcohol = c(1, 0), exercise = c(1, 1))
#' labvar(d9, smoke, alcohol, exercise,
#'        label = c("Smoking", "Alcohol use", "Regular exercise"),
#'        values = c("0" = "No", "1" = "Yes"))
#'
#' # 10. Supply labels as a named vector
#' d10 <- data.frame(sbp = c(120, 130), dbp = c(75, 85))
#' labvar(d10, sbp, dbp,
#'        label = c(sbp = "Systolic blood pressure",
#'                  dbp = "Diastolic blood pressure"))
#'
#' # 11. Select a contiguous range of variables
#' d11 <- data.frame(q1 = c(0, 1), q2 = c(1, 0), q3 = c(1, 1), age = c(20, 30))
#' labvar(d11, q1:q3, values = c("0" = "No", "1" = "Yes"))
#'
#' # 12. Select variables with a wildcard
#' d12 <- data.frame(symptom_a = c(0, 1), symptom_b = c(1, 1), age = c(20, 30))
#' labvar(d12, "symptom_*", values = c("0" = "Absent", "1" = "Present"))
#'
#' # 13. Use explicit-data syntax
#' d13 <- data.frame(outcome = c(0, 1, 0))
#' labvar(d13, outcome, label = "Outcome",
#'        values = c("0" = "No", "1" = "Yes"), ref = "No")
#'
#' # 14. Use active-data syntax
#' d14 <- data.frame(outcome = c(0, 1, 0))
#' usedf(d14, quiet = TRUE)
#' labvar(outcome, label = "Outcome",
#'        values = c("0" = "No", "1" = "Yes"), ref = "No")
#' d14_active <- usedf(quiet = TRUE)
#'
#' # 15. Use separate calls when variables need different value-label systems
#' d15 <- data.frame(sex = c(1, 2), outcome = c(0, 1))
#' labvar(d15, sex, values = c("1" = "Male", "2" = "Female"))
#' labvar(d15, outcome, values = c("0" = "No", "1" = "Yes"))
#' }
labvar <- function(..., data = NULL, label = NULL, values = NULL,
                   recode = NULL, ref = NULL, ordered = FALSE) {
  env <- parent.frame()
  exprs <- as.list(substitute(list(...)))[-1L]

  context <- .r4vn_edit_context(
    exprs = exprs,
    data_expr = substitute(data),
    data_supplied = !missing(data),
    env = env
  )

  d <- context$data
  exprs <- context$args

  variables <- .r4vn_select_dots(exprs, names(d))
  if (!length(variables)) stop("No variables were specified.", call. = FALSE)

  labels <- .r4vn_labels(label, variables)

  for (i in seq_along(variables)) {
    variable <- variables[i]

    d[[variable]] <- .r4vn_apply_lab(
      d[[variable]],
      label = labels[[i]],
      values = values,
      recode = recode,
      ref = ref,
      ordered = ordered
    )
  }

  .r4vn_commit_context(context$target, d)
}