From d04ac52e69533ba81b4fd4bc48f5f05843f9083e Mon Sep 17 00:00:00 2001
From: Thomas White <thomas.white026@gmail.com>
Date: Fri, 16 Jun 2023 12:59:09 +1000
Subject: [PATCH 01/12] First pass

---
 NAMESPACE     |   1 +
 R/stitch.R    | 143 ++++++++++++++++++++++++++++++++++++++++++++++++++
 man/stitch.Rd |  81 ++++++++++++++++++++++++++++
 3 files changed, 225 insertions(+)
 create mode 100644 R/stitch.R
 create mode 100644 man/stitch.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 2c336cea..8d169ef6 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -64,6 +64,7 @@ export(sensdata)
 export(sensmodel)
 export(simulate_spec)
 export(spec2rgb)
+export(stitch)
 export(tcspace)
 export(tcsplot)
 export(tcspoints)
diff --git a/R/stitch.R b/R/stitch.R
new file mode 100644
index 00000000..4d1a3382
--- /dev/null
+++ b/R/stitch.R
@@ -0,0 +1,143 @@
+#' Stitch together two rspec objects
+#'
+#' Stitch (row-wise merge) two `rspec` objects of differing wavelength ranges into
+#' a single `rspec` object.
+#'
+#' @param rspec1,rspec2 (required) `rspec` objects of differing wavelength ranges
+#' to stitch together.
+#' @param overlap_method the method for modifying reflectance values if regions
+#' of the spectra overlap in their wavelength range. Defaults to `average`.
+#' @param interp logical argument specifying whether reflectance values should be
+#' interpolated between the two sets of spectra if their wavelength ranges
+#' do not overlap. Defaults to `TRUE`.
+#'
+#' @export
+#' 
+#' @examples
+#'
+#' # Simulate a UV-VIS and NIR reflectance spectrum whose wavelength regions 
+#' # slightly overlap then stitch them together, with the overlapping
+#' # regions being averaged.
+#' 
+#' # Simulate specs
+#' reflect1 <- simulate_spec(wl_peak = 550, xlim = c(300, 700))
+#' reflect2 <- simulate_spec(wl_inflect = 1100, xlim = c(650, 1200))
+#' 
+#' # Ensure the names of the spectra match
+#' names(reflect1) <- names(reflect2) <- c('wl', 'sample_1')
+#' 
+#' # Stitch the spectra together by their wavelength column
+#' full_spec <- stitch(reflect1, reflect2)
+#' 
+#' # Plot the resulting spectrum
+#' plot(full_spec)
+#'
+#' # Simulate another set of UV-VIS and NIR spectra. Note two additional complexities,
+#' # both of which are handled without issue. First, the wavelength ranges are
+#' # non-overlapping (with a 100 nm gap). We'll keep the default interp = TRUE argument
+#' # to allow the missing reflectance region to be interpolated. Second, the names of
+#' # the spectra match, but are in a different order in the two rspec objects. This isn't
+#' # an issue, as the function can match up the spectra by name irrespective of their
+#' # ordering
+#' 
+#' # Simulate UV-VIS and NIR spectra
+#' reflect_vis <- merge(simulate_spec(wl_peak = 550, xlim = c(300, 700)),
+#'                      simulate_spec(wl_peak = 550, xlim = c(300, 700)))
+#' reflect_nir <- merge(simulate_spec(wl_inflect = 1000, xlim = c(800, 1250)),
+#'                      simulate_spec(wl_inflect = 1100, xlim = c(800, 1250)))
+#' 
+#' # Ensure the names of the spectra exist in each, albeit in a different order
+#' names(reflect_vis) <- c('wl', 'sample_1', 'sample_2')
+#' names(reflect_nir) <- c('wl', 'sample_2', 'sample_1')
+#' 
+#' # Stitch together by their wavelength column, with missing regions being
+#' # interpolated
+#' reflect_vis_nir <- stitch(reflect_vis, reflect_nir)
+#' 
+#' # Plot the resulting spectrum
+#' plot(reflect_vis_nir)
+#'
+#' @author Thomas White \email{thomas.white026@@gmail.com}
+#' @author Hugo Gruson \email{hugo.gruson+R@@normalesup.org}
+#'
+#' @seealso [as.rspec()], [merge.rspec()]
+
+stitch <- function(rspec1, rspec2,
+                   overlap_method = c('average', 'minimum', 'maximum'),
+                   interp = TRUE) {
+  
+  # Class check
+  if (!inherits(rspec1, 'rspec') || !inherits(rspec2, 'rspec')) {
+    stop("Both inputs must be of class 'rspec'")
+  }
+  
+  # Valied overlap_method
+  overlap_method <- match.arg(overlap_method)
+  
+  # Check that at least one spectrum has a matching name in both objects
+  common_cols <- intersect(names(rspec1), names(rspec2))
+  if (length(common_cols) <= 1) {
+    stop("At least one spectrum in both rspec objects must have a matching name")
+  }
+  
+  # Identify unique spectra in both objects
+  unique_rspec1 <- setdiff(names(rspec1), common_cols)
+  unique_rspec2 <- setdiff(names(rspec2), common_cols)
+  
+  # Create NA-filled columns in each rspec for unique spectra in the other
+  rspec1[, unique_rspec2] <- NA
+  rspec2[, unique_rspec1] <- NA
+  
+  # Reorder columns of rspec2 to match rspec1
+  rspec2 <- rspec2[, names(rspec1)]
+  
+  # Merge by wl
+  res <- rbind(rspec1, rspec2)
+  
+  # Handle overlapping wl values
+  if (any(duplicated(res$wl))) {
+    overlap_wl <- unique(res$wl[duplicated(res$wl)])
+    
+    for (wl in overlap_wl) {
+      idx <- which(res$wl == wl)
+      
+      # Replace with a switch statement
+      switch(overlap_method,
+             average = res[idx[1],-1] <- colMeans(as.matrix(res[idx,-1]), na.rm = TRUE),
+             minimum = res[idx[1],-1] <- apply(as.matrix(res[idx,-1]), 2, min, na.rm = TRUE),
+             maximum = res[idx[1],-1] <- apply(as.matrix(res[idx,-1]), 2, max, na.rm = TRUE)
+      )
+      
+      # Remove extra rows
+      if (length(idx) > 1) {
+        res <- res[-idx[-1], ]
+      }
+    }
+  }
+  
+  # Interpolate missing values
+  if (interp) {
+    full_wl_range <- min(res$wl):max(res$wl)
+    missing_wl <- setdiff(full_wl_range, res$wl)
+    
+    if(length(missing_wl) > 0) {
+      new_rows <- data.frame(wl = missing_wl, matrix(rep(NA, length(names(res)) - 1), ncol = length(names(res)) - 1))
+      names(new_rows)[-1] <- names(res)[-1]
+      
+      # Interpolate only common spectra
+      for (col in common_cols[-1]) {
+        new_values <- approx(res$wl, res[, col], xout = missing_wl)$y
+        new_rows[, col] <- new_values
+      }
+      res <- rbind(res, new_rows)
+    }
+  }
+  
+  # Sort stitched spec by wl
+  res <- res[order(res$wl), ]
+  
+  # Classes
+  class(res) <- c("rspec", "data.frame")
+  
+  res
+}
diff --git a/man/stitch.Rd b/man/stitch.Rd
new file mode 100644
index 00000000..5b49ea33
--- /dev/null
+++ b/man/stitch.Rd
@@ -0,0 +1,81 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/stitch.R
+\name{stitch}
+\alias{stitch}
+\title{Stitch together two rspec objects}
+\usage{
+stitch(
+  rspec1,
+  rspec2,
+  overlap_method = c("average", "minimum", "maximum"),
+  interp = TRUE
+)
+}
+\arguments{
+\item{rspec1, rspec2}{(required) \code{rspec} objects of differing wavelength ranges
+to stitch together.}
+
+\item{overlap_method}{the method for modifying reflectance values if regions
+of the spectra overlap in their wavelength range. Defaults to \code{average}.}
+
+\item{interp}{logical argument specifying whether reflectance values should be
+interpolated between the two sets of spectra if their wavelength ranges
+do not overlap. Defaults to \code{TRUE}.}
+}
+\description{
+Stitch (row-wise merge) two \code{rspec} objects of differing wavelength ranges into
+a single \code{rspec} object.
+}
+\examples{
+
+# Simulate a UV-VIS and NIR reflectance spectrum whose wavelength regions 
+# slightly overlap then stitch them together, with the overlapping
+# regions being averaged.
+
+# Simulate specs
+reflect1 <- simulate_spec(wl_peak = 550, xlim = c(300, 700))
+reflect2 <- simulate_spec(wl_inflect = 1100, xlim = c(650, 1200))
+
+# Ensure the names of the spectra match
+names(reflect1) <- names(reflect2) <- c('wl', 'sample_1')
+
+# Stitch the spectra together by their wavelength column
+full_spec <- stitch(reflect1, reflect2)
+
+# Plot the resulting spectrum
+plot(full_spec)
+
+# Simulate another set of UV-VIS and NIR spectra. Note two additional complexities,
+# both of which are handled without issue. First, the wavelength ranges are
+# non-overlapping (with a 100 nm gap). We'll keep the default interp = TRUE argument
+# to allow the missing reflectance region to be interpolated. Second, the names of
+# the spectra match, but are in a different order in the two rspec objects. This isn't
+# an issue, as the function can match up the spectra by name irrespective of their
+# ordering
+
+# Simulate UV-VIS and NIR spectra
+reflect_vis <- merge(simulate_spec(wl_peak = 550, xlim = c(300, 700)),
+                     simulate_spec(wl_peak = 550, xlim = c(300, 700)))
+reflect_nir <- merge(simulate_spec(wl_inflect = 1000, xlim = c(800, 1250)),
+                     simulate_spec(wl_inflect = 1100, xlim = c(800, 1250)))
+
+# Ensure the names of the spectra exist in each, albeit in a different order
+names(reflect_vis) <- c('wl', 'sample_1', 'sample_2')
+names(reflect_nir) <- c('wl', 'sample_2', 'sample_1')
+
+# Stitch together by their wavelength column, with missing regions being
+# interpolated
+reflect_vis_nir <- stitch(reflect_vis, reflect_nir)
+
+# Plot the resulting spectrum
+plot(reflect_vis_nir)
+
+}
+\seealso{
+\code{\link[=as.rspec]{as.rspec()}}, \code{\link[=merge.rspec]{merge.rspec()}}
+}
+\author{
+Thomas White \email{thomas.white026@gmail.com}
+
+Hugo Gruson \email{hugo.gruson+R@normalesup.org}
+}

From 2d237ec80bf9cd2baa16ccc4d2b6b08ce849e88c Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@10-0-0-4.tpgi.com.au>
Date: Wed, 30 Aug 2023 18:47:34 +1000
Subject: [PATCH 02/12] Merge master

---
 NEWS.md                       |   2 +
 R/summary.rspec.R             | 519 +++++++++++++++++++++++-----------
 man/summary.rspec.Rd          |  22 +-
 tests/testthat/test-S3rspec.R |  13 +-
 4 files changed, 384 insertions(+), 172 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 88f52000..f25464ab 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -4,9 +4,11 @@
 
 - Added a new function `simulate_spec()`, which allows for the flexible simulation of naturalistic spectra (inc. reflectance, irradiance, radiance, absorbance). See `?simulate_spec` for examples and information, and the handbook for further discussion.
 - `plot.rspec()` now accepts a logical `labels` argument (and `labels.cex`), to control whether text labels identifying each spectrum should be added to the outer plot margins. This was previously only available, and was required, for 'stacked' plot types, but is now optional for both 'overlay' (the default) and 'stacked' spectral plots.
+- the `wlmin` and `wlmax` arguments in `summary.rspec()` are being deprecated in favour of a single `lim` argument, for consistency across functions.
 
 ## MINOR FEATURES AND BUG FIXES
 
+- `summary.rspec()` has been rewritten for efficiency, and now only calculates the required variables when `subset` is used. As a result, the function is also slightly slower (0.5 x) when calculating the full set of variables, but much faster (10 x) when calculating a subset.
 - Removed the start-up message.
 - Removed the previously-deprecated `margins` argument from various colourspace plots.
 - Replace `rgl.triangles` with `triangles3d()` internally to avoid a deprecation issue.
diff --git a/R/summary.rspec.R b/R/summary.rspec.R
index f3f584a6..8abe287f 100644
--- a/R/summary.rspec.R
+++ b/R/summary.rspec.R
@@ -10,8 +10,9 @@
 #' of the complete output (composed of B2, S8 and H1; the variables described in
 #' Andersson and Prager 2006) are returned. Finally, a user-specified string of variable
 #' names can be used in order to filter and show only those variables.
