R/allocatequota.R

Defines functions allocatequota

# This script contains the management procedure function: allocatequota

# To Do:
  # search ???
  # Add updated historic reference proportions by state
  # check that all examples work after code completed
  # Need to add proportion available to OM with obs error here


#' @title Specify the amount of quota allocated to the commercial fishery and recreational decision areas
#' @description This function determines how much quota is allocated to the recreational fishery (40% of the total quota) and breaks down this recreational quota by state or multi-state decision areas using the specified method.
#'
#' @param quotaMethod A string specifying which method should be used to allocate quota to decision areas: "HistoricRef" "UpdatedRef" or "BioAvailability", no default.
#'      "HistoricRef" = Quota allocated based on participation in the recreational Summer flounder fishery during historic reference period from 1980-1989 as is done in the current (2018) stock assessment.
#'      "UpdatedRef" = Quota allocated based on participation in the recreational Summer flounder fishery during updated reference period during most recent ten years from 2010-2019.
#'      "BioAvailability" = Quota allocation to decision areas based on proportional biomass availability in each state.
#' @param TAC A number representing the total allowable catch based on the most recent simulated stock assessment, no default
#' @param areaindex A list which specifies column indexing for different management decision areas, no default. Produced by the decisionarea() function
#' @param bioAvailable  Vector of proportional biomass availablity in each state listed in order: MA, RI, CT, NY, NJ, DE, MD, VA, NC, no default only required when quotaMethod = "BioAvailability".
#'
#' @return A list containing:
#'      A number for the commercial quota
#'      A vector of recreational quota allocations for each decision area

#' @family management procedure functions
#'
#' @examples
#' # Allocate quota based on historic reference period from 1980 - 1989, TAC from 2018, each state is independent decision area
#' allocatequota(quotaMethod = "HistoricRef", TAC = 6384158, areaindex = list(1,2,3,4,5,6,7,8,9))
#' # Allocate quota based on updated reference period from 2010-2019, TAC from 2018, single decision area for full coastline
#' allocatequota(quotaMethod = "UpdatedRef", TAC = 6384158, areaindex = list(c(1,2,3,4,5,6,7,8,9)))
#' # Allocate quota based on biomass availability, TAC from 2018, five decision areas
#' allocatequota(quotaMethod = "BioAvailability", TAC = 6384158, areaindex = list(1,2,c(3,4,5),c(6,7,8),9), bioAvailable = c(1000,2000,3000,4000,5000,4000,3000,2000,1000))

allocatequota <- function(quotaMethod = NULL,
                          TAC = NULL,
                          areaindex = NULL,
                          bioAvailable = NULL){

  # Divide TAC between recreational & commercial fisheries acording to current (2019) methods
  RecAllocation <- TAC*0.4 # 40% total allocation to recreational fishery
  CommercialAllocation <- TAC - RecAllocation # 60% total allocation to commercial fishery

  # Divide recreational quota allocation across decision areas
  if(quotaMethod == "HistoricRef"){ # allocation to decision areas based on reference period from 1980-1989
    # Historic reference allocation
    RefProps <- c(0.0549, 0.0566, 0.0375, 0.1763, 0.3909, 0.0314, 0.0295, 0.1669, 0.056) # See data_calculations.R for source and calculation
    names(RefProps) <- c("MA", "RI", "CT", "NY", "NJ", "DE", "MD", "VA", "NC")

    areaquotas <- rep(NA, length(areaindex))
    for(iarea in 1:length(areaindex)){
      availableProp <- sum(RefProps[areaindex[[iarea]]])
      areaquotas[iarea] <- RecAllocation*availableProp
    }
  } else if(quotaMethod == "UpdatedRef"){ # allocation to decision areas based on updated reference period from 2010-2019
    # Updated reference allocation
    RefProps <- c() # ??? add here
    names(RefProps) <- c("MA", "RI", "CT", "NY", "NJ", "DE", "MD", "VA", "NC")

    areaquotas <- rep(NA, length(areaindex))
    for(iarea in 1:length(areaindex)){
      availableProp <- sum(RefProps[areaindex[[iarea]]])
      areaquotas[iarea] <- RecAllocation*availableProp
    }
  } else if(quotaMethod == "BioAvailability"){ # allocation to decision areas based on proportional biomass availability in each state
    # Proportional biomass availability by state
    RefProps <- bioAvailable # must be a vector of proportions
    names(RefProps) <- c("MA", "RI", "CT", "NY", "NJ", "DE", "MD", "VA", "NC")

    for(iarea in 1:length(areaindex)){
      availableProp <- sum(RefProps[areaindex[[iarea]]])
      areaquotas[iarea] <- RecAllocation*availableProp
    }
  }

  return(list(commercialQuota = CommercialAllocation, areaQuotas = areaquotas))
}
ahart1/flukeclimatemse documentation built on Oct. 5, 2020, 4:42 p.m.