Nothing
vec_slot_fn <- function(x, Data, err = FALSE) {
res <- slot(Data, x)
if (length(res) && !all(is.na(res))) {
return(res[1, ])
} else {
if (err) stop(paste0("Nothing found in Data@", x), call. = FALSE)
return(NULL)
}
}
matrix_slot_fn <- function(x, Data) {
res <- slot(Data, x)
if (length(res) && !all(is.na(res))) return(res[1, , ]) else return(NULL)
}
pull_Ind <- function(Data, maxage) {
Ind_name <- c("Ind", "SpInd", "VInd")
s_sel_Ind <- c("B", "SSB", 1)
s_sel_AddIndType <- 1:3
lapply_fn <- function(x) {
Index <- vec_slot_fn(x = x, Data = Data)
if (!is.null(Index)) {
ICV <- vec_slot_fn(paste0("CV_", x), Data)
if (is.null(ICV)) {
I_sd <- rep(NA_real_, length(Index))
} else {
if (sum(!is.na(ICV)) == 1) I_sd <- rep(ICV[1], length(Index))
I_sd <- sdconv(1, ICV)
}
s_sel <- s_sel_Ind[match(x, Ind_name)]
slotname <- x
} else {
I_sd <- s_sel <- slotname <- NULL
}
return(list(Index = Index, I_sd = I_sd, s_sel = s_sel, slotname = slotname))
}
get_Ind <- lapply(Ind_name, lapply_fn)
out <- list(Index = do.call(cbind, lapply(get_Ind, getElement, "Index")),
I_sd = do.call(cbind, lapply(get_Ind, getElement, "I_sd")),
s_sel = do.call(c, lapply(get_Ind, getElement, "s_sel")),
slotname = do.call(c, lapply(get_Ind, getElement, "slotname")))
if (!is.null(out$Index)) {
out$V <- matrix(NA_real_, maxage + 1, ncol(out$Index))
out$I_units <- rep(1, ncol(out$Index))
} else {
out$V <- out$I_units <- NULL
}
return(out)
}
pull_AddInd <- function(Data, maxage) {
Ind_name <- c("Ind", "SpInd", "VInd")
s_sel_Ind <- c("B", "SSB", 1)
s_sel_AddIndType <- 1:3
if (!all(is.na(Data@AddInd))) {
nindex <- dim(Data@AddInd)[2]
nyears <- dim(Data@AddInd)[3]
Index <- Data@AddInd[1, , ] %>% matrix(nyears, nindex, byrow = TRUE)
if (!all(is.na(Data@CV_AddInd[1, , ]))) {
I_sd <- sdconv(1, Data@CV_AddInd[1, , ]) %>% matrix(nyears, nindex, byrow = TRUE)
} else {
I_sd <- array(NA_real_, dim(Index))
}
V <- matrix(NA_real_, maxage + 1, nindex)
s_sel <- rep(NA_character_, nindex)
for(i in 1:nindex) {
if (!all(is.na(Data@AddIndV[1, i, ]))) {
V[, i] <- Data@AddIndV[1, i, ]
s_sel[i] <- "free"
} else if (!is.na(Data@AddIndType[i])) {
sel_arg <- match(Data@AddIndType[i], s_sel_AddIndType)
if (is.na(sel_arg)) {
warning("Data@AddIndType[", i, "] is undefined, by default, assuming this is a vulnerable biomass index.")
s_sel[i] <- 1
} else {
s_sel[i] <- s_sel_Ind[sel_arg]
}
} else {
s_sel[i] <- 1
warning("Data@AddIndType[", i, "] is undefined, by default, assuming this is a vulnerable biomass index.")
}
}
if (all(!is.na(Data@AddIunits)) && length(Data@AddIunits) == nindex) {
I_units <- Data@AddIunits
} else {
I_units <- rep(1, nindex)
}
return(list(Index = Index, I_sd = I_sd, s_sel = s_sel, slotname = rep("AddInd", ncol(Index)), V = V,
I_units = I_units))
} else {
return(list(Index = NULL, I_sd = NULL, s_sel = NULL, slotname = NULL, V = NULL, I_units = NULL))
}
}
pull_Index <- function(Data, maxage) {
Ind <- pull_Ind(Data, maxage)
AddInd <- pull_AddInd(Data, maxage)
if (all(is.na(Ind$I_sd)) && all(is.na(AddInd$I_sd))) {
I_sd <- NULL
} else {
I_sd <- cbind(Ind$I_sd, AddInd$I_sd)
}
return(list(Index = cbind(Ind$Index, AddInd$Index), I_sd = I_sd, s_selectivity = c(Ind$s_sel, AddInd$s_sel),
slotname = c(Ind$slotname, AddInd$slotname), V = cbind(Ind$V, AddInd$V),
I_units = c(Ind$I_units, AddInd$I_units)))
}
int_s_sel <- function(s_selectivity, nfleet, silent = FALSE) {
if (is.null(s_selectivity)) return(-4)
if (!silent) {
if (any(s_selectivity == "logistic")) message_info("Converting \"logistic\" index selectivity to \"logistic_length\"")
if (any(s_selectivity == "dome")) message_info("Converting \"dome\" index selectivity to \"dome_length\"")
}
s_selectivity[s_selectivity == "logistic"] <- "logistic_length"
s_selectivity[s_selectivity == "dome"] <- "dome_length"
s_sel <- suppressWarnings(as.numeric(s_selectivity)) # Numbers match fleets, otherwise see next lines
s_sel[s_selectivity == "B"] <- -4
s_sel[s_selectivity == "SSB"] <- -3
s_sel[s_selectivity == "free"] <- -2
s_sel[s_selectivity == "logistic_length"] <- -1
s_sel[s_selectivity == "dome_length"] <- 0
s_sel[s_selectivity == "logistic_age"] <- -6
s_sel[s_selectivity == "dome_age"] <- -5
if (any(s_sel > nfleet, na.rm = TRUE)) {
stop(paste("There are undefined fishing fleets in s_selectivity (for indices). There are only", nfleet, "fleets."),
call. = FALSE)
}
if (any(is.na(s_sel))) {
stop("Character entries for s_selectivity (for indices) must be either: \"B\", \"SSB\", \"logistic_length\", \"logistic_age\",
\"dome_length\", \"dome_age\", or \"free\"", call. = FALSE)
}
if (!silent) {
nsurvey <- length(s_selectivity)
message_info("Index selectivity setup:")
for(sur in 1:nsurvey) {
if (s_sel[sur] > 0) {
sout <- paste("fishery fleet", s_sel[sur])
} else {
sout <- switch(s_sel[sur] %>% as.character(),
"-6" = "logistic function (age)",
"-5" = "dome function (age)",
"-4" = "total biomass",
"-3" = "spawning biomass",
"-2" = "individual parameters at age (free)",
"-1" = "logistic function (length)",
"0" = "dome function (length)")
}
message_info("Index ", sur, ": ", sout, ifelse(sur == nsurvey, "\n\n", ""))
}
}
return(s_sel)
}
int_sel <- function(selectivity, RCMdata, silent = FALSE) {
if (!silent) {
if (any(selectivity == "logistic")) message_info("Converting \"logistic\" fishery selectivity to \"logistic_length\"")
if (any(selectivity == "dome")) message_info("Converting \"dome\" fishery selectivity to \"dome_length\"")
}
selectivity[selectivity == "logistic"] <- "logistic_length"
selectivity[selectivity == "dome"] <- "dome_length"
selectivity <- match.arg(
selectivity,
choices = c("logistic_length", "logistic_age", "dome_length", "dome_age", "free"),
several.ok = TRUE
)
sel <- suppressWarnings(as.numeric(selectivity))
sel[selectivity == "free"] <- -2
sel[selectivity == "logistic_length"] <- -1
sel[selectivity == "dome_length"] <- 0
sel[selectivity == "logistic_age"] <- -6
sel[selectivity == "dome_age"] <- -5
if (any(is.na(sel))) {
stop("Character entries for selectivity (for fleets) must be either: \"logistic_length\", \"logistic_age\",
\"dome_length\", \"dome_age\" or \"free\"", call. = FALSE)
}
if (!silent && !missing(RCMdata)) {
message_info("Fishery selectivity setup:")
Yr <- RCMdata@Misc$CurrentYr - RCMdata@Misc$nyears:1 + 1
no_blocks <- apply(RCMdata@sel_block, 2, function(x) length(unique(x)) == 1) %>% all()
for(bb in 1:length(sel)) {
fout <- switch(sel[bb] %>% as.character(),
"-6" = "logistic function (age)",
"-5" = "dome function (age)",
"-2" = "individual parameters at age (free)",
"-1" = "logistic function (length)",
"0" = "dome function (length)")
if (no_blocks) {
message_info("Fleet ", bb, ": ", fout, ifelse(bb == length(sel), "\n\n", ""))
} else {
fleet <- lapply(1:ncol(RCMdata@sel_block), function(ff) {
y <- Yr[RCMdata@sel_block[, ff] == bb]
if (length(y)) {
if (all(diff(y) == 1)) {
paste0(ff, " (", range(y) %>% paste(collapse = "-"), ")")
} else {
paste0(ff, " (", range(y) %>% paste(collapse = "-"), ", with gaps)")
}
} else {
NULL
}
})
message_info("Block ", bb, " (", fout, ") assigned to fishery:\n", do.call(c, fleet) %>% paste(collapse = "\n"),
ifelse(bb == length(sel), "\n\n", ""))
}
}
}
return(sel)
}
make_LWT <- function(LWT, nfleet, nsurvey) {
if (is.null(LWT$Chist)) {
LWT$Chist <- rep(1, nfleet)
} else if (length(LWT$Chist) == 1 && nfleet > 1) {
LWT$Chist <- rep(LWT$Chist, nfleet)
}
if (length(LWT$Chist) != nfleet) stop("LWT$Chist should be a vector of length ", nfleet, ".")
if (is.null(LWT$Index)) {
LWT$Index <- rep(1, max(1, nsurvey))
} else if (length(LWT$Index) == 1 && nsurvey > 1) {
LWT$Index <- rep(LWT$Index, nsurvey)
}
if (length(LWT$Index) != max(1, nsurvey)) stop("LWT$Index should be a vector of length ", nsurvey, ".")
if (is.null(LWT$CAA)) {
LWT$CAA <- rep(1, nfleet)
} else if (length(LWT$CAA) == 1 && nfleet > 1) {
LWT$CAA <- rep(LWT$CAA, nfleet)
}
if (length(LWT$CAA) != nfleet) stop("LWT$CAA should be a vector of length ", nfleet, ".")
if (is.null(LWT$CAL)) {
LWT$CAL <- rep(1, nfleet)
} else if (length(LWT$CAL) == 1 && nfleet > 1) {
LWT$CAL <- rep(LWT$CAL, nfleet)
}
if (length(LWT$CAL) != nfleet) stop("LWT$CAL should be a vector of length ", nfleet, ".")
if (is.null(LWT$MS)) {
LWT$MS <- rep(1, nfleet)
} else if (length(LWT$MS) == 1 && nfleet > 1) {
LWT$MS <- rep(LWT$MS, nfleet)
}
if (length(LWT$MS) != nfleet) stop("LWT$MS should be a vector of length ", nfleet, ".")
if (is.null(LWT$C_eq)) {
LWT$C_eq <- rep(1, max(1, nfleet))
} else if (length(LWT$C_eq) == 1 && nfleet > 1) {
LWT$C_eq <- rep(LWT$C_eq, nfleet)
}
if (length(LWT$C_eq) != nfleet) stop("LWT$C_eq should be a vector of length ", nfleet, ".")
if (is.null(LWT$IAA)) {
LWT$IAA <- rep(1, max(1, nsurvey))
} else if (length(LWT$IAA) == 1 && nsurvey > 1) {
LWT$IAA <- rep(LWT$IAA, nsurvey)
}
if (length(LWT$IAA) != max(1, nsurvey)) stop("LWT$IAA should be a vector of length ", nsurvey, ".")
if (is.null(LWT$IAL)) {
LWT$IAL <- rep(1, max(1, nsurvey))
} else if (length(LWT$IAL) == 1 && nsurvey > 1) {
LWT$IAL <- rep(LWT$IAL, nsurvey)
}
if (length(LWT$IAL) != max(1, nsurvey)) stop("LWT$IAL should be a vector of length ", nsurvey, ".")
return(LWT)
}
#' @rdname RCM
#' @param RCMdata An [RCMdata-class] object.
#' @export
check_RCMdata <- function(RCMdata, OM, condition = "catch", silent = FALSE) {
if (!silent) message_info("\nChecking data...\n")
condition <- match.arg(condition, choices = c("catch", "catch2", "effort"), several.ok = TRUE)
# Preliminary OM check for basics
if (!missing(OM)) {
if (!length(OM@nyears)) stop("OM@nyears is needed.", call. = FALSE)
if (!length(OM@maxage)) stop("OM@maxage is needed.", call. = FALSE)
RCMdata@Misc$nyears <- nyears <- OM@nyears
RCMdata@Misc$maxage <- maxage <- OM@maxage
RCMdata@Misc$CurrentYr <- OM@CurrentYr
} else {
#nyears <- RCMdata@Misc$nyears
maxage <- RCMdata@Misc$maxage
}
# Primarily dimension checking of catch and effort
if (any(grepl("catch", condition))) {
if (!length(RCMdata@Chist)) stop("RCM is conditioning on catch but there are no catch data.", call = FALSE)
# Convert single fleet inputs to multiple fleet, e.g. matrices to arrays
if (!is.matrix(RCMdata@Chist)) RCMdata@Chist <- matrix(RCMdata@Chist, ncol = 1)
RCMdata@Misc$nyears <- nrow(RCMdata@Chist)
RCMdata@Misc$nfleet <- ncol(RCMdata@Chist)
if (RCMdata@Misc$nfleet > 1) {
if (length(condition) == 1) RCMdata@Misc$condition <- condition <- rep(condition, RCMdata@Misc$nfleet)
if (length(condition) != RCMdata@Misc$nfleet) stop("Length of condition vector should be equal to ", RCMdata@Misc$nfleet)
if (any(condition == "catch2") && !all(condition == "catch2")) {
stop("condition must be a combination of either: (1) a combination of \"catch\" and \"effort\" or (2) all \"catch2\"")
}
}
if (all(grepl("catch", condition))) RCMdata@Ehist <- matrix(0, RCMdata@Misc$nyears, RCMdata@Misc$nfleet)
if (!length(RCMdata@Index) && !length(RCMdata@CAA) && !length(RCMdata@CAL) &&
!length(RCMdata@MS) && !length(RCMdata@Ehist)) {
warning("No data other than Chist is provided. Model will switch to conditioning on equilibrium effort.")
RCMdata@Misc$condition <- rep("effort", RCMdata@Misc$nfleet)
RCMdata@Ehist <- matrix(1, RCMdata@Misc$nyears, RCMdata@Misc$nfleet)
RCMdata@E_eq <- rep(1, RCMdata@Misc$nfleet)
} else {
RCMdata@Misc$condition <- condition
}
}
if (any(condition == "effort")) {
if (!length(RCMdata@Ehist)) stop("RCM is conditioning on effort but there are no effort data.", call = FALSE)
# Convert single fleet inputs to multiple fleet, e.g. matrices to arrays
if (!is.matrix(RCMdata@Ehist)) RCMdata@Ehist <- matrix(RCMdata@Ehist, ncol = 1)
if (is.null(RCMdata@Misc$nyears)) {
RCMdata@Misc$nyears <- nrow(RCMdata@Ehist)
} else if (nrow(RCMdata@Ehist) != RCMdata@Misc$nyears) {
stop("Different number of rows between RCMdata@Chist and RCMdata@Ehist.")
}
if (is.null(RCMdata@Misc$nfleet)) {
RCMdata@Misc$nfleet <- ncol(RCMdata@Ehist)
} else if (ncol(RCMdata@Ehist) != RCMdata@Misc$nfleet) {
stop("Different number of columns between RCMdata@Chist and RCMdata@Ehist.")
}
if (RCMdata@Misc$nfleet > 1) {
if (length(condition) == 1) RCMdata@Misc$condition <- condition <- rep(condition, RCMdata@Misc$nfleet)
if (length(condition) != RCMdata@Misc$nfleet) stop("Length of condition vector should be equal to ", RCMdata@Misc$nfleet)
}
# Can condition on effort and fit to catch (provides scaling)
if (!length(RCMdata@Chist) && all(condition == "effort")) {
RCMdata@Chist <- matrix(0, RCMdata@Misc$nyears, RCMdata@Misc$nfleet)
}
if (!is.matrix(RCMdata@Chist)) {
RCMdata@Chist <- matrix(RCMdata@Chist, ncol = 1)
}
RCMdata@Misc$condition <- condition
}
# Another round of checks for dimension
stopifnot(length(RCMdata@Misc$condition) == RCMdata@Misc$nfleet)
if (RCMdata@Misc$nyears != nrow(RCMdata@Chist)) stop("There should be ", RCMdata@Misc$nyears, "rows in RCMdata@Chist")
if (RCMdata@Misc$nyears != nrow(RCMdata@Ehist)) stop("There should be ", RCMdata@Misc$nyears, "rows in RCMdata@Ehist")
if (RCMdata@Misc$nfleet != ncol(RCMdata@Chist)) stop("There should be ", RCMdata@Misc$nfleet, "columns in RCMdata@Ehist")
if (RCMdata@Misc$nfleet != ncol(RCMdata@Ehist)) stop("There should be ", RCMdata@Misc$nfleet, "columns in RCMdata@Ehist")
# Checks for positive catch/effort
if (any(RCMdata@Chist < 0, na.rm = TRUE)) stop("Catch values should be greater than zero.", call. = FALSE)
for(ff in 1:RCMdata@Misc$nfleet) {
if (condition[ff] == "effort") {
if (any(is.na(RCMdata@Ehist[, ff]))) {
stop("Missing values (NA's) in historical effort for fleet ", ff, ". Try linear interpolation to fill these data?", call. = FALSE)
}
if (any(RCMdata@Ehist[, ff] < 0, na.rm = TRUE)) stop("Effort values for fleet ", ff, " should be greater than zero.", call. = FALSE)
}
if (grepl("catch", condition[ff])) {
if (any(is.na(RCMdata@Chist[, ff]))) {
stop("Missing values (NA's) in historical catch for fleet ", ff, ". Try linear interpolation to fill these data?", call. = FALSE)
}
if (any(RCMdata@Chist[, ff] == 0)) {
warning("Catch values of zero for fleet ", ff, " will be replaced with 1e-8.")
RCMdata@Chist[RCMdata@Chist[, ff] == 0, ff] <- 1e-8
}
}
}
if (!silent) {
message(RCMdata@Misc$nfleet, " fleet(s) detected.")
message("RCM is conditioned on:")
message(paste0("Fleet ", 1:RCMdata@Misc$nfleet, ": ", RCMdata@Misc$condition, "\n"))
message(RCMdata@Misc$nyears, " years of data detected.")
message("First year in model: ", RCMdata@Misc$CurrentYr - RCMdata@Misc$nyears + 1)
message("Last year in model: ", RCMdata@Misc$CurrentYr)
}
# Match number of historical years of catch/effort to OM
if (!missing(OM)) {
if (nyears != RCMdata@Misc$nyears) {
cpars_cond <- length(OM@cpars) && any(vapply(OM@cpars, function(x) inherits(x, "matrix") || inherits(x, "array"), logical(1)))
if (cpars_cond) {
stmt <- paste0("OM@nyears is not equal to ", RCMdata@Misc$nyears, ". ",
"There will be indexing errors in your custom parameters (OM@cpars).")
stop(stmt, call. = FALSE)
} else {
warning("OM@nyears was updated to ", RCMdata@Misc$nyears)
OM@nyears <- RCMdata@Misc$nyears
}
}
if (!length(OM@CurrentYr)) OM@CurrentYr <- RCMdata@Misc$nyears
}
# C_sd
if (sum(RCMdata@C_sd, na.rm = TRUE)) {
if (is.vector(RCMdata@C_sd)) {
if (length(RCMdata@C_sd) != RCMdata@Misc$nyears) stop("Length of C_sd vector does not equal nyears (", RCMdata@Misc$nyears, ").", call. = FALSE)
RCMdata@C_sd <- matrix(RCMdata@C_sd, ncol = 1)
} else if (is.matrix(RCMdata@C_sd)) {
if (nrow(RCMdata@C_sd) != RCMdata@Misc$nyears) stop("Number of rows of C_sd matrix does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
if (ncol(RCMdata@C_sd) != RCMdata@Misc$nfleet) stop("Number of columns of C_sd matrix does not equal nfleet (", RCMdata@Misc$nfleet, ").", call. = FALSE)
}
} else {
RCMdata@C_sd <- matrix(0.01, RCMdata@Misc$nyears, RCMdata@Misc$nfleet)
}
# Indices
if (sum(RCMdata@Index, na.rm = TRUE)) {
if (is.vector(RCMdata@Index)) {
if (length(RCMdata@Index) != RCMdata@Misc$nyears) stop("Length of Index vector does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
RCMdata@Index <- matrix(RCMdata@Index, ncol = 1)
} else if (is.matrix(RCMdata@Index)) {
if (nrow(RCMdata@Index) != RCMdata@Misc$nyears) stop("Number of rows of Index matrix does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
} else stop("Index is neither a vector nor a matrix.", call. = FALSE)
RCMdata@Misc$nsurvey <- ncol(RCMdata@Index)
if (sum(RCMdata@I_sd, na.rm = TRUE)) {
if (is.vector(RCMdata@I_sd)) {
if (length(RCMdata@I_sd) != RCMdata@Misc$nyears) stop("Length of I_sd vector does not equal nyears (", RCMdata@Misc$nyears, ").", call. = FALSE)
RCMdata@I_sd <- matrix(RCMdata@I_sd, ncol = 1)
} else if (is.matrix(RCMdata@I_sd)) {
if (nrow(RCMdata@I_sd) != RCMdata@Misc$nyears) stop("Number of rows of I_sd matrix does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
if (ncol(RCMdata@I_sd) != RCMdata@Misc$nsurvey) stop("Number of columns of I_sd matrix does not equal nsurvey (", RCMdata@Misc$nsurvey, ").", call. = FALSE)
}
SD_NA <- is.na(RCMdata@I_sd)
if (sum(SD_NA)) {
SD_out <- !is.na(RCMdata@Index[SD_NA])
if (any(SD_out)) stop("There are NA's in data@I_sd for years associated with survey values in data@Index.", call. = FALSE)
}
} else {
stop("No standard errors were found for the index.", call. = FALSE)
}
} else {
RCMdata@Misc$nsurvey <- 0
RCMdata@Index <- RCMdata@I_sd <- matrix(NA, ncol = 1, nrow = RCMdata@Misc$nyears)
}
if (!silent) message(RCMdata@Misc$nsurvey, " survey(s) detected.")
# Process age comps
if (sum(RCMdata@CAA, na.rm = TRUE)) {
if (is.matrix(RCMdata@CAA)) RCMdata@CAA <- array(RCMdata@CAA, c(dim(RCMdata@CAA), 1))
if (dim(RCMdata@CAA)[1] != RCMdata@Misc$nyears) {
stop("Number of CAA rows (", dim(RCMdata@CAA)[1], ") does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
}
if (dim(RCMdata@CAA)[2] < maxage + 1) {
warning("Number of CAA columns (", dim(RCMdata@CAA)[2], ") does not equal maxage + 1 (", maxage + 1, ").
Assuming no observations for ages greater than 0 - ", dim(RCMdata@CAA)[2] - 1, " and filling with zeros.")
add_ages <- maxage + 1 - dim(RCMdata@CAA)[2]
CAA_new <- array(0, c(RCMdata@Misc$nyears, maxage + 1, RCMdata@Misc$nfleet))
CAA_new[, 1:dim(RCMdata@CAA)[2], ] <- RCMdata@CAA
RCMdata@CAA <- CAA_new
}
if (dim(RCMdata@CAA)[2] > maxage + 1) {
maxage <- dim(RCMdata@CAA)[2] - 1
warning("Increasing maxage to ", maxage, " based on dimension of RCMdata@CAA.")
}
if (dim(RCMdata@CAA)[3] != RCMdata@Misc$nfleet) {
stop("Number of CAA slices (", dim(RCMdata@CAA)[3], ") does not equal nfleet (", RCMdata@Misc$nfleet, "). NAs are acceptable.", call. = FALSE)
}
if (!silent) message("Fleet age comps (CAA) processed, assuming ages 0 - ", maxage, " in array.")
if (!length(RCMdata@CAA_ESS)) {
RCMdata@CAA_ESS <- apply(RCMdata@CAA, c(1, 3), sum, na.rm = TRUE)
}
if (is.vector(RCMdata@CAA_ESS)) {
if (length(RCMdata@CAA_ESS) != RCMdata@Misc$nyears) stop("Length of CAA_ESS vector does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
RCMdata@CAA_ESS <- matrix(RCMdata@CAA_ESS, ncol = 1)
} else if (is.matrix(RCMdata@CAA_ESS)) {
if (nrow(RCMdata@CAA_ESS) != RCMdata@Misc$nyears) stop("Number of rows of CAA_ESS matrix does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
if (ncol(RCMdata@CAA_ESS) != RCMdata@Misc$nfleet) stop("Number of columns of CAA_ESS matrix does not equal nfleet (", RCMdata@Misc$nfleet, "). NAs are acceptable.", call. = FALSE)
} else stop("CAA_ESS is neither a vector nor a matrix.", call. = FALSE)
# Check if CAA_ESS > 0 if there are no data
RCMdata@CAA_ESS[apply(RCMdata@CAA, c(1, 3), sum, na.rm = TRUE) == 0] <- 0
} else {
RCMdata@CAA <- array(0, c(RCMdata@Misc$nyears, maxage + 1, RCMdata@Misc$nfleet))
RCMdata@CAA_ESS <- matrix(0, RCMdata@Misc$nyears, RCMdata@Misc$nfleet)
}
RCMdata@CAA <- apply(RCMdata@CAA, c(1, 3), find_na) %>% aperm(c(2, 1, 3))
if (!missing(OM)) {
if (!silent) message("Checking OM and getting biological parameters...")
OM_samp <- check_OM_for_sampling(OM, RCMdata) # Sample life history, selectivity, and obs parameters
set.seed(OM@seed)
suppressMessages({
StockPars <- MSEtool::SampleStockPars(OM_samp, msg = FALSE)
FleetPars <- MSEtool::SampleFleetPars(OM_samp, msg = FALSE)
})
} else {
StockPars <- FleetPars <- NULL
}
# Process length comps
if (sum(RCMdata@CAL, na.rm = TRUE)) {
if (is.matrix(RCMdata@CAL)) RCMdata@CAL <- array(RCMdata@CAL, c(dim(RCMdata@CAL), 1))
if (dim(RCMdata@CAL)[1] != RCMdata@Misc$nyears) {
stop("Number of CAL rows (", dim(RCMdata@CAL)[1], ") does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
}
if (!silent) message(dim(RCMdata@CAL)[2], " length bins detected in CAL.")
if (dim(RCMdata@CAL)[3] != RCMdata@Misc$nfleet) {
stop("Number of CAL slices (", dim(RCMdata@CAA)[3], ") does not equal nfleet (", RCMdata@Misc$nfleet, "). NAs are acceptable.", call. = FALSE)
}
if (!length(RCMdata@CAL_ESS)) {
RCMdata@CAL_ESS <- apply(RCMdata@CAL, c(1, 3), sum, na.rm = TRUE)
}
if (is.vector(RCMdata@CAL_ESS)) {
if (length(RCMdata@CAL_ESS) != RCMdata@Misc$nyears) stop("Length of CAL_ESS vector does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
RCMdata@CAL_ESS <- matrix(RCMdata@CAL_ESS, ncol = 1)
} else if (is.matrix(RCMdata@CAL_ESS)) {
if (nrow(RCMdata@CAL_ESS) != RCMdata@Misc$nyears) stop("Number of rows of CAL_ESS matrix does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
if (ncol(RCMdata@CAL_ESS) != RCMdata@Misc$nfleet) stop("Number of columns of CAL_ESS matrix does not equal nfleet (", RCMdata@Misc$nfleet, "). NAs are acceptable.", call. = FALSE)
} else stop("CAL_ESS is neither a vector nor a matrix.", call. = FALSE)
# Check if CAL_ESS > 0 if there are no data
RCMdata@CAL_ESS[apply(RCMdata@CAL, c(1, 3), sum, na.rm = TRUE) == 0] <- 0
} else {
RCMdata@CAL_ESS <- matrix(0, RCMdata@Misc$nyears, RCMdata@Misc$nfleet)
}
# Process mean size
if (sum(RCMdata@MS, na.rm = TRUE)) {
if (!length(RCMdata@MS_type) || !nchar(RCMdata@MS_type)) {
warning("Mean size (RCMdata@MS) found, but not type (RCMdata@MS_type). Assuming it's mean length.")
RCMdata@MS_type <- "length"
} else {
RCMdata@MS_type <- match.arg(RCMdata@MS_type, choices = c("length", "weight"))
if (!silent) message("Mean ", RCMdata@MS_type, " data found.")
}
if (is.vector(RCMdata@MS)) {
if (length(RCMdata@MS) != RCMdata@Misc$nyears) stop("Mean size vector (MS) must be of length ", RCMdata@Misc$nyears, ".", call. = FALSE)
RCMdata@MS <- matrix(RCMdata@MS, ncol = 1)
}
if (nrow(RCMdata@MS) != RCMdata@Misc$nyears) stop("Number of MS rows (", nrow(RCMdata@MS), ") does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
if (ncol(RCMdata@MS) != RCMdata@Misc$nfleet) stop("Number of MS columns (", ncol(RCMdata@MS), ") does not equal nfleet (", RCMdata@Misc$nfleet, "). NAs are acceptable.", call. = FALSE)
if (!length(RCMdata@MS_cv)) {
RCMdata@MS_cv <- rep(0.2, RCMdata@Misc$nfleet)
} else if (length(RCMdata@MS_cv) == 1) {
RCMdata@MS_cv <- rep(RCMdata@MS_cv, RCMdata@Misc$nfleet)
}
if (length(RCMdata@MS_cv) != RCMdata@Misc$nfleet) stop("Mean size CV vector (MS_cv) must be of length ", RCMdata@Misc$nfleet, ".", call. = FALSE)
} else {
RCMdata@MS <- matrix(NA, nrow = RCMdata@Misc$nyears, ncol = RCMdata@Misc$nfleet)
RCMdata@MS_cv <- rep(0.2, RCMdata@Misc$nfleet)
RCMdata@MS_type <- "length"
}
# Process equilibrium catch/effort - C_eq
if (!length(RCMdata@C_eq)) RCMdata@C_eq <- rep(0, RCMdata@Misc$nfleet)
if (any(grepl("catch", RCMdata@Misc$condition))) {
if (length(RCMdata@C_eq) == 1) RCMdata@C_eq <- rep(RCMdata@C_eq, RCMdata@Misc$nfleet)
if (length(RCMdata@C_eq) < RCMdata@Misc$nfleet) stop("C_eq needs to be of length nfleet (", RCMdata@Misc$nfleet, ").", call. = FALSE)
}
if (!length(RCMdata@C_eq_sd)) {
RCMdata@C_eq_sd <- rep(0.01, RCMdata@Misc$nfleet)
} else if (length(RCMdata@C_eq_sd) == 1) {
RCMdata@C_eq_sd <- rep(RCMdata@C_eq_sd, RCMdata@Misc$nfleet)
}
if (length(RCMdata@C_eq_sd) != RCMdata@Misc$nfleet) stop("C_eq_sd needs to be of length nfleet (", RCMdata@Misc$nfleet, ").", call. = FALSE)
if (any(grepl("catch", RCMdata@Misc$condition)) && any(RCMdata@C_eq > 0)) {
if (!silent) {
message_info("Equilibrium catch was detected. The corresponding equilibrium F will be estimated for fleets: ",
grep("catch", RCMdata@Misc$condition) %>% paste(collapse = " "))
}
}
if (!length(RCMdata@E_eq)) RCMdata@E_eq <- rep(0, RCMdata@Misc$nfleet)
if (any(RCMdata@Misc$condition == "effort")) {
if (length(RCMdata@E_eq) == 1) RCMdata@E_eq <- rep(RCMdata@E_eq, RCMdata@Misc$nfleet)
if (length(RCMdata@E_eq) < RCMdata@Misc$nfleet) stop("E_eq needs to be of length nfleet (", RCMdata@Misc$nfleet, ").", call. = FALSE)
if (any(RCMdata@E_eq > 0) && !silent) {
message_info("Equilibrium effort was detected. The corresponding equilibrium F will be estimated for fleets: ",
grep("effort", RCMdata@Misc$condition) %>% paste(collapse = " "))
}
}
# Process survey age comps
if (sum(RCMdata@IAA, na.rm = TRUE)) {
if (is.matrix(RCMdata@IAA)) RCMdata@IAA <- array(RCMdata@IAA, c(dim(RCMdata@IAA), 1))
if (dim(RCMdata@IAA)[1] != RCMdata@Misc$nyears) {
stop("Number of IAA rows (", dim(RCMdata@IAA)[1], ") does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
}
if (dim(RCMdata@IAA)[2] < maxage + 1) {
warning("Number of IAA columns (", dim(RCMdata@IAA)[2], ") does not equal maxage + 1 (", maxage + 1, ").
Assuming no observations for ages greater than 0 - ", dim(RCMdata@IAA)[2] - 1, " and filling with zeros.")
add_ages <- maxage + 1 - dim(RCMdata@IAA)[2]
IAA_new <- array(0, c(RCMdata@Misc$nyears, maxage, RCMdata@Misc$nsurvey))
IAA_new[, 1:dim(RCMdata@IAA)[2], ] <- RCMdata@IAA
RCMdata@IAA <- IAA_new
}
if (dim(RCMdata@IAA)[2] > maxage + 1) {
stop("Error in age dimension of IAA.", call. = FALSE)
}
if (dim(RCMdata@IAA)[3] != RCMdata@Misc$nsurvey) {
stop("Number of CAA slices (", dim(RCMdata@IAA)[3], ") does not equal nsurvey (", RCMdata@Misc$nsurvey, "). NAs are acceptable.", call. = FALSE)
}
if (!silent) message("Index age comps (IAA) processed, assuming ages 0 - ", maxage, " in array.")
if (!length(RCMdata@IAA_ESS)) {
RCMdata@IAA_ESS <- apply(RCMdata@IAA, c(1, 3), sum, na.rm = TRUE)
}
if (is.vector(RCMdata@IAA_ESS)) {
if (length(RCMdata@IAA_ESS) != RCMdata@Misc$nyears) stop("Length of IAA_ESS vector does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
RCMdata@IAA_ESS <- matrix(RCMdata@IAA_ESS, ncol = 1)
} else if (is.matrix(RCMdata@IAA_ESS)) {
if (nrow(RCMdata@IAA_ESS) != RCMdata@Misc$nyears) stop("Number of rows of IAA_ESS matrix does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
if (ncol(RCMdata@IAA_ESS) != RCMdata@Misc$nsurvey) stop("Number of columns of IAA_ESS matrix does not equal nsurvey (", RCMdata@Misc$nsurvey, "). NAs are acceptable.", call. = FALSE)
} else stop("IAA_ESS is neither a vector nor a matrix.", call. = FALSE)
# Check if IAA_ESS > 0 if there are no data
RCMdata@IAA_ESS[apply(RCMdata@IAA, c(1, 3), sum, na.rm = TRUE) == 0] <- 0
} else {
RCMdata@IAA <- array(0, c(RCMdata@Misc$nyears, maxage + 1, ncol(RCMdata@Index)))
RCMdata@IAA_ESS <- array(0, dim(RCMdata@Index))
}
RCMdata@IAA <- apply(RCMdata@IAA, c(1, 3), find_na) %>% aperm(c(2, 1, 3))
# Process survey length comps
if (sum(RCMdata@IAL, na.rm = TRUE)) {
if (is.matrix(RCMdata@IAL)) RCMdata@IAL <- array(RCMdata@IAL, c(dim(RCMdata@IAL), 1))
if (dim(RCMdata@IAL)[1] != RCMdata@Misc$nyears) {
stop("Number of IAL rows (", dim(RCMdata@IAL)[1], ") does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
}
if (!silent) message(dim(RCMdata@IAL)[2], " length bins detected in CAL.")
if (dim(RCMdata@IAL)[3] != RCMdata@Misc$nsurvey) {
stop("Number of IAL slices (", dim(RCMdata@IAL)[3], ") does not equal nsurvey (", RCMdata@Misc$nsurvey, "). NAs are acceptable.", call. = FALSE)
}
if (!length(RCMdata@IAL_ESS)) {
RCMdata@IAL_ESS <- apply(RCMdata@IAL, c(1, 3), sum, na.rm = TRUE)
}
if (is.vector(RCMdata@IAL_ESS)) {
if (length(RCMdata@IAL_ESS) != RCMdata@Misc$nyears) stop("Length of IAL_ESS vector does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
RCMdata@IAL_ESS <- matrix(RCMdata@IAL_ESS, ncol = 1)
} else if (is.matrix(RCMdata@IAL_ESS)) {
if (nrow(RCMdata@IAL_ESS) != RCMdata@Misc$nyears) stop("Number of rows of IAL_ESS matrix does not equal nyears (", RCMdata@Misc$nyears, "). NAs are acceptable.", call. = FALSE)
if (ncol(RCMdata@IAL_ESS) != RCMdata@Misc$nsurvey) stop("Number of columns of IAL_ESS matrix does not equal nfleet (", RCMdata@Misc$nsurvey, "). NAs are acceptable.", call. = FALSE)
} else stop("IAL_ESS is neither a vector nor a matrix.", call. = FALSE)
# Check if IAL_ESS > 0 if there are no data
RCMdata@IAL_ESS[apply(RCMdata@IAL, c(1, 3), sum, na.rm = TRUE) == 0] <- 0
} else {
RCMdata@IAL_ESS <- array(0, dim(RCMdata@Index))
}
# Length bin
if (!sum(RCMdata@CAL_ESS) && !sum(RCMdata@IAL_ESS)) { # No length/index data
if (!is.null(StockPars)) {
RCMdata@Misc$lbin <- StockPars$CAL_bins
RCMdata@Misc$lbinmid <- StockPars$CAL_binsmid
}
RCMdata@Misc$nlbin <- length(RCMdata@Misc$lbinmid)
RCMdata@CAL <- array(0, c(RCMdata@Misc$nyears, RCMdata@Misc$nlbin, RCMdata@Misc$nfleet))
RCMdata@IAL <- array(0, c(RCMdata@Misc$nyears, RCMdata@Misc$nlbin, ncol(RCMdata@Index)))
} else {
if (sum(RCMdata@CAL_ESS) && !sum(RCMdata@IAL_ESS)) { # CAL only
RCMdata@Misc$nlbin <- dim(RCMdata@CAL)[2]
RCMdata@IAL <- array(0, c(RCMdata@Misc$nyears, RCMdata@Misc$nlbin, ncol(RCMdata@Index)))
} else if (!sum(RCMdata@CAL_ESS) && sum(RCMdata@IAL_ESS)) { # IAL only
RCMdata@Misc$nlbin <- dim(RCMdata@IAL)[2]
RCMdata@CAL <- array(0, c(RCMdata@Misc$nyears, RCMdata@Misc$nlbin, RCMdata@Misc$nfleet))
} else if (dim(RCMdata@CAL)[2] == dim(RCMdata@IAL)[2]) { # Both CAL/IAL. Check nlbin for both
RCMdata@Misc$nlbin <- dim(RCMdata@CAL)[2]
} else {
stop("Number of length bins in CAL is not equal to those in IAL.", call. = FALSE)
}
if (!length(RCMdata@length_bin)) { # No length bins
stop("You must specify length_bin for your length composition.", call. = FALSE)
} else if (length(RCMdata@length_bin) == RCMdata@Misc$nlbin) { # Even length bins
binWidth <- unique(diff(RCMdata@length_bin))
if (length(binWidth) == 1) {
RCMdata@Misc$lbinmid <- RCMdata@length_bin
RCMdata@Misc$lbin <- c(RCMdata@Misc$lbinmid - 0.5 * binWidth, max(RCMdata@Misc$lbinmid) + 0.5 * binWidth)
} else {
stop("Uneven length bins detected. Provide a vector of length n_bin + 1 of the boundaries of all length bins", call. = FALSE)
}
} else if (length(RCMdata@length_bin) == RCMdata@Misc$nlbin + 1) { # Uneven length bins
RCMdata@Misc$lbin <- RCMdata@length_bin
RCMdata@Misc$lbinmid <- 0.5 * (RCMdata@Misc$lbin[1:RCMdata@Misc$nlbin + 1] - RCMdata@Misc$lbin[1:RCMdata@Misc$nlbin])
} else {
stop("Check vector of length_bin vs. the dimensions of the length compositions.", call. = FALSE)
}
RCMdata@CAL <- apply(RCMdata@CAL, c(1, 3), find_na) %>% aperm(c(2, 1, 3))
RCMdata@IAL <- apply(RCMdata@IAL, c(1, 3), find_na) %>% aperm(c(2, 1, 3))
}
# Absolute survey
if (RCMdata@Misc$nsurvey > 0) {
if (!length(RCMdata@abs_I)) RCMdata@abs_I <- rep(0L, RCMdata@Misc$nsurvey)
if (length(RCMdata@abs_I) < RCMdata@Misc$nsurvey) stop("abs_I should be of length", RCMdata@Misc$nsurvey, call. = FALSE)
} else {
RCMdata@abs_I <- 0L
}
# Index units - biomass/abundance
if (RCMdata@Misc$nsurvey > 0) {
if (!length(RCMdata@I_units)) RCMdata@I_units <- rep(1L, RCMdata@Misc$nsurvey)
if (length(RCMdata@I_units) < RCMdata@Misc$nsurvey) stop("I_units should be of length", RCMdata@Misc$nsurvey, call. = FALSE)
} else {
RCMdata@I_units <- 1L
}
# Ageing error
if (!length(RCMdata@age_error)) RCMdata@age_error <- diag(maxage + 1)
if (any(dim(RCMdata@age_error) != maxage + 1)) stop("age_error should be a square matrix of maxage + 1 rows and columns", call. = FALSE)
# Sel_block dummy fleets
if (!length(RCMdata@sel_block)) {
RCMdata@sel_block <- matrix(1:RCMdata@Misc$nfleet, nrow = RCMdata@Misc$nyears, ncol = RCMdata@Misc$nfleet, byrow = TRUE)
} else {
if (nrow(RCMdata@sel_block) != RCMdata@Misc$nyears) {
stop(paste("sel_block should be a matrix of", RCMdata@Misc$nyears, "rows."), call. = FALSE)
}
if (ncol(RCMdata@sel_block) != RCMdata@Misc$nfleet) {
stop(paste("sel_block should be a matrix of", RCMdata@Misc$nfleet, "columns."), call. = FALSE)
}
}
RCMdata@Misc$nsel_block <- as.numeric(RCMdata@sel_block) %>% unique() %>% length()
if (missing(OM)) OM <- NULL
return(list(RCMdata = RCMdata, OM = OM, StockPars = StockPars, FleetPars = FleetPars))
}
check_OM_for_sampling <- function(OM, RCMdata) {
if (length(OM@nsim) == 0) stop("OM@nsim is needed.", call. = FALSE)
if (length(OM@proyears) == 0) stop("OM@proyears is needed.", call. = FALSE)
if (length(OM@seed) == 0) stop("OM@seed is needed.", call. = FALSE)
cpars <- OM@cpars
###### Stock parameters
# Len_at_age
len_check <- !is.null(cpars$Len_age)
if (!len_check) {
Linf_check <- length(OM@Linf) == 2 || !is.null(cpars$Linf) || !is.null(cpars$Linfarray)
K_check <- length(OM@K) == 2 || !is.null(cpars$K) || !is.null(cpars$Karray)
t0_check <- length(OM@t0) == 2 || !is.null(cpars$t0)
if (!Linf_check && !K_check && !t0_check) stop("Length-at-age not found in OM.", call. = FALSE)
}
# LenCV
LenCV_check <- length(OM@LenCV) == 2 || !is.null(cpars$LenCV) || !is.null(cpars$LatASD)
if (!LenCV_check) {
any_CAL <- !is.null(RCMdata@CAL) && any(RCMdata@CAL > 0, na.rm = TRUE)
any_ML <- RCMdata@MS_type == "length" && any(RCMdata@MS > 0, na.rm = TRUE)
any_IAL <- !is.null(RCMdata@IAL) && any(RCMdata@IAL > 0, na.rm = TRUE)
if (any_CAL || any_ML || any_IAL) {
stop("OM@LenCV not found in OM.", call. = FALSE)
} else {
OM@LenCV <- c(0.1, 0.1)
}
}
# Weight_at_age
wt_check <- !is.null(cpars$Wt_age)
if (!wt_check) {
wt_check2 <- length(OM@a) > 0 && length(OM@b) > 0
if (!wt_check2) stop("Weight-at-age not found in OM.", call. = FALSE)
}
# Maturity
mat_check <- !is.null(cpars$Mat_age) ||
(!is.null(cpars$ageM) & !is.null(cpars$age95)) ||
(!is.null(cpars$L50) & (!is.null(cpars$L95) | !is.null(cpars$L50_95)))
if (!mat_check) {
mat_check2 <- length(OM@L50) == 2 && length(OM@L50_95) == 2
if (!mat_check2) stop("Maturity-at-age not found in OM.", call. = FALSE)
}
# Natural mortality
M_check <- !is.null(cpars$M_at_Length) || !is.null(cpars$Mage) || !is.null(cpars$M) || !is.null(cpars$Marray) || !is.null(cpars$M_ageArray)
if (!M_check) {
M_check2 <- length(OM@M) >= 2
if (!M_check2) stop("Natural mortality not found in OM.", call. = FALSE)
}
# Msd - placeholder
Msd_check <- length(OM@Msd) == 2 || !is.null(cpars$Msd)
if (!Msd_check) OM@Msd <- c(0, 0)
# Steepness
h_check <- length(OM@h) == 2 || !is.null(cpars$h)
if (!h_check) stop("Steepness (OM@h) not found.", call. = FALSE)
# procsd
procsd_check <- !is.null(cpars$Perr) || length(OM@Perr) == 2
if (!procsd_check) stop("OM@Perr not found.", call. = FALSE)
# autocorrelation - placeholder
AC_check <- length(OM@AC) == 2 || !is.null(cpars$AC)
if (!AC_check) OM@AC <- c(0, 0)
# Depletion - placeholder
D_check <- length(OM@D) == 2 || !is.null(cpars$D)
if (!D_check) OM@D <- c(0, 0)
# Stock recruit relationship
SR_check <- length(OM@SRrel) == 1
if (!SR_check) stop("Stock-recruit relationship (OM@SRrel) not found.", call. = FALSE)
# R0 check
R0_check <- length(OM@R0) > 0 || !is.null(cpars$R0)
if (!R0_check) {
if (all(RCMdata@Misc$condition == "effort") && all(!RCMdata@Chist)) {
OM@R0 <- 1
} else {
OM@R0 <- 1e3
warning("OM@R0 is used as the starting value for R0 in RCM, but no value was found. By default, using 1000.")
}
}
# Mvt parameters
OM@Size_area_1 <- OM@Frac_area_1 <- OM@Prob_staying <- c(0.5, 0.5)
# Fdisc placeholder
Fdisc_check <- length(OM@Fdisc) == 2 || !is.null(cpars$Fdisc)
if (!Fdisc_check) OM@Fdisc <- c(0, 0)
###### Fleet Parameters
sel_check <- (length(OM@L5) == 2 | !is.null(cpars$L5)) &&
(length(OM@LFS) == 2 | !is.null(cpars$LFS)) &&
(length(OM@Vmaxlen) == 2 | !is.null(cpars$Vmaxlen))
if (!sel_check) {
stop("Selectivity parameters (OM@L5, OM@LFS, OM@Vmaxlen) not found. These are starting values for selectivity in the model", call. = FALSE)
}
# More placeholders
OM@Esd <- OM@qinc <- OM@qcv <- OM@DR <- c(0, 0)
OM@Spat_targ <- c(1, 1)
OM@EffYears <- c(1, OM@nyears)
OM@EffLower <- OM@EffUpper <- c(0, 1)
###### Observation Parameters - Iobs
if (any(RCMdata@Index > 0, na.rm = TRUE) && !any(RCMdata@I_sd > 0, na.rm = TRUE)) {
Isd_check <- length(OM@Iobs) == 2 || !is.null(cpars$Iobs)
if (!Isd_check) stop("OM@Iobs is needed.", call. = FALSE)
}
Iobs <- OM@Iobs
OM <- MSEtool::Replace(OM, MSEtool::Generic_Obs, silent = TRUE)
if (length(Iobs) == 2) OM@Iobs <- Iobs
###### Imp
OM <- MSEtool::Replace(OM, MSEtool::Perfect_Imp, silent = TRUE)
return(OM)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.