From 418dce85b90dd303141064f7567bf4f92ebb2a23 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Mon, 6 May 2024 14:10:00 -0700 Subject: [PATCH 01/14] add simplified function for raw comps --- NAMESPACE | 1 + R/get_raw_comps.R | 249 +++++++++++++++++++++++++++++++++++++++++++ man/get_raw_comps.Rd | 89 ++++++++++++++++ 3 files changed, 339 insertions(+) create mode 100644 R/get_raw_comps.R create mode 100644 man/get_raw_comps.Rd diff --git a/NAMESPACE b/NAMESPACE index 217758b..be4f2ff 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,7 @@ export(est_growth) export(estimate_weight_length) export(fit_vbgrowth) export(get_json) +export(get_raw_comps) export(get_url) export(plot_age_length_sampling) export(plot_bio_patterns) diff --git a/R/get_raw_comps.R b/R/get_raw_comps.R new file mode 100644 index 0000000..c4c5c24 --- /dev/null +++ b/R/get_raw_comps.R @@ -0,0 +1,249 @@ +#' Creates a matrix of unexpanded (or raw) marginal length or age composition +#' data formatted for Stock Synthesis. The code will return composition data +#' for all sexes present in the data frame and no sex assignment is done for +#' unsexed fish. The function will create composition data for either +#' lengths or ages based on the comp_column_name. The function will return a +#' list of composition data based upon the sexes present in the data for a +#' two-sex model or all length/ages for single-sex model. +#' +#' @param data A data frame that includes columns of year, sex, and length/ages. The data +#' frame can be survey data pulled using pull_bio from the data warehouse or any data frame +#' that includes column names of sex, year, and the comp_column_name. The sex column is +#' expected to have sexes denoted by F, M, and U. +#' @param comp_bins A vector on length bins or age bins to create compositions across. The +#' composition data is formatted for Stock Synthesis. +#' @param comp_column_name The column name to create composition data for. This column can be +#' is used to determine whether to format the composition data for length or age +#' compositions by looking for either age (e.g., age_years, Age, best_age) or length +#' (e.g., Length, length, Length_cm) in the comp_column_name. Default Length_cm. +#' @param two_sex_comps Default TRUE. If TRUE composition data will be formatted for a +#' Stock Synthesis two-sex model and if FALSE composition data will be formatted for a +#' single-sex model. +#' @param fleet A fleet number to assign the composition data to based on the expected +#' format for Stock Synthesis. Default "Enter Fleet". +#' @param month Month the samples were collected based on the expected format for +#' Stock Synthesis to determine the length/age estimate to compare to. Default +#' "Enter Month". +#' @param partition Partition to assign the composition data based on the expected +#' format for Stock Synthesis. Partition of 0 indicates that the composition data +#' include all composition data, 1 for discarded composition data, and 2 for retained +#' fish only. Default of 0. +#' @param age_error Number of ageing error vector to apply to the age data based on +#' Stock Synthesis. Default "Enter Age Error Vector". +#' @param age_low Lower age bin for all age composition data based on the expected +#' format for Stock Synthesis. Default value of -1 which translates to the lowest age +#' bin. +#' @param age_high Upper age bin for all age composition data based on the expected +#' format for Stock Synthesis. Default value of -1 which translates to the highest +# age bin. +#' @template dir +#' @param printfolder Folder inside the directory, if provide, where the composition +#' csv files will be saved. Default "forSS3". +#' @template verbose +#' +#' @author Chantel Wetzel +#' @export +#' +get_raw_comps <- function( + data, + comp_bins, + comp_column_name = "Length_cm", + two_sex_comps = TRUE, + fleet = "Enter Fleet", + month = "Enter Month", + partition = 0, + age_error = "Enter Age Error Vector", + age_low = -1, + age_high = -1, + dir = NULL, + printfolder = "forSS3", + verbose = TRUE) +{ + + plotdir <- file.path(dir, printfolder) + check_dir(dir = plotdir, verbose = verbose) + + colnames(data) <- tolower(colnames(data)) + comp_column_name <- tolower(comp_column_name) + + vars <- c("year", "sex") + if(sum(vars %in% colnames(data)) != 2){ + stop("Data frame does not contain a column name year and/or sex. + \n The columns names can be either upper or lower case.") + } + + if(!comp_column_name %in% colnames(data)){ + stop("Data frame does not contain a column name of comp_column_name. + \n The columns names can be either upper or lower case. ") + } + + if (!two_sex_comps){ + data[, "sex"] <- "U" + } + + # Check to see if user is doing ages or lengths + if(length(grep("age", comp_column_name)) > 0) { + comp_type <- "age" + } else { + comp_type <- "length" + } + + keep <- !is.na(data[, comp_column_name]) + data <- data[keep, ] + bins <- c(comp_bins, Inf) + data$bin <- bins[findInterval(data[, comp_column_name], bins, all.inside = T)] + + # if there are NA sexes replace them with U + if (sum(is.na(data[, "sex"])) > 0) { + data[is.na(data[, "sex"]), "sex"] <- "U" + } + + # Create the comps + Results <- out <- NULL + for (y in sort(unique(data[, "year"]))) { + # Identify relevant rows + Which <- which(data[, "year"] == y & data[, "sex"] %in% c("F", "M")) + # Skip this year unless there are rows + if (length(Which) > 0) { + Row <- c(y, length(Which)) + # Loop across F then M + for (s in c("F", "M")) { + # Loop across length bins + for (l in comp_bins) + { + # Subset to relevant rows + if (l == min(bins)) { + Which2 <- Which[which(data[Which, "bin"] %in% l & data[Which, "sex"] == s)] + } + if (l != min(bins)) { + Which2 <- Which[which(data[Which, "bin"] == l & data[Which, "sex"] == s)] + } + if (l == max(bins)) { + Which2 <- Which[which(data[Which, "bin"] %in% c(l, Inf) & data[Which, "sex"] == s)] + } + # Sum to effective sample size by length_bin x Sex x Fleet x Year + if (length(Which2) == 0) Row <- c(Row, 0) + if (length(Which2) >= 1) Row <- c(Row, length(Which2)) + } + } + # Add to results matrix + Results <- rbind(Results, Row) + } # end Which loop + } # end year loop + + if(!is.null(Results)){ + Results <- as.data.frame(Results) + tmp <- data.frame( + year = Results[, 1], + month = month, + fleet = fleet, + sex = 3, + partition = partition, + nsamp = Results[, 2] + ) + out <- cbind(tmp, Results[, -c(1:2)]) + colnames(out)[-c(1:6)] <- c( + paste(rep("F", each = length(comp_bins)), comp_bins, sep = ""), + paste(rep("M", each = length(comp_bins)), comp_bins, sep = "")) + } + + # Create unsexed comps if present in the data + out_u <- NULL + if (length(data[data[, "sex"] == "U", "sex"]) > 0) { + Results <- NULL + for (y in sort(unique(data[, "year"]))) { + # Identify relevant rows + Which <- which(data[, "year"] == y & data[, "sex"] == "U") + # Skip this year unless there are rows + if (length(Which) > 0) { + # Format reference stuff + Row <- c(y, length(Which)) + # Loop across length bins + for (l in comp_bins) + { + # Subset to relevant rows + if (l == min(bins)) { + Which2 <- Which[which(data[Which, "bin"] %in% l)] + } + if (l != min(bins)) { + Which2 <- Which[which(data[Which, "bin"] == l)] + } + if (l == max(bins)) { + Which2 <- Which[which(data[Which, "bin"] %in% c(l, Inf))] + } + # Sum to effective sample size by length_bin x Sex x Fleet x Year + if (length(Which2) == 0) Row <- c(Row, 0) + if (length(Which2) >= 1) Row <- c(Row, length(Which2)) + } + # Add to results matrix + Results <- rbind(Results, Row) + } # end Which loop + } # end year loop + Results <- as.data.frame(Results) + tmp <- data.frame( + year = Results[, 1], + month = month, + fleet = fleet, + sex = 0, + partition = partition, + nsamp = Results[, 2] + ) + + if (two_sex_comps){ + out_u <- cbind(tmp, Results[, -c(1:2)], Results[, -c(1:2)]) + } else { + out_u <- cbind(tmp, Results[, -c(1:2)]) + } + colnames(out_u)[-c(1:6)] <- paste(rep("U", each = length(comp_bins)), comp_bins, sep = "") + } + + if (comp_type == "length") { + if (!is.null(out)) { + out_comps <- out + } else { + out_comps <- NULL + } + if (!is.null(out_u)) { + out_u_comps <- out_u + } + } + + if (comp_type == "age") { + if (!is.null(out)) { + out_comps <- cbind(out[, 1:5], age_error, age_low, age_high, out[, 6:dim(out)[2]]) + } else { + out_comps <- NULL + } + if (!is.null(out_u)) { + out_u_comps <- cbind(out_u[, 1:5], age_error, age_low, age_high, out_u[, 6:dim(out_u)[2]]) + } + } + + if (!is.null(dir)) { + if (!is.null(out_comps)) { + write.csv(out_comps, + file = file.path(plotdir, paste0(comp_type, "_raw_comps_sex_3_", comp_type, "_bins_", comp_bins[1], "-", max(comp_bins), ".csv")), + row.names = FALSE + ) + } + if (!is.null(out_u)) { + write.csv(out_u_comps, + file = file.path(plotdir, paste0(comp_type, "_raw_comps_sex_0_", comp_type, "_bins_", comp_bins[1], "-", max(comp_bins), ".csv")), + row.names = FALSE + ) + } + } + + comps <- list() + if (!is.null(out_comps)) { + rownames(out_comps) <- NULL + comps$sexed <- out_comps + } + if (!is.null(out_u)) { + rownames(out_u_comps) <- NULL + comps$unsexed <- out_u_comps + } + + return(comps) + +} diff --git a/man/get_raw_comps.Rd b/man/get_raw_comps.Rd new file mode 100644 index 0000000..7f4a29e --- /dev/null +++ b/man/get_raw_comps.Rd @@ -0,0 +1,89 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get_raw_comps.R +\name{get_raw_comps} +\alias{get_raw_comps} +\title{Creates a matrix of unexpanded (or raw) marginal length or age composition +data formatted for Stock Synthesis. The code will return composition data +for all sexes present in the data frame and no sex assignment is done for +unsexed fish. The function will create composition data for either +lengths or ages based on the comp_column_name. The function will return a +list of composition data based upon the sexes present in the data for a +two-sex model or all length/ages for single-sex model.} +\usage{ +get_raw_comps( + data, + comps_bins, + comp_column_name = "Length_cm", + two_sex_comps = TRUE, + fleet = "Enter Fleet", + month = "Enter Month", + partition = 0, + age_error = "Enter Age Error Vector", + age_low = -1, + age_high = -1, + dir = NULL, + printfolder = "forSS3", + verbose = TRUE +) +} +\arguments{ +\item{data}{A data frame that includes columns of year, sex, and length/ages. The data +frame can be survey data pulled using pull_bio from the data warehouse or any data frame +that includes column names of sex, year, and the comp_column_name. The sex column is +expected to have sexes denoted by F, M, and U.} + +\item{comp_column_name}{The column name to create composition data for. This column can be +is used to determine whether to format the composition data for length or age +compositions by looking for either age (e.g., age_years, Age, best_age) or length +(e.g., Length, length, Length_cm) in the comp_column_name. Default Length_cm.} + +\item{two_sex_comps}{Default TRUE. If TRUE composition data will be formatted for a +Stock Synthesis two-sex model and if FALSE composition data will be formatted for a +single-sex model.} + +\item{fleet}{A fleet number to assign the composition data to based on the expected +format for Stock Synthesis. Default "Enter Fleet".} + +\item{month}{Month the samples were collected based on the expected format for +Stock Synthesis to determine the length/age estimate to compare to. Default +"Enter Month".} + +\item{partition}{Partition to assign the composition data based on the expected +format for Stock Synthesis. Partition of 0 indicates that the composition data +include all composition data, 1 for discarded composition data, and 2 for retained +fish only. Default of 0.} + +\item{age_error}{Number of ageing error vector to apply to the age data based on +Stock Synthesis. Default "Enter Age Error Vector".} + +\item{age_low}{Lower age bin for all age composition data based on the expected +format for Stock Synthesis. Default value of -1 which translates to the lowest age +bin.} + +\item{age_high}{Upper age bin for all age composition data based on the expected +format for Stock Synthesis. Default value of -1 which translates to the highest} + +\item{dir}{directory where ouptut will be saved. The directory where the file should be saved. +If dir = NULL no output will be saved.} + +\item{printfolder}{Folder inside the directory, if provide, where the composition +csv files will be saved. Default "forSS3".} + +\item{verbose}{A logical that specifies if you want to print messages and +warnings to the console. The default is \code{TRUE}.} + +\item{comp_bins}{A vector on length bins or age bins to create compositions across. The +composition data is formatted for Stock Synthesis.} +} +\description{ +Creates a matrix of unexpanded (or raw) marginal length or age composition +data formatted for Stock Synthesis. The code will return composition data +for all sexes present in the data frame and no sex assignment is done for +unsexed fish. The function will create composition data for either +lengths or ages based on the comp_column_name. The function will return a +list of composition data based upon the sexes present in the data for a +two-sex model or all length/ages for single-sex model. +} +\author{ +Chantel Wetzel +} From c335aa0c44a6f40585bcebeef64770f2bb61e560 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Mon, 6 May 2024 14:10:11 -0700 Subject: [PATCH 02/14] add tests for composition data --- tests/testthat/test-comps.R | 45 +++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 tests/testthat/test-comps.R diff --git a/tests/testthat/test-comps.R b/tests/testthat/test-comps.R new file mode 100644 index 0000000..2e74469 --- /dev/null +++ b/tests/testthat/test-comps.R @@ -0,0 +1,45 @@ +context("Create composition data") + +if (interactive()) options(mc.cores = parallel::detectCores()) +# devtools::test() +set.seed(1) + +test_that("get_raw_comps", { + skip_on_cran() + + set.seed(123) + dat <- pull_bio( + common_name = "lingcod", + years = c(2003, 2018), + survey = "NWFSC.Combo", + verbose = TRUE + ) + length_comps <- get_raw_comps( + data = dat, + comp_bins = seq(16, 80, 4), + comp_column_name = "Length_cm", + two_sex_comps = TRUE) + expect_equal(nrow(length_comps$sexed), 16) + expect_equal( sum(length_comps$sexed$nsamp), sum(length_comps$sexed[, 7:ncol(length_comps$sexed)])) + expect_equal(nrow(length_comps$unsexed), 16) + expect_equal( sum(length_comps$unsexed$nsamp), sum(length_comps$unsexed[, 7:ncol(length_comps$unsexed)]) / 2) + + length_unsexed_comps <- get_raw_comps( + data = dat, + comp_bins = seq(16, 80, 4), + comp_column_name = "Length_cm", + two_sex_comps = FALSE) + expect_equal(nrow(length_unsexed_comps$unsexed), 16) + expect_equal( sum(length_unsexed_comps$unsexed$nsamp), sum(length_unsexed_comps$unsexed[, 7:ncol(length_unsexed_comps$unsexed)])) + + age_comps <- get_raw_comps( + data = dat, + comp_bins = 1:12, + comp_column_name = "Age", + two_sex_comps = TRUE) + expect_equal(nrow(age_comps$sexed), 16) + expect_equal( sum(age_comps$sexed$nsamp), sum(age_comps$sexed[, 10:ncol(age_comps$sexed)])) + expect_equal(nrow(age_comps$unsexed), 16) + expect_equal( sum(age_comps$unsexed$nsamp), sum(age_comps$unsexed[, 10:ncol(age_comps$unsexed)]) / 2) + +}) From fc1910beb68254ba1f9604ea70f8879fcaa67a94 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Mon, 6 May 2024 14:10:44 -0700 Subject: [PATCH 03/14] update documentation --- man/Format.AKSlope.fn.Rd | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/man/Format.AKSlope.fn.Rd b/man/Format.AKSlope.fn.Rd index 9838a9f..14e5573 100644 --- a/man/Format.AKSlope.fn.Rd +++ b/man/Format.AKSlope.fn.Rd @@ -48,14 +48,14 @@ of containing catch, length, and age data. \dontrun{ # load data files for catch and biological data load("Tri.Shelf.and.AFSC.Slope.canary.Catch.24.May.11.dmp") - catch = Tri.Shelf.and.AFSC.Slope.canary.Catch.24.May.11 + catch = Tri.Shelf.and.AFSC.Slope.canary.Catch.24.May.11 load("AFSC.Slope.Shelf.sable.bio.5.24.11.dmp") bio = AK.Surveys.Bio.sablefish.24.May.11 # call function and reformat the data filter.dat = Format.AKSlope.fn( - datTows = catch, - datL = bio, - start.year = 1997) + datTows = catch, + datL = bio, + start.year = 1997) catch = filter.dat$datTows len = filter.dat$length age = filter.dat$age From 8a1cc11ec3aded23424a3d3ea61f198eb47f22b1 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Mon, 6 May 2024 14:26:12 -0700 Subject: [PATCH 04/14] add template for printfolder and update the folder name Revise the folder name to be forSS3 rather than forSS --- R/Biomass.fn.R | 4 ++-- R/GetN.fn.R | 5 ++--- R/SurveyAFs.fn.R | 4 ++-- R/SurveyAgeAtLen.fn.R | 4 ++-- R/SurveyLFs.fn.R | 6 ++---- R/UnexpandedAF.fn.R | 4 ++-- R/checkStrata.fn.R | 39 ++++++++++++++++++--------------------- R/get_raw_comps.R | 3 +-- R/unexpandedLF.fn.R | 4 ++-- man-roxygen/printfolder.R | 2 ++ man/Biomass.fn.Rd | 5 +++-- man/CheckStrata.fn.Rd | 8 +++----- man/GetN.fn.Rd | 6 +++--- man/SurveyAFs.fn.Rd | 5 +++-- man/SurveyAgeAtLen.fn.Rd | 5 +++-- man/SurveyLFs.fn.Rd | 7 +++---- man/UnexpandedAFs.fn.Rd | 5 +++-- man/UnexpandedLFs.fn.Rd | 5 +++-- man/get_raw_comps.Rd | 12 ++++++------ 19 files changed, 65 insertions(+), 68 deletions(-) create mode 100644 man-roxygen/printfolder.R diff --git a/R/Biomass.fn.R b/R/Biomass.fn.R index 12083db..c707fbf 100644 --- a/R/Biomass.fn.R +++ b/R/Biomass.fn.R @@ -16,7 +16,7 @@ #' @param dat data-frame of the data that has been by the PullCatch.fn #' @param strat.vars A vector of the strata variable names (i.e., c("Depth_m","Latitude_dd")) #' @param strat.df a dataframe with the first column the name of the stratum, the second column the area of the stratum, and the remaining columns are the high and low variables defining the strata created by the CreateStrataDF.fn -#' @param printfolder the folder where files will be saved +#' @template printfolder #' @param outputMedian T/F output median or the mean biomass estimate #' @param month month for SS #' @param fleet fleet number for SS @@ -29,7 +29,7 @@ #' @importFrom utils write.csv #' @export -Biomass.fn <- function(dir = NULL, dat, strat.vars = c("Depth_m", "Latitude_dd"), strat.df, printfolder = "forSS", outputMedian = TRUE, +Biomass.fn <- function(dir = NULL, dat, strat.vars = c("Depth_m", "Latitude_dd"), strat.df, printfolder = "forSS3", outputMedian = TRUE, month = NA, fleet = NA, verbose = TRUE) { if (is.null(dat$cpue_kg_km2)) stop("There must be a column called cpue_kg_km2 in the dataframe") diff --git a/R/GetN.fn.R b/R/GetN.fn.R index 47eb436..7127fe3 100644 --- a/R/GetN.fn.R +++ b/R/GetN.fn.R @@ -18,8 +18,7 @@ #' will lead to the use of the correct species-specific value for #' the number of unique samples per tow. See the function call for #' allowed values, where the default is `"all"`. -#' @param printfolder A string that will be used to create the name of the -#' folder where files will be saved, i.e., `file.path(dir, printfolder)`. +#' @template printfolder #' @param output A string, where the default is `NULL`, which returns #' only a vector of samples sizes. #' `"summary"`, or any other character string, will return @@ -40,7 +39,7 @@ GetN.fn <- function(dir = NULL, "thorny", "others" ), - printfolder = "forSS", + printfolder = "forSS3", output = NULL, verbose = TRUE) { species <- match.arg(species) diff --git a/R/SurveyAFs.fn.R b/R/SurveyAFs.fn.R index 591ba8a..1928a3f 100644 --- a/R/SurveyAFs.fn.R +++ b/R/SurveyAFs.fn.R @@ -27,7 +27,7 @@ #' @param ageErr age error vector to apply #' @param nSamps effective sample size for Stock Synthesis #' @param month month when the samples were collected -#' @param printfolder folder where the length comps will be saved +#' @template printfolder #' @param remove999 the output object by the function will have the 999 column combined with the first length bin #' @param outputStage1 return the first stage expanded data without compiling it for SS #' @template verbose @@ -39,7 +39,7 @@ SurveyAFs.fn <- function(dir = NULL, datA, datTows, strat.vars = c("Depth_m", "Latitude_dd"), strat.df = NULL, ageBins = 1, SSout = TRUE, meanRatioMethod = TRUE, sex = 3, NAs2zero = T, sexRatioUnsexed = NA, maxSizeUnsexed = NA, sexRatioStage = 1, partition = 0, fleet = "Enter Fleet", agelow = "Enter", - agehigh = "Enter", ageErr = "Enter", nSamps = "Enter Samps", month = "Enter Month", printfolder = "forSS", + agehigh = "Enter", ageErr = "Enter", nSamps = "Enter Samps", month = "Enter Month", printfolder = "forSS3", remove999 = TRUE, outputStage1 = FALSE, verbose = TRUE) { # Overwrite inputs to use the same code for lengths as ages diff --git a/R/SurveyAgeAtLen.fn.R b/R/SurveyAgeAtLen.fn.R index b4b3698..767acfb 100644 --- a/R/SurveyAgeAtLen.fn.R +++ b/R/SurveyAgeAtLen.fn.R @@ -25,7 +25,7 @@ #' @param partition partition for Stock Synthesis #' @param ageErr age error value for Stock Synthesis #' @param returnSamps TRUE/FALSE stops the function after the sample size is calculated -#' @param printfolder folder where the length comps will be saved +#' @template printfolder #' @template verbose #' #' @author Allan Hicks and Chantel Wetzel @@ -35,7 +35,7 @@ SurveyAgeAtLen.fn <- function(dir = NULL, datAL, datTows, strat.vars = c("Depth_m", "Latitude_dd"), strat.df = NULL, lgthBins = 1, ageBins = 1, sex = 3, SSout = TRUE, meanRatioMethod = TRUE, raw = TRUE, NAs2zero = TRUE, month = "Enter Month", fleet = "Enter Fleet", - partition = 0, ageErr = "Enter Age Error", returnSamps = FALSE, printfolder = "forSS", verbose = TRUE) { + partition = 0, ageErr = "Enter Age Error", returnSamps = FALSE, printfolder = "forSS3", verbose = TRUE) { plotdir <- file.path(dir, printfolder) check_dir(plotdir, verbose = verbose) diff --git a/R/SurveyLFs.fn.R b/R/SurveyLFs.fn.R index ef21685..ffc45e1 100644 --- a/R/SurveyLFs.fn.R +++ b/R/SurveyLFs.fn.R @@ -42,9 +42,7 @@ #' @param nSamps A named vector of input or effective sample sizes that will be #' used to set the effective sample size of the returned input for Stock #' Synthesis. A value must be supplied for every year of data in `datL`. -#' @param printfolder A string that will be appended to `dir`, creating a folder -#' where the length-composition output will be saved. If specified as `""`, -#' the output will just be saved directly in `dir`. The default is `"forSS"`. +#' @template printfolder #' @param remove999 A logical with the default of `TRUE`, which leads to the #' output having the 999 column combined with the first length bin. #' @param outputStage1 A logical specifying if you would like the function to @@ -63,7 +61,7 @@ SurveyLFs.fn <- function(dir = NULL, datL, datTows, strat.vars = c("Depth_m", "Latitude_dd"), strat.df = NULL, lgthBins = 1, SSout = TRUE, meanRatioMethod = TRUE, sex = 3, NAs2zero = T, sexRatioUnsexed = NA, maxSizeUnsexed = NA, sexRatioStage = 1, partition = 0, fleet = "Enter Fleet", - agelow = "Enter", agehigh = "Enter", ageErr = "Enter", nSamps = "Enter Samps", month = "Enter Month", printfolder = "forSS", + agelow = "Enter", agehigh = "Enter", ageErr = "Enter", nSamps = "Enter Samps", month = "Enter Month", printfolder = "forSS3", remove999 = TRUE, outputStage1 = FALSE, sum100 = TRUE, verbose = TRUE) { # Check for the number of tows were fish were observed but not measured diff --git a/R/UnexpandedAF.fn.R b/R/UnexpandedAF.fn.R index 152cd13..596e5b2 100644 --- a/R/UnexpandedAF.fn.R +++ b/R/UnexpandedAF.fn.R @@ -11,14 +11,14 @@ #' @param agelow age bin for SS (default value of -1) #' @param agehigh age bin for SS (default value of -1) #' @param month month the samples were collected -#' @param printfolder folder where the length comps will be saved +#' @template printfolder #' @template verbose #' #' @author Chantel Wetzel #' @export UnexpandedAFs.fn <- function(dir = NULL, datA, ageBins = 1, sex = 3, partition = 0, fleet = "Enter Fleet", - ageErr = "NA", agelow = -1, agehigh = -1, month = "Enter Month", printfolder = "forSS", verbose = TRUE) { + ageErr = "NA", agelow = -1, agehigh = -1, month = "Enter Month", printfolder = "forSS3", verbose = TRUE) { # Overwrite inputs to use the same code for lengths as ages datL <- datA diff --git a/R/checkStrata.fn.R b/R/checkStrata.fn.R index 7ba4bc2..06c657c 100644 --- a/R/checkStrata.fn.R +++ b/R/checkStrata.fn.R @@ -1,24 +1,21 @@ -#' Calculates and returns the total number of tows and -#' positive tows conducted in each strata by year. The -#' selected stratas are used to expand the length and +#' Calculates and returns the total number of tows and +#' positive tows conducted in each strata by year. The +#' selected stratas are used to expand the length and #' marginal age compositions and to calculate a design -#' based index using the {Biomass.fn} function. +#' based index using the {Biomass.fn} function. #' -#' @param dir Directory where the output csv file will be -#' saved. -#' @param dat Data-frame of the catch data that has been +#' @param dir Directory where the output csv file will be +#' saved. +#' @param dat Data-frame of the catch data that has been #' created by the {PullCatch.fn} function. -#' @param strat.vars A vector of the strata variable names. +#' @param strat.vars A vector of the strata variable names. #' The default input are c("Depth_m","Latitude_dd")) which #' are the two factors the define a strata area off the coast. -#' @param strat.df Dataframe with the first column the name -#' of the stratum, the second column the area of the stratum, -#' and the remaining columns are the high and low variables +#' @param strat.df Dataframe with the first column the name +#' of the stratum, the second column the area of the stratum, +#' and the remaining columns are the high and low variables #' defining the strata created by the {CreateStrataDF.fn} function. -#' @param printfolder Folder name where files will be saved. The -#' default is "forSS" which is also used by other package functions -#' that creates and saves files that are commonly used or reported -#' in Stock Synthesis or the assessment document. +#' @template printfolder #' @template verbose #' #' @author Chantel Wetzel @@ -26,15 +23,15 @@ #' #' CheckStrata.fn <- function( - dir = NULL, - dat, - strat.vars = c("Depth_m", "Latitude_dd"), - strat.df, - printfolder = "forSS", + dir = NULL, + dat, + strat.vars = c("Depth_m", "Latitude_dd"), + strat.df, + printfolder = "forSS3", verbose = TRUE) { # Grab the strata rownmaes to index later - row.names(strat.df) <- strat.df[, 1] + row.names(strat.df) <- strat.df[, 1] numStrata <- nrow(strat.df) # create strata factors diff --git a/R/get_raw_comps.R b/R/get_raw_comps.R index c4c5c24..1c60ba0 100644 --- a/R/get_raw_comps.R +++ b/R/get_raw_comps.R @@ -37,8 +37,7 @@ #' format for Stock Synthesis. Default value of -1 which translates to the highest # age bin. #' @template dir -#' @param printfolder Folder inside the directory, if provide, where the composition -#' csv files will be saved. Default "forSS3". +#' @template printfolder #' @template verbose #' #' @author Chantel Wetzel diff --git a/R/unexpandedLF.fn.R b/R/unexpandedLF.fn.R index 14cc119..1c7df40 100644 --- a/R/unexpandedLF.fn.R +++ b/R/unexpandedLF.fn.R @@ -11,14 +11,14 @@ #' @param partition partition for Stock Synthesis #' @param fleet fleet number #' @param month month the samples were collected -#' @param printfolder folder where the length comps will be saved +#' @template printfolder #' @template verbose #' #' @author Chantel Wetzel #' @export UnexpandedLFs.fn <- function(dir = NULL, datL, lgthBins = 1, sex = 3, partition = 0, fleet = "Enter Fleet", - ageErr = "NA", agelow = -1, agehigh = -1, month = "Enter Month", printfolder = "forSS", verbose = TRUE) { + ageErr = "NA", agelow = -1, agehigh = -1, month = "Enter Month", printfolder = "forSS3", verbose = TRUE) { plotdir <- file.path(dir, printfolder) check_dir(dir = plotdir, verbose = verbose) diff --git a/man-roxygen/printfolder.R b/man-roxygen/printfolder.R new file mode 100644 index 0000000..2ec31fb --- /dev/null +++ b/man-roxygen/printfolder.R @@ -0,0 +1,2 @@ +#' @param printfolder Folder inside the directory, if provide, where +#' csv files will be saved i.e., `file.path(dir, printfolder)`. Default "forSS3". diff --git a/man/Biomass.fn.Rd b/man/Biomass.fn.Rd index d4cde07..f06adf1 100644 --- a/man/Biomass.fn.Rd +++ b/man/Biomass.fn.Rd @@ -13,7 +13,7 @@ Biomass.fn( dat, strat.vars = c("Depth_m", "Latitude_dd"), strat.df, - printfolder = "forSS", + printfolder = "forSS3", outputMedian = TRUE, month = NA, fleet = NA, @@ -29,7 +29,8 @@ Biomass.fn( \item{strat.df}{a dataframe with the first column the name of the stratum, the second column the area of the stratum, and the remaining columns are the high and low variables defining the strata created by the CreateStrataDF.fn} -\item{printfolder}{the folder where files will be saved} +\item{printfolder}{Folder inside the directory, if provide, where +csv files will be saved i.e., \code{file.path(dir, printfolder)}. Default "forSS3".} \item{outputMedian}{T/F output median or the mean biomass estimate} diff --git a/man/CheckStrata.fn.Rd b/man/CheckStrata.fn.Rd index f43cf9e..976490c 100644 --- a/man/CheckStrata.fn.Rd +++ b/man/CheckStrata.fn.Rd @@ -13,7 +13,7 @@ CheckStrata.fn( dat, strat.vars = c("Depth_m", "Latitude_dd"), strat.df, - printfolder = "forSS", + printfolder = "forSS3", verbose = TRUE ) } @@ -33,10 +33,8 @@ of the stratum, the second column the area of the stratum, and the remaining columns are the high and low variables defining the strata created by the {CreateStrataDF.fn} function.} -\item{printfolder}{Folder name where files will be saved. The -default is "forSS" which is also used by other package functions -that creates and saves files that are commonly used or reported -in Stock Synthesis or the assessment document.} +\item{printfolder}{Folder inside the directory, if provide, where +csv files will be saved i.e., \code{file.path(dir, printfolder)}. Default "forSS3".} \item{verbose}{A logical that specifies if you want to print messages and warnings to the console. The default is \code{TRUE}.} diff --git a/man/GetN.fn.Rd b/man/GetN.fn.Rd index 507fd8f..9855038 100644 --- a/man/GetN.fn.Rd +++ b/man/GetN.fn.Rd @@ -9,7 +9,7 @@ GetN.fn( dat, type = c("length", "age"), species = c("all", "flatfish", "shelfrock", "sloperock", "thorny", "others"), - printfolder = "forSS", + printfolder = "forSS3", output = NULL, verbose = TRUE ) @@ -30,8 +30,8 @@ will lead to the use of the correct species-specific value for the number of unique samples per tow. See the function call for allowed values, where the default is \code{"all"}.} -\item{printfolder}{A string that will be used to create the name of the -folder where files will be saved, i.e., \code{file.path(dir, printfolder)}.} +\item{printfolder}{Folder inside the directory, if provide, where +csv files will be saved i.e., \code{file.path(dir, printfolder)}. Default "forSS3".} \item{output}{A string, where the default is \code{NULL}, which returns only a vector of samples sizes. diff --git a/man/SurveyAFs.fn.Rd b/man/SurveyAFs.fn.Rd index 1e1ec46..f3970ee 100644 --- a/man/SurveyAFs.fn.Rd +++ b/man/SurveyAFs.fn.Rd @@ -32,7 +32,7 @@ SurveyAFs.fn( ageErr = "Enter", nSamps = "Enter Samps", month = "Enter Month", - printfolder = "forSS", + printfolder = "forSS3", remove999 = TRUE, outputStage1 = FALSE, verbose = TRUE @@ -79,7 +79,8 @@ SurveyAFs.fn( \item{month}{month when the samples were collected} -\item{printfolder}{folder where the length comps will be saved} +\item{printfolder}{Folder inside the directory, if provide, where +csv files will be saved i.e., \code{file.path(dir, printfolder)}. Default "forSS3".} \item{remove999}{the output object by the function will have the 999 column combined with the first length bin} diff --git a/man/SurveyAgeAtLen.fn.Rd b/man/SurveyAgeAtLen.fn.Rd index 065ee58..0e9c8cb 100644 --- a/man/SurveyAgeAtLen.fn.Rd +++ b/man/SurveyAgeAtLen.fn.Rd @@ -30,7 +30,7 @@ SurveyAgeAtLen.fn( partition = 0, ageErr = "Enter Age Error", returnSamps = FALSE, - printfolder = "forSS", + printfolder = "forSS3", verbose = TRUE ) } @@ -69,7 +69,8 @@ SurveyAgeAtLen.fn( \item{returnSamps}{TRUE/FALSE stops the function after the sample size is calculated} -\item{printfolder}{folder where the length comps will be saved} +\item{printfolder}{Folder inside the directory, if provide, where +csv files will be saved i.e., \code{file.path(dir, printfolder)}. Default "forSS3".} \item{verbose}{A logical that specifies if you want to print messages and warnings to the console. The default is \code{TRUE}.} diff --git a/man/SurveyLFs.fn.Rd b/man/SurveyLFs.fn.Rd index e0a378f..a7af987 100644 --- a/man/SurveyLFs.fn.Rd +++ b/man/SurveyLFs.fn.Rd @@ -25,7 +25,7 @@ SurveyLFs.fn( ageErr = "Enter", nSamps = "Enter Samps", month = "Enter Month", - printfolder = "forSS", + printfolder = "forSS3", remove999 = TRUE, outputStage1 = FALSE, sum100 = TRUE, @@ -92,9 +92,8 @@ more information.} used to set the effective sample size of the returned input for Stock Synthesis. A value must be supplied for every year of data in \code{datL}.} -\item{printfolder}{A string that will be appended to \code{dir}, creating a folder -where the length-composition output will be saved. If specified as \code{""}, -the output will just be saved directly in \code{dir}. The default is \code{"forSS"}.} +\item{printfolder}{Folder inside the directory, if provide, where +csv files will be saved i.e., \code{file.path(dir, printfolder)}. Default "forSS3".} \item{remove999}{A logical with the default of \code{TRUE}, which leads to the output having the 999 column combined with the first length bin.} diff --git a/man/UnexpandedAFs.fn.Rd b/man/UnexpandedAFs.fn.Rd index bf49134..90dba5b 100644 --- a/man/UnexpandedAFs.fn.Rd +++ b/man/UnexpandedAFs.fn.Rd @@ -16,7 +16,7 @@ UnexpandedAFs.fn( agelow = -1, agehigh = -1, month = "Enter Month", - printfolder = "forSS", + printfolder = "forSS3", verbose = TRUE ) } @@ -41,7 +41,8 @@ UnexpandedAFs.fn( \item{month}{month the samples were collected} -\item{printfolder}{folder where the length comps will be saved} +\item{printfolder}{Folder inside the directory, if provide, where +csv files will be saved i.e., \code{file.path(dir, printfolder)}. Default "forSS3".} \item{verbose}{A logical that specifies if you want to print messages and warnings to the console. The default is \code{TRUE}.} diff --git a/man/UnexpandedLFs.fn.Rd b/man/UnexpandedLFs.fn.Rd index 8d704f0..96020ed 100644 --- a/man/UnexpandedLFs.fn.Rd +++ b/man/UnexpandedLFs.fn.Rd @@ -16,7 +16,7 @@ UnexpandedLFs.fn( agelow = -1, agehigh = -1, month = "Enter Month", - printfolder = "forSS", + printfolder = "forSS3", verbose = TRUE ) } @@ -41,7 +41,8 @@ UnexpandedLFs.fn( \item{month}{month the samples were collected} -\item{printfolder}{folder where the length comps will be saved} +\item{printfolder}{Folder inside the directory, if provide, where +csv files will be saved i.e., \code{file.path(dir, printfolder)}. Default "forSS3".} \item{verbose}{A logical that specifies if you want to print messages and warnings to the console. The default is \code{TRUE}.} diff --git a/man/get_raw_comps.Rd b/man/get_raw_comps.Rd index 7f4a29e..6e62712 100644 --- a/man/get_raw_comps.Rd +++ b/man/get_raw_comps.Rd @@ -12,7 +12,7 @@ two-sex model or all length/ages for single-sex model.} \usage{ get_raw_comps( data, - comps_bins, + comp_bins, comp_column_name = "Length_cm", two_sex_comps = TRUE, fleet = "Enter Fleet", @@ -32,6 +32,9 @@ frame can be survey data pulled using pull_bio from the data warehouse or any da that includes column names of sex, year, and the comp_column_name. The sex column is expected to have sexes denoted by F, M, and U.} +\item{comp_bins}{A vector on length bins or age bins to create compositions across. The +composition data is formatted for Stock Synthesis.} + \item{comp_column_name}{The column name to create composition data for. This column can be is used to determine whether to format the composition data for length or age compositions by looking for either age (e.g., age_years, Age, best_age) or length @@ -66,14 +69,11 @@ format for Stock Synthesis. Default value of -1 which translates to the highest} \item{dir}{directory where ouptut will be saved. The directory where the file should be saved. If dir = NULL no output will be saved.} -\item{printfolder}{Folder inside the directory, if provide, where the composition -csv files will be saved. Default "forSS3".} +\item{printfolder}{Folder inside the directory, if provide, where +csv files will be saved i.e., \code{file.path(dir, printfolder)}. Default "forSS3".} \item{verbose}{A logical that specifies if you want to print messages and warnings to the console. The default is \code{TRUE}.} - -\item{comp_bins}{A vector on length bins or age bins to create compositions across. The -composition data is formatted for Stock Synthesis.} } \description{ Creates a matrix of unexpanded (or raw) marginal length or age composition From 01a2207defc3b65b48c7524589ce14a5b513eb6e Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Mon, 6 May 2024 14:42:31 -0700 Subject: [PATCH 05/14] add examples in the vignette --- vignettes/nwfscSurvey.Rmd | 40 ++++++++++++++++++++++++++++++++++----- 1 file changed, 35 insertions(+), 5 deletions(-) diff --git a/vignettes/nwfscSurvey.Rmd b/vignettes/nwfscSurvey.Rmd index 4a91fc7..de56e66 100644 --- a/vignettes/nwfscSurvey.Rmd +++ b/vignettes/nwfscSurvey.Rmd @@ -51,11 +51,13 @@ ls("package:nwfscSurvey") Pull both the catch and biological data: ```r -catch = PullCatch.fn(Name = "Pacific ocean perch", - SurveyName = "NWFSC.Combo") +catch = pull_catch( + common_name = "Pacific ocean perch", + survye = "NWFSC.Combo") -bio = PullBio.fn(Name = "Pacific ocean perch", - SurveyName = "NWFSC.Combo") +bio = pull_bio( + common_Name = "Pacific ocean perch", + survey = "NWFSC.Combo") ``` #### Initial data visualization @@ -160,13 +162,28 @@ PlotFreqData.fn(dir = getwd(), dat = Length_Freq) ``` -A new function to visualize length frequency data is also availble: +A new function to visualize length frequency data is also available: ```r plot_comps(data = Length_Freq) ``` If `dir` does not equal `NULL`, then a "plot" folder will be created in the directory location and a png of the plot will be saved. +There is also a function to create raw or unexpanded composition data that works +for either length or age data. + +```r +length_comps <- get_raw_comps( + data = dat, + comp_bins = seq(10, 40, 2), + comp_column_name = "Length_cm", + two_sex_comps = TRUE, + dir = getwd()) +``` +This function returns a list of sexed and unsexed length composition data formatted +for Stock Synthesis. The sample size (nsamp) is set equal to the number of samples +in the data frame. + #### Marginal age composition data Calculate the marginal age sample size: @@ -201,6 +218,19 @@ plot_comps( ``` If `dir` is not `NULL`, then a "plot" folder will be created in the directory location and a png of the plot will be saved. +There is also a function to create raw or unexpanded composition data that works +for either length or age data. + +```r +age_comps <- get_raw_comps( + data = dat, + comp_bins = 1:40, + comp_column_name = "Age", + two_sex_comps = TRUE, + dir = getwd()) +``` +This function returns a list of sexed and unsexed marginal age composition data formatted for Stock Synthesis. The sample size (nsamp) is set equal to the number of samples in the data frame. + #### Conditional-age-at-length data To calculate conditional-age-at-length data formatted for Stock Synthesis: From bd14d96141ae981e1d502083d2b9f9a40ba590e6 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Wed, 8 May 2024 07:35:21 -0700 Subject: [PATCH 06/14] add examples and function documentation --- R/get_raw_comps.R | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/R/get_raw_comps.R b/R/get_raw_comps.R index 1c60ba0..fed82ab 100644 --- a/R/get_raw_comps.R +++ b/R/get_raw_comps.R @@ -1,3 +1,6 @@ +#' Calculate unexpanded/raw length or marginal age compositions +#' +#' @details #' Creates a matrix of unexpanded (or raw) marginal length or age composition #' data formatted for Stock Synthesis. The code will return composition data #' for all sexes present in the data frame and no sex assignment is done for @@ -40,9 +43,32 @@ #' @template printfolder #' @template verbose #' +#' @returns A list of length or marginal age compositions for sexed and +#' unsexed fish formatted for Stock Synthesis. +#' #' @author Chantel Wetzel #' @export #' +#' @examples +#' \dontrun{ +#' bio <- pull_bio{ +#' common_name = "lingcod", +#' survey = "NWFSC.Combo +#' } +#' +#' length_comps <- get_raw_comps( +#' data = bio, +#' comp_bins = seq(20, 70, 4) +#' ) +#' +#' age_comps <- get_raw_comps( +#' data = bio, +#' comp_bins = 1:20, +#' comp_column_name = "Age" +#' ) +#' +#' } +#' get_raw_comps <- function( data, comp_bins, From 257f43a1a0ca545b398a927bdc0d02ff8d7e2c32 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Wed, 8 May 2024 13:04:19 -0700 Subject: [PATCH 07/14] update printfolder to forSS3 --- R/Biomass.fn.R | 2 +- R/GetN.fn.R | 2 +- R/SurveyAFs.fn.R | 2 +- R/SurveyAgeAtLen.fn.R | 2 +- R/SurveyLFs.fn.R | 2 +- R/UnexpandedAF.fn.R | 2 +- R/checkStrata.fn.R | 2 +- R/get_raw_comps.R | 2 +- R/unexpandedLF.fn.R | 2 +- man/get_raw_comps.Rd | 43 +++++++++++++++++++++++++++++++++---------- 10 files changed, 42 insertions(+), 19 deletions(-) diff --git a/R/Biomass.fn.R b/R/Biomass.fn.R index a58b896..617aa94 100644 --- a/R/Biomass.fn.R +++ b/R/Biomass.fn.R @@ -56,7 +56,7 @@ Biomass.fn <- function( dat, strat.vars = c("Depth_m", "Latitude_dd"), strat.df, - printfolder = "forSS", + printfolder = "forSS3", outputMedian = TRUE, month = "Enter month", fleet = "Enter fleet", diff --git a/R/GetN.fn.R b/R/GetN.fn.R index ca158b1..02ccb81 100644 --- a/R/GetN.fn.R +++ b/R/GetN.fn.R @@ -54,7 +54,7 @@ GetN.fn <- function( "thorny", "others" ), - printfolder = "forSS", + printfolder = "forSS3", output = NULL, verbose = TRUE) { diff --git a/R/SurveyAFs.fn.R b/R/SurveyAFs.fn.R index edc7407..8f44ce5 100644 --- a/R/SurveyAFs.fn.R +++ b/R/SurveyAFs.fn.R @@ -66,7 +66,7 @@ SurveyAFs.fn <- function( ageErr = "Enter", nSamps = "Enter Samps", month = "Enter Month", - printfolder = "forSS", + printfolder = "forSS3", remove999 = TRUE, outputStage1 = FALSE, verbose = TRUE) { diff --git a/R/SurveyAgeAtLen.fn.R b/R/SurveyAgeAtLen.fn.R index 7d9a9d8..bfec9c9 100644 --- a/R/SurveyAgeAtLen.fn.R +++ b/R/SurveyAgeAtLen.fn.R @@ -56,7 +56,7 @@ SurveyAgeAtLen.fn <- function( partition = 0, ageErr = "Enter Age Error", returnSamps = FALSE, - printfolder = "forSS", + printfolder = "forSS3", verbose = TRUE) { plotdir <- file.path(dir, printfolder) diff --git a/R/SurveyLFs.fn.R b/R/SurveyLFs.fn.R index 380b1e8..25e9246 100644 --- a/R/SurveyLFs.fn.R +++ b/R/SurveyLFs.fn.R @@ -71,7 +71,7 @@ SurveyLFs.fn <- function( ageErr = "Enter", nSamps = "Enter Samps", month = "Enter Month", - printfolder = "forSS", + printfolder = "forSS3", remove999 = TRUE, outputStage1 = FALSE, sum100 = TRUE, diff --git a/R/UnexpandedAF.fn.R b/R/UnexpandedAF.fn.R index 01cbb38..755d49f 100644 --- a/R/UnexpandedAF.fn.R +++ b/R/UnexpandedAF.fn.R @@ -29,7 +29,7 @@ UnexpandedAFs.fn <- function( agelow = -1, agehigh = -1, month = "Enter Month", - printfolder = "forSS", + printfolder = "forSS3", verbose = TRUE) { # Overwrite inputs to use the same code for lengths as ages diff --git a/R/checkStrata.fn.R b/R/checkStrata.fn.R index 6bbb160..88e3a68 100644 --- a/R/checkStrata.fn.R +++ b/R/checkStrata.fn.R @@ -27,7 +27,7 @@ CheckStrata.fn <- function( dat, strat.vars = c("Depth_m", "Latitude_dd"), strat.df, - printfolder = "forSS", + printfolder = "forSS3", verbose = TRUE) { # Grab the strata rownmaes to index later diff --git a/R/get_raw_comps.R b/R/get_raw_comps.R index fed82ab..5bc8ca1 100644 --- a/R/get_raw_comps.R +++ b/R/get_raw_comps.R @@ -53,7 +53,7 @@ #' \dontrun{ #' bio <- pull_bio{ #' common_name = "lingcod", -#' survey = "NWFSC.Combo +#' survey = "NWFSC.Combo" #' } #' #' length_comps <- get_raw_comps( diff --git a/R/unexpandedLF.fn.R b/R/unexpandedLF.fn.R index 5c66fde..fd251bc 100644 --- a/R/unexpandedLF.fn.R +++ b/R/unexpandedLF.fn.R @@ -29,7 +29,7 @@ UnexpandedLFs.fn <- function( agelow = -1, agehigh = -1, month = "Enter Month", - printfolder = "forSS", + printfolder = "forSS3", verbose = TRUE) { plotdir <- file.path(dir, printfolder) diff --git a/man/get_raw_comps.Rd b/man/get_raw_comps.Rd index 6e62712..e163c20 100644 --- a/man/get_raw_comps.Rd +++ b/man/get_raw_comps.Rd @@ -2,13 +2,7 @@ % Please edit documentation in R/get_raw_comps.R \name{get_raw_comps} \alias{get_raw_comps} -\title{Creates a matrix of unexpanded (or raw) marginal length or age composition -data formatted for Stock Synthesis. The code will return composition data -for all sexes present in the data frame and no sex assignment is done for -unsexed fish. The function will create composition data for either -lengths or ages based on the comp_column_name. The function will return a -list of composition data based upon the sexes present in the data for a -two-sex model or all length/ages for single-sex model.} +\title{Calculate unexpanded/raw length or marginal age compositions} \usage{ get_raw_comps( data, @@ -66,16 +60,24 @@ bin.} \item{age_high}{Upper age bin for all age composition data based on the expected format for Stock Synthesis. Default value of -1 which translates to the highest} -\item{dir}{directory where ouptut will be saved. The directory where the file should be saved. +\item{dir}{Directory where output will be saved. The directory where the file should be saved. If dir = NULL no output will be saved.} -\item{printfolder}{Folder inside the directory, if provide, where -csv files will be saved i.e., \code{file.path(dir, printfolder)}. Default "forSS3".} +\item{printfolder}{A string that will be appended to \code{dir}, creating a folder +where the output will be saved. If specified as \code{""}, +the output will just be saved directly in \code{dir}. The default is \code{"forSS3"}.} \item{verbose}{A logical that specifies if you want to print messages and warnings to the console. The default is \code{TRUE}.} } +\value{ +A list of length or marginal age compositions for sexed and +unsexed fish formatted for Stock Synthesis. +} \description{ +Calculate unexpanded/raw length or marginal age compositions +} +\details{ Creates a matrix of unexpanded (or raw) marginal length or age composition data formatted for Stock Synthesis. The code will return composition data for all sexes present in the data frame and no sex assignment is done for @@ -83,6 +85,27 @@ unsexed fish. The function will create composition data for either lengths or ages based on the comp_column_name. The function will return a list of composition data based upon the sexes present in the data for a two-sex model or all length/ages for single-sex model. +} +\examples{ +\dontrun{ +bio <- pull_bio{ + common_name = "lingcod", + survey = "NWFSC.Combo" +} + +length_comps <- get_raw_comps( + data = bio, + comp_bins = seq(20, 70, 4) +) + +age_comps <- get_raw_comps( + data = bio, + comp_bins = 1:20, + comp_column_name = "Age" +) + +} + } \author{ Chantel Wetzel From 4042811b463df397358ddcf9dc0b97061671598e Mon Sep 17 00:00:00 2001 From: Ian Taylor <4992918+iantaylor-NOAA@users.noreply.github.com> Date: Fri, 10 May 2024 12:44:47 -0700 Subject: [PATCH 08/14] change a few more instances of SS to SS3 --- R/SurveyAFs.fn.R | 2 +- R/SurveyLFs.fn.R | 2 +- R/UnexpandedAF.fn.R | 2 +- man/SurveyAFs.fn.Rd | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/SurveyAFs.fn.R b/R/SurveyAFs.fn.R index 8f44ce5..573a455 100644 --- a/R/SurveyAFs.fn.R +++ b/R/SurveyAFs.fn.R @@ -37,7 +37,7 @@ #' @template printfolder #' @param remove999 The output object by the function will have the 999 column combined with the first age bin. #' Default TRUE. -#' @param outputStage1 return the first stage expanded data without compiling it for SS +#' @param outputStage1 return the first stage expanded data without compiling it for SS3 #' @template verbose #' #' @author Allan Hicks and Chantel Wetzel diff --git a/R/SurveyLFs.fn.R b/R/SurveyLFs.fn.R index 25e9246..6aa02c6 100644 --- a/R/SurveyLFs.fn.R +++ b/R/SurveyLFs.fn.R @@ -597,7 +597,7 @@ SurveyLFs.fn <- function( cat("\nNOTE: Files have been saved the the printfolder directory. The first file has the 999 column showing fish smaller or younger than the initial bin. Check to make sure there is not a large number of fish smaller or younger than the initial bin. - The second file has combined the 999 with the first bin and is ready for use in SS.\n") + The second file has combined the 999 with the first bin and is ready for use in SS3.\n") } if (!remove999) { diff --git a/R/UnexpandedAF.fn.R b/R/UnexpandedAF.fn.R index 755d49f..6dfb77e 100644 --- a/R/UnexpandedAF.fn.R +++ b/R/UnexpandedAF.fn.R @@ -48,7 +48,7 @@ UnexpandedAFs.fn <- function( ageErr = ageErr, agelow = agelow, agehigh = agelow, - printfolder = "forSS", + printfolder = "forSS3", verbose = TRUE ) diff --git a/man/SurveyAFs.fn.Rd b/man/SurveyAFs.fn.Rd index 76871f1..320d49d 100644 --- a/man/SurveyAFs.fn.Rd +++ b/man/SurveyAFs.fn.Rd @@ -105,7 +105,7 @@ the output will just be saved directly in \code{dir}. The default is \code{"forS \item{remove999}{The output object by the function will have the 999 column combined with the first age bin. Default TRUE.} -\item{outputStage1}{return the first stage expanded data without compiling it for SS} +\item{outputStage1}{return the first stage expanded data without compiling it for SS3} \item{verbose}{A logical that specifies if you want to print messages and warnings to the console. The default is \code{TRUE}.} From 7c7ef02f6eda409ffb91c050e1586084892b051f Mon Sep 17 00:00:00 2001 From: Ian Taylor <4992918+iantaylor-NOAA@users.noreply.github.com> Date: Fri, 10 May 2024 12:54:39 -0700 Subject: [PATCH 09/14] fix a few typos on vignette --- vignettes/nwfscSurvey.Rmd | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/vignettes/nwfscSurvey.Rmd b/vignettes/nwfscSurvey.Rmd index de56e66..f9f6377 100644 --- a/vignettes/nwfscSurvey.Rmd +++ b/vignettes/nwfscSurvey.Rmd @@ -53,10 +53,10 @@ Pull both the catch and biological data: ```r catch = pull_catch( common_name = "Pacific ocean perch", - survye = "NWFSC.Combo") + survey = "NWFSC.Combo") bio = pull_bio( - common_Name = "Pacific ocean perch", + common_name = "Pacific ocean perch", survey = "NWFSC.Combo") ``` @@ -101,7 +101,7 @@ biomass = Biomass.fn(dir = getwd(), dat = catch, strat.df = strata) ``` -`Biomass.fn()` returns a list with the second element containing the design-based index of abundance. The design based index is calculated based on the defined stratas. The function writes a csv file inside the dir input location to a "forSS" folder. The function returns a list with the second element containing the design-based estimates by year: +`Biomass.fn()` returns a list with the second element containing the design-based index of abundance. The design based index is calculated based on the defined stratas. The function writes a csv file inside the dir input location to a "forSS3" folder. The function returns a list with the second element containing the design-based estimates by year: ```{r, results = 'asis', echo = FALSE} library(xtable) @@ -133,10 +133,10 @@ If `dir` does not equal `NULL`, then a "plot" folder will be created in the dire #### Length composition data -`GetN()` calculates the input sample size based on Stewart & Hamel (2014) which determined that the input sample size was related to the species group (flatfish, shelf rockfish, slope rockfish, thornyhead, others, or all groups) and number of tows. The function writes a csv file with the "forSS" folder containing the number of tows and observed fish by year. +`GetN.fn()` calculates the input sample size based on Stewart & Hamel (2014) which determined that the input sample size was related to the species group (flatfish, shelf rockfish, slope rockfish, thornyhead, others, or all groups) and number of tows. The function writes a csv file with the "forSS3" folder containing the number of tows and observed fish by year. ```r -n <- GetN(dir = getwd(), +n <- GetN.fn(dir = getwd(), dat = bio, type = "length", species = "shelfrock") @@ -152,7 +152,7 @@ Length_Freq <- SurveyLFs.fn(dir = getwd(), strat.df = strata, lgthBins = len_bins) ``` -The above call will calculate the length frequencies for use in Stock Synthesis and write the files inside the "forSS" folder. The example call does not assign unsexed fish to the sexed length comps but will produce csv files for both the sexed and unsexed fish. If you would like to assign the unsexed fish to a sex based on the sex ratio the user will need to specificy the sex ratio value (sexRatioUnsexed) to use for fish under a specified size (maxSizeUnsexed) where unsexed fish greater than the specified size will be assign based on the sex ratio from other observations. +The above call will calculate the length frequencies for use in Stock Synthesis and write the files inside the "forSS3" folder. The example call does not assign unsexed fish to the sexed length comps but will produce csv files for both the sexed and unsexed fish. If you would like to assign the unsexed fish to a sex based on the sex ratio the user will need to specificy the sex ratio value (sexRatioUnsexed) to use for fish under a specified size (maxSizeUnsexed) where unsexed fish greater than the specified size will be assign based on the sex ratio from other observations. There are many inputs to `SurveyLFs.fn()`, please look over the function inputs to explore additional ways to process the data. @@ -174,7 +174,7 @@ for either length or age data. ```r length_comps <- get_raw_comps( - data = dat, + data = bio, comp_bins = seq(10, 40, 2), comp_column_name = "Length_cm", two_sex_comps = TRUE, @@ -188,7 +188,7 @@ in the data frame. Calculate the marginal age sample size: ```r -n <- getN(dir = getwd(), +n <- GetN.fn(dir = getwd(), dat = bio, type = "age", species = "shelfrock") @@ -205,7 +205,7 @@ Ages <- SurveyAFs.fn(dir = getwd(), ageBins = age_bins, nSamps = n) ``` -The above call will calculate the marginal age-composition data for the age data read in using `readInExcelAgeComps.fn()` and writes the files inside the "forSS" folder. +The above call will calculate the marginal age-composition data for the age data read in using `readInExcelAgeComps.fn()` and writes the files inside the "forSS3" folder. To plot the age frequency data: ```r @@ -223,7 +223,7 @@ for either length or age data. ```r age_comps <- get_raw_comps( - data = dat, + data = bio, comp_bins = 1:40, comp_column_name = "Age", two_sex_comps = TRUE, @@ -239,8 +239,8 @@ caal <- SurveyAgeAtLen.fn(dir = getwd(), datAL = bio, datTows = catch, strat.df = strata, - lgthBins = len.bins, - ageBins = age.bins) + lgthBins = len_bins, + ageBins = age_bins) ``` Creates unexpanded conditional-age-at-length data for both sexes with input sample sizes based on the observed number of fish in each length bin by year. From dd861006b5ca912197be1b7287d42cbe7a841898 Mon Sep 17 00:00:00 2001 From: Ian Taylor <4992918+iantaylor-NOAA@users.noreply.github.com> Date: Fri, 10 May 2024 12:55:16 -0700 Subject: [PATCH 10/14] fix typo in Roxygen example --- R/get_raw_comps.R | 4 ++-- man/get_raw_comps.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/get_raw_comps.R b/R/get_raw_comps.R index 5bc8ca1..6eba47a 100644 --- a/R/get_raw_comps.R +++ b/R/get_raw_comps.R @@ -51,10 +51,10 @@ #' #' @examples #' \dontrun{ -#' bio <- pull_bio{ +#' bio <- pull_bio( #' common_name = "lingcod", #' survey = "NWFSC.Combo" -#' } +#' ) #' #' length_comps <- get_raw_comps( #' data = bio, diff --git a/man/get_raw_comps.Rd b/man/get_raw_comps.Rd index e163c20..85ad721 100644 --- a/man/get_raw_comps.Rd +++ b/man/get_raw_comps.Rd @@ -88,10 +88,10 @@ two-sex model or all length/ages for single-sex model. } \examples{ \dontrun{ -bio <- pull_bio{ +bio <- pull_bio( common_name = "lingcod", survey = "NWFSC.Combo" -} +) length_comps <- get_raw_comps( data = bio, From e9563ae3a909abe2c16027d11fc2f27d1a51a0b7 Mon Sep 17 00:00:00 2001 From: Ian Taylor <4992918+iantaylor-NOAA@users.noreply.github.com> Date: Fri, 10 May 2024 13:16:24 -0700 Subject: [PATCH 11/14] update test to switch from PullHaul.fn() to pull_haul() --- tests/testthat/test-data.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index 8d014ef..33c7c7b 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -109,13 +109,13 @@ test_that("pull-sample-types", { }) -test_that("PullHaul", { +test_that("pull_haul", { skip_on_cran() - dat <- PullHaul.fn( - YearRange = c(2003, 2018), - SurveyName = "NWFSC.Combo", - Dir = NULL, verbose = TRUE + dat <- pull_haul( + years = c(2003, 2018), + survey = "NWFSC.Combo", + dir = NULL, verbose = TRUE ) expect_is(dat, "data.frame") expect_equal(nrow(dat), 10351) From c6fb7a4db29dce95dec8f6ed8f17e521b3f107d3 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 17 May 2024 14:58:48 -0700 Subject: [PATCH 12/14] set unsexed "male" comps to 0 for 2-sex model --- R/get_raw_comps.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/get_raw_comps.R b/R/get_raw_comps.R index 6eba47a..2985219 100644 --- a/R/get_raw_comps.R +++ b/R/get_raw_comps.R @@ -215,7 +215,7 @@ get_raw_comps <- function( ) if (two_sex_comps){ - out_u <- cbind(tmp, Results[, -c(1:2)], Results[, -c(1:2)]) + out_u <- cbind(tmp, Results[, -c(1:2)], 0 * Results[, -c(1:2)]) } else { out_u <- cbind(tmp, Results[, -c(1:2)]) } From aed492002d828252acd8152e3d1717c401096aa4 Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 17 May 2024 14:59:59 -0700 Subject: [PATCH 13/14] modify to work with new get_raw_comps 1. This also corrects the sum100 check. 2. Improves the min and max y-axis label and maximum range. --- R/plot_comps.R | 33 ++++++++++++++++++++------------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/R/plot_comps.R b/R/plot_comps.R index 2075d79..9eac980 100644 --- a/R/plot_comps.R +++ b/R/plot_comps.R @@ -38,12 +38,13 @@ plot_comps <- function( width = 10, height = 7) { - data_type <- ifelse(sum(names(data) == "ageErr") == 0, "length", "age") - sex_type <- unique(data$sex) #paste(unique(substr(names(data)[10:ncol(data)], 1, 1)), collapse = "_") - if(is.numeric(data[, "InputN"])) { - N <- data[, "InputN"] + data_type <- ifelse(sum(names(data) %in% c("ageErr", "age_error")) == 0, "length", "age") + sex_type <- unique(data$sex) + input_nsamp <- which(colnames(data) %in% c("nsamp", "InputN")) + if (is.numeric(data[, input_nsamp])) { + N <- data[, input_nsamp] } else { - N <- rep(1,nrow(data)) + N <- rep(1, nrow(data)) } plotdir <- file.path(dir, "plots") @@ -61,7 +62,7 @@ plot_comps <- function( year <- as.numeric(as.character(data$year)) sex <- unique(data$sex) - if (length(sex) > 1 ){ + if (length(sex) > 1 ) { stop("This function does not work on processed composition files with multiple Stock Synthesis sex specifications (sex = 0, sex = 1, sex = 3). Please filter file down to @@ -87,12 +88,12 @@ plot_comps <- function( # Determine if entries are proportions (e.g., sum to 1 or 100) # and convert if needed - if (sum(as.numeric(comps[1, ])) == 100) { - comps <- 100 * comps / apply(comps, 1, sum) - } if (sum(as.numeric(comps[1, ])) > 0.999 & sum(as.numeric(comps[1, ])) < 1.001) { comps <- 100 * comps } + if (sum(as.numeric(comps[1, ])) != 100) { + comps <- 100 * comps / apply(comps, 1, sum) + } mod_comps <- cbind(year, comps) df <- reshape2::melt(mod_comps, id = "year") @@ -113,10 +114,16 @@ plot_comps <- function( bub_step <- ifelse(max(df$value) < 50, 5, 10) bub_range <- c(1, seq(bub_step, floor(max(df$value)), bub_step)) max_range <- 15 - if(max(df$variable) - min(df$variable) > 40 ){ - y_axis <- seq(min(df$variable), max(df$variable), by = 10) + if (max(df$variable) - min(df$variable) >= 40) { + y_axis <- seq( + plyr::round_any(min(df$variable), 10, floor), + plyr::round_any(max(df$variable), 10, ceiling), + by = 10) } else { - y_axis <- seq(min(df$variable), max(df$variable), by = 5) + y_axis <- seq( + plyr::round_any(min(df$variable), 5, floor), + plyr::round_any(max(df$variable), 5, ceiling), + by = 5) } igroup <- 1 @@ -136,7 +143,7 @@ plot_comps <- function( facet_grid(sex~.) + scale_y_continuous( breaks = y_axis, - limits = if (add_0_ylim) {c(0, NA)} else {NULL} + limits = if (add_0_ylim) {c(0, max(y_axis))} else {c(NA, max(y_axis))} ) + labs(x = "Year", y = ylabel, size = "Relative\nAbundance (%)", fill = "") + theme(legend.key = element_blank(), From ba88e913cf7c5034055135b0ab1ca9af60e309eb Mon Sep 17 00:00:00 2001 From: Chantel Wetzel Date: Fri, 17 May 2024 15:17:04 -0700 Subject: [PATCH 14/14] fix test --- tests/testthat/test-comps.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-comps.R b/tests/testthat/test-comps.R index 2e74469..e722746 100644 --- a/tests/testthat/test-comps.R +++ b/tests/testthat/test-comps.R @@ -7,7 +7,6 @@ set.seed(1) test_that("get_raw_comps", { skip_on_cran() - set.seed(123) dat <- pull_bio( common_name = "lingcod", years = c(2003, 2018), @@ -22,7 +21,7 @@ test_that("get_raw_comps", { expect_equal(nrow(length_comps$sexed), 16) expect_equal( sum(length_comps$sexed$nsamp), sum(length_comps$sexed[, 7:ncol(length_comps$sexed)])) expect_equal(nrow(length_comps$unsexed), 16) - expect_equal( sum(length_comps$unsexed$nsamp), sum(length_comps$unsexed[, 7:ncol(length_comps$unsexed)]) / 2) + expect_equal( sum(length_comps$unsexed$nsamp), sum(length_comps$unsexed[, 7:ncol(length_comps$unsexed)]) ) length_unsexed_comps <- get_raw_comps( data = dat, @@ -40,6 +39,6 @@ test_that("get_raw_comps", { expect_equal(nrow(age_comps$sexed), 16) expect_equal( sum(age_comps$sexed$nsamp), sum(age_comps$sexed[, 10:ncol(age_comps$sexed)])) expect_equal(nrow(age_comps$unsexed), 16) - expect_equal( sum(age_comps$unsexed$nsamp), sum(age_comps$unsexed[, 10:ncol(age_comps$unsexed)]) / 2) + expect_equal( sum(age_comps$unsexed$nsamp), sum(age_comps$unsexed[, 10:ncol(age_comps$unsexed)]) ) })