R/solutionset-class.R

In multiscape: Multi-Action, Multi-Objective Spatial Planning

#' @include internal.R
#'
#' @export
if (!methods::isClass("SolutionSet")) methods::setOldClass("SolutionSet")
NULL

#' @name solutionset-class
#' @aliases SolutionSet
#' @title SolutionSet class
#'
#' @description
#' The \code{SolutionSet} class stores the result of solving a
#' \code{\link{Problem}} object.
#'
#' A \code{SolutionSet} object is the standard result object returned by
#' \code{\link{solve}}. It may contain a single solved run, as in ordinary
#' single-objective optimization, or multiple solved runs, as in weighted-sum,
#' \eqn{\epsilon}-constraint, or AUGMECON workflows.
#'
#' The object stores the original problem, run-level design and outcome tables,
#' objective values, diagnostics, method metadata, and additional metadata needed
#' to inspect, compare, and analyse optimization results.
#'
#' @details
#' \strong{Conceptual role}
#'
#' The \code{SolutionSet} class represents the result of a solving workflow:
#' \preformatted{
#' Problem -> solve() -> SolutionSet
#' }
#'
#' Single-objective workflows are represented as \code{SolutionSet} objects with
#' one run. Multi-objective workflows are represented as \code{SolutionSet}
#' objects with one or more runs generated by the selected method.
#'
#' This design provides a common result structure for downstream analysis,
#' including objective-value extraction, run diagnostics, trade-off analysis,
#' Pareto-frontier summaries, distance-based ranking, and comparison between
#' scenarios.
#'
#' \strong{Typical use cases}
#'
#' A \code{SolutionSet} is used to inspect and analyse the results returned by
#' \code{\link{solve}}. Typical use cases include:
#' \itemize{
#'   \item inspecting selected planning units or actions;
#'   \item extracting run-level objective values;
#'   \item comparing alternative solutions produced by a multi-objective method;
#'   \item analysing trade-offs between objectives;
#'   \item filtering feasible, unique, or non-dominated solutions;
#'   \item computing distances to observed ideal or nadir points;
#'   \item preparing plots and tables for reporting.
#' }
#'
#' \strong{Internal structure}
#'
#' A \code{SolutionSet} object separates information into several layers:
#'
#' \describe{
#'   \item{\code{problem}}{The \code{Problem} object used to generate the
#'   solution set.}
#'
#'   \item{\code{solution}}{A named \code{list} containing the core solving
#'   outputs. This typically includes the run design, the run summary table, and
#'   the stored run-level solution objects used internally by \pkg{multiscape}.}
#'
#'   \item{\code{summary}}{A named \code{list} containing user-facing summaries
#'   aggregated across runs when such summaries are available.}
#'
#'   \item{\code{diagnostics}}{A named \code{list} containing diagnostics about
#'   the solution set as a whole.}
#'
#'   \item{\code{method}}{A named \code{list} describing the optimization method
#'   used.}
#'
#'   \item{\code{meta}}{A named \code{list} containing additional metadata.}
#'
#'   \item{\code{name}}{A \code{character(1)} identifier for the solution set.}
#' }
#'
#' \strong{Run-level content}
#'
#' The \code{solution} field is the main internal container for run-level
#' information. Typical entries include:
#'
#' \describe{
#'   \item{\code{design}}{A \code{data.frame} describing the optimization
#'   design. In multi-objective workflows this may include weights,
#'   \eqn{\epsilon}-levels, or other method-specific parameters. In
#'   single-objective workflows this table usually contains one row.}
#'
#'   \item{\code{runs}}{A \code{data.frame} summarizing the outcome of each run.
#'   This typically includes run identifiers, solver status, runtime, optimality
#'   gap, objective values, and method-specific information.}
#'
#'   \item{\code{solutions}}{A list of stored run-level solution objects used
#'   internally by \pkg{multiscape}. Users should normally rely on accessor
#'   functions rather than directly manipulating this list.}
#' }
#'
#' In most workflows, the \code{runs} table is the most useful compact
#' representation of the solution set. Detailed inspection should preferably be
#' done through accessor functions such as \code{\link{get_pu}},
#' \code{\link{get_actions}}, \code{\link{get_features}}, and
#' \code{\link{get_targets}}.
#'
#' \strong{Objective values and run tables}
#'
#' The run table may store objective values in columns named
#' \code{value_<alias>}, where \code{<alias>} is the alias of a registered
#' objective. For example:
#' \itemize{
#'   \item \code{value_cost},
#'   \item \code{value_frag},
#'   \item \code{value_benefit}.
#' }
#'
#' This convention provides a compact format for downstream functions that
#' analyse trade-offs, frontiers, or distances between solutions.
#'
#' Depending on the solving method, the run table may also contain design
#' columns such as:
#' \itemize{
#'   \item \code{weight_<alias>} for weighted-sum runs;
#'   \item \code{eps_<alias>} for \eqn{\epsilon}-constraint or AUGMECON runs.
#' }
#'
#' \strong{Single-objective and multi-objective results}
#'
#' \code{solve()} always returns a \code{SolutionSet}. For a single-objective
#' problem, the returned object contains one run. For a multi-objective
#' workflow, the returned object contains one or more runs generated by the
#' selected method.
#'
#' This unified output structure makes it possible to use the same inspection
#' and analysis functions regardless of whether the original problem was
#' single-objective or multi-objective.
#'
#' \strong{Diagnostics}
#'
#' The \code{diagnostics} field stores metadata about the solve process.
#' Depending on the workflow, it may summarize:
#' \itemize{
#'   \item number of design rows;
#'   \item number of attempted runs;
#'   \item number of stored solutions;
#'   \item status frequencies;
#'   \item runtime ranges;
#'   \item gap ranges;
#'   \item and other aggregate information about the set of runs.
#' }
#'
#' \strong{Printing}
#'
#' The \code{print()} method provides a concise summary of the solution set.
#' It reports:
#' \itemize{
#'   \item the optimization method and participating objective aliases;
#'   \item the run-design type when this information is available;
#'   \item the number of design rows, attempted runs, stored solutions, and
#'   runs without a stored solution;
#'   \item run-level status, runtime, and optimality-gap summaries;
#'   \item the observed range of each objective across stored solutions;
#'   \item and any filtering, uniqueness, or append metadata already recorded
#'   in the object.
#' }
#'
#' Printing does not calculate non-dominance, uniqueness, similarities,
#' selection frequencies, or distances. These analyses are intentionally kept
#' outside the print method so that printing remains fast and does not depend on
#' optional packages.
#'
#' This printed output is intended as a quick overview. Detailed inspection
#' should use public accessor and analysis functions such as
#' \code{\link{get_runs}}, \code{\link{get_objectives}},
#' \code{\link{solution_filter}}, and
#' \code{\link{frontier_distances}}.
#'
#' @section Fields:
#' \describe{
#'   \item{\code{problem}}{The \code{Problem} object used to generate the
#'   solution set.}
#'
#'   \item{\code{solution}}{A named \code{list} containing the core solving
#'   outputs, typically including \code{design}, \code{runs}, and internally
#'   stored run-level solutions.}
#'
#'   \item{\code{summary}}{A named \code{list} containing user-facing summaries
#'   associated with the solution set.}
#'
#'   \item{\code{diagnostics}}{A named \code{list} containing diagnostics about
#'   the solution set as a whole.}
#'
#'   \item{\code{method}}{A named \code{list} describing the optimization method
#'   used.}
#'
#'   \item{\code{meta}}{A named \code{list} of additional metadata.}
#'
#'   \item{\code{name}}{A \code{character(1)} name for the solution set
#'   object.}
#' }
#'
#' @section Methods:
#' \describe{
#'   \item{\code{print()}}{Print a concise summary of the solution set,
#'   including method name, number of runs, and run-level diagnostics.}
#'
#'   \item{\code{show()}}{Alias of \code{print()}.}
#'
#'   \item{\code{repr()}}{Return a short one-line representation of the
#'   solution set.}
#'
#'   \item{\code{getMethod()}}{Return the method specification stored in
#'   \code{self$method}.}
#'
#'   \item{\code{getDesign()}}{Return the design table stored in
#'   \code{self$solution$design}.}
#'
#'   \item{\code{getRuns()}}{Return the run summary table stored in
#'   \code{self$solution$runs}.}
#'
#'   \item{\code{getSolutions()}}{Return the internally stored run-level
#'   solution objects. This is mainly intended for advanced use; most users
#'   should prefer higher-level accessor functions.}
#' }
#'
#' @return No return value. This page documents the \code{SolutionSet} class.
#'
#' @seealso
#' \code{\link{solve}},
#' \code{\link{plot_tradeoff}},
#' \code{\link{get_pu}},
#' \code{\link{get_actions}},
#' \code{\link{get_features}},
#' \code{\link{get_targets}}
NULL

