.inter_assert_data_frame <- function(x, arg) {
  if (!is.data.frame(x)) {
    stop(sprintf("`%s` must be a data frame.", arg), call. = FALSE)
  }
  invisible(TRUE)
}

.inter_assert_column <- function(data, column, arg, allow_null = FALSE) {
  if (is.null(column) && allow_null) {
    return(NULL)
  }
  if (!is.character(column) || length(column) != 1L || is.na(column)) {
    stop(sprintf("`%s` must be one column name supplied as a string.", arg),
         call. = FALSE)
  }
  if (!column %in% names(data)) {
    stop(sprintf("Column `%s`, supplied to `%s`, was not found.", column, arg),
         call. = FALSE)
  }
  column
}

.inter_key <- function(data, variables) {
  if (!length(variables)) {
    return(rep.int(".all", nrow(data)))
  }
  values <- lapply(data[variables], function(x) {
    x <- as.character(x)
    x[is.na(x)] <- "<NA>"
    gsub("\\u001f", "<US>", x, fixed = TRUE)
  })
  do.call(paste, c(values, sep = "\u001f"))
}

.inter_family <- function(family) {
  if (inherits(family, "family")) {
    return(family)
  }
  if (!is.character(family) || length(family) != 1L) {
    stop("`family` must be a family object or one of 'gaussian' and 'binomial'.",
         call. = FALSE)
  }
  switch(
    match.arg(family, c("gaussian", "binomial")),
    gaussian = stats::gaussian(),
    binomial = stats::binomial()
  )
}

.inter_weighted_mean <- function(x, w) {
  ok <- is.finite(x) & is.finite(w) & w > 0
  if (!any(ok)) {
    return(NA_real_)
  }
  sum(x[ok] * w[ok]) / sum(w[ok])
}

.inter_group_sum <- function(x, key, all_keys = NULL) {
  ans <- tapply(x, key, sum, na.rm = TRUE)
  if (is.null(all_keys)) {
    return(ans)
  }
  out <- stats::setNames(rep.int(0, length(all_keys)), all_keys)
  common <- intersect(names(ans), all_keys)
  out[common] <- ans[common]
  out
}

.inter_match_rows <- function(x, specification) {
  if (is.null(specification) || !length(specification)) {
    return(rep.int(TRUE, nrow(x)))
  }
  if (is.data.frame(specification)) {
    if (!nrow(specification)) {
      return(rep.int(FALSE, nrow(x)))
    }
    vars <- names(specification)
    if (!all(vars %in% names(x))) {
      stop("Structural-zero variables must occur in the census dimensions.",
           call. = FALSE)
    }
    hit <- rep.int(FALSE, nrow(x))
    for (i in seq_len(nrow(specification))) {
      current <- rep.int(TRUE, nrow(x))
      for (variable in vars) {
        value <- specification[[variable]][i]
        if (!is.na(value)) {
          current <- current & as.character(x[[variable]]) == as.character(value)
        }
      }
      hit <- hit | current
    }
    return(hit)
  }
  if (!is.list(specification) || is.null(names(specification))) {
    stop("A domain must be a named list or a data frame.", call. = FALSE)
  }
  if (!all(names(specification) %in% names(x))) {
    stop("Domain variables must occur in the reconstructed population table.",
         call. = FALSE)
  }
  hit <- rep.int(TRUE, nrow(x))
  for (variable in names(specification)) {
    hit <- hit & as.character(x[[variable]]) %in%
      as.character(specification[[variable]])
  }
  hit
}

.inter_aggregate <- function(data, variables, value, fun = sum) {
  if (!length(variables)) {
    out <- data.frame(.all = "All", stringsAsFactors = FALSE)
    out[[value]] <- fun(data[[value]])
    return(out)
  }
  stats::aggregate(data[[value]], data[variables], fun,
                   na.rm = TRUE, drop = FALSE)
}

.inter_restore_rng <- function(old_seed) {
  if (is.null(old_seed)) {
    if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) {
      rm(".Random.seed", envir = .GlobalEnv)
    }
  } else {
    assign(".Random.seed", old_seed, envir = .GlobalEnv)
  }
}
