.inter_build_grid <- function(design, margins, max_cells = 1e6) {
  dims <- margins$dimensions
  missing_survey <- setdiff(dims, names(design$data))
  if (length(missing_survey)) {
    stop("All census dimensions must occur in the survey data. Missing: ",
         paste(missing_survey, collapse = ", "), call. = FALSE)
  }
  if (!design$area %in% dims) {
    stop("The survey area variable must occur in at least one census margin.",
         call. = FALSE)
  }

  levels_by_dimension <- lapply(dims, function(variable) {
    values <- as.character(design$data[[variable]])
    for (table in margins$tables) {
      if (variable %in% names(table)) {
        values <- c(values, as.character(table[[variable]]))
      }
    }
    sort(unique(values[!is.na(values)]))
  })
  names(levels_by_dimension) <- dims
  cell_count <- prod(vapply(levels_by_dimension, length, integer(1)))
  if (!is.finite(cell_count) || cell_count > max_cells) {
    stop("The implied joint census table is too large. Collapse categories or increase `max_cells` deliberately.",
         call. = FALSE)
  }
  grid <- expand.grid(levels_by_dimension, KEEP.OUT.ATTRS = FALSE,
                      stringsAsFactors = FALSE)
  if (!is.null(margins$structural_zeros) && nrow(margins$structural_zeros)) {
    zero <- .inter_match_rows(grid, margins$structural_zeros)
    grid <- grid[!zero, , drop = FALSE]
  }
  if (!nrow(grid)) {
    stop("Structural-zero rules removed every population cell.", call. = FALSE)
  }
  rownames(grid) <- NULL
  grid$.cell <- seq_len(nrow(grid))
  grid
}

.inter_seed_counts <- function(grid, design, dims, total, prior) {
  if (!is.numeric(prior) || length(prior) != 1L || !is.finite(prior) ||
      prior <= 0) {
    stop("`prior` must be one positive finite number.", call. = FALSE)
  }
  grid_key <- .inter_key(grid, dims)
  survey_key <- .inter_key(design$data, dims)
  mapped <- match(survey_key, grid_key)
  positive <- design$data[[design$weights]] > 0
  if (any(is.na(mapped) & positive)) {
    stop("Positive-weight survey records conflict with structural-zero rules or census levels.",
         call. = FALSE)
  }
  observed <- numeric(nrow(grid))
  observed_by_cell <- tapply(
    design$data[[design$weights]][!is.na(mapped)],
    mapped[!is.na(mapped)],
    sum,
    na.rm = TRUE
  )
  if (length(observed_by_cell)) {
    observed[as.integer(names(observed_by_cell))] <-
      as.numeric(observed_by_cell)
  }
  seed <- observed + prior
  seed * total / sum(seed)
}

.inter_margin_maps <- function(grid, margins) {
  maps <- vector("list", length(margins$tables))
  names(maps) <- names(margins$tables)
  for (i in seq_along(margins$tables)) {
    table <- margins$tables[[i]]
    dims <- margins$table_dimensions[[i]]
    grid_key <- .inter_key(grid, dims)
    groups <- unique(grid_key)
    table_key <- .inter_key(table, dims)
    target <- stats::setNames(table[[margins$count]], table_key)
    target_for_group <- as.numeric(target[groups])
    target_for_group[is.na(target_for_group)] <- 0
    maps[[i]] <- list(
      name = names(margins$tables)[i],
      dimensions = dims,
      group = match(grid_key, groups),
      groups = groups,
      target = target_for_group
    )
  }
  maps
}

.inter_reconstruct <- function(design, margins, prior = 0.5,
                               max_iter = 1000L, tol = 1e-8,
                               max_cells = 1e6) {
  grid <- .inter_build_grid(design, margins, max_cells = max_cells)
  counts <- .inter_seed_counts(grid, design, margins$dimensions,
                               margins$total, prior)
  seed <- counts
  maps <- .inter_margin_maps(grid, margins)
  converged <- FALSE
  error <- Inf

  for (iteration in seq_len(max_iter)) {
    for (map in maps) {
      current <- as.numeric(rowsum(counts, map$group, reorder = FALSE))
      impossible <- map$target > 0 & current <= 0
      if (any(impossible)) {
        stop("The census margins and structural-zero rules are incompatible.",
             call. = FALSE)
      }
      ratio <- rep.int(0, length(current))
      positive <- map$target > 0
      ratio[positive] <- map$target[positive] / current[positive]
      counts <- counts * ratio[map$group]
    }
    errors <- vapply(maps, function(map) {
      current <- as.numeric(rowsum(counts, map$group, reorder = FALSE))
      max(abs(current - map$target) / pmax(1, map$target))
    }, numeric(1))
    error <- max(errors)
    if (is.finite(error) && error <= tol) {
      converged <- TRUE
      break
    }
  }
  if (!converged) {
    warning("Population reconstruction did not reach the requested tolerance.",
            call. = FALSE)
  }
  grid$.population <- counts
  grid$.seed <- seed
  structure(
    list(
      grid = grid,
      maps = maps,
      iterations = iteration,
      error = error,
      converged = converged,
      tolerance = tol,
      prior = prior
    ),
    class = "inter_population"
  )
}

.inter_constraint_system <- function(grid, margins) {
  maps <- .inter_margin_maps(grid, margins)
  rows <- sum(vapply(maps, function(x) length(x$target), integer(1)))
  A <- matrix(0, nrow = rows, ncol = nrow(grid))
  b <- numeric(rows)
  labels <- character(rows)
  cursor <- 0L
  for (map in maps) {
    for (j in seq_along(map$target)) {
      cursor <- cursor + 1L
      A[cursor, map$group == j] <- 1
      b[cursor] <- map$target[j]
      labels[cursor] <- paste0(map$name, ":", map$groups[j])
    }
  }
  keep <- !duplicated(cbind(A, b))
  list(A = A[keep, , drop = FALSE], b = b[keep], labels = labels[keep])
}

#' Diagnose agreement with census margins
#'
#' @param object A fitted `inter_sae` object.
#' @return A data frame containing target, reconstructed value, error, and
#'   relative error for every published census cell.
#' @export
margin_diagnostics <- function(object) {
  if (!inherits(object, "inter_sae")) {
    stop("`object` must be a fitted `inter_sae` object.", call. = FALSE)
  }
  counts <- object$population$grid$.population
  pieces <- lapply(object$population$maps, function(map) {
    current <- as.numeric(rowsum(counts, map$group, reorder = FALSE))
    data.frame(
      table = map$name,
      cell = map$groups,
      target = map$target,
      reconstructed = current,
      error = current - map$target,
      relative_error = abs(current - map$target) / pmax(1, map$target),
      stringsAsFactors = FALSE
    )
  })
  do.call(rbind, pieces)
}
