#' @title imarpe: R package for the the automation of graphs, tables and reports of the Instituto del Mar del Peru
#' @author Criscely Lujan-Paredes \email{criscelylujan@gmail.com}, Luis Lau-Medrano \email{luis.laum@gmail.com}.
#' @name imarpe
#' @description This packages provides tools for the elaboration of graphs and tables that are
#' routinely performed in reports produced by Instituto del Mar del Peru. The package imarpe
#' is designed to work with generic functions regardless of the type of data used.
#' @docType package
#' @keywords automatization, reports, fishery, imarpe.
NULL
#' @title Get data from fishery class
#'
#' @description This function read the fishing information (landings, effort and catch per unit effor) to
#' create a data base which includes a data frame and a list with the main features of the data frame.
#' The included data frame object has observations corresponding to rows and variables to columns.
#'
#' @param file The name of a file with a comma separated values format (extension of this files are .csv).
#' This file have fishing information related to the landing and effort. If it does not contain an absolute path,
#' the file name is relative to the current working directory, \code{\link{getwd}}.
#' @param type The type of the information: fisheryInfo with two variables (landing and fishing effort) and
#' the cpue (catch per unith effort).
#' @param varType The type of the variable that has been to analyze. This can be: lading, effort and cpue.
#' @param toTons A logical parameter. \code{TRUE} (dafault) it assume that the fishery information is
#' in kilograms and converts it into tonnes (divided by 1000). \code{FALSE} it assume the the information
#' is in tons and don't convert the data.
#' @param sp The name of the species.
#' @param start The date to start the analysis. By dafault is \code{NULL}.
#' @param end The date to end the analysis. By dafault is \code{NULL}.
#' @param port The specific port to analyze. By dafault is \code{NULL} and analyze all ports.
#' @param efforType If the varType is effort or cpue (catch per unit effort) this parameter indicate what
#' type of effort will be used.
#' \itemize{
#' \item "viaje" for the travel number.
#' \item "capacidad_bodega" for storage capacity.
#' \item "anzuelos" for the hook number.
#' \item "embarcaciones" for the number of boats.
#' }
#' @param fleeType The fleet type to analyze. By default is \code{NULL}.
#' @param ... Further arguments passed to \code{.fleetData} function.
#'
#' @return
#' \tabular{ll}{
#' \code{data} \tab A data frame containing a representation of the data in the file.\cr
#' \code{info} \tab A list containing the main features of the data. \cr
#' \code{fleeTable} \tab A data frame with the fishery information by years and months by
#' each type of fleet.
#' }
#' @note If type is not explicitly defined, the function will be equivalent to use \code{\link{read.csv}}.
#' @author Criscely Lujan-Paredes, \email{criscelylujan@gmail.com}.
#' @examples
#' # Read a example of a data base
#' fisheryData = system.file("extdata", "fisheryData.csv", package = "imarpe")
#'
#' # For landing information assuming the analyzed species is 'caballa', put the name of the species on \code{sp}
#' landing = getFishingData(file = fisheryData, type = "fisheryinfo", varType = "landing", sp = "caballa")
#'
#' # If you can analyzed a period of time you have to use \code{start} and \code{end} parameters
#' landing = getFishingData(file = fisheryData, type = "fisheryinfo", varType = "landing", sp = "caballa",
#' start = "2009-04-10", end = "2009-08-30")
#'
#' # If you can analyzed a specific port put the name of the port on \code{port}
#' landing = getFishingData(file = fisheryData, type = "fisheryinfo", varType = "landing", sp = "caballa",
#' start = "2009-04-10", end = "2009-08-30", port = "PAITA")
#'
#' # Check the class of the landing object, it would be 'fishery'
#' class(landing)
#'
#' # To get the data of the landing object.
#' dataBase = landing$data
#'
#' # To get the main features of the landing object.
#' info = landing$info
#'
#' # To get the data frame with the landings by each type of fleet.
#' fleet = landing$fleeTable
#'
#'
#' # To analyze the effort information on the same data, use the parameter varType and
#' # specify the type of effort in the parameter efforType
#' effort = getFishingData(file = fisheryData, type = "fisheryinfo", varType = "effort",
#' sp = "caballa", efforType = "capacidad_bodega")
#'
#' # To analyze the cpue information on the same data change the parameter type, specify
#' the varType and specify the type of effort to calculate the catch per unit effort (cpue)
#' cpue = getFishingData(file = fisheryData, type = "cpue", varType = "cpue",
#' sp = "caballa", efforType = "capacidad_bodega")
#'
#' @export
getFishingData = function(file, type, varType, toTons=TRUE, sp, start=NULL, end = NULL, port = NULL,
efforType = "viaje", fleeType=NULL, ...){
dataBase = .convertBase(file=file, sp=sp, fleeType=fleeType, efforType=efforType)
fleet = .fleetData(file = file, varType = varType, toTons = toTons, sp = sp, efforType=efforType,
fleeType = fleeType, start = start, end = end, port = port, ...)
output = switch(tolower(type),
fisheryinfo = .getFisheryData(x = dataBase, fileName = file, fleet = fleet, varType = varType,
toTons = toTons, sp = sp, start = start, end = end,
port = port, efforType = efforType),
cpue = .getCPUEData(x = dataBase, fileName = file, fleet = fleet, varType = varType,
toTons = toTons, sp = sp, start = start, end = end,
port = port, efforType = efforType),
read.csv(file = dataBase, stringsAsFactors = FALSE, ...))
return(output)
}
#' @title Get data from bitacora class
#'
#' @description This function read the information from the Programme of Fishery Logbooks (in spanish: Programa de
#' Bitacoras de Pesca - PBP) and create a data base which includes a data frame and a list with the main features
#' of the data frame. The included data frame object has observations corresponding to rows and variables to columns.
#' @param file The name of the file. If it does not contain an absolute path, the file name is relative to
#' the current working directory, \code{\link{getwd}}.
#' @param colTrip Name of travel code column. By default is "CODIGO_VIAJE".
#' @param colPort Name of the port column. By default is "PUERTO_SALIDA".
#' @param colDateStart Name of data column with the start date of the travel. By default is "DIA_SALIDA".
#' @param colDateOut Name of data column with the end date of the travel. By default is "DIA_ARRIBO".
#' @param colSearchTime Name of the data column with the search time. By default is "DURACION_BUSQUEDA".
#' @param colStorageCapacity Name of the data column with the storage capacity. By default is "CAPACIDAD_BODEGA_REGISTRADA".
#' @param colLat Name of the data column with the latitude. By default is "LATITUD_INICIAL".
#' @param colLon Name of the data column with the longitude. By default is "LONGITUD_INICIAL".
#' @param colHaul Name of the data column with the fishing haul number. By default is "NUMERO_CALA".
#' @param colHaulTotal Name of the data column with the total number of fishing hauls by travel. By default is "TOTAL_CALAS".
#' @param colCatchHaul Name of the data column with the catch by fishing haul. By default is "CAPTURA_CALA".
#' @param capAnch Name of the data column with the anchovy catches. By default is "CAPTURA_ANCHOVETA".
#' @param capSar Name of the data column with the sardine catches. By default is "CAPTURA_SARDINA".
#' @param capJur Name of the data column with the jack mackerel catches. By default is "CAPTURA_JUREL".
#' @param capCab Name of the data column with the chub mackerel catches. By default is "CAPTURA_CABALLA".
#' @param capBon Name of the data column with the bonito catches. By default is "CAPTURA_BONITO".
#'
#' @return
#' \tabular{ll}{
#' \code{data} \tab A data frame containing a representation of the data in the file.\cr
#' \code{info} \tab A list containing the main features of the data.
#' }
#' @note If type is not explicitly defined, the function will be equivalent to use \code{\link{read.csv}}.
#' @author Criscely Lujan-Paredes, \email{criscelylujan@gmail.com}.
#' @examples
#' # Read a example of data base
#' bitacoraData = system.file("extdata", "bitacoraData.csv", package = "imarpe")
#'
#' # Create a object of bitacora class
#' bitacoraObject = getBitacoraData(file = bitacoraData)
#'
#' # Check the class of bitacoraObject
#' class(bitacoraObject)
#'
#' # To get the data of bitacora class
#' dataBase = bitacoraObject$data
#'
#' # To get the main features of the data
#' info = bitacoraObject$info
#'
#' @export
getBitacoraData = function(file, colTrip = "CODIGO_VIAJE", colPort = "PUERTO_SALIDA",
colDateStart = "DIA_SALIDA", colDateOut = "DIA_ARRIBO",
colSearchTime = "DURACION_BUSQUEDA", colStorageCapacity = "CAPACIDAD_BODEGA_REGISTRADA",
colLat = "LATITUD_INICIAL", colLon = "LONGITUD_INICIAL",
colHaul = "NUMERO_CALA", colHaulTotal = "TOTAL_CALAS", colCatchHaul = "CAPTURA_CALA",
capAnch = "CAPTURA_ANCHOVETA", capSar = "CAPTURA_SARDINA",
capJur = "CAPTURA_JUREL", capCab = "CAPTURA_CABALLA", capBon = "CAPTURA_BONITO"){
dataBase = .getBitacoraData(file = file, colTrip = colTrip, colPort = colPort,
colDateOut = colDateOut, colDateStart = colDateStart, colSearchTime = colSearchTime,
colStorageCapacity = colStorageCapacity, colLat = colLat, colLon = colLon,
colHaul = colHaul, colHaulTotal = colHaulTotal, colCatchHaul = colCatchHaul,
capAnch = capAnch, capSar = capSar, capJur = capJur, capCab = capCab, capBon = capBon)
return(dataBase)
}
#' @title Report method
#' @description This function built a report for each class including on imarpe package.
#' @param object Object of class \code{fishery}, \code{cpue} and \code{bitacora}.
#' @param format The format to export the report.
#' @param output Folder where the report will be saved.
#' @param ... Extra arguments passed to \code{\link{report}} function.
#' @return A report on specific format.
#' @author Criscely Lujan-Paredes, \email{criscelylujan@gmail.com}.
#' @export
report = function(x, format, output, ...) {
UseMethod("report")
}
#' @title Get main results from bitacora
#' @description Principal function of bitacora class objects to get principal results.
#' @param object Object of \code{bitacora} class.
#' @param observedTrip Parameter to indicate whether the observed trip will be estimated.
#' By default is \code{NULL} but if it will be estimated receive the logical value of \code{TRUE}.
#' @param fishingHaul Parameter to indicate whether the fishing haul sampled will be
#' estimated. By default is \code{NULL} but if it will be estimated receive the
#' logical value of \code{TRUE}.
#' @param fishingPoints Parameter to indicate whether the fishing poins will be estimated.
#' By default is \code{NULL} but if it will be estimated received the logical value of \code{TRUE}.
#' @param speciesComposition Parameter to indicate whether the species composition will be
#' estimated. By default is \code{NULL} but if it will estimated received the logical value of \code{TRUE}.
#' @param distributionCatch Parameter to indicate whether the distribution of catches will be
#' estimated. By default is \code{NULL} but if it will estimated received the logical value of \code{TRUE}.
#' @param effortData Parameter to indicate whether the effort data will be
#' estimated. By default is \code{NULL} but if it will estimated received the logical value of \code{TRUE}.
#' @param language The select language to print the results. By default is "spanish".
#' @param latByPort \code{logical}. Parameter of fishingHaul.bitacora function. By
#' default is \code{FALSE} indicating that latitude information is not get from
#' port information. When is \code{TRUE}, the latitude is get from port information.
#' @param specie \code{character}. Parameter of distributionCatch.bitacora function.
#' Receives the name of the species that is calculated the distribution of the catch.
#' Default value is "anchoveta" but this could be:
#' \itemize{
#' \item "anchoveta" to estimated the anchovy catches distribution.
#' \item "sardina" to estimated the sardine catches distribution.
#' \item "jurel" to estimated the jack mackerel catches distribution.
#' \item "caballa" to estimated the chub mackerel catches distribution.
#' \item "bonito" to estimated the bonito catches distribution.
#' }
#' @return A list of \code{bitacora_mainResults} class. The \code{length} of the list is six,
#' one by each parameter (observedTrip, fishingHaul, fishingPoints, speciesComposition,
#' distributionCatch, and effortData).
#' @details If one of the parameter (observedTrip, fishingHaul, fishingPoints, speciesComposition,
#' distributionCatch, and effortData) is \code{NULL} on \code{getMainResults.bitacora} function
#' the output of this parameter on the list produced by the function is \code{NULL} too.
#' @author Criscely Lujan-Paredes, \email{criscelylujan@gmail.com}.
#' @examples
#' # Read a example of data base
#' bitacoraData = system.file("extdata", "bitacoraData.csv", package = "imarpe")
#'
#' # Create a object of bitacora class
#' bitacoraObject = getBitacoraData(file = bitacoraData)
#' class(bitacoraObject)
#'
#' # Get the results
#' mainBitacoraData = getMainResults.bitacora(object = bitacoraObject, language = "spanish",
#' specie = "anchoveta", observedTrip = TRUE, fishingHaul = TRUE, distributionCatch = TRUE)
#'
#' # See the principal results bitacora class object
#' mainBitacoraData$observedTrip
#' mainBitacoraData$fishingHaul
#' mainBitacoraData$distributionCatch
#'
#' @export
getMainResults.bitacora = function(object, observedTrip = NULL, fishingHaul = NULL, fishingPoints = NULL,
speciesComposition = NULL, distributionCatch = NULL, effortData = NULL,
language = "spanish", latByPort = FALSE, specie = "anchoveta") {
if(is.null(observedTrip) & is.null(fishingHaul) & is.null(fishingPoints) &
is.null(speciesComposition) & is.null(distributionCatch) & is.null(effortData)) {
message("There is not output to return")
return(invisible())
}
#Check the output to return
if(isTRUE(observedTrip)) {observedTrip = .observedTrip.bitacora(object, language) }
if(isTRUE(fishingHaul)) {fishingHaul = .fishingHaul.bitacora(object, language, latByPort)}
if(isTRUE(fishingPoints)) {fishingPoints = .fishingPoints.bitacora(object)}
if(isTRUE(speciesComposition)) {speciesComposition = .speciesComposition.bitacora(object, language)}
if(isTRUE(distributionCatch)) {distributionCatch = .distributionCatch.bitacora(object, language, specie)}
if(isTRUE(effortData)) {effortData = .effortData.bitacora(object) }
output = list(observedTrip = observedTrip,
fishingHaul = fishingHaul,
fishingPoints = fishingPoints,
speciesComposition = speciesComposition,
distributionCatch = distributionCatch,
effortData = effortData)
class(output) = "bitacora_mainResults"
return(output)
}
#' @title PlotFishignPoints method
#' @description Method for plotFishingPoins.bitacora function.
#' @param x Object of \code{bitacora} class.
#' @param ... Extra arguments passed to \code{plotFishingPoints.bitacora} function.
#' @details For more details read the help of \code{\link{plotFishingPoints.bitacora}}.
#' @author Criscely Lujan-Paredes, \email{criscelylujan@gmail.com}.
#' @export
plotFishingPoints = function(x, laguage, dataType, ...) {
UseMethod(generic = "plotFishingPoints", object = x)
}
#' @title PlotFishingPresence method
#' @description Method for plotFishingPresence.bitacora function.
#' @param x Object of \code{bitacora} class.
#' @param ... Extra arguments passed to \code{plotFishingPresence.bitacora} function.
#' @details For more details read the help of \code{\link{plotFishingPresence.bitacora}}.
#' @author Criscely Lujan-Paredes, \email{criscelylujan@gmail.com}.
#' @export
plotFishingPresence = function(x, ...) {
UseMethod(generic = "plotFishingPresence", object = x)
}
#' @title PlotSpeciesComposition method
#' @description Method for plotSpeciesComposition.bitacora function.
#' @param x Object of \code{bitacora} class.
#' @param ... Extra arguments passed to \code{plotSpeciesComposition.bitacora} function.
#' @details For more details read the help of \code{\link{plotSpeciesComposition.bitacora}}.
#' @author Criscely Lujan-Paredes, \email{criscelylujan@gmail.com}.
#' @export
plotSpeciesComposition = function(x, ...) {
UseMethod(generic = "plotSpeciesComposition", object = x)
}
#' @title PlotEffort method
#' @description Method for plotEffort.numeric function.
#' @param x Object of \code{bitacora} class.
#' @param ... Extra arguments passed to \code{plotEffort.numeric} function.
#' @details For more details read the help of \code{\link{plotEffort.numeric}}.
#' @author Criscely Lujan-Paredes, \email{criscelylujan@gmail.com}.
#' @export
plotEffort = function(effort1, effort2, ...) {
UseMethod(generic = "plotEffort", object = c(effort1, effort2))
}
#' @title Get daily report of fishing monitoring
#' @description This function download anchovy landing information from an official
#' repository of the IMARPE to compare this landings with the biomass estimated.
#'
#' @param directory Directory where the anchovy landing reports are stored. By default it
#' is \code{NULL}, temporarily saved and then deleted. If you want to keep this parameter
#' must be changed.
#' @param datesList A \code{list} of six dates (format: YEAR-month-day) with the names:
#' \itemize{
#' \item surveyDate: finish date of reference survey.
#' \item startDate: start date to download the landing files.
#' \item endDate: end date to download the landing files.
#' \item endSeasonDate: end date of fishing season.
#' }
#' @param simpleFreqSizes A comma delimited file (.csv) with simple frequency data per size.
#' @param dataCruise A RData with the outputs of the cruise.
#' @param officialBiomass A official value of biomass.
#' @param addEnmalle \code{logical} which indicates whether to add or not (default) 'enmalle' influence to catches.
#' @param enmalleParams If \code{addEnmalle = TRUE}, a \code{list} with main parameters to describe 'enmalle':
#' \itemize{
#' \item mean: the meanfor 'enmallados' length.
#' \item sd: the SD for 'enmallados' length.
#' \item maxProportion: factor of 'enmallados'.
#' }
#' @param urlFishingMonitoring The web address (url - Uniform Resource Locator) for downloading
#' the landings. By default it is \url{http://www.imarpe.pe/imarpe/archivos/reportes/imarpe_rpelag_porfinal}.
#' @param threshold Threshold for considering the number of individuals. By default \code{threshold = 30}.
#' @param species The species that is going to be analyzed. By default is \code{species = "Anchoveta"}.
#' @param a Length-weight ratio parameter. By default, it is \code{NULL}, check Details.
#' @param b Length-weight ratio parameter. By default, it is \code{NULL}, check Details.
#' @param growthParameters A \code{list} of growthParamters. By default this are:
#' \itemize{
#' \item k = 0.83
#' \item Linf = 19.21
#' \item sizeM = c(0, 8, 12)
#' \item vectorM = rep(0.8, 3)
#' \item catchFactor = 1
#' \item scenario = "neutro"
#' }
#'
#'
#' @details Allometric growth parameters \code{a} and \code{b} are completely necesary for calculations, if they
#' are \code{NULL} (default), the users must be sure that the \code{dataCruise} file has them inside (that is true if
#' \code{dataCruise} comes from \code{TBE} package).
#'
#' @return A object of fishingMonitoring class. It is saved on the working directory.
#' @author Wencheng Lau-Medrano, \email{luis.laum@gmail.com}, Josymar Torrejon and Pablo Marin.
#' @export
getDailyReport <- function(directory = NULL, datesList, simpleFreqSizes, dataCruise, dataCruiseCsv, officialBiomass = NULL,
readLocalPorcentas = FALSE, dirPorcentas = NULL, porcentaPrefix = "/imarpe_rpelag_porfinal",
addEnmalle = TRUE, enmalleParams = list(mean = 11, sd = 5.5, maxProportion = 0.20*0.05),
prop_enmalleParams = list(peak = 7, top = 11, asc_width = exp(1),
dsc_width = exp(1), init = 0, final = 0),
urlFishingMonitoring = "http://www.imarpe.pe/imarpe/archivos/reportes/imarpe_rpelag_porfinal",
threshold = 30, species = "Anchoveta",
a = NULL, b = NULL,
growthParameters = list(k = 0.83, Linf = 19.21, sizeM = c(0, 8, 12), vectorM = c(1.29, 0.92, 0.83),
catchFactor = 1, scenario = "neutro")){
# COMPILAR PORCENTAS
cat("\n-------COMPILING DAILY REPORTS-------\n")
if(is.null(directory) || !dir.exists(directory)){
directory <- tempdir()
dir.create(path = directory, showWarnings = FALSE)
}
datesList <- lapply(datesList, function(x) as.Date(x, format = ifelse(grepl(pattern = "-", x = x), "%Y-%m-%d", "%d/%m/%Y")))
catchFactor <- ifelse(is.null(growthParameters$catchFactor), 1, growthParameters$catchFactor[1])
if(!is.null(growthParameters$scenario)){
growthParameters <- switch(growthParameters$scenario,
favorable = list(k = 0.95, Linf = 19.98, t0 = -0.13, sizeM = c(0, 8, 12), vectorM = c(1.29, 0.92, 0.83)),
neutro = list(k = 0.83, Linf = 19.21, t0 = -0.21, sizeM = c(0, 8, 12), vectorM = c(1.29, 0.92, 0.83)),
desfavorable = list(k = 0.64, Linf = 18.60, t0 = -0.30, sizeM = c(0, 8, 12), vectorM = c(1.28, 1.08, 1.00)),
paste("Invalid value for 'growthParameters$scenario'.",
"If you prefer to specify the Growth parameters, set growthParameters$scenario = NULL"))
}
growthParameters$catchFactor <- catchFactor
# Downloading daily reports
# Descargar porcentas (si se requiere)
if(isTRUE(readLocalPorcentas)){
if(!is.character(dirPorcentas) || length(dirPorcentas) != 1 || !dir.exists(dirPorcentas)){
stop("Missing or incorrect value fo 'dirPorcentas'.")
}
}else{
if(!is.null(dirPorcentas)){
dirPorcentas <- tempdir()
dir.create(path = dirPorcentas, showWarnings = FALSE)
}
DownloadPorcenta(directorio = dirPorcentas, dirUrl = urlFishingMonitoring,
inicio = datesList$startDate, fin = datesList$endDate)
}
# Leer porcentaes
porcentasSalida <- ReadPorcenta(directorio = dirPorcentas, inicio = datesList$startDate, fin = datesList$endDate)
# Escribir tabla compilada
porcentasArchivo <- paste0(directory, "desembarque_UpTo",
format(datesList$endDate, "%d%m%Y"),".csv")
write.csv(x = porcentasSalida$desembarque, file = porcentasArchivo, row.names = FALSE)
# PONDERAR DATOS DE FRECUENCIAS SIMPLES Y DESEMBARQUES
cat("\n-------WEIGHTING SIMPLE FREQUENCY DATA AND LANDINGS-------\n")
# Leer frecuencias simples
datosPonderacion <- leerData(muestreo = simpleFreqSizes, desembarque = porcentasArchivo)
# Hacer ponderaciones
if(is.character(dataCruise) & length(dataCruise) == 1){
surveyData <- get(load(dataCruise))
}else{#} if(is.list(dataCruise)){
# Read survey info
dataCruise <- read.csv(file = dataCruiseCsv, na.strings = c("", " ", NA, "NA"),
check.names = FALSE, stringsAsFactors = FALSE)
# Build surveyData object
surveyData <- list()
surveyData$results$nc$biomass$total <- sum(dataCruise$Biomasa)
surveyData$results$nc$biomass$length <- dataCruise$Biomasa
}#else{
#stop("'dataCruise' must be a string indicating whether the path of a survey RData file or a list with survey info. See Details.")
#}
# Si el objeto proviene de TBE, obtener valores de a y b
if(is.null(a) | is.null(b)){
if(!is.null(surveyData$info$a_b)){
a <- surveyData$info$a_b$a
b <- surveyData$info$a_b$b
}else{
stop("'a' and 'b' are missing.")
}
}
# Get weighted data
DatosPonderados <- LC_ponderada(data = datosPonderacion, tallas = seq(5, 20, 0.5), especie = species,
umbral = threshold, a = a, b = b)
# Guardar datos ponderados
ponderadosArchivo <- paste0("data/ponderados_UpTo", format(datesList$endDate, "%d%m%Y"),".csv")
guardarPonderacion(data = DatosPonderados, filename = ponderadosArchivo)
# GENERAR DATOS PARA REPORTE
cat("\n-------GENERATE DATA FOR REPORTING-------\n")
sp <- tolower(species)
allMarks <- seq(2, 20, 0.5)
# Read catch data
catchData <- readAtLength(file = ponderadosArchivo, sp = sp, check.names = FALSE)
rownames(catchData) <- allMarks
# Create an empty matrix of catches
allDates <- seq(from = datesList$startDate, to = datesList$endDate, by = "day")
newCatch <- matrix(data = 0, nrow = length(allMarks), ncol = length(allDates),
dimnames = list(allMarks, as.character(allDates)))
# Replace read catchData over the pattern
newCatch[,match(colnames(catchData), as.character(allDates))] <- catchData
catchData <- newCatch
# Weight to official biomass
officialBiomass <- ifelse(is.null(officialBiomass), surveyData$results$nc$biomass$total, officialBiomass)
surveyVector <- as.numeric(surveyData$results$nc$biomass$length)
surveyVector <- surveyVector/sum(surveyVector)*officialBiomass
surveyVector <- surveyVector/(a*allMarks^b)
# Get Enmalle info
if(isTRUE(addEnmalle)){
# Get enmalle info
enmalleInfo <- getEnmallamiento(imarsisData = datosPonderacion$baseMuestreo, enmalleParams = enmalleParams,
prop_enmalleParams = prop_enmalleParams,
a = a, b = b)
# Add enmalle info to catchData
enmalleInfo <- aggregate(x = enmalleInfo$enmalleMatrix, by = list(rownames(enmalleInfo$enmalleMatrix)),
FUN = sum, na.rm = TRUE)
enmalleNames <- enmalleInfo[,1]
# Get Factor by day
catchMuestreo <- aggregate(x = datosPonderacion$baseMuestreo$captura..t.,
by = list(datosPonderacion$baseMuestreo$date), sum, na.rm = TRUE)
index <- match(enmalleInfo[,1], as.character(catchMuestreo[,1]))
catchMuestreo <- catchMuestreo[index,]
index <- match(enmalleInfo[,1], colnames(catchData))
weightFactor <- colSums(catchData[,index]*a*allMarks^b)/rowSums(as.matrix(catchMuestreo[,-1]), na.rm = TRUE)
weightFactor[is.infinite(weightFactor)] <- 0
# Weighting values of catch
enmalleInfo <- sweep(t(enmalleInfo[,-1])*1e-6, 2, weightFactor, "*")
colnames(enmalleInfo) <- enmalleNames
# Add enmalle info to catchData matrix
for(i in seq(ncol(enmalleInfo))){
indexCol <- colnames(catchData) == colnames(enmalleInfo)[i]
indexRow <- match(rownames(enmalleInfo), rownames(catchData))
catchData[indexRow, indexCol] <- rowSums(cbind(catchData[indexRow, indexCol], enmalleInfo[,i]), na.rm = TRUE)
}
}
# MAKE PROJECTIONS
# Projection from end of survey to the start of season
index <- seq(from = datesList$surveyDate, to = datesList$startDate - 1, by = "day")
catchVector <- matrix(data = 0, nrow = length(allMarks), ncol = length(index),
dimnames = list(allMarks, as.character(index)))
preSeasonProj <- as.matrix(surveyVector)
for(i in seq_along(index)){
tempOutput <- projectPOPE(N = cbind(preSeasonProj[,i], preSeasonProj[,i]),
catch = catchVector[,i],
a = a, b = b, k = growthParameters$k, Linf = growthParameters$Linf,
sizeM = growthParameters$sizeM, vectorM = growthParameters$vectorM,
freq = 365, sp = sp, Ts = 1)
preSeasonProj <- cbind(preSeasonProj, tempOutput$N[2,])
}
# BY WEEK
# Get index on starting days on weeks
weekIndex <- cumsum(grepl(x = weekdays(allDates), pattern = "lunes|monday"))
weekIndex <- weekIndex - ifelse(weekIndex[1] == 1, 1, 0)
# Start week matrix with survey data
outputByWeek <- as.matrix(preSeasonProj[,ncol(preSeasonProj)])
dimnames(outputByWeek) <- list(allMarks, "Crucero")
# Make an index of the number of days in each week
repWeekIndex <- table(weekIndex)
# If the 1st day is not Monday, then make a daily projection until the nearest one
if(repWeekIndex[1] < 7){
index <- weekIndex == 0
catchVector <- as.matrix(catchData[,index])
output <- outputByWeek
for(i in seq(sum(index))){
tempOutput <- projectPOPE(N = cbind(output[,i], output[,i]),
catch = catchVector[,i]*growthParameters$catchFactor,
a = a, b = b, k = growthParameters$k, Linf = growthParameters$Linf,
sizeM = growthParameters$sizeM, vectorM = growthParameters$vectorM,
freq = 365, sp = sp, Ts = 1)
output <- cbind(output, tempOutput$N[2,])
}
outputByWeek <- cbind(outputByWeek, output[,ncol(output)])
colnames(outputByWeek)[-1] <- paste(format(allDates[which(index)[c(1, sum(index))]], "%d/%m"), collapse = " - ")
}
# If there is (at least) a Monday with more than 6 days, then make a weekly projection
index7days <- repWeekIndex == 7
if(sum(index7days) > 0){
catchVector <- aggregate(t(catchData), list(weekIndex), sum, na.rm = TRUE)
index <- is.element(catchVector[,1], names(repWeekIndex)[index7days])
catchVector <- as.matrix(t(catchVector[index,])[-1,])
output <- as.matrix(outputByWeek[,ncol(outputByWeek)])
for(i in seq(ncol(catchVector))){
tempOutput <- projectPOPE(N = cbind(output[,i], output[,i]),
catch = catchVector[,i]*growthParameters$catchFactor,
a = a, b = b, k = growthParameters$k, Linf = growthParameters$Linf,
sizeM = growthParameters$sizeM, vectorM = growthParameters$vectorM,
freq = 52, sp = sp, Ts = 1)
output <- cbind(output, tempOutput$N[2,])
}
index <- !duplicated(weekIndex) & is.element(weekIndex, names(repWeekIndex[repWeekIndex == 7]))
namesColumns <- allDates[index]
namesColumns <- data.frame(namesColumns, namesColumns + 6)
namesColumns <- apply(namesColumns, 1, function(x) paste(format(as.Date(x), "%d/%m"), collapse = " - "))
output <- as.matrix(output[,-1])
colnames(output) <- namesColumns
outputByWeek <- cbind(outputByWeek, output)
}
# If the last week has less than 7 days, then make a daily projection until the end
if(length(repWeekIndex) > 1 && tail(repWeekIndex, 1) < 7){
index <- weekIndex == tail(names(repWeekIndex), 1)
catchVector <- as.matrix(catchData[,index])
output <- as.matrix(outputByWeek[,ncol(outputByWeek)])
for(i in seq(sum(index))){
tempOutput <- projectPOPE(N = cbind(output[,i], output[,i]),
catch = catchVector[,i]*growthParameters$catchFactor,
a = a, b = b, k = growthParameters$k, Linf = growthParameters$Linf,
sizeM = growthParameters$sizeM, vectorM = growthParameters$vectorM,
freq = 365, sp = sp, Ts = 1)
output <- cbind(output, tempOutput$N[2,])
}
output <- as.matrix(output[,-1])
dimnames(output) <- list(allMarks, as.character(allDates[index]))
output <- as.matrix(output[,ncol(output)])
colnames(output) <- paste(format(range(allDates[index]), "%d/%m"), collapse = " - ")
outputByWeek <- cbind(outputByWeek, output)
}
# BY DAY (all season)
outputByDayAll <- as.matrix(preSeasonProj[,ncol(preSeasonProj)])
dimnames(outputByDayAll) <- list(allMarks, "Crucero")
for(i in seq(ncol(catchData))){
tempOutput <- projectPOPE(N = cbind(outputByDayAll[,i], outputByDayAll[,i]),
catch = catchData[,i]*growthParameters$catchFactor,
a = a, b = b, k = growthParameters$k, Linf = growthParameters$Linf,
sizeM = growthParameters$sizeM, vectorM = growthParameters$vectorM,
freq = 365, sp = sp, Ts = 1)
outputByDayAll <- cbind(outputByDayAll, tempOutput$N[2,])
}
colnames(outputByDayAll)[-1] <- as.character(allDates)
# Build catch matrix by weeks
catchByWeek <- aggregate(x = t(catchData), by = list(weekIndex), FUN = sum)
catchByWeek <- cbind(surveyVector, t(catchByWeek[,-1]), catchData[,ncol(catchData)])
rownames(catchByWeek) <- allMarks
colnames(catchByWeek) <- c("Crucero",
tapply(allDates, weekIndex, function(x) paste(format(range(x), format = "%d/%m"), collapse = " - ")),
colnames(catchData)[ncol(catchData)])
# Concatenate object as a list
output <- list(allMarks = allMarks,
a = a,
b = b,
surveyVector = surveyVector,
catchByDay = catchData,
catchByWeek = catchByWeek,
projPreSeason = preSeasonProj,
projByWeek = outputByWeek,
projByDay = outputByDayAll,
weekIndex = weekIndex,
getInfo = getInfo,
startDate = datesList$startDate,
endDate = datesList$endDate,
endExploringDate = datesList$endExploringDate,
endSeasonDate = datesList$endSeasonDate,
allDates = allDates)
class(output) = "fishingMonitoring"
save(output, file = "output.RData")
return(output)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.