updated vignettes

.Rbuildignore

@@ -6,3 +6,5 @@
 ^docs$
 ^pkgdown$
 ^\.github$
+^doc$
+^Meta$

.gitignore

@@ -6,3 +6,5 @@
 .quarto
 docs
 inst/doc
+/doc/
+/Meta/

NAMESPACE

@@ -3,7 +3,7 @@
 export("%>%")
 export(broken_stick)
 export(broken_stick_stevens)
-export(fake_crabs)
+export(fake_crustaceans)
 export(infl_pt)
 export(regrans_fun)
 export(two_line_logistic)

R/broken_stick.R

@@ -34,7 +34,7 @@
 #'
 #' @examples
 #' set.seed(12)
-#' fc <- fake_crabs(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
+#' fc <- fake_crustaceans(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
 #' broken_stick(fc, xvar="x", yvar="y", method=c("segmented", "chngpt"))
 broken_stick <- function(dat,
                          xvar,

R/broken_stick_stevens.R

@@ -23,8 +23,8 @@
 #'
 #' @examples
 #' set.seed(12)
-#' fc <- fake_crabs(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
-#' broken_stick_stevens(fc, xvar="x", yvar="y", verbose = FALSE)
+#' fc <- fake_crustaceans(n = 100, L50 = 100, allo_params = c(1, 0.2, 1.1, 0.2))
+#' broken_stick_stevens(fc, xvar = "x", yvar = "y", verbose = FALSE)
 broken_stick_stevens <- function(dat,
                                  xvar,
                                  yvar,

R/fake_crabs.R → R/fake_crustaceans.R

@@ -29,10 +29,10 @@
 #'
 #' @examples
 #' set.seed(123)
-#' fake_crabs(n=25)
-fake_crabs <- function(L50 = 100, # length at 50% maturity on ref var scale
+#' fake_crustaceans(n=25)
+fake_crustaceans <- function(L50 = 100, # length at 50% maturity on ref var scale
                        slope = 5, # slope parameter for logistic maturity
-                       n = 1000, # number of crabs sampled
+                       n = 1000, # number of crustaceans sampled
                        # mean of reference variable, e.g., carapace width in mm
                        x_mean = 105,
                        # standard deviation of reference variable
@@ -46,37 +46,37 @@ fake_crabs <- function(L50 = 100, # length at 50% maturity on ref var scale
 
 
   # Create normal distribution of carapace widths for a given n, mean, and SD
-  fake_crabs <- data.frame(x = stats::rnorm(n = n, mean = x_mean, sd = x_sd))
+  fake_crustaceans <- data.frame(x = stats::rnorm(n = n, mean = x_mean, sd = x_sd))
 
   # Add probability of maturity for each individual crab
   # based on a logistic distribution with given location (L50) and
   # shape (slope of the logistic curve) parameters
-  fake_crabs$prob_mat <- stats::plogis(fake_crabs$x, L50, slope)
+  fake_crustaceans$prob_mat <- stats::plogis(fake_crustaceans$x, L50, slope)
 
   # Based on the probabilities of maturity,
   # use a binomial distribution to assign each crab a maturity status
   # (0 = immature, 1 = mature)
-  mature_vec <- stats::rbinom(n, 1, fake_crabs$prob_mat)
+  mature_vec <- stats::rbinom(n, 1, fake_crustaceans$prob_mat)
 
   # Add vector of maturities to data frame of x-vars and maturity probabilities
-  fake_crabs$mature <- as.factor(mature_vec)
+  fake_crustaceans$mature <- as.factor(mature_vec)
 
-  err_sd <- fake_crabs %>%
+  err_sd <- fake_crustaceans %>%
     dplyr::summarise(
       range = max(.data$x, na.rm = TRUE) - min(.data$x, na.rm = TRUE)
     ) %>%
     dplyr::mutate(err_sd = .data$range * 0.01 / error_scale) %>%
     dplyr::pull(err_sd)
 
   err <- stats::rnorm(n = n, sd = err_sd)
-  fake_crabs$errs <- exp(err)
+  fake_crustaceans$errs <- exp(err)
 
   a0 <- allo_params[1] # Immature slope parameter
   b0 <- allo_params[2] # Immature intercept parameter
   a1 <- allo_params[3] # Mature slope parameter
   b1 <- allo_params[4] # Immature intercept parameter
 
-  fake_crabs <- fake_crabs %>%
+  fake_crustaceans <- fake_crustaceans %>%
     #if crab is immature, use immature parameters
     dplyr::mutate(y = dplyr::case_when(
       .data$mature == 0 ~ b0 * (.data$x ^ (a0)) * .data$errs,
@@ -86,8 +86,8 @@ fake_crabs <- function(L50 = 100, # length at 50% maturity on ref var scale
       log_y = log(.data$y)  #find log of x
     )
 
-  fake_crabs <- fake_crabs %>% dplyr::select(-"errs")
+  fake_crustaceans <- fake_crustaceans %>% dplyr::select(-"errs")
 
-  return(fake_crabs)
+  return(fake_crustaceans)
 
 }

R/infl_pt.R

@@ -38,7 +38,7 @@
 #' hist(z)
 #' dat1 <- data.frame(xvar=rep(1, 200),yvar=z)
 #' infl_pt(dat1, "xvar", "yvar", TRUE)
-#' fc <- fake_crabs(n=100, allo_params=c(1, 0.2, 1.1, 0.2))
+#' fc <- fake_crustaceans(n=100, allo_params=c(1, 0.2, 1.1, 0.2))
 #' infl_pt(fc, "x", "y", TRUE)
 #'
 infl_pt <- function(dat, x, y, plot = FALSE) {

R/regrans.R

@@ -22,7 +22,7 @@
 #'
 #' @examples
 #' set.seed(12)
-#' fc <- fake_crabs(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
+#' fc <- fake_crustaceans(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
 #' regrans_fun(fc, "x", "y", verbose = FALSE)
 #' head(regrans_fun(fc, "x", "y", verbose = TRUE), n=30)
 regrans_fun <- function(dat,
@@ -44,7 +44,7 @@ regrans_fun <- function(dat,
     upper <- stats::quantile(x, 0.8)
   }
 
-  changept_choices <- seq(lower, upper, l = n_tries)
+  changept_choices <- seq(lower, upper, length.out = n_tries)
 
   help_fun <- function(i)
   {

R/two_line_logistic.R

@@ -5,12 +5,18 @@
 #'   variable (e.g., carapace width).
 #' @param yvar Name of column (integer or double) of measurements for the y-axis
 #'   variable (e.g., claw height).
-#' @param imm_int Starting value for the immature intercept parameter when fitting the NLS model
-#' @param imm_slope tarting value for the immature slope parameter when fitting the NLS model
-#' @param mat_int Starting value for the mature intercept parameter when fitting the NLS model
-#' @param mat_slope Starting value for the mature slope parameter when fitting the NLS model
-#' @param SM50_start Starting value for SM50 parameter when fitting the NLS model. If not provided, taken to be the median of the x-variable
-#' @param alpha_start Starting value for the logistic slope parameter when fitting the NLS model
+#' @param imm_int Starting value for the immature intercept parameter when
+#'   fitting the NLS model
+#' @param imm_slope tarting value for the immature slope parameter when fitting
+#'   the NLS model
+#' @param mat_int Starting value for the mature intercept parameter when fitting
+#'   the NLS model
+#' @param mat_slope Starting value for the mature slope parameter when fitting
+#'   the NLS model
+#' @param SM50_start Starting value for SM50 parameter when fitting the NLS
+#'   model. If not provided, taken to be the median of the x-variable
+#' @param alpha_start Starting value for the logistic slope parameter when
+#'   fitting the NLS model
 #' @param verbose Should additional output be returned besides the SM50
 #'   estimate?
 #'
@@ -20,7 +26,7 @@
 #'
 #' @examples
 #' set.seed(12)
-#' fc <- fake_crabs(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
+#' fc <- fake_crustaceans(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
 #' two_line_logistic(fc, xvar="x", yvar="y", verbose = FALSE)
 two_line_logistic <- function(dat,
                               xvar,

R/two_line_stevens.R

@@ -33,8 +33,8 @@
 #'
 #' @examples
 #' #' set.seed(12)
-#' fc <- fake_crabs(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
-#' two_line_stevens(fc, xvar="x", yvar="y", verbose = FALSE)
+#' fc <- fake_crustaceans(n = 100, L50 = 100, allo_params = c(1, 0.2, 1.1, 0.2))
+#' two_line_stevens(fc, xvar = "x", yvar = "y", verbose = FALSE)
 two_line_stevens <- function(dat,
                              xvar,
                              yvar,
@@ -90,8 +90,9 @@ two_line_stevens <- function(dat,
     mse <- rep(0, n0)
 
     for (i in 1:n0) {
-      piecewise1 <- stats::lm(yvar ~ xvar * (xvar < xvar[i]) + xvar * (xvar >= xvar[i]), data =
-                         stevens)
+      piecewise1 <- stats::lm(
+        yvar ~ xvar * (xvar < xvar[i]) + xvar * (xvar >= xvar[i]),
+        data = stevens)
       mse[i] <- mean(piecewise1$residuals ^ 2)
     }
 
@@ -123,8 +124,8 @@ two_line_stevens <- function(dat,
   }
 
   ## rerun piecewise regression at best bp
-  piecewise2 <- stats::lm(yvar ~ xvar * (xvar < bp) + xvar * (xvar > bp), data =
-                     stevens)
+  piecewise2 <- stats::lm(yvar ~ xvar * (xvar < bp) + xvar * (xvar > bp),
+                          data = stevens)
 
   pw_vals <- stats::coef(piecewise2)
   pw_vals[which(is.na(pw_vals))] <- 0
@@ -134,7 +135,6 @@ two_line_stevens <- function(dat,
   b_hi <- pw_vals[2]
 
   jx <- as.numeric((a_lo - a_hi) / (b_hi - b_lo)) #the point where 2 lines meet
-  jy <- a_lo + b_lo * jx
 
   ####  Reassign group membership
   memb_pw <- rep(1, n0)
@@ -143,8 +143,8 @@ two_line_stevens <- function(dat,
 
   output <- list(
     data = stevens,
-    bp = bp,
-    jx = jx,
+    breakpoint = bp,
+    intersection = jx,
     imm_slope = b_lo,
     imm_int = a_lo,
     mat_slope = b_hi,

tests/testthat/test-broken_stick.R

@@ -1,6 +1,6 @@
 test_that("Stevens wrapper works", {
   set.seed(123)
-  fc <- fake_crabs(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
+  fc <- fake_crustaceans(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
   expect_equal(
     round(broken_stick(fc, xvar="x", yvar="y", method="stevens"),4),
     121.4316

tests/testthat/test-broken_stick_stevens.R

@@ -1,6 +1,6 @@
 test_that("function returns expected value", {
   set.seed(123)
-  fc <- fake_crabs(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
+  fc <- fake_crustaceans(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
   expect_equal(
     round(broken_stick_stevens(fc, xvar="x", yvar="y", verbose = FALSE),4),
     121.4316

tests/testthat/test-regrans.R

@@ -1,6 +1,6 @@
 test_that("function returns expected value", {
   set.seed(123)
-  fc <- fake_crabs(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
+  fc <- fake_crustaceans(n=100, L50=100, allo_params=c(1, 0.2, 1.1, 0.2))
   expect_equal(
     round(regrans_fun(fc, xvar="x", yvar="y", verbose = FALSE),4),
     122.0217