.pa_solutionset_method_label <- function(method) {
  if (is.null(method) || !is.list(method)) return("unknown")
  as.character(method$name %||% method$type %||% "unknown")[1]
}

.pa_solutionset_aliases <- function(method) {
  if (is.null(method) || !is.list(method)) return(character(0))
  aliases <- as.character(method$aliases %||% character(0))
  aliases[!is.na(aliases) & nzchar(aliases)]
}


.pa_solutionset_status_summary <- function(runs) {
  if (is.null(runs) || !inherits(runs, "data.frame") || nrow(runs) == 0L || !("status" %in% names(runs))) {
    return("none")
  }

  st <- as.character(runs$status)
  st <- st[!is.na(st) & nzchar(st)]

  if (length(st) == 0L) return("none")

  tb <- table(st)
  paste0(names(tb), ": ", as.integer(tb), collapse = ", ")
}

.pa_solutionset_range_text <- function(x, digits = 3) {
  if (is.null(x)) return("none")
  x <- as.numeric(x)
  x <- x[is.finite(x) & !is.na(x)]
  if (length(x) == 0L) return("none")
  if (length(x) == 1L) return(as.character(round(x, digits)))
  paste0(round(min(x), digits), "..", round(max(x), digits))
}


.pa_solutionset_solution_counts <- function(runs, solutions = NULL) {
  n_runs <- if (inherits(runs, "data.frame")) nrow(runs) else 0L

  if (inherits(runs, "data.frame") && "solution_id" %in% names(runs)) {
    has_solution <- !is.na(runs$solution_id) & runs$solution_id >= 1L
    return(list(stored = sum(has_solution), missing = sum(!has_solution)))
  }

  n_solutions <- if (is.list(solutions)) length(solutions) else 0L
  list(stored = n_solutions, missing = max(0L, n_runs - n_solutions))
}