-#' @param wlmin,wlmax minimum and maximum used to define the range of wavelengths used in
-#' calculations (default is to use entire range in the `rspec` object).
+#' @param lim The range of wavelengths used in calculations. The default is to use
+#' the entire range in the `rspec` object (typically equivalent to `lim = c(300, 700)`).
+#' @param wlmin,wlmax Deprecated. Use the `lim` argument instead.
 #' @param ... class consistency (ignored)
 #'
 #' @return A data frame containing either 23 or 5 (`subset = TRUE`) variables described
@@ -91,6 +92,7 @@
 #'
 #' H5 (Hue): Wavelength at bmax. Sensitive to noise and may be variable if there is
 #' more than one maxima and minima. REF 5
+#'
 #' @note If minimum wavelength is over 400, UV chroma is not computed.
 #' @note Variables which compute bmax and bmaxneg should be used with caution, for they
 #' rely on smoothed curves to remove noise, which would otherwise result in spurious
@@ -103,11 +105,21 @@
 #' @export
 #'
 #' @examples
+#' # Load data
 #' data(sicalis)
+#'
+#' # Calculate and display all spectral summary variables
 #' summary(sicalis)
+#'
+#' # Calculate only subset of B2, S8 and H1 as per Andersson (1999)
 #' summary(sicalis, subset = TRUE)
+#'
+#' # Calculate user-specified subset of B1 and H4
 #' summary(sicalis, subset = c("B1", "H4"))
-#' @author Pierre-Paul Bitton \email{bittonp@@windsor.ca}, Rafael Maia \email{rm72@@zips.uakron.edu}
+#'
+#' @author Thomas E. White \email{thomas.white026@@gmail.com}
+#' @author Pierre-Paul Bitton \email{bittonp@@windsor.ca}
+#' @author Rafael Maia \email{rm72@@zips.uakron.edu}
 #'
 #' @references Montgomerie R. 2006. Analyzing colors. In Hill, G.E, and McGraw, K.J., eds.
 #' Bird Coloration. Volume 1 Mechanisms and measurements. Harvard University Press, Cambridge, Massachusetts.
@@ -158,230 +170,415 @@
 #' 13- Smiseth, P., J. Ornborg, S. Andersson, and T. Amundsen. 2001. Is male plumage reflectance
 #' correlated with paternal care in bluethroats? Behavioural Ecology 12:164-170.
 #'
-summary.rspec <- function(object, subset = FALSE, wlmin = NULL, wlmax = NULL, ...) {
-  chkDots(...)
+summary.rspec <- function(object, subset = FALSE, lim = NULL, wlmin = NULL, wlmax = NULL, ...) {
+    chkDots(...)
+
+    wl <- isolate_wl(object, keep = "wl")
+
+    # The control-flow here is for cases when users specify only of the deprecated
+    # wlmin or wlmax arguments. Can be removed once deprecated in next release.
+    if (!all(missing("wlmin"), missing("wlmin"))) {
+      warning("The 'wlmin' and 'wlmax' arguments are deprecated as of v2.9.0,
+      and will be removed in future releases. Use the lim() argument instead.")
+      if (!missing("wlmin") && missing("wlmax"))
+        lim  <- c(wlmin, max(wl))
+      if (missing("wlmin") && !missing("wlmax"))
+        lim  <- c(min(wl), wlmax)
+      if (all(missing("wlmin"), missing("wlmin")))
+        lim  <- c(wlmin, wlmax)
+    }
+
+    lambdamin <- max(lim[1], min(wl))
+    lambdamax <- min(lim[2], max(wl))
+
+    # wl-range checks
+    if (!missing(lim)) {
+      if (lambdamin > lim[1]) {
+        stop("Minimum specified wavelength is smaller than the range of spectral data. Check the lim argument.")
+      }
+      if (lambdamax < lim[2]) {
+        stop("Maximum specified wavelength is larger than the range of spectral data. Check the lim argument.")
+      }
+    }
 
-  wl <- isolate_wl(object, keep = "wl")
+    # Restrict to range of wlmin:wlmax
+    object <- object[which(wl == lambdamin):which(wl == lambdamax), ]
 
-  # Set WL min & max
-  lambdamin <- max(wlmin, min(wl))
-  lambdamax <- min(wlmax, max(wl))
+    wl <- isolate_wl(object, keep = "wl")
+    object <- isolate_wl(object, keep = "spec")
 
-  if (!is.null(wlmin) && lambdamin > wlmin) {
-    stop("wlmin is smaller than the range of spectral data")
-  }
-  if (!is.null(wlmax) && lambdamax < wlmax) {
-    stop("wlmax is larger than the range of spectral data")
-  }
+    # Establish variables and handle any subsetting
+    variable_names <- c("B1", "B2", "B3", "S1", "S2", "S3", "S4", "S5", "S6",
+                        "S7", "S8", "S9", "S10", "H1", "H2", "H3", "H4", "H5")
 
-  # Restrict to range of wlmin:wlmax
-  object <- object[which(wl == lambdamin):which(wl == lambdamax), ]
+    if (is.logical(subset)) {
+      if (subset) {
+        variable_names <- c("B2", "S8", "H1")
+      }
+    } else {
+      if (all(subset %in% variable_names)) {
+        variable_names <- subset
+      } else {
+        stop("Names in ", dQuote("subset"), " do not match color variable names")
+      }
+    }
+
+    # Preserve original variable names
+    variable_names_orig <- variable_names
 
-  wl <- isolate_wl(object, keep = "wl")
-  object <- isolate_wl(object, keep = "spec")
+    # Replace S1 with sub-variables
+    if ("S1" %in% variable_names) {
+      # Find index of 'S1'
+      s1_index <- which(variable_names == "S1")
 
-  output.mat <- matrix(nrow = ncol(object), ncol = 23)
+      # Remove 'S1'
+      variable_names <- variable_names[-s1_index]
 
-  # Three measures of brightness
-  B1 <- colSums(object)
+      # Full names
+      new_var_names <- c("S1U", "S1V", "S1B", "S1G", "S1Y", "S1R")
 
-  B2 <- colMeans(object)
+      # Append full names at the right place
+      variable_names <- append(variable_names, new_var_names, after = s1_index - 1)
+    }
 
-  B3 <- vapply(object, max, numeric(1))
+    # Define final summary output df
+    color.var <- data.frame(matrix(ncol = length(variable_names),
+                                   nrow = ncol(object)))
+    names(color.var) <- variable_names
+
+    # Dictionary to store computed variables
+    computed_vars <- list()
+
+    # Define a dependency structure among variables.
+    # This allows us to speed up computation by computing only the necessary
+    # variables (and their dependencies) when subset is not FALSE.
+    dependencies <- list(
+      B1 = list(fun = calc_B1, deps = NULL),
+      B2 = list(fun = calc_B2, deps = NULL),
+      B3 = list(fun = calc_B3, deps = NULL),
+      S1 = list(fun = calc_S1, deps = "B1"),
+      S2 = list(fun = calc_S2, deps = c("B3", "Rmin")),
+      S3 = list(fun = calc_S3, deps = c("H1", "B1")),
+      S4 = list(fun = calc_S4, deps = NULL),
+      S5 = list(fun = calc_S5, deps = NULL),
+      S6 = list(fun = calc_S6, deps = c("B3", "Rmin")),
+      S7 = list(fun = calc_S7, deps = c("B1", "Rmid")),
+      S8 = list(fun = calc_S8, deps = c("S6", "B2")),
+      S9 = list(fun = calc_S9, deps = NULL),
+      S10 = list(fun = calc_S10, deps = c("S8", "S4")),
+      H1 = list(fun = calc_H1, deps = NULL),
+      H2 = list(fun = calc_H2, deps = NULL),
+      H3 = list(fun = calc_H3, deps = c("B3", "Rmin", "Rmid")),
+      H4 = list(fun = calc_H4, deps = NULL),
+      H5 = list(fun = calc_H5, deps = NULL),
+      Rmin = list(fun = calc_Rmin, deps = NULL),
+      Rmid = list(fun = calc_Rmid, deps = NULL)
+    )
+
+    # Function to calculate a variable, which ensures each variable
+    # is calculated only once
+    compute_color_var <- function(var_name) {
+
+       # If the variable is already computed, return it
+      if (!is.null(computed_vars[[var_name]])) {
+        return(computed_vars[[var_name]])
+      }
+
+      # Get the function and its dependencies
+      fun <- dependencies[[var_name]]$fun
+      deps <- dependencies[[var_name]]$deps
+
+      # If the function has dependencies, calculate them first
+      if (!is.null(deps)) {
+        for (dep in deps) {
+          computed_vars[[dep]] <- compute_color_var(dep)
+        }
+      }
+
+      # Calculate and store variable
+      computed_vars[[var_name]] <- fun(object, wl, computed_vars)
+
+      # Special case handling for S1, which returns a list
+      if (var_name == "S1") {
+        for (sub_var_name in names(computed_vars[[var_name]])) {
+          color.var[, sub_var_name] <- computed_vars[[var_name]][[sub_var_name]]
+        }
+      } else {
+        color.var[, var_name] <- computed_vars[[var_name]]
+      }
+
+      # Return the computed variable
+      return(computed_vars[[var_name]])
+    }
 
-  Rmin <- vapply(object, min, numeric(1))
+    # Calculate all specified variables
+    for (var_name in variable_names_orig) {
+      if (var_name == "S1") {
+        color.var[, c("S1U", "S1V", "S1B", "S1G", "S1Y", "S1R")] <- compute_color_var("S1")
+      } else {
+        color.var[, var_name] <- compute_color_var(var_name)
+      }
+    }
 
-  Rmid <- (B3 + Rmin) / 2
+    row.names(color.var) <- names(object)
 
-  # Chromas
+    if ("Rmid" %in% names(color.var))
+      color.var <- color.var[, !names(color.var) %in% "Rmid"]
+    if ("Rmin" %in% names(color.var))
+      color.var <- color.var[, !names(color.var) %in% "Rmin"]
 
-  # Red
-  if (lambdamin <= 605 && lambdamax >= 700) {
-    Redchromamat <- object[wl >= 605 & wl <= 700, , drop = FALSE] # red 605-700nm inclusive
-    Redchroma <- colSums(Redchromamat) / B1 # S1 red
-    output.mat[, 9] <- Redchroma
-  } else {
-    warning("cannot calculate red chroma; wavelength range not between 605 and 700 nm", call. = FALSE)
+    # The double-conversion here is just so the attributes are in the same order
+    # as in the original formulation, for CI test consistency
+    as.data.frame(as.matrix(color.var))
   }
 
-  # Yellow
-  if (lambdamin <= 550 && lambdamax >= 625) {
-    Yellowchromamat <- object[wl >= 550 & wl <= 625, , drop = FALSE] # yellow 550-625nm
-    Yellowchroma <- colSums(Yellowchromamat) / B1 # S1 yellow
-    output.mat[, 8] <- Yellowchroma
-  } else {
-    warning("cannot calculate yellow chroma; wavelength range not between 550 and 625 nm", call. = FALSE)
-  }
 
-  # Green
-  if (lambdamin <= 510 && lambdamax >= 605) {
-    Greenchromamat <- object[wl >= 510 & wl <= 605, , drop = FALSE] # green 510-605nm inlusive
-    Greenchroma <- colSums(Greenchromamat) / B1 # S1 green
-    output.mat[, 7] <- Greenchroma
-  } else {
-    warning("cannot calculate green chroma; wavelength range not between 510 and 605 nm", call. = FALSE)
-  }
+## ----- Common intermediaries ----- ##
 
-  # Blue
-  if (lambdamin <= 400 && lambdamax >= 510) {
-    Bluechromamat <- object[wl >= 400 & wl <= 510, , drop = FALSE] # blue 400-510nm inclusive
-    Bluechroma <- colSums(Bluechromamat) / B1 # S1 blue
-    output.mat[, 6] <- Bluechroma
-  } else {
-    warning("cannot calculate blue chroma; wavelength range not between 400 and 510 nm", call. = FALSE)
-  }
+calc_Rmin <- function(object, wl, lambdamin, lambdamax) {
+  vapply(object, min, numeric(1))
+}
+
+calc_Rmid <- function(object, wl, lambdamin, lambdamax) {
+  (calc_B3(object) + calc_Rmin(object)) / 2
+}
+
+## ----- Brightness ----- ##
+
+calc_B1 <- function(object, wl, computed_vars, ...) {
+  colSums(object)
+}
 
-  # UV
-  if (lambdamin <= 400 && lambdamax >= 400) {
-    UVchromamat <- object[wl >= lambdamin & wl <= 400, , drop = FALSE]
-    UVchroma <- colSums(UVchromamat) / B1 # S1 UV
-    output.mat [, 4] <- UVchroma
-  } else {
-    warning("cannot calculate UV chroma; wavelength range not below 400 nm", call. = FALSE)
+calc_B2 <- function(object, wl, computed_vars, ...) {
+  colMeans(object)
+}
+
+calc_B3 <- function(object, wl, computed_vars, ...) {
+  vapply(object, max, numeric(1))
+}
+
+## ----- Saturation ----- ##
+
+calc_S1 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  B1 <- computed_vars[["B1"]]
+  lambdamin <- min(wl)
+  lambdamax <- max(wl)
+
+  # Define the chroma ranges
+  chroma_ranges <- list(
+    S1U = list(min = lambdamin, max = 400,
+      message = "cannot calculate UV chroma; wavelength range not below 400 nm"
+    ),
+    S1V = list(min = lambdamin, max = 415,
+      message = "cannot calculate violet chroma; wavelength below 415 nm"
+    ),
+    S1B = list(min = 400, max = 510,
+      message = "cannot calculate blue chroma; wavelength range not between 400 and 510 nm"
+    ),
+    S1G = list(min = 510, max = 605,
+      message = "cannot calculate green chroma; wavelength range not between 510 and 605 nm"
+    ),
+    S1Y = list(min = 550, max = 625,
+      message = "cannot calculate yellow chroma; wavelength range not between 550 and 625 nm"
+    ),
+    S1R = list(min = 605, max = 700,
+      message = "cannot calculate red chroma; wavelength range not between 605 and 700 nm"
+    )
+  )
+
+  output.mat <- matrix(ncol = length(chroma_ranges), nrow = ncol(object))
+
+  for (i in seq_along(chroma_ranges)) {
+    if (lambdamin <= chroma_ranges[[i]]$min && lambdamax >= chroma_ranges[[i]]$max) {
+      chromamat <- object[wl >= chroma_ranges[[i]]$min & wl <= chroma_ranges[[i]]$max, , drop = FALSE]
+      chroma <- colSums(chromamat) / B1
+      output.mat[, i] <- chroma
+    } else {
+      warning(chroma_ranges[[i]]$message, call. = FALSE)
+    }
   }
 
   if (lambdamin > 300 && lambdamin < 400) {
     warning("Minimum wavelength is ", lambdamin, "; UV-related variables may not be meaningful", call. = FALSE)
   }
 
-  # Violet
-  if (lambdamin <= 415 && lambdamax >= 415) {
-    Vchromamat <- object[wl >= lambdamin & wl <= 415, , drop = FALSE]
-    Vchroma <- colSums(Vchromamat) / B1 # S1 Violet
-    output.mat[, 5] <- Vchroma
-  } else {
-    warning("cannot calculate violet chroma; wavelength below 415 nm", call. = FALSE)
-  }
+  return(
+    list(
+      S1U = output.mat[, 1],
+      S1V = output.mat[, 2],
+      S1B = output.mat[, 3],
+      S1G = output.mat[, 4],
+      S1Y = output.mat[, 5],
+      S1R = output.mat[, 6]
+    )
+  )
+}
 
-  # lambda Rmax hue
-  H1 <- wl[max.col(t(object), ties.method = "first")]
+calc_S2 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  B3 <- computed_vars[["B3"]]
+  Rmin <- computed_vars[["Rmin"]]
 
-  # Segment-based variables
+  # Calc
+  B3 / Rmin
+}
 
-  segmts <- trunc(quantile(lambdamin:lambdamax, names = FALSE))
+calc_S3 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  H1 <- computed_vars[["H1"]]
+  B1 <- computed_vars[["B1"]]
 
+  # Calc
+  S3 <- vapply(seq_len(ncol(object)), function(col) {
+    spec <- object[, col]
+    H1_spec <- H1[col]
+    sum(spec[wl >= (H1_spec - 50) & wl <= (H1_spec + 50)])
+  }, numeric(1))
+  S3 / B1
+}
+
+calc_S4 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  diffsmooth <- apply(object, 2, diff)
+  incr <- apply(diffsmooth, 2, min) > 0
+
+  # Calc
+  bmaxneg <- abs(apply(diffsmooth, 2, min))
+  bmaxneg[incr] <- NA
+  bmaxneg
+}
+
+calc_S5 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  lambdamin <- min(wl)
+  lambdamax <- max(wl)
+
+  # Calc
+  segmts <- trunc(quantile(lambdamin:lambdamax, names = FALSE))
   Q1 <- wl >= segmts[1] & wl <= segmts[2]
   Q2 <- wl >= segmts[2] & wl <= segmts[3]
   Q3 <- wl >= segmts[3] & wl <= segmts[4]
   Q4 <- wl >= segmts[4] & wl <= segmts[5]
