1
#' @include misc.R raptr-internal.R generics.R
2
NULL
3

4
#' RapResults: An S4 class to represent RAP results
5
#'
6
#' This class is used to store RAP results.
7
#'
8
#' @slot summary [base::data.frame()] with summary information on
9
#'  solutions.
10
#'
11
#' @slot selections [base::matrix()] with binary selections. The cell
12
#'   \eqn{x_{ij}} denotes if planning unit \eqn{j} is selected in the
13
#'   \eqn{i}'th solution.
14
#'
15
#' @slot amount.held [base::matrix()] with the amount held for each
16
#'   species in each solution.
17
#'
18
#' @slot space.held [base::matrix()] with the proportion of attribute
19
#'   space sampled for each species in each solution.
20
#'
21
#' @slot best `integer` with index of best solution.
22
#'
23
#' @slot logging.file `character` Gurobi log files.
24
#'
25
#' @slot .cache [base::environment()] used to store extra data.
26
#'
27
#' @details The `summary` table follows Marxan conventions
28
#' (<https://marxansolutions.org/>). The columns
29
#' are:
30
#' \describe{
31
#' \item{Run_Number}{The index of each solution in the object.}
32
#' \item{Status}{The status of the solution. The values in this column
33
#' correspond to outputs from the Gurobi software package (<http://www.gurobi.com/documentation/6.5/refman/optimization_status_codes.html>).}
34
#' \item{Score}{The objective function for the solution.}
35
#' \item{Cost}{Total cost associated with a solution.}
36
#' \item{Planning_Units}{Number of planning units selected in a solution.}
37
#' \item{Connectivity_Total}{The total amount of shared boundary length between
38
#' all planning units. All solutions in the same object should have equal
39
#' values for this column.}
40
#' \item{Connectivity_In}{The amount of shared boundary length among planning
41
#' units selected in the solution.}
42
#' \item{Connectivity_Edge}{The amount of exposed boundary length in the
43
#' solution.}
44
#' \item{Connectivity_Out}{The number of shared boundary length among planning
45
#' units not selected in the solution.}
46
#' \item{Connectivity_Fraction}{The ratio of shared boundary length in the
47
#' solution (`Connectivity_In`) to the total amount of boundary length
48
#' (`Connectivity_Edge`). This ratio is an indicator of solution quality.
49
#' Solutions with a lower ratio will have less planning units and will be more
50
#' efficient.}
51
#' }
52
#'
53
#' @seealso [RapResults()], [read.RapResults()].
54
#'
55
#' @name RapResults-class
56
#'
57
#' @rdname RapResults-class
58
#'
59
#' @exportClass RapResults
60
methods::setClass("RapResults",
61
  methods::representation(summary = "data.frame", selections = "matrix",
62
                          amount.held = "matrix", space.held = "matrix",
63
                          logging.file = "character", best = "integer",
64
                          .cache = "environment"),
65
  validity = function(object) {
66
    # summary
67
    assertthat::assert_that(
68
      all(unlist(sapply(object@summary, function(x) all(!is.na(x))))),
69
      msg = "summary contains NA or non-finite values")
70

71
    # selections
72
    assertthat::assert_that(
73
      all(object@selections %in% c(0, 1)),
74
      msg = "selections contains values that are not 0 or 1")
75

76
    # amount.held
77
    assertthat::assert_that(
78
      all(c(is.finite(object@amount.held))),
79
      msg = "amount.held contains NA or non-finite values")
80
    assertthat::assert_that(
81
      all(object@amount.held >= 0 & object@amount.held <= 1),
82
      msg = "amount.held contains values less than 0 or greater than 1")
83

84
    # space.held
85
    if (any(na.omit(object@space.held) < 0))
86
      warning(paste0("some species have space.held values less than 0, ",
87
                     "and thus are poorly represented"))
88
    if (any(na.omit(object@space.held) > 1))
89
      warning(paste0("some species have space.held values greater than 1, ",
90
                     "due to low precision in the calculations. Increase the ",
91
                     "failure.multiplier parameter to fix this"))
92

93
    # logging.file
94
    assertthat::assert_that(
95
      all(!is.na(object@logging.file)),
96
      msg = "logging.file contains NA values")
97

98
    # best
99
    assertthat::assert_that(
100
      length(object@best) == 1,
101
      msg = "best contains more than one value")
102
    assertthat::assert_that(
103
      all(is.finite(object@best)),
104
      msg = "best contains NA or non-finite values")
105
    assertthat::assert_that(
106
      object@best %in% seq_len(nrow(object@space.held)),
107
      msg = "best is not an index of a solution in object")
108
    # cross-slot dependencies
109
    assertthat::assert_that(
110
      nrow(object@summary) == length(object@logging.file),
111
      msg = "summary has different number of solutions to logging.file")
112
    assertthat::assert_that(
113
      nrow(object@summary) == nrow(object@selections),
114
      msg = paste0("object@summary has different number of solutions to ",
115
                   "object@selections"))
116
    assertthat::assert_that(
117
      nrow(object@summary) == nrow(object@amount.held),
118
      msg = paste0("summary has different number of solutions to ",
119
                   "amount.held"))
120
    assertthat::assert_that(
121
      nrow(object@summary) == nrow(object@space.held),
122
      msg = "summary has different number of solutions to space.held")
123
    return(TRUE)
124
  }
125
)
126