.pa_solutionset_objective_ranges <- function(runs, digits = 3) {
  if (is.null(runs) || !inherits(runs, "data.frame") || nrow(runs) == 0L) {
    return(character(0))
  }
  value_cols <- grep("^value_", names(runs), value = TRUE)
  if (length(value_cols) == 0L) return(character(0))

  unname(vapply(value_cols, function(nm) {
    values <- suppressWarnings(as.numeric(runs[[nm]]))
    values <- values[is.finite(values) & !is.na(values)]
    objective <- sub("^value_", "", nm)
    if (length(values) == 0L) return(paste0(objective, ": none"))
    paste0(objective, ": ", .pa_solutionset_range_text(values, digits = digits))
  }, character(1)))
}

.pa_solutionset_run_design_summary <- function(method, design = NULL) {
  if (is.null(method) || !is.list(method)) method <- list()

  spec <- method$runs %||% method$run_design %||% method$design %||% NULL

  if (inherits(spec, "RunGrid")) {
    return(list(
      type = "grid",
      detail = paste0(
        "n = ", spec$n %||% "?",
        ", extremes = ", if (isTRUE(spec$include_extremes)) "yes" else "no"
      )
    ))
  }

  if (inherits(spec, "RunManual")) {
    n <- if (!is.null(spec$values) && inherits(spec$values, "data.frame")) nrow(spec$values) else NA_integer_
    return(list(type = "manual", detail = if (is.finite(n)) paste0(n, " requested runs") else NULL))
  }

  type <- as.character(method$run_design_type %||% method$runs_type %||% method$design_type %||% "")[1]
  if (!is.na(type) && nzchar(type)) return(list(type = type, detail = NULL))

  if (inherits(design, "data.frame") && nrow(design) > 0L) {
    design_cols <- grep("^(weight_|eps_)", names(design), value = TRUE)
    if (any(grepl("^weight_", design_cols))) return(list(type = "weighted grid/manual", detail = NULL))
    if (any(grepl("^eps_", design_cols))) return(list(type = "epsilon grid/manual", detail = NULL))
  }

  list(type = "unspecified", detail = NULL)
}

