From 6deab7fbb3e07f0bf2a9ccddabd61e5af7e641a5 Mon Sep 17 00:00:00 2001 From: Derek Ogle Date: Fri, 15 Jan 2021 06:31:02 -0600 Subject: [PATCH] Fixed #64 --- NEWS.md | 1 + R/psdAdd.R | 70 +++--- docs/news/index.html | 2 + docs/pkgdown.yml | 2 +- docs/reference/bootCase.html | 26 +- docs/reference/growthModels.html | 352 +++++++++++---------------- docs/reference/psdAdd.html | 2 +- docs/reference/stockRecruitment.html | 82 +++---- man/psdAdd.Rd | 2 +- tests/testthat/testthat_PSD.R | 41 ++++ 10 files changed, 279 insertions(+), 301 deletions(-) diff --git a/NEWS.md b/NEWS.md index c8573d0d..7e86ae34 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,7 @@ * Moved a bunch of plotting examples in the documentation to `tests\plottests\` to speed up testing. The `tests\plottests\` was added to `.Rbuildignore` . * `hist.formula()`: Modified. Fixed bug with y-axes when `freq=FALSE` is used (fixes [#62](https://github.com/droglenc/FSA/issues/62); thanks to @carlostorrescubila). * `fitPlot()`: Modified. Fixed bugs with handling models that used character rather than factor variables. +* `psdAdd()`: Modified. Fixed bug relate to species that were `NA` (fixes [#64](https://github.com/droglenc/FSA/issues/64); thanks to Dan Shoup). Added more tests and fixed some typos in the documentation. * `psdPlot()`: Modified. Fixed bug with box around the plot when `add.psd=FALSE`. Added 5% expansion to top of y-axis so that bars did not run into the box. * `residPlot()`: Modified. Fixed bugs with handling models that used character rather than factor variables. diff --git a/R/psdAdd.R b/R/psdAdd.R index 8ac8c534..af9c0df7 100644 --- a/R/psdAdd.R +++ b/R/psdAdd.R @@ -12,7 +12,7 @@ #' @param verbose A logical that indicates whether detailed messages about species without Gabelhouse lengths or with no recorded values should be printed or not. #' @param \dots Not used. #' -#' @details This computes a vector that contains the Gabelhouse lengths specific to each species for all individuals in an entire data frame. The vector can be appended to an existing data.frame to create a variable that contains the Gabelhouse lengths for each individual. The Gabelhouse length value will be \code{NA} for each individual for which a Gabelhouse length definitions do not exist in \code{\link{PSDlit}}. Species names in the data.frame must be the same as those used in \code{\link{PSDlit}}. See the examples for one method for changing species names to something that this function will recognize. +#' @details This computes a vector that contains the Gabelhouse lengths specific to each species for all individuals in an entire data frame. The vector can be appended to an existing data.frame to create a variable that contains the Gabelhouse lengths for each individual. The Gabelhouse length value will be \code{NA} for each individual for which Gabelhouse length definitions do not exist in \code{\link{PSDlit}}. Species names in the data.frame must be the same as those used in \code{\link{PSDlit}}. See the examples for one method for changing species names to something that this function will recognize. #' #' Individuals shorter than \dQuote{stock} length will be listed as \code{substock} if \code{use.names=TRUE} or \code{0} if \code{use.names=FALSE}. #' @@ -101,40 +101,54 @@ psdAdd.default <- function(len,species,units=c("mm","cm","in"),use.names=TRUE, use.names <- FALSE } ## Prepare the PSD literature values data frame - # get is used to eliminate problem with rcmd check - PSDlit <- get(utils::data("PSDlit", envir = environment()), envir = environment()) - - ## Create data.frame with length, species, rownumbers, and PSD values (blank) - data <- data.frame(len,species,rownums=seq_along(len),PSD=rep(NA,length(len))) - ## initiate a blank new data frame with same columns as old data frame - ndata <- data[-c(seq_len(nrow(data))),] - ## get list of species + # get() is used to eliminate problem with rcmd check + PSDlit <- get(utils::data("PSDlit",envir=environment()),envir=environment()) + ## Find species that have known Gabelhouse lengths + # get list of species in data specs <- levels(factor(species)) - - ## cycle through each species where PSD values are known - for (i in seq_along(specs)) { - ## isolate the current species - tmpdf <- data[data[,2]==specs[i],] - ## compute PSD - if (specs[i] %in% levels(PSDlit$species)) { - ## put in additional lengths if they are provided - if (specs[i] %in% addSpec) tmpAddLens <- addLens[which(addSpec==specs[i])] - else tmpAddLens <- NULL - # get the Gabelhouse length categories - glhse <- psdVal(specs[i],units=units,addLens=tmpAddLens) - # computes the Gabelhouse length categories and adds to the data frame - if (all(is.na(tmpdf[,1]))) { - if (verbose) message("All values in 'len' were missing for ",specs[i]) - tmpdf$PSD <- tmpdf[,1] - } else tmpdf$PSD <- lencat(tmpdf[,1],breaks=glhse,use.names=use.names,as.fact=FALSE) - } else if (verbose) message("No known Gabelhouse (PSD) lengths for ",specs[i]) + GLHSspecs <- specs[specs %in% levels(PSDlit$species)] + ## Create data.frames with species that are NA and w/o Gabelhouse lengths and + ## one with Gabelhouse lengths. The loop below will then start with a + ## the non-Gabelhouse species and sequentially add the Gabelhouse fish + # Create data.frame with length, species, rownumbers, and PSD values (blank) + # - rownumbers is needed to get back the original order + # - PSD will eventually have the Gabelhouse length categories + data <- data.frame(len,species,rownums=seq_along(len),PSD=rep(NA,length(len))) + # data.frame where species is NA and doesn't have Gabelhousee length + ndata <- data[is.na(data$species) | !data$species %in% GLHSspecs,] + if (verbose & nrow(ndata)>0) + message("No known Gabelhouse (PSD) lengths for: ",unique(ndata$species)) + # data.frame where species have Gabelhouse lengths ... make sure no NAs + data <- data[data$species %in% GLHSspecs,] + data <- data[!is.na(data$species),] + + ## Cycle through each species where PSD values are known, add PSD categories + ## and append to data.frame that contained species w/o Gabelhouse lengths + for (i in seq_along(GLHSspecs)) { + # isolate a data.frame with the current species + tmpdf <- data[data$species==GLHSspecs[i],] + # add Gabelhouse lengths ... put in additional lengths if they are provided + if (GLHSspecs[i] %in% addSpec) + tmpAddLens <- addLens[which(addSpec==GLHSspecs[i])] + else tmpAddLens <- NULL + # get the Gabelhouse length categories + glhse <- psdVal(GLHSspecs[i],units=units,addLens=tmpAddLens) + # computes the Gabelhouse length categories and adds to the data frame + if (all(is.na(tmpdf$len))) { + if (verbose) message("All values in 'len' were missing for ",GLHSspecs[i]) + tmpdf$PSD <- tmpdf$len + } else tmpdf$PSD <- lencat(tmpdf$len,breaks=glhse, + use.names=use.names,as.fact=FALSE) # bind current species to the new data frame being created ndata <- rbind(ndata,tmpdf) } ## reorder the data.frame to match original rows ndata <- ndata[order(ndata$rownums),] ## factor the PSD variable if using category names - if (use.names) ndata$PSD <- factor(ndata$PSD,levels=c("substock","stock","quality","preferred","memorable","trophy")) + if (use.names) + ndata$PSD <- factor(ndata$PSD, + levels=c("substock","stock","quality", + "preferred","memorable","trophy")) ## return just the vector of PSD values ndata$PSD } diff --git a/docs/news/index.html b/docs/news/index.html index 85b0c171..284377a0 100644 --- a/docs/news/index.html +++ b/docs/news/index.html @@ -139,6 +139,8 @@

  • fitPlot(): Modified. Fixed bugs with handling models that used character rather than factor variables.
  • +psdAdd(): Modified. Fixed bug relate to species that were NA (fixes #64; thanks to Dan Shoup). Added more tests and fixed some typos in the documentation.
    • +
  • psdPlot(): Modified. Fixed bug with box around the plot when add.psd=FALSE. Added 5% expansion to top of y-axis so that bars did not run into the box.
  • residPlot(): Modified. Fixed bugs with handling models that used character rather than factor variables.
    • diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index afdf088c..44b36c14 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -2,7 +2,7 @@ pandoc: 2.11.3.1 pkgdown: 1.6.1 pkgdown_sha: ~ articles: {} -last_built: 2021-01-11T18:42Z +last_built: 2021-01-15T12:26Z urls: reference: http://derekogle.com/FSA/reference article: http://derekogle.com/FSA/articles diff --git a/docs/reference/bootCase.html b/docs/reference/bootCase.html index b4bca09e..8f594e44 100644 --- a/docs/reference/bootCase.html +++ b/docs/reference/bootCase.html @@ -284,22 +284,22 @@

    Examp } nl1 <- nls(cells~fnx(days,B1,B2,B3),data=Ecoli, start=list(B1=6,B2=7.2,B3=-1.45)) -if (FALSE) { + # bootCase is provided only for backward compatability. Consider using # Boot from the car package instead. nl1.bootc <- bootCase(nl1,coef,B=99) # B=99 too few to be useful - confint(nl1.bootc,"B1") - confint(nl1.bootc,c(2,3)) - confint(nl1.bootc,conf.level=0.90) - confint(nl1.bootc,plot=TRUE) - predict(nl1.bootc,fnx,days=1:3) - predict(nl1.bootc,fnx,days=3) - htest(nl1.bootc,1,bo=6,alt="less") - hist(nl1.bootc) - plot(nl1.bootc) - cor(nl1.bootc) -} - +
    #> 'bootCase' is provided here only for backward compatibility. +#> Consider using 'Boot' from the 'car' package instead.
    #> Loading required namespace: boot
    #> Error in fnx(days, B1, B2, B3): could not find function "fnx"
    confint(nl1.bootc,"B1") +
    #> Error in confint(nl1.bootc, "B1"): object 'nl1.bootc' not found
    confint(nl1.bootc,c(2,3)) +
    #> Error in confint(nl1.bootc, c(2, 3)): object 'nl1.bootc' not found
    confint(nl1.bootc,conf.level=0.90) +
    #> Error in confint(nl1.bootc, conf.level = 0.9): object 'nl1.bootc' not found
    confint(nl1.bootc,plot=TRUE) +
    #> Error in confint(nl1.bootc, plot = TRUE): object 'nl1.bootc' not found
    predict(nl1.bootc,fnx,days=1:3) +
    #> Error in predict(nl1.bootc, fnx, days = 1:3): object 'nl1.bootc' not found
    predict(nl1.bootc,fnx,days=3) +
    #> Error in predict(nl1.bootc, fnx, days = 3): object 'nl1.bootc' not found
    htest(nl1.bootc,1,bo=6,alt="less") +
    #> Error in htest(nl1.bootc, 1, bo = 6, alt = "less"): object 'nl1.bootc' not found
    hist(nl1.bootc) +
    #> Error in hist(nl1.bootc): object 'nl1.bootc' not found
    plot(nl1.bootc) +
    #> Error in plot(nl1.bootc): object 'nl1.bootc' not found
    cor(nl1.bootc) +
    #> Error in is.data.frame(x): object 'nl1.bootc' not found