Merge Dev to Main for v0.9.6

.Rbuildignore

@@ -22,5 +22,7 @@ cran-comments.md
 ## Logo
 inst/sticker/
 man/figures/logo.png
+man/figures/logo.svg
+
 ^\.github$
 ^codecov\.yml$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: FSA
-Version: 0.9.5
-Date: 2023-8-25
+Version: 0.9.6
+Date: 2025-1-6
 Title: Simple Fisheries Stock Assessment Methods
 Description: A variety of simple fish stock assessment methods.
 Authors@R: c(
@@ -46,8 +46,10 @@ Suggests:
     psych,
     Rcapture,
     rmarkdown,
-    testthat,
+    testthat (>= 3.0.0),
     tibble,
+    tidyr,
     covr
 Encoding: UTF-8
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
+Config/testthat/edition: 3

FSA.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: 41ed5498-c0fd-4cc3-8f0f-c170ffdd4aa6
 
 RestoreWorkspace: Default
 SaveWorkspace: Default

NAMESPACE

@@ -11,6 +11,7 @@ S3method(chapmanRobson,formula)
 S3method(coef,catchCurve)
 S3method(coef,chapmanRobson)
 S3method(coef,depletion)
+S3method(coef,removal)
 S3method(confint,boot)
 S3method(confint,catchCurve)
 S3method(confint,chapmanRobson)
@@ -20,6 +21,8 @@ S3method(confint,mrClosed2)
 S3method(confint,mrOpen)
 S3method(confint,nlsBoot)
 S3method(confint,removal)
+S3method(depletion,default)
+S3method(depletion,formula)
 S3method(dunnTest,default)
 S3method(dunnTest,formula)
 S3method(hist,boot)
@@ -43,13 +46,14 @@ S3method(predict,boot)
 S3method(predict,nlsBoot)
 S3method(print,dunnTest)
 S3method(print,extraTest)
-S3method(print,metaM)
 S3method(psdAdd,default)
 S3method(psdAdd,formula)
 S3method(rSquared,catchCurve)
 S3method(rSquared,default)
 S3method(rSquared,depletion)
 S3method(rSquared,lm)
+S3method(removal,default)
+S3method(removal,formula)
 S3method(sumTable,formula)
 S3method(summary,ageBias)
 S3method(summary,agePrec)

NEWS.md

@@ -1,3 +1,38 @@
+# FSA 0.9.6
+* Updated testing to use `testthat` v3.0.0.
+  * Changes to `DESCRIPTION` including adding `tidyr` in Suggests (for example in `removal()`).
+  * Replaced MANY `expect_is()` with `expect_equal(class())` idioms.
+  * Replaced many `expect_equivalent()` with `expect_equal()` as `expect_equivalent()` was not needed to begin with.
+  * Replaced many `expect_equivalent()` with `expect_equal(,ignore_attr=TRUE)` as `expect_equivalent()` was deprecated.
+  * Had to correct many tests where I expected just `matrix` but the class was `c("matrix","array")`.
+  * Had to handle multiple warnings for some tests (see [this article](https://testthat.r-lib.org/articles/third-edition.html#warnings)).
+  * Moved all `require()` in individual files to `testthat.R`. This removed many `require()` that were not needed.
+* Fixed four minor errors in documentation from legacy uses of `\R{}` rather than `\code{}`.
+* Made some accessibility changes and rebuilt favicons as suggested by `pkgdown`.
+
+* `alkPlot()`: Modified. Added note in documentation pointing to a fishR blog post on using `ggplot2` to make similar plots.
+* `catchCurve()`: Modified. Added `as.df=` to extractor functions and `incl.est=` to `confint.catchCurve()` to match functionality added to `depletion()`.
+* `chapmanRobson()`: Modified. Added `as.df=` to extractor functions and `incl.est=` to `confint.chapmanRobson()` to match functionality added to `depletion()`.
+* `depletion()`: Modified to address [#111](https://github.com/fishR-Core-Team/FSA/issues/111).
+  * Added formula notation such that `depletion()` wash changed to a method call and `depletion.default()` and `depletion.formula()` were added. Tests for the formula were included.
+  * Added `as.df=` to `coef.depletion()`, `confint.depletion()`, and `summary.depletion()` so that the result is returned as a data.frame when set to `TRUE` (default is `FALSE` to maintain backward compatability).
+  * Added `incl.est=` to `confint.depletion()` to make it easier to get away from the clunky `cbind("Est"=coef(),confint())` code.
+* `GompertzFuns()`: Modified. Accepted pull request related to [#112](https://github.com/fishR-Core-Team/FSA/issues/112) that fixed several typos and dead links in the documentation ... thanks Arni. Corrected the erroneous reference to t* (should have been t0) in the documentation for the Gompertz function (fixes [#113](https://github.com/fishR-Core-Team/FSA/issues/113) ... thanks again to Arni).
+* `metaM()`: Modified to address [#114](https://github.com/fishR-Core-Team/FSA/issues/114).
+  * Returns data.frame rather than list.
+  * Added conditional mortality rate (cm) to returned data.frame (for use with `rFAMS`).
+  * Removed `justM=` and its functionality (not needed with data.frame returned).
+  * Added `verbose=` to allow user to limit some of what is returned in data.frame.
+  * Removed `print.metaM()` method.
+  * Added Quinn and Deriso (1999), Peterson and Wroblewski (1984), and Chan and Watanabe (1989) methods from FAMS manual. These are probably only useful for comparison to FAMS results.
+  * Added an example for computing an average M or cm from multiple model results.
+* `Mmethods()`: Modified. Changed `what=` to `method=` for simplicity with `metaM()`.
+* `removal()`: Modified.
+  * Added a formula version to better match `depletion()`.
+  * Deprecated `just.ests=`. Functionality will be largely replaced with `incl.ests=` in `confint()`. Replaced split-apply example with a new one that performs similarly without `just.ests=` and is more in-line with examples in `depletion` *et al.*
+  * Added `coef()` extractor function.
+  * Modified `confint()` and `summary()` extractor functions to better match `depletion()`.
+
 # FSA 0.9.5
 * Fixed FSA-package \alias problem using the "automatic approach" (i.e., adding a "_PACKAGE" line to FSA.R) suggested in an e-mail from Kurt Hornik on 19-Aug-2023.
 

R/FSAUtils.R

@@ -765,6 +765,9 @@ repeatedRows2Keep <- function(df,cols2use=NULL,cols2ignore=NULL,
 #'
 #' @description Computes the standard error of the mean (i.e., standard deviation divided by the square root of the sample size).
 #'
+#' @details
+#' The standard error of the value in vector \code{x} is simply the standard deviation of \code{x} divided by the square root of the number of valid items in \code{x}
+#' 
 #' @param x A numeric vector.
 #' @param na.rm A logical that indicates whether missing values should be removed before computing the standard error.
 #' 
@@ -777,18 +780,19 @@ repeatedRows2Keep <- function(df,cols2use=NULL,cols2ignore=NULL,
 #' @keywords manip
 #'
 #' @examples
+#' # example vector
 #' x <- 1:20
-#' sd(x)/sqrt(length(x))
 #' se(x)
+#' sd(x)/sqrt(length(x))   ## matches
 #' 
 #' # all return NA if missing values are not removed
 #' x2 <- c(x,NA)
 #' sd(x2)/sqrt(length(x2))
 #' 
 #' # Better if missing values are removed
-#' se(x2,na.rm=FALSE)
-#' sd(x2,na.rm=TRUE)/sqrt(length(x2[complete.cases(x2)]))
-#' se(x2)
+#' se(x2)              ## Default behavior
+#' sd(x2,na.rm=TRUE)/sqrt(length(x2[complete.cases(x2)]))  ## Matches
+#' se(x2,na.rm=FALSE)  ## Result from not removing NAs
 #' 
 #' @export
 se <- function (x,na.rm=TRUE) {

R/alkPlot.R

@@ -10,8 +10,11 @@
 #'   \item A plot with (differently colored) lines, as estimated by loess splines, that connect the proportions of ages within each length interval is constructed with \code{type="splines"}.
 #'   \item A \dQuote{bubble} plot where circles whose size is proportional to the proportion of fish of each age in each length interval is constructed with \code{type="bubble"}. The color of the bubbles can be controlled with \code{col=} and an underlying grid for ease of seeing the age and length interval for each bubble can be controlled with \code{grid=}. Bubbles from a second age-length key can be overlaid on an already constructed bubble plot by using \code{add=TRUE} in a second call to \code{alkPlot}.
 #' }
+#' 
 #' Note that all plots are \dQuote{vertically conditional} -- i.e., each represents the proportional ages WITHIN each length interval.
 #' 
+#' @note These plots are used primarily to explore the structure of an age-length key. While some may find them of "publication-quality", that level of quality and overall control of aspects of the plot are not the primary purpose of this function. Publication-quality plots can be readily made using \code{ggplot2} as demonstrated \href{https://fishr-core-team.github.io/fishR/blog/posts/2025-1-5_ALKPlots_GGplot/}{in this fishR post}.
+#' 
 #' @param key A numeric matrix that contains the age-length key.
 #' @param type A string that indicates the type of plot to construct. See details.
 #' @param xlab,ylab A string that contains the label for the x- or y-axis.

R/bootstrap.R

@@ -15,7 +15,7 @@
 #' @param parm A number or string that indicates which column of \code{object} contains the parameter estimates to use for the confidence interval or hypothesis test.
 #' @param conf.level A level of confidence as a proportion.
 #' @param level Same as \code{conf.level}.
-#' @param plot A logical that indicates whether a plot should be constructed. If \code{confint} then a histogram of the \code{parm} parameters from the bootstrap samples with error bars that illustrate the bootstrapped confidence intervals will be constructed. If code{htest} then a histogram of the \code{parm} parameters with a vertical line illustrating the \code{bo} value will be constructed.
+#' @param plot A logical that indicates whether a plot should be constructed. If \code{confint} then a histogram of the \code{parm} parameters from the bootstrap samples with error bars that illustrate the bootstrapped confidence intervals will be constructed. If \code{htest} then a histogram of the \code{parm} parameters with a vertical line illustrating the \code{bo} value will be constructed.
 #' @param err.col A single numeric or character that identifies the color for the error bars on the plot.
 #' @param err.lwd A single numeric that identifies the line width for the error bars on the plot.
 #' @param rows A single numeric that contains the number of rows to use on the graphic.
@@ -165,7 +165,7 @@ hist.boot <- function(x,same.ylim=TRUE,ymax=NULL,
 #' @param parm An integer that indicates which parameter to compute the confidence interval or hypothesis test for. The confidence interval Will be computed for all parameters if \code{NULL}.
 #' @param conf.level A level of confidence as a proportion. 
 #' @param level Same as \code{conf.level}. Used for compatibility with the main \code{confint}.
-#' @param plot A logical that indicates whether a plot should be constructed. If \code{confint}, then a histogram of the \code{parm} parameters from the bootstrap samples with error bars that illustrate the bootstrapped confidence intervals will be constructed. If code{htest}, then a histogram of the \code{parm} parameters with a vertical lines illustrating the \code{bo}value will be constructed.
+#' @param plot A logical that indicates whether a plot should be constructed. If \code{confint}, then a histogram of the \code{parm} parameters from the bootstrap samples with error bars that illustrate the bootstrapped confidence intervals will be constructed. If \code{htest}, then a histogram of the \code{parm} parameters with a vertical lines illustrating the \code{bo}value will be constructed.
 #' @param err.col A single numeric or character that identifies the color for the error bars on the plot.
 #' @param err.lwd A single numeric that identifies the line width for the error bars on the plot.
 #' @param rows A numeric that contains the number of rows to use on the graphic.

R/catchCurve.R

@@ -13,6 +13,8 @@
 #' @param ages2use A numerical vector of ages that define the descending limb of the catch curve.
 #' @param weighted A logical that indicates whether a weighted regression should be used. See details.
 #' @param negWeightReplace A single non-negative numeric that will replace negative weights (defaults to 0). Only used when \code{weighted=TRUE}. See details.
+#' @param as.df A logical that indicates whether the results of \code{coef}, \code{confint}, or \code{summary} should be returned as a data.frame. Ignored in \code{summary} if \code{parm="lm"}.
+#' @param incl.est A logical that indicated whether the parameter point estimate should be included in the results from \code{confint}. Defaults to \code{FALSE}.
 #' @param pos.est A string to identify where to place the estimated mortality rates on the plot. Can be set to one of \code{"bottomright"}, \code{"bottom"}, \code{"bottomleft"}, \code{"left"}, \code{"topleft"}, \code{"top"}, \code{"topright"}, \code{"right"} or \code{"center"} for positioning the estimated mortality rates on the plot. Typically \code{"bottomleft"} (DEFAULT) and \code{"topright"} will be \dQuote{out-of-the-way} placements. Set \code{pos.est} to \code{NULL} to remove the estimated mortality rates from the plot.
 #' @param cex.est A single numeric character expansion value for the estimated mortality rates on the plot.
 #' @param round.est A numeric that indicates the number of decimal place to which Z (first value) and A (second value) should be rounded. If only one value then it will be used for both Z and A.
@@ -66,11 +68,13 @@
 #' ## demonstration of formula notation
 #' cc1 <- catchCurve(catch~age,data=BrookTroutTH,ages2use=2:6)
 #' summary(cc1)
-#' cbind(Est=coef(cc1),confint(cc1))
+#' coef(cc1)
+#' confint(cc1)
+#' confint(cc1,incl.est=TRUE)
 #' rSquared(cc1)
 #' plot(cc1)
 #' summary(cc1,parm="Z")
-#' cbind(Est=coef(cc1,parm="Z"),confint(cc1,parm="Z"))
+#' confint(cc1,parm="Z",incl.est=TRUE)
 #' 
 #' ## demonstration of excluding ages2use
 #' cc2 <- catchCurve(catch~age,data=BrookTroutTH,ages2use=-c(0,1))
@@ -84,7 +88,7 @@
 #'
 #' ## demonstration of returning the linear model results
 #' summary(cc3,parm="lm")
-#' cbind(Est=coef(cc3,parm="lm"),confint(cc3,parm="lm"))
+#' confint(cc3,parm="lm",incl.est=TRUE)
 #' 
 #' ## demonstration of ability to work with missing age classes
 #' df <- data.frame(age=c(  2, 3, 4, 5, 7, 9,12),
@@ -94,13 +98,45 @@
 #' plot(cc4)
 #' 
 #' ## demonstration of ability to work with missing age classes
-#' ## evein if catches are recorded as NAs
+#' ## even if catches are recorded as NAs
 #' df <- data.frame(age=c(  2, 3, 4, 5, 6, 7, 8, 9,10,11,12),
 #'                  ct= c(100,92,83,71,NA,56,NA,35,NA,NA, 1))
 #' cc5 <- catchCurve(ct~age,data=df,ages2use=4:12)
 #' summary(cc5)
 #' plot(cc5)
 #'
+#' ## Demonstration of computation for multiple groups
+#' ##   only ages on the descending limb for each group are in the data.frame
+#' # Get example data
+#' data(FHCatfish,package="FSAdata")
+#' FHCatfish
+#' 
+#' # Note use of incl.est=TRUE and as.df=TRUE
+#' if (require(dplyr)) {
+#'   res <- FHCatfish %>%
+#'     dplyr::group_by(river) %>%
+#'     dplyr::group_modify(~confint(catchCurve(abundance~age,data=.x),
+#'                                  incl.est=TRUE,as.df=TRUE)) %>%
+#'     as.data.frame() # removes tibble and grouping structure
+#'   res
+#' }
+#' 
+#' ## Demonstration of computation for multiple groups
+#' ##   ages not on descending limb are in the data.frame, but use same
+#' ##     ages.use= for each group
+#' # Get example data
+#' data(WalleyeKS,package="FSAdata")
+#' 
+#' # Note use of incl.est=TRUE and as.df=TRUE
+#' if (require(dplyr)) {
+#'   res <- WalleyeKS %>%
+#'     dplyr::group_by(reservoir) %>%
+#'     dplyr::group_modify(~confint(catchCurve(catch~age,data=.x,ages2use=2:10),
+#'                                  incl.est=TRUE,as.df=TRUE)) %>%
+#'     as.data.frame() # removes tibble and grouping structure
+#'   res
+#' }
+#' 
 #' @rdname catchCurve
 #' @export
 catchCurve <- function (x,...) {
@@ -189,32 +225,62 @@ catchCurve.formula <- function(x,data,ages2use=age,
 
 #' @rdname catchCurve
 #' @export
-summary.catchCurve <- function(object,parm=c("both","all","Z","A","lm"),...) {
+summary.catchCurve <- function(object,parm=c("both","all","Z","A","lm"),
+                               as.df=FALSE,...) {
   parm <- match.arg(parm)
-  tmp <- summary(object$lm,...)
+  res <- summary(object$lm,...)
   if (parm!="lm") {
+    # matrix of all possible results
     Z <- summary(object$lm)$coef[2,]
     Z[c(1,3)] <- -Z[c(1,3)]
     A <- c(100*(1-exp(-Z[1])),NA,NA,NA)
-    tmp <- rbind(Z,A)
-    if (!parm %in% c("both","all")) tmp <- tmp[parm,,drop=FALSE]
+    resm <- rbind(Z,A)
+    # data.frame of all possible results
+    resd <- data.frame(cbind(t(resm[1,c("Estimate","Std. Error")]),
+                             t(resm[2,c("Estimate","Std. Error")])))
+    names(resd) <- c("Z","Z_SE","A","A_SE")
+    # remove parameters not asked for
+    if (!parm %in% c("all","both")) {
+      resm <- resm[parm,,drop=FALSE]
+      resd <- resd[grepl(parm,names(resd))]
+    }
+    # prepare to return data.frame if asked for, otherwise matrix
+    if (as.df) res <- resd
+      else res <- resm
   }
-  tmp
+  res
 }
 
 #' @rdname catchCurve
 #' @export
-coef.catchCurve <- function(object,parm=c("all","both","Z","A","lm"),...) {
+coef.catchCurve <- function(object,parm=c("all","both","Z","A","lm"),
+                            as.df=FALSE,...) {
   parm <- match.arg(parm)
-  tmp <- stats::coef(object$lm,...)
-  if (parm!="lm") {
-    Z <- -tmp[2]
-    A <- 100*(1-exp(-Z))
-    tmp <- c(Z,A)
-    names(tmp) <- c("Z","A")
-    if (!parm %in% c("both","all")) tmp <- tmp[parm]
+  # matrix of lm results
+  res <- stats::coef(object$lm,...)
+  if (parm=="lm") {
+    if (as.df) {
+      resd <- data.frame(cbind(t(res[1]),t(res[2])))
+      names(resd) <- names(res)
+      res <- resd
+    }
+  } else {
+    # matrix of all possible results
+    Z <- -res[[2]]
+    resm <- c(Z=Z,A=100*(1-exp(-Z)))
+    # data.frame of all possible results
+    resd <- data.frame(cbind(t(resm[1]),t(resm[2])))
+    names(resd) <- names(resm)
+    # remove parameters not asked for
+    if (!parm %in% c("all","both")) {
+      resm <- resm[parm,drop=FALSE]
+      resd <- resd[grepl(parm,names(resd))]
+    }
+    # prepare to return data.frame if asked for, otherwise matrix
+    if (as.df) res <- resd
+      else res <- resm
   } 
-  tmp
+  res
 }
 
 #' @rdname catchCurve
@@ -226,17 +292,51 @@ anova.catchCurve <- function(object,...) {
 #' @rdname catchCurve
 #' @export
 confint.catchCurve <- function(object,parm=c("all","both","Z","A","lm"),
-                               level=conf.level,conf.level=0.95,...) {
+                               level=conf.level,conf.level=0.95,
+                               as.df=FALSE,incl.est=FALSE,...) {
   parm <- match.arg(parm)
   ## Check on conf.level
   iCheckConfLevel(conf.level) 
   ci <- stats::confint(object$lm,conf.level=level,...)
-  if (parm=="lm") res <- ci
-  else {
-    res <- rbind(Z=-ci[2,2:1],A=100*(1-exp(ci[2,2:1])))
-    if (!parm %in% c("all","both")) res <- res[parm,,drop=FALSE]
+  if (parm=="lm") {
+    # matrix of all possible results
+    resm <- ci
+    resm <- cbind(Est=stats::coef(object$lm),ci)
+    colnames(resm) <- c("Est",iCILabel(conf.level))
+    ## make data.frame of all possible results
+    resd <- data.frame(cbind(t(resm[1,]),t(resm[2,])))
+    names(resd) <- c("(Intercept)","(Intercept)_LCI","(Intercept)_UCI",
+                     "age.e","age.e_LCI","age.e_UCI")
+    ## remove estimates if not asked for
+    if (!incl.est) {
+      resm <- resm[,-which(colnames(resm)=="Est"),drop=FALSE]
+      resd <- resd[!names(resd) %in% c("(Intercept)","age.e")]
+    }
+    ## Return the appropriate matrix or data.frame
+    if (as.df) res <- resd
+      else res <- resm
+  } else {
+    # matrix of all possible results
+    resm <- cbind(coef.catchCurve(object),
+                  rbind(Z=-ci[2,2:1],A=100*(1-exp(ci[2,2:1]))))
+    colnames(resm) <- c("Est",iCILabel(conf.level))
+    # data.frame of all possible results
+    resd <- data.frame(cbind(t(resm[1,]),t(resm[2,])))
+    names(resd) <- c("Z","Z_LCI","Z_UCI","A","A_LCI","A_UCI")
+    ## remove estimates if not asked for
+    if (!incl.est) {
+      resm <- resm[,-which(colnames(resm)=="Est"),drop=FALSE]
+      resd <- resd[!names(resd) %in% c("Z","A")]
+    }
+    ## remove unasked for parameters
+    if (!parm %in% c("all","both")) {
+      resm <- resm[parm,,drop=FALSE]
+      resd <- resd[grepl(parm,names(resd))]
+    }
+    ## Return the appropriate matrix or data.frame
+    if (as.df) res <- resd
+      else res <- resm
   }
-  colnames(res) <- iCILabel(conf.level)
   res
 }