.pa_solutionset_processing_summary <- function(meta) {
  if (is.null(meta) || !is.list(meta)) return(character(0))
  out <- character(0)
  if (isTRUE(meta$filtered)) out <- c(out, "filtered: yes")
  if (isTRUE(meta$nondominated_only) || isTRUE(meta$nondominated)) out <- c(out, "non-dominated only: yes")

  unique_by <- meta$unique_by %||% meta$uniqueness$by %||% NULL
  if (!is.null(unique_by) && length(unique_by) > 0L) out <- c(out, paste0("unique by: ", as.character(unique_by)[1]))

  n_sources <- meta$n_sources %||% meta$appended_sources %||% NULL
  if (!is.null(n_sources) && length(n_sources) == 1L && is.finite(as.numeric(n_sources))) {
    out <- c(out, paste0("combined sources: ", as.integer(n_sources)))
  }
  out
}

.pa_solutionset_run_columns <- function(runs) {
  if (is.null(runs) || !inherits(runs, "data.frame") || nrow(runs) == 0L) {
    return(list(design = character(0), values = character(0), core = character(0)))
  }

  nm <- names(runs)

  core_cols <- intersect(c("run_id", "status", "runtime", "gap"), nm)
  design_cols <- grep("^(weight_|eps_)", nm, value = TRUE)
  value_cols <- grep("^value_", nm, value = TRUE)

  list(
    core = core_cols,
    design = design_cols,
    values = value_cols
  )
}



