R/control_rule.R

Defines functions control_rule

Documented in control_rule

#' Control rule
#'
#' \code{control_rule} determines how to calculate the density ratio and manage
#'    the fishery (i.e. set fishing effort for the next timestep).
#'
#' @param t temporary numeric value, the current time step.
#' @param cr temporary numeric value, the current control rule.
#' @param fdr temporary numeric value, the current final target density ratio.
#' @param A numeric value, the number of total areas in the model. Default
#'    value is 5.
#' @param E numeric array, the relative fishing effort displayed in each area,
#'    at each time step, under each control rule, and for each natural mortality
#'    estimate.
#' @param Count numeric array, the number of individuals estimated to be in each
#'    area, at each timestep, under each control rule, for each estimate of
#'    natural mortality, for both all individuals and just mature individuals.
#' @param Time1 numeric value, the number of years to run the model before a
#'    marine reserve is implemented. Default value is 50.
#' @param TimeT numeric value, the number of years to run the model total.
#'    Default value is 70.
#' @param Transects numerical value, the number of sampling transects conducted
#'    in each area to estimate density ratio. Default value is 24.
#' @param Nat_mortality numeric vector, the estimates of natural mortality.
#' @param Final_DRs numeric vector, the final target density ratios.
#' @param Inside numeric vector, the area(s) inside the marine reserve. Default
#'    is c(3).
#' @param Outside numeric vector, the area(s) outside the marine reserve.
#'    Default is c(1, 2, 4, 5).
#' @param Years_sampled numeric value, the number of years of sampling upon
#'    which to base the estimate of density ratio. Default value is 1.
#' @param Areas_sampled character value, the areas to be sampled to calculate
#'    density ratio. Values can be:
#'    'all' - sample all areas.
#'    'far' - sample only areas farthest from the marine reserve.
#'    Default value is 'all'.
#' @param Ind_sampled character value, the individuals to be sampled to
#'    calculate density ratio. Values can be:
#'    'all' - sample all individuals.
#'    'mature' - sample only mature individuals.
#'    Default value is 'all'.
#' @param Floor_DR numeric value, the DR value under which effort will be
#'    reduced to 10\% of its starting value. Default value is 0.2.
#' @param BM logical value, are the control rules from Babcock and MacCall 2011?
#'    Default value is FALSE.
#' @param Sampling_Var logical value, is there any error in sampling? Default
#'    value is TRUE.
#' @param Density_ratio numeric array, the true density ratio at each time step
#'    under each control rule and for each final density ratio.
#' @return a numeric vector of fishing effort for the next timestep, under the
#'    specific control rule, with a specific estimate of natural mortality.
#' @param Abundance numeric array, the total number of individuals in each area,
#'    at each timestep, under all control rules, with all estimates of natural
#'    mortality.
#' @export
#'
#' @examples
#' A = 5; TimeT = 70; CR = 6; FDR = 4; Transects = 24
#' E <- array(rep(1, A*TimeT*CR*FDR), c(A, TimeT, CR, FDR))
#' Count <- array(rep(5, A*TimeT*Transects*2*CR*FDR),
#'    c(A, TimeT, Transects, 2, CR, FDR))
#' Density_Ratio <- array(rep(0.5, TimeT*CR*FDR), c(TimeT, CR, FDR))
#' Abundance <- array(rep(3400, A*TimeT*CR*FDR*1), c(A, TimeT, CR, FDR, 1))
#' control_rule(t = 51, cr = 1, fdr = 1, A = 5, E, Count, Time1 = 50,
#'    TimeT = 70, Transects = 24, Nat_mortality = c(0.14, 0.09, 0.19),
#'    Final_DRs = c(0.2, 0.4, 0.6, 0.8), Inside = 3, Outside = c(1, 2, 4, 5),
#'    Years_sampled = 1, Areas_sampled = 'all', Ind_sampled = 'all',
#'    Floor_DR = 0.2, BM = FALSE, Sampling_Var = TRUE, Density_Ratio,
#'    Abundance)
control_rule <- function(t, cr, fdr, A = 5, E, Count, Time1 = 50,
                         TimeT = 70, Transects = 24, Nat_mortality, Final_DRs,
                         Inside = 3, Outside = c(1, 2, 4, 5), Years_sampled = 1,
                         Areas_sampled = 'all', Ind_sampled = 'all',
                         Floor_DR = 0.2, BM = FALSE, Sampling_Var = TRUE,
                         Density_ratio, Abundance) {

  ###### Error handling ########################################################

  # classes of variables
  if (t %% 1 != 0) {stop('t must be an integer value.')}
  if (cr %% 1 != 0) {stop('cr must be an integer value.')}
  if (fdr %% 1 != 0) {stop('fdr must be an integer value.')}
  if (A %% 1 != 0) {stop('A must be an integer value.')}
  if (!is.numeric(E)) {stop('E must be a numeric array.')}
  if (!is.numeric(Count)) {stop('Count must be a numeric array.')}
  if (Time1 %% 1 != 0) {stop('Time1 must be an integer value.')}
  if (TimeT %% 1 != 0) {stop('TimeT must be an integer value.')}
  if (Transects %% 1 != 0) {stop('Transects must be an integer value.')}
  if (!is.numeric(Nat_mortality)) {
    stop('Nat_mortality must be a numeric vector.')}
  if (!is.numeric(Final_DRs)) {stop('Final_DRs must be a numeric vector.')}
  if (sum(Inside %% 1 != 0) != 0) {stop('Inside must be a vector of integers.')}
  if (sum(Outside %% 1 != 0) != 0) {
    stop('Outside must be a vector of integers.')}
  if (Years_sampled %% 1 != 0 && !is.null(Years_sampled)) {
    stop('Years_sampled must be an integer value or NULL.')}
  if (!is.character(Areas_sampled) && !is.null(Areas_sampled)) {
    stop('Areas_sampled must be a character value or NULL.')}
  if (!is.character(Ind_sampled) && !is.null(Ind_sampled)) {
    stop('Ind_sampled must be a character value or NULL.')}
  if (!is.numeric(Floor_DR)) {stop('Floor_DR must be a numeric vector.')}
  if (!is.logical(BM)) {stop('BM must be a logical value.')}
  if (!is.logical(Sampling_Var)) {
    stop('Sampling_Var must be a logical value.')}
  if (!is.numeric(Density_ratio)) {stop('Density_ratio must be a numeric array.')}
  if (!is.numeric(Abundance)) {stop('Abundance must be a numeric array.')}

  # acceptable values
  if (t <= 0) {stop('t must be greater than 0.')}
  if (cr <= 0) {stop('cr must be greater than 0.')}
  if (fdr <= 0) {stop('fdr must be greater than 0.')}
  if (A <= 0) {stop('A must be greater than 0.')}
  if (sum(E < 0) > 0) {
    stop('All values in E must be greater than or equal to 0.')}
  if (sum(Count < 0) > 0) {
    stop('All values in Count must be greater than or equal to 0.')}
  if (Time1 <= 0) {stop('Time1 must be greater than 0.')}
  if (TimeT <= 0) {stop('TimeT must be greater than 0.')}
  if (Transects <= 0) {stop('Transects must be greater than 0.')}
  if (sum(Nat_mortality <= 0) > 0 || sum(Nat_mortality > 1) > 0) {
    stop('All values in Nat_mortality must be between 0 and 1.')}
  if (sum(Final_DRs <= 0) > 0) {
    stop('All values in Final_DRs must be greater than 0.')}
  if (sum(Inside < 0) > 0) {
    stop('All values in Inside must be greater than or equal to 0.')}
  if (sum(Outside < 0) > 0) {
    stop('All values in Outside must be greater than or equal to 0.')}
  if (is.numeric(Years_sampled) && Years_sampled <= 0) {
    stop('Years_sampled must be greater than 0 or NULL.')}
  if (is.character(Areas_sampled) && Areas_sampled != 'far' &&
      Areas_sampled != 'all' ) {
    stop('Areas_sampled must be either "far" or "all" or NULL.')}
  if (is.character(Ind_sampled) && Ind_sampled != 'mature' &&
      Ind_sampled != 'all') {
    stop('Ind_sampled must be either "mature" or "all" or NULL.')}
  if (Floor_DR <= 0) {stop('Floor_DR must be greater than 0.')}
  if (sum(Density_ratio < 0) > 0) {
    stop('All values in Density_ratio must be greater than or equal to 0.')}
  if (sum(Abundance < 0) > 0) {
    stop('All values in Abundance must be greater than or equal to 0.')}

  # relational values
  if (sum(Inside > A) > 0) {
    stop('All values in Inside must be less than or equal to A.')}
  if (sum(Outside > A) > 0) {
    stop('All values in Outside must be less than or equal to A.')}
  if (sum(intersect(Inside, Outside)) > 0) {
    stop('Areas cannot both be inside and outside the marine reserve.')}
  if (Time1 >= TimeT) {stop('TimeT must be greater than Time1.')}
  if(dim(E)[1] != dim(Count)[1] | dim(E)[1] != A | dim(Abundance)[1] != A) {
    stop('E, Count, or Abundance has an incorrect number of areas.')}
  if(dim(E)[2] != dim(Count)[2] | dim(E)[2] != TimeT ||
     dim(Density_ratio)[1] != TimeT | dim(Abundance)[2] != TimeT) {
    stop('E, Count, Density_ratio, or Abundance has an incorrect number of time
         steps.')}
  if(dim(Count)[3] != Transects) {
    stop('Count has the wrong number of transects.')}
  if(dim(E)[3] != dim(Count)[5]  | dim(E)[3] != dim(Density_ratio)[2] |
     dim(Abundance)[3] != dim(E)[3]) {
    stop('E, Count, Density_ratio, or Abundance has an incorrect number of
         control rules.')}
  if(dim(E)[4] != dim(Count)[6] | dim(E)[4] != dim(Abundance)[4]) {
    stop('E, Count, Density_ratio, or Abundance has an incorrect number of
         final density ratios.')}
  if (t > dim(E)[2]) {stop('The given "t" value is too high for E.')}
  if (cr > dim(E)[3]) {stop('The given "cr" value is too high for E.')}
  if (fdr > dim(E)[4]) {stop('The given "fdr" value is too high for E.')}
  if (Floor_DR > min(Final_DRs)) {
    stop('Floor_DR must be less than or equal to the minimum final density
         ratio.')}

  ##############################################################################

  # if there is no sampling error, use true DR to dictate effort for next time
  # step
  True_DR <- Density_ratio[t, cr, fdr]

  if (BM == FALSE) {

    j <- ceiling(cr / 2)

    if (Sampling_Var == TRUE) {
        DR <- density_ratio(t, cr, fdr, A, Count, Years_sampled,
                          Areas_sampled, Ind_sampled, Transects, Inside,
                          Outside)
      } else { DR <- True_DR }

    # static control rules, with constant target DRs (cr = 1, 3, 5)
    if (cr %% 2 == 1) {

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr, E, DR,
                                        target_DR = Final_DRs[fdr],
                                        floor_DR = Floor_DR,
                                        effort_inc_allowed = 0.1, Time1)

      # transient control rules with shifting target DRs (cr = 2, 4, 6)
    } else if (cr %% 2 == 0) {

      target <- transient_DR(Time1, TimeT, Final_DRs, Nat_mortality, cr, fdr)

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr, E, DR,
                                        target_DR = target[t - Time1 + 1],
                                        floor_DR = Floor_DR,
                                        effort_inc_allowed = 0.1, Time1)
    }

  } else if (BM == TRUE) {

    Final_DRs <- c(0.7, 0.8, 0.9)

    if (cr == 1) {

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- 1.1*E[, t, cr, fdr]

    } else if (cr == 2) {

      DR <- true_DR(t, cr, fdr = 1, Abundance, Inside, Outside, Density_ratio,
                    BM = TRUE, Years_sampled = 3, Areas_sampled = 'all',
                    Ind_sampled = 'all', A = 5)

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr = 1, E, DR,
                                        target_DR = 0.6, floor_DR = 0.2,
                                        effort_inc_allowed = 0.1, Time1)

    } else if (cr == 3) {

      DR <- true_DR(t, cr, fdr = 1, Abundance, Inside, Outside, Density_ratio,
                    BM = TRUE, Years_sampled = 1, Areas_sampled = 'all',
                    Ind_sampled = 'all', A = 5)

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr = 1, E, DR,
                                        target_DR = 0.6, floor_DR = 0.2,
                                        effort_inc_allowed = 0.1, Time1)

    } else if (cr == 4) {

      DR <- true_DR(t, cr, fdr = 1, Abundance, Inside, Outside, Density_ratio,
                    BM = TRUE, Years_sampled = 1, Areas_sampled = 'far',
                    Ind_sampled = 'all', A = 5)

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr = 1, E, DR,
                                        target_DR = 0.6, floor_DR = 0.2,
                                        effort_inc_allowed = 0.1, Time1)

    } else if (cr == 5) {

      DR <- true_DR(t, cr, fdr = 1, Abundance, Inside, Outside, Density_ratio,
                    BM = TRUE, Years_sampled = 1, Areas_sampled = 'all',
                    Ind_sampled = 'mature', A = 5)

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr = 1, E, DR,
                                        target_DR = 0.6, floor_DR = 0.2,
                                        effort_inc_allowed = 0.1, Time1)

    } else if (cr == 6) {

      DR <- true_DR(t, cr, fdr = 1, Abundance, Inside, Outside, Density_ratio,
                    BM = TRUE, Years_sampled = 1, Areas_sampled = 'all',
                    Ind_sampled = 'all', A = 5)

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr = 1, E, DR,
                                        target_DR = 0.8, floor_DR = 0.2,
                                        effort_inc_allowed = 0.1, Time1)

    } else if (cr == 7) {

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- E[, t, cr, fdr]

    } else if (cr == 8) {

      DR <- true_DR(t, cr, fdr = 1, Abundance, Inside, Outside, Density_ratio,
                    BM = TRUE, Years_sampled = 1, Areas_sampled = 'all',
                    Ind_sampled = 'all', A = 5)

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr = 1, E, DR,
                                        target_DR = 0.6, floor_DR = 0.2,
                                        effort_inc_allowed = 0, Time1)

    } else if (cr == 9) {

      DR <- true_DR(t, cr, fdr = 1, Abundance, Inside, Outside, Density_ratio,
                    BM = TRUE, Years_sampled = 1, Areas_sampled = 'all',
                    Ind_sampled = 'all', A = 5)

      target <- transient_DR(Time1, TimeT, Final_DRs, Nat_mortality, cr = 1,
                             fdr = 1)

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr = 1, E, DR,
                                        target_DR = target[t - Time1 + 1],
                                        floor_DR = 0.2,
                                        effort_inc_allowed = 0.1, Time1)

    } else if (cr == 10) {

      DR <- true_DR(t, cr, fdr = 1, Abundance, Inside, Outside, Density_ratio,
                    BM = TRUE, Years_sampled = 1, Areas_sampled = 'all',
                    Ind_sampled = 'all', A = 5)

      target <- transient_DR(Time1, TimeT, Final_DRs, Nat_mortality, cr = 1,
                             fdr = 2)

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr = 1, E, DR,
                                        target_DR = target[t - Time1 + 1],
                                        floor_DR = 0.2,
                                        effort_inc_allowed = 0.1, Time1)

    } else if (cr == 11) {

      DR <- true_DR(t, cr, fdr = 1, Abundance, Inside, Outside, Density_ratio,
                    BM = TRUE, Years_sampled = 1, Areas_sampled = 'all',
                    Ind_sampled = 'all', A = 5)

      target <- transient_DR(Time1, TimeT, Final_DRs, Nat_mortality, cr = 1,
                             fdr = 3)

      # calculate effort at the next timestep
      E[, t + 1, cr, fdr] <- management(t, cr, fdr = 1, E, DR,
                                        target_DR = target[t - Time1 + 1],
                                        floor_DR = 0.2,
                                        effort_inc_allowed = 0.1, Time1)

    }
  }

  return(E[, t + 1, cr, fdr])

}
vquennessen/densityratio documentation built on Aug. 28, 2022, 5:36 p.m.