127
#' Create RapResults object
128
#'
129
#' This function creates a new [RapResults()] object.
130
#'
131
#' @param summary [base::data.frame()] with summary information on
132
#'   solutions. See details below for more information.
133
#'
134
#' @param selections [base::matrix()] with binary selections. The
135
#'   cell \eqn{x_{ij}} denotes if planning unit \eqn{j} is selected in the
136
#'   \eqn{i}'th solution.
137
#'
138
#' @param amount.held [base::matrix()] with the amount held for each
139
#'   species in each solution.
140
#'
141
#' @param space.held [base::matrix()] with the proportion of
142
#'   attribute space sampled for each species in each solution.
143
#'
144
#' @param logging.file `character` Gurobi log files.
145
#'
146
#' @param .cache [base::environment()] used to cache calculations.
147
#'
148
#' @details The `summary` table follows Marxan conventions (
149
#' <https://marxansolutions.org/>). The columns
150
#' are:
151
#' \describe{
152
#' \item{Run_Number}{The index of each solution in the object.}
153
#' \item{Status}{The status of the solution. The values in this column
154
#' correspond to outputs from the Gurobi software package (<http://www.gurobi.com/documentation/6.5/refman/optimization_status_codes.html>).}
155
#' \item{Score}{The objective function for the solution.}
156
#' \item{Cost}{Total cost associated with a solution.}
157
#' \item{Planning_Units}{Number of planning units selected in a solution.}
158
#' \item{Connectivity_Total}{The total amount of shared boundary length between
159
#' all planning units. All solutions in the same object should have equal
160
#' values for this column.}
161
#' \item{Connectivity_In}{The amount of shared boundary length among planning
162
#' units selected in the solution.}
163
#' \item{Connectivity_Edge}{The amount of exposed boundary length in the
164
#' solution.}
165
#' \item{Connectivity_Out}{The number of shared boundary length among planning
166
#' units not selected in the solution.}
167
#' \item{Connectivity_Fraction}{The ratio of shared boundary length in the
168
#' solution (`Connectivity_In`) to the total amount of boundary length
169
#' (`Connectivity_Edge`). This ratio is an indicator of solution quality.
170
#' Solutions with a lower ratio will have less planning units and will be more
171
#' efficient.}
172
#' }
173
#'
174
#' @note slot `best` is automatically determined based on data in
175
#'   `summary`.
176
#'
177
#' @return `RapResults` object
178
#'
179
#' @seealso [RapResults-class] [read.RapResults()].
180
#'
181
#' @export
182
RapResults <- function(summary, selections, amount.held, space.held,
183
                       logging.file, .cache = new.env()) {
184 4
  methods::new("RapResults", summary = summary, selections = selections,
185 4
               amount.held = amount.held, space.held = space.held,
186 4
               logging.file = logging.file, best = which.min(summary$Score),
187 4
               .cache = new.env())
188
}
189

190
#' @rdname selections
191
#'
192
#' @export
193
selections.RapResults <- function(x, y = 0) {
194 4
  if (is.null(y))
195 4
    return(x@selections)
196 4
  if (y == 0)
197 4
    return(x@selections[x@best, ])
198 4
  return(x@selections[y, ])
199
}
200

201

202
#' @rdname score
203
#'
204
#' @export
205
score.RapResults <- function(x, y = 0) {
206 4
  if (is.null(y))
207 4
    return(x@summary$Score)
208 4
  if (y == 0)
209 4
    return(x@summary$Score[x@best])
210 4
  return(x@summary$Score[y])
211
}
212

213
#' @method summary RapResults
214
#'
215
#' @export summary
216
summary.RapResults <- function(object) {
217 4
  return(object@summary)
218
}
219

220
#' @rdname logging.file
221
#'
222
#' @export
223
logging.file.RapResults <- function(x, y = 0) {
224 4
  if (is.null(y))
225 4
    return(x@logging.file)
226 4
  if (y == 0)
227 4
    return(x@logging.file[x@best])
228 4
  return(x@logging.file[y])
229
}
230

231
#' @method print RapResults
232
#'
233
#' @rdname print
234
#'
235
#' @export
236
print.RapResults <- function(x, ..., header = TRUE) {
237 0
  assertthat::assert_that(assertthat::is.flag(header))
238 0
  if (header)
239 0
    message("RapResults object.")
240 0
  message("  Number of solutions: ", nrow(x@summary))
241 0
  message(paste0("  Best solution score: ", score(x, 0),
242 0
                 " (", sum(selections(x, 0)), " planning units)"))
243 0
  invisible()
244
}
245

246
#' @rdname show
247
#'
248
#' @usage \S4method{show}{RapResults}(object)
249
#'
250
#' @name show
251
#'
252
#' @aliases show,RapResults-method
253
methods::setMethod("show", "RapResults",
254 0
                   function(object) print.RapResults(object))
255

256

257
#' @rdname is.cached
258
#'
259
#' @name is.cached
260
methods::setMethod("is.cached",
261
                   methods::signature(x = "RapResults", name = "character"),
262 4
                   function(x, name) !is.null(x@.cache[[name]]))
263

264
#' @rdname cache
265
#'
266
#' @name cache
267
methods::setMethod("cache",
268
                   methods::signature(x = "RapResults", name = "character",
269
                                      y = "ANY"),
270 4
                   function(x, name, y) x@.cache[[name]] <- y)
271

272
#' @rdname cache
273
#'
274
#' @name cache
275
methods::setMethod("cache",
276
                   methods::signature(x = "RapResults", name = "character",
277
                                      y = "missing"),
278 4
                   function(x, name, y) x@.cache[[name]])

Read our documentation on viewing source code .

Loading