#' @export
SolutionSet <- pproto(
  "SolutionSet",
  problem = NULL,
  solution = list(),
  summary = list(),
  diagnostics = list(),
  method = list(),
  meta = list(),
  name = "solset",

  print = function(self) {
    ch <- .pa_cli_box_chars()
    div_id <- cli::cli_div(theme = .pa_cli_theme())

    method_name <- .pa_solutionset_method_label(self$method)
    aliases <- .pa_solutionset_aliases(self$method)

    design <- self$solution$design %||% NULL
    runs <- self$solution$runs %||% NULL
    sols <- self$solution$solutions %||% list()

    n_design <- if (inherits(design, "data.frame")) nrow(design) else 0L
    n_runs <- if (inherits(runs, "data.frame")) nrow(runs) else 0L

    counts <- .pa_solutionset_solution_counts(runs, sols)
    n_solutions <- counts$stored
    n_without_solution <- counts$missing

    alias_txt <- if (length(aliases) == 0L) {
      "none"
    } else {
      .pa_preview_text(aliases, max_show = 6L, quote = FALSE)
    }

    status_txt <- .pa_solutionset_status_summary(runs)
    runtime_txt <- if (inherits(runs, "data.frame") && "runtime" %in% names(runs)) {
      .pa_solutionset_range_text(runs$runtime, digits = 3)
    } else "none"
    gap_txt <- if (inherits(runs, "data.frame") && "gap" %in% names(runs)) {
      .pa_solutionset_range_text(runs$gap, digits = 4)
    } else "none"

    run_cols <- .pa_solutionset_run_columns(runs)
    design_txt <- if (length(run_cols$design) == 0L) "none" else paste(run_cols$design, collapse = ", ")
    value_txt <- if (length(run_cols$values) == 0L) "none" else paste(run_cols$values, collapse = ", ")

    run_design <- .pa_solutionset_run_design_summary(self$method, design)
    objective_ranges <- .pa_solutionset_objective_ranges(runs, digits = 3)
    processing <- .pa_solutionset_processing_summary(self$meta)

    cli::cli_text("A multiscape solution set ({.cls SolutionSet})")

    cli::cli_text("{ch$j}{ch$b}{.h method}", .envir = environment())
    cli::cli_text("{ch$v}{ch$j}{ch$b}name:              {.code {method_name}}", .envir = environment())
    cli::cli_text("{ch$v}{ch$j}{ch$b}objectives:        {length(aliases)} ({alias_txt})", .envir = environment())
    cli::cli_text("{ch$v}{ch$l}{ch$b}run design:        {run_design$type}", .envir = environment())

    if (!is.null(run_design$detail) && nzchar(run_design$detail)) {
      cli::cli_text("{ch$v} {ch$l}{ch$b}design detail:     {run_design$detail}", .envir = environment())
    }

    cli::cli_text("{ch$l}{ch$b}{.h content}", .envir = environment())
    cli::cli_text(" {ch$v}{ch$j}{ch$b}design rows:       {n_design}", .envir = environment())
    cli::cli_text(" {ch$v}{ch$j}{ch$b}attempted runs:    {n_runs}", .envir = environment())
    cli::cli_text(" {ch$v}{ch$j}{ch$b}stored solutions:  {n_solutions}", .envir = environment())
    cli::cli_text(" {ch$v}{ch$l}{ch$b}without solution:  {n_without_solution}", .envir = environment())

    cli::cli_text("{ch$l}{ch$b}{.h run summary}", .envir = environment())
    cli::cli_text(" {ch$v}{ch$j}{ch$b}statuses:          {status_txt}", .envir = environment())
    cli::cli_text(" {ch$v}{ch$j}{ch$b}runtime:           {runtime_txt}", .envir = environment())
    cli::cli_text(" {ch$v}{ch$j}{ch$b}gap:               {gap_txt}", .envir = environment())
    cli::cli_text(" {ch$v}{ch$j}{ch$b}design columns:    {design_txt}", .envir = environment())
    cli::cli_text(" {ch$v}{ch$l}{ch$b}objective columns: {value_txt}", .envir = environment())

    if (length(objective_ranges) > 0L) {
      cli::cli_text("{ch$l}{ch$b}{.h objective ranges}", .envir = environment())
      for (i in seq_along(objective_ranges)) {
        branch <- if (i < length(objective_ranges)) ch$j else ch$l
        cli::cli_text(" {ch$v}{branch}{ch$b}{objective_ranges[[i]]}", .envir = environment())
      }
    }

    if (length(processing) > 0L) {
      cli::cli_text("{ch$l}{ch$b}{.h processing}", .envir = environment())
      for (i in seq_along(processing)) {
        branch <- if (i < length(processing)) ch$j else ch$l
        cli::cli_text(" {ch$v}{branch}{ch$b}{processing[[i]]}", .envir = environment())
      }
    }

    info_sym <- cli::symbol$info
    if (is.function(info_sym)) info_sym <- info_sym()

    cli::cli_text(cli::col_grey(paste0(
      "# ", info_sym,
      " Use get_runs(), get_objectives(), get_pu(), and get_actions() to inspect results."
    )))

    if (length(aliases) > 1L && n_solutions > 1L) {
      cli::cli_text(cli::col_grey(paste0(
        "# ", info_sym,
        " Use solution_filter(), frontier_extremes(), and frontier_distances() for multi-objective analysis."
      )))
    }

    cli::cli_end(div_id)
    invisible(TRUE)
  },

  show = function(self) self$print(),

  repr = function(self) {
    method_name <- .pa_solutionset_method_label(self$method)
    runs <- self$solution$runs %||% NULL
    sols <- self$solution$solutions %||% list()
    n_runs <- if (inherits(runs, "data.frame")) nrow(runs) else 0L
    counts <- .pa_solutionset_solution_counts(runs, sols)
    paste0(
      "<SolutionSet> method=", method_name,
      ", runs=", n_runs,
      ", solutions=", counts$stored
    )
  },

  getMethod = function(self) self$method,
  getDesign = function(self) self$solution$design %||% NULL,
  getRuns = function(self) self$solution$runs %||% NULL,
  getSolutions = function(self) self$solution$solutions %||% list()
)



