#' Validate aggregate census margins
#'
#' @param margins A data frame or named list of aggregate census tables.
#' @param count Name of the population-count column in every table.
#' @param structural_zeros Optional data frame. Each row describes an impossible
#'   combination; `NA` acts as a wildcard.
#' @param tolerance Relative tolerance for comparing table totals.
#' @param reconcile If `TRUE`, rescale inconsistent table totals to their mean.
#' @return An object of class `census_margins`.
#' @export
census_margins <- function(margins, count = "Freq", structural_zeros = NULL,
                           tolerance = 1e-8, reconcile = FALSE) {
  if (is.data.frame(margins)) {
    margins <- list(margin1 = margins)
  }
  if (!is.list(margins) || !length(margins) ||
      !all(vapply(margins, is.data.frame, logical(1)))) {
    stop("`margins` must be a data frame or a non-empty list of data frames.",
         call. = FALSE)
  }
  if (is.null(names(margins)) || any(!nzchar(names(margins)))) {
    names(margins) <- paste0("margin", seq_along(margins))
  }
  if (!is.character(count) || length(count) != 1L) {
    stop("`count` must be one column name.", call. = FALSE)
  }

  cleaned <- vector("list", length(margins))
  names(cleaned) <- names(margins)
  totals <- numeric(length(margins))
  dimensions <- vector("list", length(margins))

  for (i in seq_along(margins)) {
    table <- margins[[i]]
    if (!count %in% names(table)) {
      stop(sprintf("Census table `%s` has no `%s` column.", names(margins)[i],
                   count), call. = FALSE)
    }
    dims <- setdiff(names(table), count)
    if (!length(dims)) {
      stop("Every census table must contain at least one dimension.",
           call. = FALSE)
    }
    values <- table[[count]]
    if (!is.numeric(values) || any(!is.finite(values)) || any(values < 0)) {
      stop("Census counts must be finite and non-negative.", call. = FALSE)
    }
    if (anyNA(table[dims])) {
      stop("Census dimensions may not contain missing values.", call. = FALSE)
    }
    key <- .inter_key(table, dims)
    if (anyDuplicated(key)) {
      table <- stats::aggregate(table[[count]], table[dims], sum,
                                na.rm = TRUE, drop = FALSE)
      names(table)[ncol(table)] <- count
    }
    cleaned[[i]] <- table
    totals[i] <- sum(table[[count]])
    dimensions[[i]] <- dims
  }

  target_total <- mean(totals)
  relative_difference <- max(abs(totals - target_total)) / max(1, target_total)
  if (relative_difference > tolerance) {
    if (!isTRUE(reconcile)) {
      stop(paste0(
        "Census margin totals are inconsistent. Use `reconcile = TRUE` only ",
        "if proportional rescaling is substantively justified."
      ),
           call. = FALSE)
    }
    for (i in seq_along(cleaned)) {
      if (totals[i] <= 0) {
        stop("A zero-total census table cannot be reconciled.", call. = FALSE)
      }
      cleaned[[i]][[count]] <- cleaned[[i]][[count]] * target_total / totals[i]
    }
    totals[] <- target_total
  }

  if (!is.null(structural_zeros)) {
    .inter_assert_data_frame(structural_zeros, "structural_zeros")
    all_dims <- unique(unlist(dimensions, use.names = FALSE))
    if (!all(names(structural_zeros) %in% all_dims)) {
      stop("Structural-zero columns must be census dimensions.", call. = FALSE)
    }
  }

  structure(
    list(
      tables = cleaned,
      count = count,
      dimensions = unique(unlist(dimensions, use.names = FALSE)),
      table_dimensions = dimensions,
      total = target_total,
      original_totals = totals,
      reconciled = relative_difference > tolerance,
      structural_zeros = structural_zeros,
      tolerance = tolerance
    ),
    class = "census_margins"
  )
}

#' @export
print.census_margins <- function(x, ...) {
  cat("Validated census margins\n")
  cat("  Tables: ", length(x$tables), "\n", sep = "")
  cat("  Dimensions: ", paste(x$dimensions, collapse = ", "), "\n", sep = "")
  cat("  Population total: ", format(x$total, scientific = FALSE), "\n", sep = "")
  cat("  Reconciled: ", if (x$reconciled) "yes" else "no", "\n", sep = "")
  invisible(x)
}