-
   S5R <- colSums(object[Q4, , drop = FALSE])
   S5Y <- colSums(object[Q3, , drop = FALSE])
   S5G <- colSums(object[Q2, , drop = FALSE])
   S5B <- colSums(object[Q1, , drop = FALSE])
+  sqrt((S5R - S5G) ^ 2 + (S5Y - S5B) ^ 2)
+}
 
-  S5 <- sqrt((S5R - S5G)^2 + (S5Y - S5B)^2)
+calc_S6 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  B3 <- computed_vars[["B3"]]
+  Rmin <- computed_vars[["Rmin"]]
 
-  H4 <- atan2(S5Y - S5B, S5R - S5G)
+  # Calc
+  B3 - Rmin
+}
 
-  # Carotenoid chroma
+calc_S7 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  B1 <- computed_vars[["B1"]]
+  Rmid <- computed_vars[["Rmid"]]
 
-  R450 <- as.numeric(object[which(wl == 450), , drop = FALSE])
-  R700 <- as.numeric(object[which(wl == 700), , drop = FALSE])
-  Carotchroma <- (R700 - R450) / R700
-
-  # H3
+  # Calc
   index_Rmid <- vapply(seq_len(ncol(object)), function(x) {
     which.min(abs(object[, x] - Rmid[x]))
   }, numeric(1))
-  H3 <- wl[index_Rmid]
-
-  # S7
-
   S7 <- vapply(seq_len(ncol(object)), function(col) {
     spec <- object[, col]
     index_Rmid_spec <- index_Rmid[col]
     spec_low <- spec[seq_len(index_Rmid_spec)]
     spec_high <- spec[index_Rmid_spec:length(spec)]
-
     return(sum(spec_low) - sum(spec_high))
   }, numeric(1))
+  S7 / B1
+}
 
-  S7 <- S7 / B1
+calc_S8 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  S6 <- computed_vars[["S6"]]
+  B2 <- computed_vars[["B2"]]
 
+  # Calc
+  S6 / B2
+}
 
-  # S3
-  S3 <- vapply(seq_len(ncol(object)), function(col) {
-    spec <- object[, col]
-    H1_spec <- H1[col]
-    sum(spec[wl >= (H1_spec - 50) & wl <= (H1_spec + 50)])
-  }, numeric(1))
-  S3 <- S3 / B1
+calc_S9 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  R450 <- as.numeric(object[which(wl == 450), , drop = FALSE])
+  R700 <- as.numeric(object[which(wl == 700), , drop = FALSE])
 
-  # Spectral saturation
-  S2 <- B3 / Rmin # S2
+  # Calc
+  (R700 - R450) / R700
+}
 
-  S6 <- B3 - Rmin # S6
+calc_S10 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  S8 <- computed_vars[["S8"]]
+  S4 <- computed_vars[["S4"]]
 
-  S8 <- S6 / B2 # S8
+  # Calc
+  S8 * S4
+}
 
-  # H2
-  diffsmooth <- apply(object, 2, diff)
+## ----- Hue ----- ##
+
+calc_H1 <- function(object, wl, computed_vars, ...) {
+  # Calc
+  wl[max.col(t(object), ties.method = "first")]
+}
 
-  # Spectra that are monotically increasing or decreasing
+calc_H2 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  diffsmooth <- apply(object, 2, diff)
   incr <- apply(diffsmooth, 2, min) > 0
   decr <- apply(diffsmooth, 2, max) < 0
 
-  lambdabmaxneg <- wl[apply(diffsmooth, 2, which.min)] # H2
+  # Calc
+  lambdabmaxneg <- wl[apply(diffsmooth, 2, which.min)]
   lambdabmaxneg[incr] <- NA
+  lambdabmaxneg
+}
 
-  # S4
-  bmaxneg <- abs(apply(diffsmooth, 2, min)) # S4
-  bmaxneg[incr] <- NA
-
-  # S10
-  S10 <- S8 * bmaxneg # S10
-
-  # H5
-  lambdabmax <- wl[apply(diffsmooth, 2, which.max)] # H5
-  lambdabmax[decr] <- NA
-
-
-  # Add remaining variables to output
-
-  output.mat[, 1] <- B1
-  output.mat[, 2] <- B2
-  output.mat[, 3] <- B3
-  output.mat[, 10] <- S2
-  output.mat[, 11] <- S3
-  output.mat[, 12] <- bmaxneg
-  output.mat[, 13] <- S5
-  output.mat[, 14] <- S6
-  output.mat[, 15] <- S7
-  output.mat[, 16] <- S8
-  output.mat[, 17] <- Carotchroma
-  output.mat[, 18] <- S10
-  output.mat[, 19] <- H1
-  output.mat[, 20] <- lambdabmaxneg
-  output.mat[, 21] <- H3 # Rmid
-  output.mat[, 22] <- H4
-  output.mat[, 23] <- lambdabmax
-
-  # PPB added S1v and S1Y
-
+calc_H3 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  B3 <- computed_vars[["B3"]]
+  Rmin <- computed_vars[["Rmin"]]
+  Rmid <- computed_vars[["Rmid"]]
+  index_Rmid <- vapply(seq_len(ncol(object)), function(x) {
+    which.min(abs(object[, x] - Rmid[x]))
+  }, numeric(1))
 
-  color.var <- data.frame(output.mat, row.names = names(object))
+  # Calc
+  wl[index_Rmid]
+}
 
-  colvarnames <- c(
-    "B1", "B2", "B3", "S1U", "S1V", "S1B", "S1G",
-    "S1Y", "S1R", "S2", "S3", "S4", "S5", "S6", "S7", "S8",
-    "S9", "S10", "H1", "H2", "H3", "H4", "H5"
-  )
+calc_H4 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  lambdamin <- min(wl)
+  lambdamax <- max(wl)
+  segmts <- trunc(quantile(lambdamin:lambdamax, names = FALSE))
+  Q1 <- wl >= segmts[1] & wl <= segmts[2]
+  Q2 <- wl >= segmts[2] & wl <= segmts[3]
+  Q3 <- wl >= segmts[3] & wl <= segmts[4]
+  Q4 <- wl >= segmts[4] & wl <= segmts[5]
+  S5R <- colSums(object[Q4, , drop = FALSE])
+  S5Y <- colSums(object[Q3, , drop = FALSE])
+  S5G <- colSums(object[Q2, , drop = FALSE])
+  S5B <- colSums(object[Q1, , drop = FALSE])
 
-  names(color.var) <- colvarnames
+  # Calc
+  atan2(S5Y - S5B, S5R - S5G)
+}
 
-  if (is.logical(subset)) {
-    if (subset) {
-      color.var <- color.var[c("B2", "S8", "H1")]
-    }
-  } else {
-    # check if any color variables selected don't exist
-    if (all(subset %in% colvarnames)) {
-      color.var <- color.var[subset]
-    } else {
-      stop("Names in ", dQuote("subset"), " do not match color variable names")
-    }
-  }
+calc_H5 <- function(object, wl, computed_vars, ...) {
+  # Dependencies
+  diffsmooth <- apply(object, 2, diff)
+  decr <- apply(diffsmooth, 2, max) < 0
 
-  color.var
+  # Calc
+  lambdabmax <- wl[apply(diffsmooth, 2, which.max)]
+  lambdabmax[decr] <- NA
+  lambdabmax
 }
diff --git a/man/summary.rspec.Rd b/man/summary.rspec.Rd
index 6e2b5f22..1f7da63a 100644
--- a/man/summary.rspec.Rd
+++ b/man/summary.rspec.Rd
@@ -4,7 +4,7 @@
 \alias{summary.rspec}
 \title{Colourimetric variables}
 \usage{
-\method{summary}{rspec}(object, subset = FALSE, wlmin = NULL, wlmax = NULL, ...)
+\method{summary}{rspec}(object, subset = FALSE, lim = NULL, wlmin = NULL, wlmax = NULL, ...)
 }
 \arguments{
 \item{object}{(required) a data frame, possibly an object of class \code{rspec},
@@ -17,8 +17,10 @@ of the complete output (composed of B2, S8 and H1; the variables described in
 Andersson and Prager 2006) are returned. Finally, a user-specified string of variable
 names can be used in order to filter and show only those variables.}
 
-\item{wlmin, wlmax}{minimum and maximum used to define the range of wavelengths used in
-calculations (default is to use entire range in the \code{rspec} object).}
+\item{lim}{The range of wavelengths used in calculations. The default is to use
+the entire range in the \code{rspec} object (typically equivalent to \code{lim = c(300, 700)}).}
+
+\item{wlmin, wlmax}{Deprecated. Use the \code{lim} argument instead.}
 
 \item{...}{class consistency (ignored)}
 }
