R/spec_relative_targets.R

In prioritizr: Systematic Conservation Prioritization in R

#' @include internal.R ConservationProblem-class.R
NULL

#' Specify relative targets
#'
#' Specify targets expressed as a proportion (between 0 and 1) of the maximum
#' level of representation of each feature in the study area.
#' Please note that proportions
#' are scaled according to the features' total abundances in the study area
#' (including any locked out planning units, or planning units with `NA`
#' cost values) using the [feature_abundances()] function.
#' Note that this function is designed to be used with [add_auto_targets()]
#' and [add_group_targets()].
#'
#' @param targets `numeric` vector that specifies targets for each
#' of the features. If a single `numeric` value is specified, then all features
#' are assigned the same proportion-based target. Note that values
#' range between 0 and 1 (corresponding to 0% and 100% respectively).
#'
#' @inheritParams spec_absolute_targets
#'
#' @section Mathematical formulation:
#' This method involves setting target thresholds based on a proportion.
#' To express this mathematically, we will define the following terminology.
#' Let \eqn{f} denote the total abundance of a feature (e.g., geographic
#' range size), and \eqn{a} the relative target for the feature
#' (per `targets`).
#' Given this terminology, the target threshold (\eqn{t}) for the feature
#' is calculated as follows.
#' \deqn{t = f \times a}
#'
#' @inherit spec_jung_targets seealso return
#'
#' @seealso
#' To add relative targets directly to a [problem()], see
#' [add_relative_targets()].
#'
#' @family methods
#'
#' @examples
#' \dontrun{
#' # set seed for reproducibility
#' set.seed(500)
#'
#' # load data
#' sim_complex_pu_raster <- get_sim_complex_pu_raster()
#' sim_complex_features <- get_sim_complex_features()
#'
#' # create base problem
#' p0 <-
#'   problem(sim_complex_pu_raster, sim_complex_features) %>%
#'   add_min_set_objective() %>%
#'   add_binary_decisions() %>%
#'   add_default_solver(verbose = FALSE)
#'
#' # create problem with targets of 10% for each feature
#' p1 <-
#'   p0 %>%
#'   add_auto_targets(method = spec_relative_targets(targets = 0.1))
#'
#' # solve problem
#' s1 <- solve(p1)
#'
#' # plot solution
#' plot(s1, main = "solution based on 10% targets", axes = FALSE)
#'
#' # targets can also be specified for each feature separately.
#' # to demonstrate this, we will set a target value for each
#' # feature based on a random percentage between 10% and 80%
#' target_values <- runif(terra::nlyr(sim_complex_features), 0.1, 0.8)
#'
#' # create problem with targets defined separately for each feature
#' p2 <-
#'   p0 %>%
#'   add_auto_targets(method = spec_relative_targets(targets = target_values))
#'
#' # solve problem
#' s2 <- solve(p2)
#'
#' # plot solution
#' plot(s2, main = "solution based on varying targets", axes = FALSE)
#' }
#' @export
spec_relative_targets <- function(targets, ...) {
  # assert arguments are valid
  assert_valid_method_arg(targets)
  assert_required(targets)
  rlang::check_dots_empty()
  # return new method
  new_target_method(
    name = "Relative targets",
    type = "relative",
    fun = calc_relative_targets,
    args = list(targets = targets)
  )
}

calc_relative_targets <- function(x, features, targets,
                                  call = fn_caller_env()) {
  # assert that arguments are valid
  assert_required(x, call = call)
  assert_required(targets, call = call)
  assert(
    # x
    is_conservation_problem(x),
    has_single_zone(x),
    # features
    is_integer(features),
    all(features >= 1),
    all(features <= x$number_of_features()),
    call = call,
    .internal = TRUE
  )
  assert(
    # targets
    is.numeric(targets),
    is_match_of(length(targets), c(1, number_of_features(x))),
    all_finite(targets),
    all_proportion(targets),
    call = call
  )

  # if needed, duplicate target values for each feature
  if (identical(length(targets), 1L)) {
    targets <- rep(targets, x$number_of_features())
  }

  # return targets
  targets[features]
}