Skip to content

Commit

Permalink
Merge pull request #62 from fishR-Core-Team/dev
Browse files Browse the repository at this point in the history
Dev to Master for v0.2.7
  • Loading branch information
droglenc authored Dec 19, 2023
2 parents 26de836 + 2f89963 commit 41edf8d
Show file tree
Hide file tree
Showing 72 changed files with 2,184 additions and 541 deletions.
8 changes: 4 additions & 4 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,9 +1,9 @@
Package: RFishBC
Version: 0.2.6
Date: 2023-8-28
Version: 0.2.7
Date: 2023-12-18
Title: Back-Calculation of Fish Length
Authors@R: person("Derek","Ogle",
email="derek@derekogle.com",
Authors@R: person(c("Derek","H."),"Ogle",
email="DerekOgle51@gmail.com",
role=c("aut","cre"),
comment=c(ORCID="0000-0002-0370-9299"))
Description: Helps fisheries scientists collect measurements from calcified
Expand Down
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -13,4 +13,5 @@ export(findScalingFactor)
export(gConvert)
export(getID)
export(listFiles)
export(saveDigitizedImage)
export(showDigitizedImage)
14 changes: 13 additions & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
@@ -1,4 +1,16 @@
# RFishBC 0.2.5.9000
# RFishBC 0.2.7
* Updated my (DHO) e-mail address in description and all `@author` tags in the documentation files.
* Removed use of `captioner` package in vignettes as it is no longer available on CRAN (address [#54](https://github.com/fishR-Core-Team/RFishBC/issues/54)).
* Removed `itemize()` in `@return` section of `digitizeRadii()` documentation (addresses note in R-devel CRAN check).
* Replaced `itemize()` with `describe()` in `@details` section of `RFBCoptions()` documentation (addresses note in R-devel CRAN check).
* `backCalc()`: replaced use of `gather()` and `spread()` with `pivot_longer()` and `pivot_wider()` as `gather()` and `spread()` are no longer actively developed.
* `backCalc()`: added ability to retain fish for which no radial measurements were made (addresses [#49](https://github.com/fishR-Core-Team/RFishBC/issues/49)).
* `backCalc()`: added a warning if the r-squared value for the length-structure relationship used in the back-calculation technique is below 0.80 (only for those functions that use a linear model). This attempts to address [#47](https://github.com/fishR-Core-Team/RFishBC/issues/47).
* `backCalc()`: Added simple examples to documentation.
* `saveDigitizedImage()`: Added (address [#44](https://github.com/fishR-Core-Team/RFishBC/issues/44)).
* `showDigitizedImage()`: Added `Encoding()` to unicode "arrows" for plotting to address an issue in the upcoming R v4.4.0 (will address [#59](https://github.com/fishR-Core-Team/RFishBC/issues/59)).

# RFishBC 0.2.6
* Updated `test-coverage.yaml` to [latest version](https://github.com/r-lib/actions/blob/v2/examples/test-coverage.yaml).
* Updated `pkgdown.yaml` to [latest version](https://github.com/r-lib/actions/blob/v2/examples/pkgdown.yaml).
* `listFiles()`: Corrected URL errors in documentation.
Expand Down
4 changes: 2 additions & 2 deletions R/RFBCoptions.R
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@
#' @return None, but the list in \code{RFBCoptions} will be modified.
#'
#' @details The arguments that can be set with this function are:
#' \itemize{
#' \describe{
#' \item{\code{reading}: }{A single character string (or an object that can be coerced to a character) that identifies the reading for a structure. If the structure will be read multiple times, then this may be used to specify the particular reading. Defaults to \code{NULL}. Used in \code{\link{digitizeRadii}}.}
#' \item{\code{description}: }{A single character string that contains a short (but more detailed than in \code{reading}) description for a reading of a structure. Defaults to \code{NULL}. Used in \code{\link{digitizeRadii}}.}
#' \item{\code{suffix}: }{A single character string that will be added to the RData file name. If \code{NULL} and \code{reading} is not \code{NULL}, then this will be replaced with the value in \code{reading}. Defaults to \code{NULL}. Used in \code{\link{digitizeRadii}}.}
Expand Down Expand Up @@ -60,7 +60,7 @@
#'
#' @seealso \code{\link{digitizeRadii}} and \code{\link{showDigitizedImage}}
#'
#' @author Derek H. Ogle, \email{derek@@derekogle.com}
#' @author Derek H. Ogle, \email{DerekOgle51@gmail.com}
#'
#' @export
#'
Expand Down
2 changes: 1 addition & 1 deletion R/aStandard.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
#' @param species A string that contains the species name for which to find teh standard intercept value.
#' @return A single value from \code{\link{StdIntLit}} that is the standard intercept value (a; mm) for the species provided in \code{species}.
#'
#' @author Derek H. Ogle, \email{derek@@derekogle.com}
#' @author Derek H. Ogle, \email{DerekOgle51@gmail.com}
#'
#' @seealso \code{\link{StdIntLit}}
#'
Expand Down
4 changes: 2 additions & 2 deletions R/addFindNotes.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@
#'
#' @details A detailed description of its use is in the "Other Features" vignette on the \href{https://fishr-core-team.github.io/RFishBC/index.html}{RFishBC website}.
#'
#' @author Derek H. Ogle, \email{derek@@derekogle.com}
#' @author Derek H. Ogle, \email{DerekOgle51@gmail.com}
#'
#' @export
#'
Expand Down Expand Up @@ -42,7 +42,7 @@ addNote <- function(nms,note) {
#'
#' @details A detailed description of its use is in the "Other Features" vignette on the \href{https://fishr-core-team.github.io/RFishBC/index.html}{RFishBC website}.
#'
#' @author Derek H. Ogle, \email{derek@@derekogle.com}
#' @author Derek H. Ogle, \email{DerekOgle51@gmail.com}
#'
#' @export
#'
Expand Down
103 changes: 91 additions & 12 deletions R/backCalc.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
#' @param BCM A single numeric between 1 and 22 or a string that indicates which model to use (based on numbers and names in Vigliola and Meekan (2009)). See Details in \code{\link{bcFuns}} for the list of available models.
#' @param a The fish length when the structure first forms as used in the Fraser-Lee model (i.e., \code{BCM=1} or \code{BCM="FRALE"}). If this is missing then \code{a} will be estimated as the intercept from the fish length on structure radius linear regression.
#' @param L0p The length at the \dQuote{Biological Intercept} point. Only used in the \dQuote{Biological Intercept} (\code{BCM=3}), \dQuote{Watanabe and Kuroki} (\code{BCM=12}), and \dQuote{Modified Fry} (\code{BCM=14}) models.
#' @param R0p The stucture radius at the \dQuote{Biological Intercept} point. Only used in the \dQuote{Biological Intercept} (\code{BCM=3}), \dQuote{Watanabe and Kuroki} (\code{BCM=12}), and \dQuote{Modified Fry} (\code{BCM=14}) models.
#' @param R0p The structure radius at the \dQuote{Biological Intercept} point. Only used in the \dQuote{Biological Intercept} (\code{BCM=3}), \dQuote{Watanabe and Kuroki} (\code{BCM=12}), and \dQuote{Modified Fry} (\code{BCM=14}) models.
#' @param L0 The length at the arbitrarily selected point in the \dQuote{Fry} (\code{BCM=13}) model.
#' @param R0 The structure radius at the arbitrarily selected point in the \dQuote{Fry} (\code{BCM=13}) model.
#' @param inFormat The format of the data in \code{dat}. The two choices are \code{"long"} with one radial measurement per line (and all radial measurements for a fish in separate rows) and \code{"wide"} with one fish per line (and all radial measurements in separate variables). Defaults to \code{"long"}.
Expand All @@ -17,8 +17,61 @@
#'
#' @return A data.frame similar to \code{dat} but with the radial measurements replaced by back-calculated lengths at previous ages.
#'
#' @author Derek H. Ogle, \email{DerekOgle51@gmail.com}
#'
#' @keywords manip
#'
#' @examples
#' ## None yet.
#' ## Get some data
#' data(SMBassWB1,package="RFishBC") ## fish data
#' data(SMBassWB2,package="RFishBC") ## rad data
#'
#' # Simplify to 3 fish so we can see what is going on
#' tmp1 <- subset(SMBassWB1,id %in% c(377,378,379))
#' tmp2 <- subset(SMBassWB2,id %in% c(377,378,379))
#'
#' # Combine data frames to form a wide data frame (i.e., a left join)
#' wdat1 <- merge(tmp1,tmp2,by="id",all.x=TRUE)
#' wdat1
#'
#' # Make a long data frame for examples (remove annuli with NA rads)
#' ldat1 <- tidyr::pivot_longer(wdat1,rad1:rad9,names_to="ann",names_prefix="rad",
#' values_to="rad")
#' ldat1 <- subset(ldat1,!is.na(rad))
#' ldat1 <- as.data.frame(ldat1)
#' ldat1
#'
#' ## Back-calculate using Dahl-Lea method
#' # wide in and wide out
#' wwres1 <- backCalc(wdat1,lencap,BCM="DALE",inFormat="wide",digits=0)
#' wwres1
#'
#' # wide in and long out
#' wlres1 <- backCalc(wdat1,lencap,BCM="DALE",inFormat="wide",
#' outFormat="long",digits=0)
#' wlres1
#'
#' # long in and wide out
#' lwres1 <- backCalc(ldat1,lencap,BCM="DALE",inFormat="long",digits=0)
#' lwres1
#'
#' # wide in and long out
#' llres1 <- backCalc(ldat1,lencap,BCM="DALE",inFormat="long",
#' outFormat="long",digits=0)
#' llres1
#'
#' ## Situation with no radial measurements for some fish
#' # Create an extra fish with length (tmp1) but no rad
#' tmp1a <- rbind(tmp1,
#' data.frame(id=999,
#' species="SMB",lake="WB",gear="E",
#' yearcap=1990,lencap=225))
#' wdat2 <- merge(tmp1a,tmp2,by="id",all.x=TRUE)
#' wdat2
#'
#' # wide in and wide out
#' wwres2 <- backCalc(wdat2,lencap,BCM="DALE",inFormat="wide",digits=0)
#' wwres2
#'
#' @export
backCalc <- function(dat,lencap,BCM,inFormat,outFormat=inFormat,
Expand Down Expand Up @@ -48,20 +101,25 @@ backCalc <- function(dat,lencap,BCM,inFormat,outFormat=inFormat,
## Convert wide to long
nms <- names(dat)
rads <- nms[grepl("rad",nms) & !grepl("radcap",nms)]
dat <- tidyr::gather(dat,key=ann,value=rad,rads[1]:rads[length(rads)])
dat <- tidyr::pivot_longer(dat,rads[1]:rads[length(rads)],
names_to="ann",values_to="rad")
## Change annuli labels into annuli numbers
dat$ann <- as.numeric(stringr::str_replace_all(dat$ann,"rad",""))
## Remove annuli where the radius was missing
dat <- dat[!is.na(dat$rad),]
## Delete plus-growth if asked to do so
if (deletePlusGrowth) dat <- dat[dat$ann<=dat$agecap,]
## Sort by id and then ann number
dat <- dat[order(dat$id,dat$ann),]
}
## Extract fish for which a radius was not measured (save to add back at end)
## assumes no rads measured if first was not measured
norad_dat <- dat[dat$ann==1 & is.na(dat$rad),]

## Remove annuli where the radius was missing
dat <- dat[!is.na(dat$rad),]
## Delete plus-growth if asked to do so
if (deletePlusGrowth) dat <- dat[dat$ann<=dat$agecap,]
## Sort by id and then ann number
dat <- dat[order(dat$id,dat$ann),]

## Perform relevant regressions if needed
### initiate all possible regression variables (except for a)
b <- c <- A <- B <- C <- NULL
b <- c <- A <- B <- C <- rsq <- NULL
### Get data (one lencap and one radcap per id) for regressions
regdat <- dat[dat$ann==1,]
regLcap <- regdat[,rlang::quo_name(rlang::enquo(lencap)),drop=TRUE]
Expand All @@ -72,23 +130,28 @@ backCalc <- function(dat,lencap,BCM,inFormat,outFormat=inFormat,
regLR <- stats::lm(regLcap~regRcap)
if (is.null(a) | BCM!=2) a <- stats::coef(regLR)[[1]]
b <- stats::coef(regLR)[[2]]
rsq <- FSA::rSquared(regLR)
} else if (BCM==6) { # SLR of R on L (extract A, B)
regRL <- stats::lm(regRcap~regLcap)
A <- stats::coef(regRL)[[1]]
B <- stats::coef(regRL)[[2]]
rsq <- FSA::rSquared(regRL)
} else if (BCM==7) { # MLR of R on L and A (extract A, B, C)
regRLA <- stats::lm(regRcap~regLcap+regAcap)
A <- stats::coef(regRLA)[[1]]
B <- stats::coef(regRLA)[[2]]
C <- stats::coef(regRLA)[[3]]
rsq <- FSA::rSquared(regRLA)
} else if (BCM==8) { # MLR of L on R and A (extract a, b, c)
regLRA <- stats::lm(regLcap~regRcap+regAcap)
a <- stats::coef(regLRA)[[1]]
b <- stats::coef(regLRA)[[2]]
c <- stats::coef(regLRA)[[3]]
rsq <- FSA::rSquared(regLRA)
} else if (BCM==9) { # SLR of log(L) on log(R) (extract c)
regLR2 <- stats::lm(log(regLcap)~log(regRcap))
c <- stats::coef(regLR2)[[2]]
rsq <- FSA::rSquared(regLR2)
} else if (BCM==10) { # NLS of L on R (extract c)
tmp <- stats::lm(log(regLcap)~log(regRcap))
sv <- stats::coef(tmp)
Expand Down Expand Up @@ -122,11 +185,13 @@ backCalc <- function(dat,lencap,BCM,inFormat,outFormat=inFormat,
a <- stats::coef(qregLR)[[1]]
b <- stats::coef(qregLR)[[2]]
c <- stats::coef(qregLR)[[3]]
rsq <- FSA::rSquared(qregLR)
} else if (BCM==18) { # QR of R on L (extract A,B,C)
qregRL <- stats::lm(regRcap~regLcap+I(regLcap^2))
A <- stats::coef(qregRL)[[1]]
B <- stats::coef(qregRL)[[2]]
C <- stats::coef(qregRL)[[3]]
rsq <- FSA::rSquared(qregRL)
} else if (BCM==21) { # NLS L on R (extract a, bb)
tmp <- stats::lm(log(regLcap)~regRcap)
sv <- stats::coef(tmp)
Expand All @@ -144,6 +209,15 @@ backCalc <- function(dat,lencap,BCM,inFormat,outFormat=inFormat,
B <- stats::coef(nlsRL)[[2]]
}

# Warn about possible poor back-calculation values
if (!is.null(rsq)) {
if (rsq<0.80)
WARN("R-squared for the length-structure relationship is low (",
formatC(rsq,format="f",digits=3),"). The\n",
"computed model coefficients and resulting back-calculated lengths\n",
"may be suspect! Examine the length-structure plot for your data.\n")
}

## Perform the back-calculation
### Get the back-calculation model function
BCFUN <- bcFuns(BCM)
Expand All @@ -158,12 +232,17 @@ backCalc <- function(dat,lencap,BCM,inFormat,outFormat=inFormat,
dat$bclen <- round(dat$bclen,digits=digits)

## Prepare data to return
### Add back fish with no radial measurements if they exist
if (nrow(norad_dat)>0) {
norad_dat$bclen <- NA
dat <- rbind(dat,norad_dat)
}
### Remove radii information
dat <- dat[,!grepl("rad",names(dat))]
### Convert to wide format (if asked to do so)
if (outFormat=="wide") {
dat <- tidyr::spread(dat,key=ann,value=bclen,sep="len")
names(dat) <- gsub("ann","",names(dat))
dat <- tidyr::pivot_wider(dat,names_from="ann",names_prefix="len",
values_from="bclen")
}
## Return the data
dat
Expand Down
2 changes: 1 addition & 1 deletion R/bcFuns.R
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,7 @@
#' }
#' @return A function that can be used to predict length at previous age (Li) given length-at-capture (Lcap), hard-part radius-at-age i (Ri), and hard-part radius-at-capture (Rcap). In addition, some functions/models may require the previous age (agei) and the age-at-capture (agec), certain parameters related to the biological intercept (R0p & L0p), or certain parameters estimated from various regression models (a,b,c,A,B,C). See source for more information.
#'
#' @author Derek H. Ogle, \email{derek@@derekogle.com}
#' @author Derek H. Ogle, \email{DerekOgle51@gmail.com}
#'
#' @section IFAR Supplement: \url{https://derekogle.com/IFAR/supplements/backcalculation.html}
#'
Expand Down
2 changes: 1 addition & 1 deletion R/combineData.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@
#'
#' @details A detailed description of its use is in \href{https://fishr-core-team.github.io/RFishBC/articles/collectRadiiData.html}{this vignette} on the \href{https://fishr-core-team.github.io/RFishBC/index.html}{RFishBC website}. The list of R data file names may be efficiently created with \code{\link{listFiles}} as described in that vignette. The R data file names may also be selected from a dialog box if using Windows.
#'
#' @author Derek H. Ogle, \email{derek@@derekogle.com}
#' @author Derek H. Ogle, \email{DerekOgle51@gmail.com}
#'
#' @export
#'
Expand Down
Loading

0 comments on commit 41edf8d

Please sign in to comment.