@@ -115,10 +117,18 @@ Smoothing affects only B3, S2, S4, S6, S10, H2, and H5 calculation. All other
 variables can be reliably extracted using non-smoothed data.
 }
 \examples{
+# Load data
 data(sicalis)
+
+# Calculate and display all spectral summary variables
 summary(sicalis)
+
+# Calculate only subset of B2, S8 and H1 as per Andersson (1999)
 summary(sicalis, subset = TRUE)
+
+# Calculate user-specified subset of B1 and H4
 summary(sicalis, subset = c("B1", "H4"))
+
 }
 \references{
 Montgomerie R. 2006. Analyzing colors. In Hill, G.E, and McGraw, K.J., eds.
@@ -172,5 +182,9 @@ eastern bluebirds. Animal Behaviour 69:67-72.
 correlated with paternal care in bluethroats? Behavioural Ecology 12:164-170.
 }
 \author{
-Pierre-Paul Bitton \email{bittonp@windsor.ca}, Rafael Maia \email{rm72@zips.uakron.edu}
+Thomas E. White \email{thomas.white026@gmail.com}
+
+Pierre-Paul Bitton \email{bittonp@windsor.ca}
+
+Rafael Maia \email{rm72@zips.uakron.edu}
 }
diff --git a/tests/testthat/test-S3rspec.R b/tests/testthat/test-S3rspec.R
index 81369594..5ee8a0d6 100644
--- a/tests/testthat/test-S3rspec.R
+++ b/tests/testthat/test-S3rspec.R
@@ -86,25 +86,24 @@ test_that("summary.rspec", {
   expect_named(summary(sicalis, subset = c("B1", "H4")), c("B1", "H4"))
 
   # Different wl ranges
-  expect_warning(summary(sicalis, wlmin = 500), "wavelength range not between")
+  expect_warning(summary(sicalis, lim = c(500, 700)), "wavelength range not between")
   expect_warning(summary(sicalis[1:200, ]), "wavelength range not between")
-  expect_warning(summary(sicalis, wlmax = 600), "wavelength range not between")
-  expect_error(summary(sicalis, wlmin = 200), "wlmin is smaller")
-  expect_error(summary(sicalis, wlmax = 1000), "wlmax is larger")
+  expect_warning(summary(sicalis, lim = c(300, 600)), "wavelength range not between")
+  expect_error(summary(sicalis, lim = c(200, 700)), "smaller than the range")
+  expect_error(summary(sicalis, lim = c(300, 1000)), "larger than the range")
 
   # Test one spectrum rspec object
   one_spec <- sicalis[, c(1, 2)]
   expect_identical(dim(summary(one_spec)), c(1L, 23L))
   expect_warning(
-    expect_length(summary(one_spec, wlmin = 500), 23),
-    "blue chroma"
+    expect_length(summary(one_spec, lim = c(500, 700)), 23), "blue chroma"
   )
 
   # Error if subset vars do not exist
   expect_error(summary(sicalis, subset = "H9"), "do not match color variable names")
 
   # Warning about UV variables if full UV range is not included
-  expect_warning(summary(sicalis, wlmin = 350), "UV-related variables may not be meaningful")
+  expect_warning(summary(sicalis, lim = c(350, 700)), "UV-related variables may not be meaningful")
 })
 
 test_that("plot.rspec", {

From eb9a3cc6a34e28d650d433054b6de73f89037ce1 Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@10-0-0-4.tpgi.com.au>
Date: Wed, 30 Aug 2023 18:51:19 +1000
Subject: [PATCH 03/12] Fix linting

---
 R/stitch.R | 68 +++++++++++++++++++++++++++---------------------------
 1 file changed, 34 insertions(+), 34 deletions(-)

diff --git a/R/stitch.R b/R/stitch.R
index 4d1a3382..51346915 100644
--- a/R/stitch.R
+++ b/R/stitch.R
@@ -12,23 +12,23 @@
 #' do not overlap. Defaults to `TRUE`.
 #'
 #' @export
-#' 
+#'
 #' @examples
 #'
-#' # Simulate a UV-VIS and NIR reflectance spectrum whose wavelength regions 
+#' # Simulate a UV-VIS and NIR reflectance spectrum whose wavelength regions
 #' # slightly overlap then stitch them together, with the overlapping
 #' # regions being averaged.
-#' 
+#'
 #' # Simulate specs
 #' reflect1 <- simulate_spec(wl_peak = 550, xlim = c(300, 700))
 #' reflect2 <- simulate_spec(wl_inflect = 1100, xlim = c(650, 1200))
-#' 
+#'
 #' # Ensure the names of the spectra match
 #' names(reflect1) <- names(reflect2) <- c('wl', 'sample_1')
-#' 
+#'
 #' # Stitch the spectra together by their wavelength column
 #' full_spec <- stitch(reflect1, reflect2)
-#' 
+#'
 #' # Plot the resulting spectrum
 #' plot(full_spec)
 #'
@@ -39,21 +39,21 @@
 #' # the spectra match, but are in a different order in the two rspec objects. This isn't
 #' # an issue, as the function can match up the spectra by name irrespective of their
 #' # ordering
-#' 
+#'
 #' # Simulate UV-VIS and NIR spectra
 #' reflect_vis <- merge(simulate_spec(wl_peak = 550, xlim = c(300, 700)),
 #'                      simulate_spec(wl_peak = 550, xlim = c(300, 700)))
 #' reflect_nir <- merge(simulate_spec(wl_inflect = 1000, xlim = c(800, 1250)),
 #'                      simulate_spec(wl_inflect = 1100, xlim = c(800, 1250)))
-#' 
+#'
 #' # Ensure the names of the spectra exist in each, albeit in a different order
 #' names(reflect_vis) <- c('wl', 'sample_1', 'sample_2')
 #' names(reflect_nir) <- c('wl', 'sample_2', 'sample_1')
-#' 
+#'
 #' # Stitch together by their wavelength column, with missing regions being
 #' # interpolated
 #' reflect_vis_nir <- stitch(reflect_vis, reflect_nir)
-#' 
+#'
 #' # Plot the resulting spectrum
 #' plot(reflect_vis_nir)
 #'
@@ -63,67 +63,67 @@
 #' @seealso [as.rspec()], [merge.rspec()]
 
 stitch <- function(rspec1, rspec2,
-                   overlap_method = c('average', 'minimum', 'maximum'),
+                   overlap_method = c("average", "minimum", "maximum"),
                    interp = TRUE) {
-  
+
   # Class check
-  if (!inherits(rspec1, 'rspec') || !inherits(rspec2, 'rspec')) {
+  if (!inherits(rspec1, "rspec") || !inherits(rspec2, "rspec")) {
     stop("Both inputs must be of class 'rspec'")
   }
-  
+
   # Valied overlap_method
   overlap_method <- match.arg(overlap_method)
-  
+
   # Check that at least one spectrum has a matching name in both objects
   common_cols <- intersect(names(rspec1), names(rspec2))
   if (length(common_cols) <= 1) {
     stop("At least one spectrum in both rspec objects must have a matching name")
   }
-  
+
   # Identify unique spectra in both objects
   unique_rspec1 <- setdiff(names(rspec1), common_cols)
   unique_rspec2 <- setdiff(names(rspec2), common_cols)
-  
+
   # Create NA-filled columns in each rspec for unique spectra in the other
   rspec1[, unique_rspec2] <- NA
   rspec2[, unique_rspec1] <- NA
-  
+
   # Reorder columns of rspec2 to match rspec1
   rspec2 <- rspec2[, names(rspec1)]
-  
+
   # Merge by wl
   res <- rbind(rspec1, rspec2)
-  
+
   # Handle overlapping wl values
-  if (any(duplicated(res$wl))) {
+  if (anyDuplicated(res$wl) > 0) {
     overlap_wl <- unique(res$wl[duplicated(res$wl)])
-    
+
     for (wl in overlap_wl) {
       idx <- which(res$wl == wl)
-      
+
       # Replace with a switch statement
       switch(overlap_method,
-             average = res[idx[1],-1] <- colMeans(as.matrix(res[idx,-1]), na.rm = TRUE),
-             minimum = res[idx[1],-1] <- apply(as.matrix(res[idx,-1]), 2, min, na.rm = TRUE),
-             maximum = res[idx[1],-1] <- apply(as.matrix(res[idx,-1]), 2, max, na.rm = TRUE)
+             average = res[idx[1], -1] <- colMeans(as.matrix(res[idx, -1]), na.rm = TRUE),
+             minimum = res[idx[1], -1] <- apply(as.matrix(res[idx, -1]), 2, min, na.rm = TRUE),
+             maximum = res[idx[1], -1] <- apply(as.matrix(res[idx, -1]), 2, max, na.rm = TRUE)
       )
-      
+
       # Remove extra rows
       if (length(idx) > 1) {
         res <- res[-idx[-1], ]
       }
     }
   }
-  
+
   # Interpolate missing values
   if (interp) {
     full_wl_range <- min(res$wl):max(res$wl)
     missing_wl <- setdiff(full_wl_range, res$wl)
-    
-    if(length(missing_wl) > 0) {
+
+    if (length(missing_wl) > 0) {
       new_rows <- data.frame(wl = missing_wl, matrix(rep(NA, length(names(res)) - 1), ncol = length(names(res)) - 1))
       names(new_rows)[-1] <- names(res)[-1]
-      
+
       # Interpolate only common spectra
       for (col in common_cols[-1]) {
         new_values <- approx(res$wl, res[, col], xout = missing_wl)$y
@@ -132,12 +132,12 @@ stitch <- function(rspec1, rspec2,
       res <- rbind(res, new_rows)
     }
   }
-  
+
   # Sort stitched spec by wl
   res <- res[order(res$wl), ]
-  
+
   # Classes
   class(res) <- c("rspec", "data.frame")
-  
+
   res
 }

From a4108c5468a017e665e2b3e969421d65676e9f38 Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@Thomass-MacBook-Air.local>
Date: Mon, 11 Sep 2023 08:35:19 +1000
Subject: [PATCH 04/12] Implement method/generic

---
 NAMESPACE                          |  1 +
 R/{stitch.R => stitch.rspec.R}     | 17 +++++++++++------
 man/{stitch.Rd => stitch.rspec.Rd} | 16 ++++++++--------
 3 files changed, 20 insertions(+), 14 deletions(-)
 rename R/{stitch.R => stitch.rspec.R} (93%)
 rename man/{stitch.Rd => stitch.rspec.Rd} (92%)

diff --git a/NAMESPACE b/NAMESPACE
index 8d169ef6..287ea6d0 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -9,6 +9,7 @@ S3method(plot,rimg)
 S3method(plot,rspec)
 S3method(plot,sensmod)
 S3method(points,colspace)
+S3method(stitch,rspec)
 S3method(subset,colspace)
 S3method(subset,rspec)
 S3method(subset,vismodel)
diff --git a/R/stitch.R b/R/stitch.rspec.R
similarity index 93%
rename from R/stitch.R
rename to R/stitch.rspec.R
index 51346915..38bc5121 100644
--- a/R/stitch.R
+++ b/R/stitch.rspec.R
@@ -4,9 +4,9 @@
 #' a single `rspec` object.
 #'
 #' @param rspec1,rspec2 (required) `rspec` objects of differing wavelength ranges
-#' to stitch together.
+#' to stitch together by row.
 #' @param overlap_method the method for modifying reflectance values if regions
-#' of the spectra overlap in their wavelength range. Defaults to `average`.
+#' of the spectra overlap in their wavelength range. Defaults to `mean`.
 #' @param interp logical argument specifying whether reflectance values should be
 #' interpolated between the two sets of spectra if their wavelength ranges
 #' do not overlap. Defaults to `TRUE`.
@@ -62,9 +62,9 @@
 #'
 #' @seealso [as.rspec()], [merge.rspec()]
 
-stitch <- function(rspec1, rspec2,
-                   overlap_method = c("average", "minimum", "maximum"),
-                   interp = TRUE) {
+stitch.rspec <- function(rspec1, rspec2,
+                         overlap_method = c("mean", "minimum", "maximum"),
+                         interp = TRUE) {
 
   # Class check
   if (!inherits(rspec1, "rspec") || !inherits(rspec2, "rspec")) {
@@ -103,7 +103,7 @@ stitch <- function(rspec1, rspec2,
 
       # Replace with a switch statement
       switch(overlap_method,
-             average = res[idx[1], -1] <- colMeans(as.matrix(res[idx, -1]), na.rm = TRUE),
+             mean = res[idx[1], -1] <- colMeans(as.matrix(res[idx, -1]), na.rm = TRUE),
              minimum = res[idx[1], -1] <- apply(as.matrix(res[idx, -1]), 2, min, na.rm = TRUE),
              maximum = res[idx[1], -1] <- apply(as.matrix(res[idx, -1]), 2, max, na.rm = TRUE)
       )
@@ -141,3 +141,8 @@ stitch <- function(rspec1, rspec2,
 
   res
 }
+
+#' @export
+stitch <- function(x, ...) {
+  UseMethod("stitch", x)
+}
diff --git a/man/stitch.Rd b/man/stitch.rspec.Rd
similarity index 92%
rename from man/stitch.Rd
rename to man/stitch.rspec.Rd
index 5b49ea33..022e3b85 100644
--- a/man/stitch.Rd
+++ b/man/stitch.rspec.Rd
@@ -1,22 +1,22 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/stitch.R
-\name{stitch}
-\alias{stitch}
+% Please edit documentation in R/stitch.rspec.R
+\name{stitch.rspec}
+\alias{stitch.rspec}
 \title{Stitch together two rspec objects}
 \usage{
-stitch(
+\method{stitch}{rspec}(
   rspec1,
   rspec2,
-  overlap_method = c("average", "minimum", "maximum"),
+  overlap_method = c("mean", "minimum", "maximum"),
   interp = TRUE
 )
 }
 \arguments{
 \item{rspec1, rspec2}{(required) \code{rspec} objects of differing wavelength ranges
-to stitch together.}
+to stitch together by row.}
 
 \item{overlap_method}{the method for modifying reflectance values if regions
-of the spectra overlap in their wavelength range. Defaults to \code{average}.}
+of the spectra overlap in their wavelength range. Defaults to \code{mean}.}
 
 \item{interp}{logical argument specifying whether reflectance values should be
 interpolated between the two sets of spectra if their wavelength ranges
@@ -28,7 +28,7 @@ a single \code{rspec} object.
 }
 \examples{
 
-# Simulate a UV-VIS and NIR reflectance spectrum whose wavelength regions 
+# Simulate a UV-VIS and NIR reflectance spectrum whose wavelength regions
 # slightly overlap then stitch them together, with the overlapping
 # regions being averaged.
 

From 52e8073c0a1a1aa04cd8f0b19a308cba2bb93a3e Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@Thomass-MacBook-Air.local>
Date: Mon, 11 Sep 2023 08:58:21 +1000
Subject: [PATCH 05/12] Merge master

---
 DESCRIPTION                      |   4 +-
 R/stitch.rspec.R                 |  12 +-
 man/stitch.rspec.Rd              |  81 ------
 tests/testthat/test-hashes.R     | 472 -------------------------------
 tests/testthat/test-regression.R | 219 ++++++++++++++
 5 files changed, 228 insertions(+), 560 deletions(-)
 delete mode 100644 man/stitch.rspec.Rd
 delete mode 100644 tests/testthat/test-hashes.R
 create mode 100644 tests/testthat/test-regression.R

diff --git a/DESCRIPTION b/DESCRIPTION
index 1fc01775..4cccac57 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -53,14 +53,14 @@ Imports:
     viridisLite
 Suggests:
     alphashape3d,
-    digest,
     imager,
     knitr,
     mapproj,
     rgl,
     rmarkdown,
     testthat(>= 2.99.0),
-    vdiffr
+    vdiffr,
+    digest
 VignetteBuilder: 
     knitr
 Config/Needs/website:
diff --git a/R/stitch.rspec.R b/R/stitch.rspec.R
index 38bc5121..4bb470d3 100644
--- a/R/stitch.rspec.R
+++ b/R/stitch.rspec.R
@@ -62,7 +62,13 @@
 #'
 #' @seealso [as.rspec()], [merge.rspec()]
 
-stitch.rspec <- function(rspec1, rspec2,
+stitch <- function(rspec1, rspec2, overlap_method, interp) {
+  UseMethod("stitch", x)
+}
+
+#' @rdname stitch
+#' @export
+stitch.rspec.default <- function(rspec1, rspec2,
                          overlap_method = c("mean", "minimum", "maximum"),
                          interp = TRUE) {
 
@@ -142,7 +148,3 @@ stitch.rspec <- function(rspec1, rspec2,
   res
 }
 
-#' @export
-stitch <- function(x, ...) {
-  UseMethod("stitch", x)
-}
diff --git a/man/stitch.rspec.Rd b/man/stitch.rspec.Rd
deleted file mode 100644
index 022e3b85..00000000
--- a/man/stitch.rspec.Rd
+++ /dev/null
@@ -1,81 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/stitch.rspec.R
-\name{stitch.rspec}
-\alias{stitch.rspec}
-\title{Stitch together two rspec objects}
-\usage{
-\method{stitch}{rspec}(
-  rspec1,
-  rspec2,
-  overlap_method = c("mean", "minimum", "maximum"),
-  interp = TRUE
-)
-}
-\arguments{
-\item{rspec1, rspec2}{(required) \code{rspec} objects of differing wavelength ranges
-to stitch together by row.}
-
-\item{overlap_method}{the method for modifying reflectance values if regions
-of the spectra overlap in their wavelength range. Defaults to \code{mean}.}
-
-\item{interp}{logical argument specifying whether reflectance values should be
-interpolated between the two sets of spectra if their wavelength ranges
-do not overlap. Defaults to \code{TRUE}.}
-}
-\description{
-Stitch (row-wise merge) two \code{rspec} objects of differing wavelength ranges into
-a single \code{rspec} object.
-}
-\examples{
-
-# Simulate a UV-VIS and NIR reflectance spectrum whose wavelength regions
-# slightly overlap then stitch them together, with the overlapping
-# regions being averaged.
-
-# Simulate specs
-reflect1 <- simulate_spec(wl_peak = 550, xlim = c(300, 700))
-reflect2 <- simulate_spec(wl_inflect = 1100, xlim = c(650, 1200))
-
-# Ensure the names of the spectra match
-names(reflect1) <- names(reflect2) <- c('wl', 'sample_1')
-
-# Stitch the spectra together by their wavelength column
-full_spec <- stitch(reflect1, reflect2)
-
-# Plot the resulting spectrum
-plot(full_spec)
-
-# Simulate another set of UV-VIS and NIR spectra. Note two additional complexities,
-# both of which are handled without issue. First, the wavelength ranges are
-# non-overlapping (with a 100 nm gap). We'll keep the default interp = TRUE argument
-# to allow the missing reflectance region to be interpolated. Second, the names of
-# the spectra match, but are in a different order in the two rspec objects. This isn't
-# an issue, as the function can match up the spectra by name irrespective of their
-# ordering
-
-# Simulate UV-VIS and NIR spectra
-reflect_vis <- merge(simulate_spec(wl_peak = 550, xlim = c(300, 700)),
-                     simulate_spec(wl_peak = 550, xlim = c(300, 700)))
-reflect_nir <- merge(simulate_spec(wl_inflect = 1000, xlim = c(800, 1250)),
-                     simulate_spec(wl_inflect = 1100, xlim = c(800, 1250)))
-
-# Ensure the names of the spectra exist in each, albeit in a different order
-names(reflect_vis) <- c('wl', 'sample_1', 'sample_2')
-names(reflect_nir) <- c('wl', 'sample_2', 'sample_1')
-
-# Stitch together by their wavelength column, with missing regions being
-# interpolated
-reflect_vis_nir <- stitch(reflect_vis, reflect_nir)
-
-# Plot the resulting spectrum
-plot(reflect_vis_nir)
-
-}
-\seealso{
-\code{\link[=as.rspec]{as.rspec()}}, \code{\link[=merge.rspec]{merge.rspec()}}
-}
-\author{
-Thomas White \email{thomas.white026@gmail.com}
-
-Hugo Gruson \email{hugo.gruson+R@normalesup.org}
-}
diff --git a/tests/testthat/test-hashes.R b/tests/testthat/test-hashes.R
deleted file mode 100644
index 454bcbdd..00000000
--- a/tests/testthat/test-hashes.R
+++ /dev/null
@@ -1,472 +0,0 @@
-local_edition(2)
-
-skip_on_cran()
-
-data(flowers)
-data(sicalis)
-data(teal)
-
-test_that("coldist", {
-  # JND transform
-  vis.flowers <- vismodel(flowers, visual = "apis")
-  cd.flowers <- coldist(vis.flowers, n = c(1, 1, 1))
-  jnd.flowers <- jnd2xyz(cd.flowers)
-  # expect_equal(digest::sha1(jndrot(jnd2xyz(coldist(vismodel(flowers, achromatic = "bt.dc", relative = FALSE), achromatic = TRUE))), digits = 4),
-  #              "07064d68561bad24d8f02c0413611b5ba49ec53a")
-
-  # Output
-  expect_identical(
-    digest::sha1(coldist(colspace(
-      vismodel(flowers, visual = "canis", achromatic = "ml")
-    ), achromatic = TRUE), digits = 4),
-    "bc460149b2263a857c9d573e77169556fa641f56"
-  )
-  # expect_equal(digest::sha1(coldist(vismodel(flowers, visual = 'canis', achromatic = 'ml'), achromatic = TRUE, n = c(1, 1)), digits = 4),
-  #              "7329a3c550fe1d2939423e4104066c868891914f")
-  expect_identical(
-    digest::sha1(
-      coldist(
-        colspace(vismodel(
-          flowers,
-          visual = "canis", achromatic = "all"
-        )),
-        n = c(1, 2),
-        achromatic = TRUE,
-        subset = "Hibbertia_acicularis"
-      ),
-      digits = 4
-    ),
-    "27ab9af8efe2b1651cd36f8506262f87e2b127a7"
-  )
-  expect_identical(
-    digest::sha1(
-      coldist(
-        colspace(
-          vismodel(
-            flowers,
-            visual = "apis",
-            achromatic = "all",
-            relative = FALSE,
-            vonkries = TRUE
-          ),
-          space = "hexagon"
-        ),
-        n = c(1, 2),
-        achromatic = TRUE,
-        subset = c("Hibbertia_acicularis", "Grevillea_buxifolia")
-      ),
-      digits = 4
-    ),
-    "754c01809100bdacc80d40db2359797f41180c23"
-  )
-  expect_identical(
-    digest::sha1(coldist(colspace(
-      vismodel(flowers, visual = "segment")
-    ), achromatic = TRUE), digits = 4),
-    "d65c018342664ae9c8dca35e715c57dde28de30a"
-  )
-  expect_identical(
-    digest::sha1(coldist(colspace(
-      vismodel(
-        flowers,
-        visual = "cie10",
-        illum = "D65",
-        vonkries = TRUE,
-        relative = FALSE
-      ),
-      "cielab"
-    )), digits = 4),
-    "ab8d1c2eac211561f68759137baa2b5d3005b199"
-  )
-})
-
-test_that("coldist_nolinux", {
-  skip_on_os("linux")
-
-  expect_identical(
-    digest::sha1(coldist(
-      as.matrix(vismodel(flowers, achro = "bt.dc")),
-      qcatch = "Qi",
-      achromatic = TRUE
-    ), digits = 3),
-    "1f797fe87a2e1502080e1c99251b3a768164e7c7"
-  )
-})
-
-test_that("bootcoldist", {
-  skip_on_os("linux")
-
-  # Empirical means
-  data(sicalis)
-  vm.sic <- vismodel(sicalis, visual = "apis", achromatic = "l")
-  gr.sic <- gsub("ind..", "", rownames(vm.sic))
-  bcd.sic <- suppressWarnings(bootcoldist(
-    vm.sic,
-    by = gr.sic,
-    n = c(1, 2, 3),
-    weber = 0.1,
-    weber.achro = 0.1
-  ))
-  expect_identical(
-    digest::sha1(c(bcd.sic[, 1], bcd.sic[, 4])),
-    "9d10fc3ed22e787974464b30a0c5254209522388"
-  )
-})
-
-test_that("special_colspace", {
-  skip_on_os("linux")
-
-  expect_identical(
-    digest::sha1(colspace(
-      vismodel(flowers, visual = "canis", achromatic = "all")
-    ), digits = 3),
-    "41e6dafe465f01a883abd395c00be168aec45b2d"
-  ) # dispace
-  expect_identical(
-    digest::sha1(colspace(
-      vismodel(flowers, visual = "apis", achromatic = "l")
-    ), digits = 3),
-    "f327404a1e417cef90d5c79a5cfd6ecb8c494de4"
-  ) # trispace
-  expect_identical(
-    digest::sha1(colspace(
-      vismodel(flowers, visual = "bluetit", achromatic = "ch.dc")
-    ), digits = 3),
-    "d6d882283d9f005f436066b7da0d5e9a4c4b1e15"
-  ) # tcs
-})
-
-test_that("special_colspace", {
-  expect_identical(
-    digest::sha1(colspace(
-      vismodel(flowers, visual = "musca", achro = "md.r1"),
-      space = "categorical"
-    ), digits = 4),
-    "b20853b3e52a60f2dd17b418a48b681d7f49e7d1"
-  ) # categorical
-  expect_identical(
-    digest::sha1(colspace(
-      vismodel(flowers, visual = "segment", achromatic = "bt.dc"),
-      space = "segment"
-    ), digits = 4),
-    "f47081fbc5f3f896fc50b2223937d91b6f61069e"
-  ) # segment
-  expect_identical(
-    digest::sha1(colspace(
-      vismodel(
-        flowers,
-        visual = "apis",
-        relative = FALSE,
-        qcatch = "Ei",
-        vonkries = TRUE,
-        achromatic = "l"
-      ),
-      space = "coc"
-    ), digits = 4),
-    "d6e5c22dd45d2604c0d2fc16509b8887cb7812d2"
-  ) # coc
-  expect_identical(
-    digest::sha1(
-      colspace(
-        vismodel(
-          flowers,
-          visual = "apis",
-          qcatch = "Ei",
-          vonkries = TRUE,
-          relative = FALSE,
-          achromatic = "l"
-        ),
-        space = "hexagon"
-      ),
-      digits = 4
-    ),
-    "a1fdd24e315413825c94d4caf1164b8be57c8156"
-  ) # hexagon
-  expect_identical(
-    digest::sha1(colspace(
-      vismodel(flowers, visual = "cie10"),
-      space = "ciexyz"
-    ), digits = 4),
-    "99684793a0db286562bff697354496ac3ef0abfb"
-  ) # ciexyz
-  expect_identical(
-    digest::sha1(colspace(
-      vismodel(flowers, visual = "cie10"),
-      space = "cielab"
-    ), digits = 4),
-    "55961f7e22403fba0c0c658868918722befb5f2c"
-  ) # cielab
-  expect_identical(
-    digest::sha1(colspace(
-      vismodel(flowers, visual = "cie10"),
-      space = "cielch"
-    ), digits = 4),
-    "e0ad250b695e97c9ffb53c0303f19d908e33d033"
-  ) # cielch
-
-  # sha1() has no method for the 'table' class
-  # expect_equal(
-  #   digest::sha1(summary(colspace(vismodel(flowers, visual = "cie10"), space = "cielch")), digits = 4),
-  #   "8d9c05ec7ae28b219c4c56edbce6a721bd68af82"
-  # )
-})
-
-test_that("voloverlap()", {
-  tcs.sicalis.C <- subset(colspace(vismodel(sicalis)), "C")
-  tcs.sicalis.T <- subset(colspace(vismodel(sicalis)), "T")
-  tcs.sicalis.B <- subset(colspace(vismodel(sicalis)), "B")
-
-  expect_identical(
-    digest::sha1(
-      voloverlap(tcs.sicalis.T, tcs.sicalis.B, type = "convex"),
-      digits = 4
-    ),
-    "3717422024683f1e3e1bd8dbfe832b177147afce"
-  )
-
-  expect_identical(
-    digest::sha1(
-      voloverlap(tcs.sicalis.T, tcs.sicalis.C, type = "convex"),
-      digits = 4
-    ),
-    "69b323778e83f2e43a91d60326f1e726eb2cd0e4"
-  )
-})
-
-test_that("processing & general", {
-  # Sensdata
-  expect_known_hash(
-    expect_silent(sensdata(
-      illum = "all",
-      bkg = "all",
-      trans = "all"
-    )),
-    "b084b37ec7"
-  )
-
-  # Peakshape
-  expect_known_hash(
-    expect_silent(peakshape(flowers, absolute.min = TRUE)),
-    "7fbaba1738"
-  )
-
-  # Simulate
-  # Ideal
-  expect_known_hash(
-    digest::sha1(summary(simulate_spec(ylim = c(
-      0, 50
-    ))), digits = 4),
-    "88a30943a99d1ea14bc42ac4e4f4d54d"
-  )
-  # Sigmoidd low-high
-  expect_known_hash(
-    digest::sha1(summary(simulate_spec(wl_inflect = 550)), digits = 4),
-    "8e3891ab1c6cf8a10bcab6410fa2f4a0"
-  )
-  # Sigmoid high-low
-  expect_known_hash(
-    digest::sha1(summary(
-      simulate_spec(wl_inflect = 550, ylim = c(100, 0))
-    ), digits = 4),
-    "2b9191b2b7107e2903702b77a80c432d"
-  )
-  # Gaussian
-  expect_known_hash(
-    digest::sha1(summary(simulate_spec(wl_peak = 400)), digits = 4),
-    "9e86606691410fa965031f7b6b180c48"
-  )
-
-  # Merge
-  teal1 <- teal[, c(1, 3:5)]
-  teal2 <- teal[, c(1, 2, 6:12)]
-  expect_known_hash(
-    expect_silent(merge(teal1, teal2, by = "wl")),
-    "02df3eedf3"
-  )
-
-  # Subset
-  vis.sicalis <- vismodel(sicalis)
-  tcs.sicalis <- colspace(vis.sicalis, space = "tcs")
-  expect_identical(
-    digest::sha1(subset(vis.sicalis, "C"), digits = 4),
-    "93ae671c250d2d4f0f5dcf9e714eb497d8baf74f"
-  )
-  expect_identical(
-    digest::sha1(subset(sicalis, "T", invert = TRUE), digits = 4),
-    "332a97ed1c25045b70d871a8686e268d09cefd76"
-  )
-
-  # Summary
-  expect_known_hash(
-    expect_silent(summary(teal)),
-    "c64e1fd403"
-  )
-  expect_known_hash(
-    expect_silent(summary(sicalis)),
-    "66129550f3"
-  )
-})
-
-test_that("images", {
-  suppressWarnings(RNGversion("3.5.0")) # back compatibility for now
-  set.seed(2231)
-
-  papilio <-
-    getimg(system.file("testdata", "images", "butterflies", "papilio.png", package = "pavo"))
-  snakes <-
-    getimg(system.file("testdata", "images", "snakes", package = "pavo"))
-
-  expect_identical(
-    digest::sha1(summary(papilio), digits = 4),
-    "aa1c46d4796c523f51c4e959ac90a692dd8ecfe4"
-  )
-  expect_identical(
-    digest::sha1(summary(snakes), digits = 4),
-    "dd7fc9fd7c41da84c641181a9a3701da74f3c41e"
-  )
-})
-
-test_that("vismodel", {
-  # Output
-  expect_identical(
-    digest::sha1(
-      vismodel(
-        flowers,
-        visual = "canis",
-        achromatic = "all",
-        illum = "bluesky"
-      ),
-      digits = 4
-    ),
-    "61879badc0cb518ebd8f62f9c8838c7b32cb51ff"
-  )
-  expect_identical(
-    digest::sha1(
-      vismodel(
-        flowers,
-        visual = "apis",
-        qcatch = "fi",
-        achromatic = "ml",
-        scale = 10000
-      ),
-      digits = 4
-    ),
-    "4a3539c87d1c672510df68992b9dc6954337a736"
-  )
-  expect_identical(
-    digest::sha1(
-      vismodel(
-        flowers,
-        visual = "bluetit",
-        achromatic = "ch.dc",
-        trans = "bluetit"
-      ),
-      digits = 4
-    ),
-    "fbd9f6b5368f2c81f11ec86a78322e7a14cc7f47"
-  )
-  expect_identical(
-    digest::sha1(
-      vismodel(
-        flowers,
-        visual = "musca",
-        achromatic = "md.r1",
-        relative = FALSE
-      ),
-      digits = 4
-    ),
-    "edcb721c2093c7af40efdae94837c4e01031c8ae"
-  )
-  expect_identical(
-    digest::sha1(
-      vismodel(
-        flowers,
-        visual = "apis",
-        relative = FALSE,
-        qcatch = "Ei",
-        bkg = "green",
-        vonkries = TRUE,
-        achromatic = "l"
-      ),
-      digits = 4
-    ),
-    "a6bc51f272c930a4ac9e69a1851eca16f5a3a1a0"
-  )
-  expect_identical(
-    digest::sha1(vismodel(flowers, visual = "cie10"), digits = 4),
-    "fc5f5f2f11fefdcff1bbdd264e28d520f0812712"
-  )
-
-  # Attributes
-  if (getRversion() < "4.0.0") {
-    expect_identical(
-      digest::sha1(attributes(
-        vismodel(
-          flowers,
-          visual = "canis",
-          achromatic = "all",
-          illum = "bluesky"
-        )
-      ), digits = 4),
-      "0f788526e4db68c9921e441066779146f8a4c377"
-    )
-    expect_identical(
-      digest::sha1(attributes(
-        vismodel(
-          flowers,
-          visual = "apis",
-          qcatch = "fi",
-          achromatic = "ml",
-          scale = 10000
-        )
-      ), digits = 4),
-      "b9d488a8e36bca04a66e4513e781c21b66c10ce9"
-    )
-    expect_identical(
-      digest::sha1(attributes(
-        vismodel(
-          flowers,
-          visual = "bluetit",
-          achromatic = "ch.dc",
-          trans = "bluetit"
-        )
-      ), digits = 4),
-      "0a3fb5b639d4c4224cf91045d5f8a13cc06f8550"
-    )
-  } else {
-    expect_identical(
-      digest::sha1(attributes(
-        vismodel(
-          flowers,
-          visual = "canis",
-          achromatic = "all",
-          illum = "bluesky"
-        )
-      ), digits = 4),
-      "397eda31c6948884e09ef58a1b8f0ec5d4f3401c"
-    )
-    expect_identical(
-      digest::sha1(attributes(
-        vismodel(
-          flowers,
-          visual = "apis",
-          qcatch = "fi",
-          achromatic = "ml",
-          scale = 10000
-        )
-      ), digits = 4),
-      "60744da46c20782fa8af0bf2a93316ed0d2e6e9d"
-    )
-    expect_identical(
-      digest::sha1(attributes(
-        vismodel(
-          flowers,
-          visual = "bluetit",
-          achromatic = "ch.dc",
-          trans = "bluetit"
-        )
-      ), digits = 4),
-      "7bca56baefdd2a42fcb59c26614fe0bbec326865"
-    )
-  }
-})
diff --git a/tests/testthat/test-regression.R b/tests/testthat/test-regression.R
new file mode 100644
index 00000000..9096f85d
--- /dev/null
+++ b/tests/testthat/test-regression.R
@@ -0,0 +1,219 @@
+data(flowers)
+data(sicalis)
+data(teal)
+
+test_that("coldist", {
+  # JND transform
+  vis.flowers <- vismodel(flowers, visual = "apis")
+  cd.flowers <- coldist(vis.flowers, n = c(1, 1, 1))
+  jnd.flowers <- jnd2xyz(cd.flowers)
+  result1 <- jndrot(jnd2xyz(coldist(vismodel(flowers, achromatic = "bt.dc", relative = FALSE), achromatic = TRUE)))
+  
+  expect_equal(dim(result1), c(36, 4))
+  expect_equal(round(mean(unlist(result1)^3), 3), -132.915)
+
+  # Output
+  result2 <- coldist(colspace(vismodel(flowers, visual = "canis", achromatic = "ml")), achromatic = TRUE)
+  expect_equal(dim(result2), c(630, 4))
+  expect_equal(round(mean(unlist(result2[,3:4])), 4), 0.8693)
+  
+  result3 <- coldist(colspace(vismodel(flowers, visual = "canis", achromatic = "all")),
+             n = c(1, 2), achromatic = TRUE, subset = "Hibbertia_acicularis")
+  expect_equal(dim(result3), c(35, 4))
+  expect_equal(round(mean(unlist(result3[, 3:4])), 4), 0.5388)
+  
+  result4 <- coldist(colspace(vismodel(flowers, visual = "apis", achromatic = "all",
+                    relative = FALSE, vonkries = TRUE), space = "hexagon"),
+             n = c(1, 2), achromatic = TRUE, subset = c("Hibbertia_acicularis", "Grevillea_buxifolia"))
+  expect_equal(dim(result4), c(1, 4))
+  expect_equal(round(mean(unlist(result4[, 3:4])), 4), 0.464)
+  
+  result5 <- coldist(colspace(vismodel(flowers, visual = "segment")), achromatic = TRUE)
+  expect_equal(dim(result5), c(630, 4))
+  expect_equal(round(mean(unlist(result5[, 3:4])), 4), 0.2685)
+  
+  result6 <- coldist(colspace(vismodel(flowers, 
+                                       visual = "cie10", 
+                                       illum = "D65", 
+                                       vonkries = TRUE, 
+                                       relative = FALSE), "cielab"))
+  expect_equal(dim(result6), c(630, 4))
+  expect_equal(round(mean(unlist(result6[, 3])), 4), 28.7164)
+  
+  result7 <- coldist(as.matrix(vismodel(flowers, achro = "bt.dc")), qcatch = "Qi", achromatic = TRUE)
+  expect_equal(dim(result7), c(630, 4))
+  expect_equal(round(mean(unlist(result7[, 3])), 4), 11.7606)
+  
+})
+
+test_that("bootcoldist", {
+
+  # Empirical means
+  data(sicalis)
+  vm.sic <- vismodel(sicalis, visual = "apis", achromatic = "l")
+  gr.sic <- gsub("ind..", "", rownames(vm.sic))
+  bcd.sic <- suppressWarnings(bootcoldist(
+    vm.sic,
+    by = gr.sic,
+    n = c(1, 2, 3),
+    weber = 0.1,
+    weber.achro = 0.1
+  ))
+  expect_equal(
+    unname(round(c(bcd.sic[, 1], bcd.sic[, 4]), 4)), 
+  c(4.5760, 1.1340, 5.6378, 8.2510, 0.0124, 8.2387))
+})
+
+test_that("special_colspace", {
+
+  # Dispace
+  result8 <- colspace(vismodel(flowers, visual = "canis", achromatic = "all"))
+  expect_equal(dim(result8), c(36, 5))
+  expect_equal(round(mean(unlist(result8)), 4), 0.4061)
+  
+  # Trispace
+  result9 <- colspace(vismodel(flowers, visual = "apis", achromatic = "l"))
+  expect_equal(dim(result9), c(36, 8))
+  expect_equal(round(mean(unlist(result9)), 4), 0.0876)
+  
+  # tcs
+  result10 <- colspace(vismodel(flowers, visual = "bluetit", achromatic = "ch.dc"))
+  expect_equal(dim(result10), c(36, 17))
+  expect_equal(round(mean(unlist(result10)), 4), 0.0923)
+  
+  # categorical
+  result11 <- colspace(vismodel(flowers, visual = "musca", achro = "md.r1"), space = "categorical")
+  expect_equal(dim(result11), c(36, 10))
+  expect_equal(round(mean(unlist(result11[, -7])), 4), -0.0949)
+  
+  # segment
+  result12 <- colspace(vismodel(flowers, visual = "segment", achromatic = "bt.dc"), space = "segment")
+  expect_equal(dim(result12), c(36, 9))
+  expect_equal(round(mean(unlist(result12)), 4), 20.4668)
+  
+  # coc
+  result13 <- colspace(vismodel(flowers, visual = "apis", relative = FALSE, qcatch = "Ei", 
+                       vonkries = TRUE, achromatic = "l"), space = "coc")
+  expect_equal(dim(result13), c(36, 7))
+  expect_equal(round(mean(unlist(result13)), 4), 0.5304)
+  
+  # hexagon
+  result14 <- colspace(vismodel(flowers, visual = "apis", qcatch = "Ei", 
+                                vonkries = TRUE, relative = FALSE, achromatic = "l"), space = "hexagon")
+  expect_equal(dim(result14), c(36, 10))
+  expect_equal(round(mean(unlist(result14[-9])), 4), 20.3489)
+  
+  # ciezyx
+  result15 <- colspace(vismodel(flowers, visual = "cie10"), space = "ciexyz")
+  expect_equal(dim(result15), c(36, 6))
+  expect_equal(round(mean(unlist(result15)), 4), 0.3596)
+  
+  # cielab
+  result16 <- colspace(vismodel(flowers, visual = "cie10"), space = "cielab")
+  expect_equal(dim(result16), c(36, 6))
+  expect_equal(round(mean(unlist(result16)), 4), 9.5446)
+  
+  # cielch
+  result17 <- colspace(vismodel(flowers, visual = "cie10"), space = "cielch")
+  expect_equal(dim(result17), c(36, 8))
+  expect_equal(round(mean(unlist(result17)), 4), 26.2162)
+  
+})
+
+
+test_that("voloverlap()", {
+  tcs.sicalis.C <- subset(colspace(vismodel(sicalis)), "C")
+  tcs.sicalis.T <- subset(colspace(vismodel(sicalis)), "T")
+  tcs.sicalis.B <- subset(colspace(vismodel(sicalis)), "B")
+
+  expect_equal(round(mean(unlist(voloverlap(tcs.sicalis.T, tcs.sicalis.B, type = "convex"))), 4), 0.0395)
+  expect_equal(round(mean(unlist(voloverlap(tcs.sicalis.T, tcs.sicalis.C, type = "convex"))[1:2]^-1), 4), 201959.93)
+  
+})
+
+test_that("processing & general", {
+  # Sensdata
+  result18 <- sensdata(illum = "all", bkg = "all", trans = "all")
+  expect_equal(dim(result18), c(401, 7))
+  expect_equal(round(mean(unlist(result18)), 4), 72.8731)
+
+  # Peakshape
+  result19 <- peakshape(flowers, absolute.min = TRUE)
+  expect_equal(dim(result19), c(36, 7))
+  expect_equal(round(mean(unlist(result19[, 2:6]), na.rm = TRUE), 4), 287.7377)
+
+  # Simulate
+  # Ideal
+  result20 <- summary(simulate_spec(ylim = c(0, 50)))
+  expect_equal(dim(result20), c(1, 23))
+  expect_equal(round(mean(unlist(result20)), 4), 928.3311)
+  
+  # Sigmoidd low-high
+  result21 <- summary(simulate_spec(wl_inflect = 550))
+  expect_equal(dim(result21), c(1, 23))
+  expect_equal(round(mean(unlist(subset(result21, select = -c(S2))), na.rm = TRUE), 4), 1479.6564)
+  
+  # Sigmoid high-low
+  result22 <- summary(simulate_spec(wl_inflect = 550, ylim = c(100, 0)))
+  expect_equal(dim(result22), c(1, 23))
+  expect_equal(round(mean(unlist(subset(result22, select = -c(S2, S9))), na.rm = TRUE), 4), 1885.9745)
+  
+  # Gaussian
+  result23 <- summary(simulate_spec(wl_peak = 400))
+  expect_equal(dim(result23), c(1, 23))
+  expect_equal(round(mean(unlist(subset(result23, select = -c(S2, S9))), na.rm = TRUE), 4), 694.4126)
+
+  # Merge
+  teal1 <- teal[, c(1, 3:5)]
+  teal2 <- teal[, c(1, 2, 6:12)]
+  expect_equal(round(mean(unlist(merge(teal1, teal2, by = "wl"))), 4), 51.1874)
+
+  # Subset
+  vis.sicalis <- vismodel(sicalis)
+  tcs.sicalis <- colspace(vis.sicalis, space = "tcs")
+  expect_equal(round(mean(unlist(subset(vis.sicalis, "C")), na.rm = TRUE), 4), 0.25)
+  expect_equal(round(mean(unlist(subset(sicalis, "T", invert = TRUE)), na.rm = TRUE), 4), 40.1018)
+
+  # Summary
+  expect_equal(round(mean(unlist(summary(teal))), 4), 287.9638)
+  expect_equal(round(mean(unlist(subset(summary(sicalis), select = -c(S2)))), 4), 313.7217)
+  
+})
+
+test_that("images", {
+
+  papilio <-
+    getimg(system.file("testdata", "images", "butterflies", "papilio.png", package = "pavo"))
+  snakes <-
+    getimg(system.file("testdata", "images", "snakes", package = "pavo"))
+
+  expect_equal(unlist(unname(summary(papilio))), 'papilio')
+  expect_equal(unlist(unname(summary(snakes))), c('snake_01', 'snake_02'))
+})
+
+test_that("vismodel", {
+  result24 <- vismodel(flowers, visual = "canis", achromatic = "all", illum = "bluesky")
+  expect_equal(dim(result24), c(36, 3))
+  expect_equal(round(mean(unlist(result24)), 4), 0.4572)
+  
+  result25 <- vismodel(flowers, visual = "apis", qcatch = "fi", achromatic = "ml", scale = 10000)
+  expect_equal(dim(result25), c(36, 4))
+  expect_equal(round(mean(unlist(result25)), 4), 2.3597)
+  
+  result26 <- vismodel(flowers, visual = "bluetit", achromatic = "ch.dc", trans = "bluetit")
+  expect_equal(dim(result26), c(36, 5))
+  expect_equal(round(mean(unlist(result26)), 4), 0.2832)
+  
+  result27 <- vismodel(flowers, visual = "musca", achromatic = "md.r1", relative = FALSE)
+  expect_equal(dim(result27), c(36, 5))
+  expect_equal(round(mean(unlist(result27)), 4), 0.1904)
+  
+  result28 <- vismodel(flowers, visual = "apis", relative = FALSE, qcatch = "Ei", bkg = "green",
+        vonkries = TRUE, achromatic = "l")
+  expect_equal(dim(result28), c(36, 4))
+  expect_equal(round(mean(unlist(result28)), 4), 0.5457)
+  
+  result29 <- vismodel(flowers, visual = "cie10")
+  expect_equal(dim(result29), c(36, 4))
+  expect_equal(round(mean(unlist(result29), na.rm = TRUE), 4), 0.3859)
+})

From e53560cb891c49bfe517f63f62b0f828b580bd9f Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@Thomass-MacBook-Air.local>
Date: Mon, 11 Sep 2023 09:10:36 +1000
Subject: [PATCH 06/12] Fix up generic/method

---
 R/stitch.rspec.R | 12 +++----
 man/stitch.Rd    | 84 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 90 insertions(+), 6 deletions(-)
 create mode 100644 man/stitch.Rd

diff --git a/R/stitch.rspec.R b/R/stitch.rspec.R
index 4bb470d3..86dbd5aa 100644
--- a/R/stitch.rspec.R
+++ b/R/stitch.rspec.R
@@ -63,14 +63,15 @@
 #' @seealso [as.rspec()], [merge.rspec()]
 
 stitch <- function(rspec1, rspec2, overlap_method, interp) {
-  UseMethod("stitch", x)
+  UseMethod("stitch")
 }
 
 #' @rdname stitch
+#'
 #' @export
-stitch.rspec.default <- function(rspec1, rspec2,
-                         overlap_method = c("mean", "minimum", "maximum"),
-                         interp = TRUE) {
+stitch.rspec <- function(rspec1, rspec2,
+                                 overlap_method = c("mean", "minimum", "maximum"),
+                                 interp = TRUE) {
 
   # Class check
   if (!inherits(rspec1, "rspec") || !inherits(rspec2, "rspec")) {
@@ -146,5 +147,4 @@ stitch.rspec.default <- function(rspec1, rspec2,
   class(res) <- c("rspec", "data.frame")
 
   res
-}
-
+}
\ No newline at end of file
diff --git a/man/stitch.Rd b/man/stitch.Rd
new file mode 100644
index 00000000..530f0f77
--- /dev/null
+++ b/man/stitch.Rd
@@ -0,0 +1,84 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/stitch.rspec.R
+\name{stitch}
+\alias{stitch}
+\alias{stitch.rspec}
+\title{Stitch together two rspec objects}
+\usage{
+stitch(rspec1, rspec2, overlap_method, interp = TRUE)
+
+\method{stitch}{rspec}(
+  rspec1,
+  rspec2,
+  overlap_method = c("mean", "minimum", "maximum"),
+  interp = TRUE
+)
+}
+\arguments{
+\item{rspec1, rspec2}{(required) \code{rspec} objects of differing wavelength ranges
+to stitch together by row.}
+
+\item{overlap_method}{the method for modifying reflectance values if regions
+of the spectra overlap in their wavelength range. Defaults to \code{mean}.}
+
+\item{interp}{logical argument specifying whether reflectance values should be
+interpolated between the two sets of spectra if their wavelength ranges
+do not overlap. Defaults to \code{TRUE}.}
+}
+\description{
+Stitch (row-wise merge) two \code{rspec} objects of differing wavelength ranges into
+a single \code{rspec} object.
+}
+\examples{
+
+# Simulate a UV-VIS and NIR reflectance spectrum whose wavelength regions
+# slightly overlap then stitch them together, with the overlapping
+# regions being averaged.
+
+# Simulate specs
+reflect1 <- simulate_spec(wl_peak = 550, xlim = c(300, 700))
+reflect2 <- simulate_spec(wl_inflect = 1100, xlim = c(650, 1200))
+
+# Ensure the names of the spectra match
+names(reflect1) <- names(reflect2) <- c('wl', 'sample_1')
+
+# Stitch the spectra together by their wavelength column
+full_spec <- stitch(reflect1, reflect2)
+
+# Plot the resulting spectrum
+plot(full_spec)
+
+# Simulate another set of UV-VIS and NIR spectra. Note two additional complexities,
+# both of which are handled without issue. First, the wavelength ranges are
+# non-overlapping (with a 100 nm gap). We'll keep the default interp = TRUE argument
+# to allow the missing reflectance region to be interpolated. Second, the names of
+# the spectra match, but are in a different order in the two rspec objects. This isn't
+# an issue, as the function can match up the spectra by name irrespective of their
+# ordering
+
+# Simulate UV-VIS and NIR spectra
+reflect_vis <- merge(simulate_spec(wl_peak = 550, xlim = c(300, 700)),
+                     simulate_spec(wl_peak = 550, xlim = c(300, 700)))
+reflect_nir <- merge(simulate_spec(wl_inflect = 1000, xlim = c(800, 1250)),
+                     simulate_spec(wl_inflect = 1100, xlim = c(800, 1250)))
+
+# Ensure the names of the spectra exist in each, albeit in a different order
+names(reflect_vis) <- c('wl', 'sample_1', 'sample_2')
+names(reflect_nir) <- c('wl', 'sample_2', 'sample_1')
+
+# Stitch together by their wavelength column, with missing regions being
+# interpolated
+reflect_vis_nir <- stitch(reflect_vis, reflect_nir)
+
+# Plot the resulting spectrum
+plot(reflect_vis_nir)
+
+}
+\seealso{
+\code{\link[=as.rspec]{as.rspec()}}, \code{\link[=merge.rspec]{merge.rspec()}}
+}
+\author{
+Thomas White \email{thomas.white026@gmail.com}
+
+Hugo Gruson \email{hugo.gruson+R@normalesup.org}
+}

From 7ba3d0db2d6d62f967eab1ffca86e2c919417093 Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@thomass-air.staff.wireless.sydney.edu.au>
Date: Mon, 11 Sep 2023 11:35:30 +1000
Subject: [PATCH 07/12] Add to pkgdown

---
 pkgdown/_pkgdown.yml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml
index 108c79e5..df9b2a5b 100644
--- a/pkgdown/_pkgdown.yml
+++ b/pkgdown/_pkgdown.yml
@@ -20,6 +20,7 @@ reference:
   - '`procspec`'
   - '`rimg2cimg`'
   - '`spec2rgb`'
+  - '`stitch.rspec`'
   - '`subset.rspec`'
   - '`simulate_spec`'
 

From 7423e541904546bcf642bbbf7637452a8cb8817f Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@thomass-air.staff.wireless.sydney.edu.au>
Date: Mon, 11 Sep 2023 13:09:31 +1000
Subject: [PATCH 08/12] Merge master

---
 .github/workflows/R-CMD-check.yaml | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml
index f9bc4eff..cbea44ff 100644
--- a/.github/workflows/R-CMD-check.yaml
+++ b/.github/workflows/R-CMD-check.yaml
@@ -48,7 +48,9 @@ jobs:
 
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:
-          extra-packages: any::rcmdcheck
+          extra-packages: 
+            any::rcmdcheck,
+            vdiffr@1.0.5
           needs: check
 
       - uses: r-lib/actions/check-r-package@v2

From 22f1bc88139c500a9049bb4d2fccd03168feb9ec Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@Thomass-MacBook-Air.local>
Date: Mon, 11 Sep 2023 13:36:37 +1000
Subject: [PATCH 09/12] Add warnings/errors and tests

---
 R/stitch.rspec.R                 |  7 +++++-
 man/stitch.Rd                    |  2 +-
 tests/testthat/test-processing.R | 40 ++++++++++++++++++++++++++++++++
 3 files changed, 47 insertions(+), 2 deletions(-)

diff --git a/R/stitch.rspec.R b/R/stitch.rspec.R
index 86dbd5aa..5f2c4235 100644
--- a/R/stitch.rspec.R
+++ b/R/stitch.rspec.R
@@ -78,7 +78,7 @@ stitch.rspec <- function(rspec1, rspec2,
     stop("Both inputs must be of class 'rspec'")
   }
 
-  # Valied overlap_method
+  # Validate overlap_method
   overlap_method <- match.arg(overlap_method)
 
   # Check that at least one spectrum has a matching name in both objects
@@ -86,6 +86,11 @@ stitch.rspec <- function(rspec1, rspec2,
   if (length(common_cols) <= 1) {
     stop("At least one spectrum in both rspec objects must have a matching name")
   }
+  
+  # Warn if only subset is present across both rspec objects
+  if (length(common_cols) != ncol(rspec1) || length(common_cols) != ncol(rspec2)) {
+    warning("Not all spectra are present in both objects. Stitching only the common samples.")
+  }
 
   # Identify unique spectra in both objects
   unique_rspec1 <- setdiff(names(rspec1), common_cols)
diff --git a/man/stitch.Rd b/man/stitch.Rd
index 530f0f77..f986a0a5 100644
--- a/man/stitch.Rd
+++ b/man/stitch.Rd
@@ -5,7 +5,7 @@
 \alias{stitch.rspec}
 \title{Stitch together two rspec objects}
 \usage{
-stitch(rspec1, rspec2, overlap_method, interp = TRUE)
+stitch(rspec1, rspec2, overlap_method, interp)
 
 \method{stitch}{rspec}(
   rspec1,
diff --git a/tests/testthat/test-processing.R b/tests/testthat/test-processing.R
index 00f622a0..dc8d8e0b 100644
--- a/tests/testthat/test-processing.R
+++ b/tests/testthat/test-processing.R
@@ -86,6 +86,46 @@ test_that("Aggregation", {
   expect_error(aggspec(teal, by = 7), "by not a multiple")
 })
 
+test_that("Stitch", {
+  
+  # Overlapping ranges
+  r1 <- simulate_spec(wl_peak = 550, xlim = c(300, 700))
+  r2 <- simulate_spec(wl_inflect = 1100, xlim = c(650, 1200))
+  names(r1) <- names(r2) <- c('wl', 'sample_1')
+  r_stitch <- stitch(r1, r2)
+  
+  expect_equal(dim(r_stitch), c(901, 2))
+  expect_equal(r_stitch$wl, 300:1200)
+  expect_equal(summary(r_stitch)$H5, 520)
+  expect_equal(summary(r_stitch)$S6, 100)
+  expect_equal(summary(r_stitch)$B3, 100)
+
+  # Non-overlapping ranges
+  r_vis <- merge(simulate_spec(wl_peak = 550, xlim = c(300, 700)),
+                 simulate_spec(wl_peak = 550, xlim = c(300, 700)))
+  r_nir <- merge(simulate_spec(wl_inflect = 1000, xlim = c(800, 1250)),
+                 simulate_spec(wl_inflect = 1100, xlim = c(800, 1250)))
+  names(r_vis) <- c('wl', 'sample_1', 'sample_2')  # Names match, different order
+  names(r_nir) <- c('wl', 'sample_2', 'sample_1')
+  r_vis_nir <- stitch(r_vis, r_nir)
+  
+  expect_equal(dim(r_vis_nir), c(951, 3))
+  expect_equal(r_vis_nir$wl, 300:1250)
+  expect_equal(summary(r_vis_nir)$H5, c(520, 520))
+  expect_equal(summary(r_vis_nir)$S6, c(100, 100))
+  expect_equal(summary(r_vis_nir)$B3, c(100, 100))
+  
+  # Errors and warnings
+  names(r_vis) <- c('wl', 'sample_1', 'sample_2')
+  names(r_nir) <- c('wl', 'sample_3', 'sample_4')
+  expect_error(stitch(r_vis, r_nir), "matching name")
+  
+  names(r_vis) <- c('wl', 'sample_1', 'sample_2')
+  names(r_nir) <- c('wl', 'sample_1', 'sample_3')
+  expect_warning(stitch(r_vis, r_nir), "Not all spectra are present")
+  
+})
+
 test_that("Convert", {
   # Flux/irrad
   illum <- sensdata(illum = "forestshade")

From c16cb06710e647f5151d2c10eb872967991a3b34 Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@Thomass-MacBook-Air.local>
Date: Mon, 11 Sep 2023 13:39:43 +1000
Subject: [PATCH 10/12] Update news

---
 NEWS.md | 1 +
 1 file changed, 1 insertion(+)

diff --git a/NEWS.md b/NEWS.md
index f25464ab..ec9ed34e 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,7 @@
 
 ## NEW FEATURES AND SIGNIFICANT CHANGES
 
+- Added a new function `stitch.rspec()`, which facilitates the row-wise merging of spectra. For example, when combining spectra whose wavelength ranges do not overlap, or overlap only slightly (as is common when recording separate UV-VIS and NIR spectra). See `?stitch.rspec` for examples and information, as well as the handbook.
 - Added a new function `simulate_spec()`, which allows for the flexible simulation of naturalistic spectra (inc. reflectance, irradiance, radiance, absorbance). See `?simulate_spec` for examples and information, and the handbook for further discussion.
 - `plot.rspec()` now accepts a logical `labels` argument (and `labels.cex`), to control whether text labels identifying each spectrum should be added to the outer plot margins. This was previously only available, and was required, for 'stacked' plot types, but is now optional for both 'overlay' (the default) and 'stacked' spectral plots.
 - the `wlmin` and `wlmax` arguments in `summary.rspec()` are being deprecated in favour of a single `lim` argument, for consistency across functions.

From f395b89434418c94f5694862ee5a193857f63201 Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@Thomass-MacBook-Air.local>
Date: Mon, 11 Sep 2023 13:41:56 +1000
Subject: [PATCH 11/12] Damn linting

---
 R/stitch.rspec.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/stitch.rspec.R b/R/stitch.rspec.R
index 5f2c4235..ee26598d 100644
--- a/R/stitch.rspec.R
+++ b/R/stitch.rspec.R
@@ -86,7 +86,7 @@ stitch.rspec <- function(rspec1, rspec2,
   if (length(common_cols) <= 1) {
     stop("At least one spectrum in both rspec objects must have a matching name")
   }
-  
+
   # Warn if only subset is present across both rspec objects
   if (length(common_cols) != ncol(rspec1) || length(common_cols) != ncol(rspec2)) {
     warning("Not all spectra are present in both objects. Stitching only the common samples.")
@@ -152,4 +152,4 @@ stitch.rspec <- function(rspec1, rspec2,
   class(res) <- c("rspec", "data.frame")
 
   res
-}
\ No newline at end of file
+}

From 66e240df8e4e35132fe58adbecba43d01f44b885 Mon Sep 17 00:00:00 2001
From: Thomas White <twhite@10-0-0-6.tpgi.com.au>
Date: Sun, 24 Sep 2023 19:02:49 +1000
Subject: [PATCH 12/12] Update cran comments. Minor tweaks for cran

---
 cran-comments.md | 17 ++++++-----------
 inst/CITATION    | 11 +++++------
 2 files changed, 11 insertions(+), 17 deletions(-)

diff --git a/cran-comments.md b/cran-comments.md
index 43cb5a2a..1cac0c79 100644
--- a/cran-comments.md
+++ b/cran-comments.md
@@ -1,17 +1,12 @@
 ## Test environments
 
-* local macOS 12.4 install, R 4.2.1
-* macOS (on GitHub actions), R release
-* ubuntu 20.04 (on GitHub actions), R 4.1.3, R 4.2.1, R-devel
-* Windows (on GitHub actions), R 4.2.1
+* local macOS 13.4.1 install, R 4.3.1
+* macOS (on GitHub actions), R 4.3.1
+* ubuntu 22.04.3 (on GitHub actions), R 4.2.3, R 4.3.1, R-devel
+* Windows (on GitHub actions), R 4.3.1
 * win-builder (R release and devel)
-* rhub::check_for_cran()   
-* rhub::check_on_solaris()  
+* rhub::check_for_cran()     
 
 ## R CMD check results
 
-0 errors | 0 warnings | 0 note
-
-## Comments
-
-This release includes a fix for the math rendering problems identified by CRAN checks, as also kindly communicated by email from Kurt Hornik.
\ No newline at end of file
+0 errors | 0 warnings | 0 note
\ No newline at end of file
diff --git a/inst/CITATION b/inst/CITATION
index fa2ad529..af9ea539 100644
--- a/inst/CITATION
+++ b/inst/CITATION
@@ -1,13 +1,12 @@
-citHeader("To cite package pavo in publications use:")
+citHeader("To cite the package pavo in publications please use:")
 
-citEntry(
-  entry = "Article",
+bibentry(
+  bibtype = "Article",
   title = "pavo 2: new tools for the spectral and spatial analysis of colour in R",
-  author = c("Rafael Maia", "Hugo Gruson", "John A. Endler", "Thomas E. White"),
+  author = "Rafael Maia and Hugo Gruson and John A. Endler and Thomas E. White",
   journal = "Methods in Ecology and Evolution",
   year = "2019",
   volume = "10",
   number = "7",
   page = "1097-1107",
-  doi = "10.1111/2041-210X.13174",
-  textVersion = "Maia R., Gruson H., Endler J. A., White T. E. 2019. pavo 2: new tools for the spectral and spatial analysis of colour in R. Methods in Ecology and Evolution, 10(7), 1097-1107")
+  doi = "10.1111/2041-210X.13174")