/
classes.R
154 lines (138 loc) · 5.2 KB
/
classes.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
# classes.R - DESC
# FLasher/R/classes.R
# Copyright European Union, 2016
# Author: Iago Mosqueira (EC JRC) <iago.mosqueira@ec.europa.eu>
#
# Distributed under the terms of the European Union Public Licence (EUPL) V.1.1.
# .biol_quants - biol-based targets
.biol_quants <- c('srp', 'ssb_end', 'biomass_end', 'ssb_spawn', 'biomass_spawn',
'ssb_flash', 'biomass_flash', 'inmb_end', 'indb')
# .qlevels - available quants for fwdControl
.qlevels <- c('catch', 'landings', 'discards', 'f', 'fbar', 'revenue',
'effort', .biol_quants)
# .fcb, .vfcb - Possible fishery-catch-biol combinations in @target {{{
.fcb <- list(
list(quant=c("effort", "revenue"), fishery=TRUE, catch=FALSE, biol=FALSE),
list(quant=c("revenue"), fishery=TRUE, catch=TRUE, biol=FALSE),
list(quant=c("fbar", "f"), fishery=c(TRUE, FALSE), catch=c(TRUE, FALSE),
biol=c(TRUE,TRUE)),
list(quant=c("catch", "landings", "discards"),
fishery=c(TRUE, FALSE),catch=c(TRUE, FALSE), biol=c(FALSE, TRUE)),
list(quant=.biol_quants, catch=FALSE, fishery=FALSE, biol=TRUE))
.foo <- function(x) {
fcb <- as.data.frame(x[2:4])
quant <- rep(x[[1]], each=nrow(fcb))
return(cbind(data.frame(quant=quant), fcb[rep(seq(nrow(fcb)), length(x[[1]])),]))
}
.vfcb <- do.call(rbind, c(lapply(.fcb, .foo), list(make.row.names = FALSE)))
# }}}
# fwdControl class {{{
#' A class for the targets and limits of a fishery and stock projection.
#'
#' The desired targets, limits and time steps used in fishery projections can be
#' specified by creating an object of class `fwdControl`.
#'
#' [...]
#'
#' @name fwdControl
#' @rdname fwdControl
#' @aliases fwdControl fwdControl-methods fwdControl-class
#' @docType class
#'
#' @slot target The table of quantities and time steps used as target, *data.frame*.
#' @slot iters The values and limits for each target quantity and time step, *array*.
#' @slot FCB The matrix describing which FLCatch of which FLFishery catches which FLBiol. A *matrix* with 3 columns: F, C, and B.
#'
#' @section Validity: \describe{
#' \item{VALIDITY}{Neque porro quisquam est qui dolorem ipsum.}
#' }
#'
#' @section Accessors:
#' All slots in the class have accessor and replacement methods defined that
#' allow retrieving and substituting individual slots.
#'
#' The values passed for replacement need to be of the class of that slot.
#' A numeric vector can also be used when replacing FLQuant slots, and the
#' vector will be used to substitute the values in the slot, but not its other
#' attributes.
#'
#' @section Constructor:
#'
#' A construction method exists for this class that can take named arguments for
#' any of its slots. All slots are then created to match the requirements of the
#' class validity. If an unnamed \code{FLQuant} object is provided, this is used
#' for sizing but not stored in any slot.
#'
#' @author Iago Mosqueira, Finlay Scott - EC JRC.
#' @seealso \link{data.frame}
#' @keywords classes
#' @md
#' @examples
#'
#' # CREATE targets on fishing mortality ('f') by year
#'
#' target <- data.frame(year=2000:2010, value=rlnorm(11), quant='f')
#'
#' fwc <- fwdControl(target=target)
#'
#' # INSPECT fwdControl object
#'
#' show(fwc)
setClass("fwdControl",
# REPRESENTATION
slots=c(
target="data.frame",
iters="array",
FCB="array"),
# PROTOTYPE
# year quant season area unit relYear relSeason relFishery relCatch relBiol
# minAge maxAge fishery catch biol
prototype=list(
target=data.frame(
year=1,
quant=factor(NA, levels=.qlevels),
season="all",
area="unique",
unit="unique",
relYear=as.integer(NA),
relSeason=as.integer(NA),
relFishery=as.integer(NA),
relCatch=as.integer(NA),
relBiol=as.integer(NA),
relMinAge=as.integer(NA),
relMaxAge=as.integer(NA),
minAge=as.integer(NA),
maxAge=as.integer(NA),
fishery=as.integer(NA),
catch=as.integer(NA),
biol=as.integer(NA),
stringsAsFactors=FALSE),
iters=array(NA, dimnames=list(row=1, val=c("min", "value", "max"), iter=1),
dim=c(1,3,1)),
FCB=array(c(NA), dim=c(1,3), dimnames=list(1, c("F", "C", "B")))),
# VALIDITY
validity=function(object) {
# rows in target == rows in iters
if(nrow(object@target) != dim(object@iters)[1])
return("Mismatch in number of rows in target and array")
# TODO: classes of data.frame columns
# TODO: colnames in target
# min, value or max not NA TODO NAs in fwdControl@iters by fwdControl()
# if(any(apply(object@iters, 3, function(x) sum(is.na(x))) == 3))
# return("Every target and iter must contain either 'min', 'value' or 'max.")
# FCB
if(!all.equal(dimnames(object@FCB)[[2]], c("F", "C", "B")))
return("colnames of FCB slot are incorrect, must be 'F', 'C', 'B'")
if(length(dim(object@FCB)) != 2)
return("@FCB array must have 2 dimensions")
# multiple biol targets
if(is(object@target$biol, "list")) {
if(any(as.character(object@target$quant)
[unlist(lapply(object@target$biol, length)) > 1] != "catch"))
return("Only 'catch' targets allowed for multiple biols")
}
# levels in "quant"
if(!all(as.character(object@target$quant) %in% .qlevels))
return("Specified 'quant' currently not available as target in fwd")
}
) # }}}