#' Wrap a single-run result into a SolutionSet
#'
#' @description
#' Internal helper used by solve.Problem() so that solve() always returns a
#' SolutionSet object, even for single-objective problems.
#'
#' The internal run-level result is stored in
#' \code{x$solution$solutions}, while the \code{SolutionSet} receives a
#' one-row design table and a one-row run table.
#'
#' @noRd
.pa_as_single_solution_set <- function(sol,
                                       problem = NULL,
                                       name = "solset") {
  if (!inherits(sol, "Solution")) {
    stop("`sol` must be a valid internal single-run result.", call. = FALSE)
  }

  problem <- problem %||% sol$problem %||% NULL

  # Assign stable metadata to the contained run-level result.
  sol$meta <- sol$meta %||% list()
  sol$meta$run_id <- 1L

  sol$method <- sol$method %||% list()
  sol$method$type <- sol$method$type %||% "single"
  sol$method$name <- sol$method$name %||% "single"

  # Extract diagnostics safely.
  status <- tryCatch(getStatus(sol), error = function(e) "unknown")

  runtime <- tryCatch(
    as.numeric(sol$diagnostics$runtime %||% NA_real_),
    error = function(e) NA_real_
  )

  gap <- tryCatch(
    as.numeric(sol$diagnostics$gap %||% NA_real_),
    error = function(e) NA_real_
  )

  objective <- tryCatch(
    as.numeric(sol$solution$objective %||% NA_real_),
    error = function(e) NA_real_
  )

  alias_values <- sol$solution$alias_values %||% NULL

  if (is.null(alias_values) || length(alias_values) == 0L) {
    alias_values <- numeric(0)
  } else {
    alias_values <- as.numeric(alias_values)
    names(alias_values) <- names(sol$solution$alias_values)
  }

  aliases <- names(alias_values)
  aliases <- aliases[!is.na(aliases) & nzchar(aliases)]

  # One-row design table.
  design <- data.frame(
    run_id = 1L,
    stringsAsFactors = FALSE
  )

  # One-row runs table.
  runs <- data.frame(
    run_id = 1L,
    status = status,
    runtime = runtime,
    gap = gap,
    objective = objective,
    stringsAsFactors = FALSE
  )

  if (length(alias_values) > 0L) {
    value_df <- as.data.frame(
      as.list(stats::setNames(
        as.numeric(alias_values),
        paste0("value_", names(alias_values))
      )),
      stringsAsFactors = FALSE
    )

    runs <- cbind(runs, value_df)
  }

  solutions <- list(sol)
  names(solutions) <- "1"

  # Reuse the same summary binder used by multi-objective methods.
  summary_set <- .pamo_bind_solution_summaries(
    solutions = solutions,
    run_ids = 1L
  )

  solutions <- .pa_strip_nested_solution_problems(solutions)

  out <- pproto(
    NULL,
    SolutionSet,
    problem = problem,
    solution = list(
      design = design,
      runs = runs,
      solutions = solutions
    ),
    summary = summary_set,
    diagnostics = list(
      n_design = nrow(design),
      n_runs = nrow(runs),
      n_solutions = length(solutions),
      status_summary = .pa_solutionset_status_summary(runs),
      runtime_range = if ("runtime" %in% names(runs)) {
        .pa_solutionset_range_text(runs$runtime, digits = 3)
      } else {
        "none"
      },
      gap_range = if ("gap" %in% names(runs)) {
        .pa_solutionset_range_text(runs$gap, digits = 4)
      } else {
        "none"
      }
    ),
    method = list(
      type = "single",
      name = "single",
      aliases = aliases
    ),
    meta = list(
      single_objective = TRUE,
      wrapped_solution = TRUE
    ),
    name = name
  )

  .pa_finalize_solution_ids(out)
}