feat: Add opusreader2 to hyperSpec

DESCRIPTION

@@ -18,6 +18,7 @@ Suggests:
     hyperSpec,
     opusreader2,
     RColorBrewer,
+    rlist,
     simplerspec,
     testthat (>= 3.0.0),
     tibble

NAMESPACE

@@ -3,6 +3,7 @@
 export(ChemoSpec_to_hyperSpec)
 export(hyperSpec_to_ChemoSpec)
 export(matrix_to_ChemoSpec)
+export(opusreader2_to_hyperSpec)
 export(simplerspec_to_ChemoSpec)
 export(simplerspec_to_hyperSpec)
 export(to_ChemoSpec)

R/to_hyperSpec.R

@@ -68,6 +68,127 @@ ChemoSpec_to_hyperSpec <- function(Spectra, ...) {
   )
 }
 
+#' {opusreader2} ⚪ ➡️ 🔵 {hyperSpec}
+#'
+#' Spectra are automatically grouped by wavenumbers in `data_block`, and a list
+#' is returned. The spectra must then be resampled/aligned to match a common set
+#' of wavenumbers before they can be combined.
+#'
+#' Some data will not be converted:
+#' - Spectra columns except the `spc_column`
+#' - Wavenumber columns except the `wavelength_column`
+#'
+#' @param or2 An `opusreader2_list`.
+#' @inheritParams to_hyperSpec
+#' @inheritDotParams hyperSpec::new_hyperSpec gc
+#'
+#' @returns A list of `hyperSpec::hyperSpec-class` objects.
+#'
+#' @examples
+#' data("opusreader2_list")
+#' spectra <- opusreader2_to_hyperSpec(opusreader2_list[[1]]) |> str()
+#'
+#' @export
+#' @keywords from_opusreader2 to_hyperSpec
+#' @seealso `to_hyperSpec()`
+opusreader2_to_hyperSpec <- function(
+  opusreader2_list,
+  data_block = "ab",
+  ...
+) {
+  rlang::check_installed("rlist")
+  checkmate::assert_class(opusreader2_list, c("list_opusreader2", "list"))
+
+  data_block <- data_block |> match.arg({
+    # Finds blocks which are in all files
+    blocks_tbl = opusreader2_list |> lapply(function(x) {
+      is_block = x |> lapply(function(block) {
+        !is.null(block$data)
+      })
+      is_block[which(as.logical(is_block))] |> names()
+    }) |> unlist() |> table()
+
+    blocks_tbl[which(blocks_tbl == length(opusreader2_list))] |> names()
+  })
+
+  param_blocks <- {
+    # Finds blocks which are in all files
+    params_tbl = opusreader2_list |> lapply(function(x) {
+      is_block = x |> lapply(function(block) {
+        !is.null(block$parameters)
+      })
+      is_block[which(as.logical(is_block))] |> names()
+    }) |> unlist() |> table()
+
+    params_tbl[which(params_tbl == length(opusreader2_list))] |> names()
+  }
+
+  opusreader2_list |>
+    rlist::list.group(.[[data_block]]$wavenumbers) |>
+    lapply(function(opusreader2_list) {
+      wavelength <- opusreader2_list[[1]][[data_block]]$wavenumbers
+
+      data <- {
+        data_pre = opusreader2_list |> lapply(function(x) {
+          x[param_blocks] |> lapply(function(block) {
+            block$parameters |> lapply(function(param) {
+              param$parameter_value
+            })
+          }) |> as.data.frame()
+        })
+
+        # This will drop meta data columns not included in EVERY spectra being loaded
+        data_cols_to_keep = {
+          data_cols_tbl = data_pre |> lapply(colnames) |> unlist() |> table()
+
+          cols_to_drop = data_cols_tbl[which(data_cols_tbl != length(opusreader2_list))] |> names()
+
+          if (cols_to_drop |> length() > 0) {
+            warning(paste(
+              "Dropping the following columns due to not being present in every file being loaded:\n·",
+              data_cols_tbl[which(data_cols_tbl != length(opusreader2_list))] |> names() |> paste(collapse = "\n· ")
+            ))
+          }
+
+          data_cols_tbl[which(data_cols_tbl == length(opusreader2_list))] |> names()
+        }
+
+        data_pre = data_pre |> lapply(function(df) {
+          df[, data_cols_to_keep]
+        })
+
+        do.call("rbind", data_pre)
+      }
+
+      labels <- opusreader2_list[[1]][param_blocks] |> lapply(function(block) {
+        block$parameters |> lapply(function(param) {
+          param$parameter_name_long
+        })
+      }) |> unlist() |> as.list()
+      labels$.wavelength <- "TODO"
+      labels$spc <- "TODO"
+
+      spc <- do.call(
+        "rbind",
+        opusreader2_list |> lapply(function(x) x[[data_block]]$data |> as.double())
+      )
+
+      checkmate::assert_matrix(
+        spc, "numeric",
+        nrows = opusreader2_list |> length(), ncols = wavelength |> length()
+      )
+
+      data$spc <- spc
+
+      to_hyperSpec(
+        data = data,
+        wavelength = wavelength,
+        labels = labels,
+        ...
+      )
+    })
+}
+
 #' {simplerspec} ⚪ ➡️ 🔵 {hyperSpec}
 #'
 #' Some data will not be converted:
@@ -144,7 +265,7 @@ simplerspec_to_hyperSpec <- function(
   to_hyperSpec(
     data = data,
     wavelength = wavelength,
-    labels = labels # ,
-    # ...
+    labels = labels,
+    ...
   )
 }

_pkgdown.yml

@@ -17,6 +17,9 @@ reference:
     #- has_keyword("from_hyperSpec")
     - to_hyperSpec
     - has_keyword("to_hyperSpec")
+  - title: "⚪ `opusreader2`"
+    contents:
+    - has_keyword("from_opusreader2")
   - title: "⚪ `simplerspec`"
     contents:
     - has_keyword("from_simplerspec")

man/opusreader2_to_hyperSpec.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/to_hyperSpec.R
+\name{opusreader2_to_hyperSpec}
+\alias{opusreader2_to_hyperSpec}
+\title{{opusreader2} ⚪ ➡️ 🔵 {hyperSpec}}
+\usage{
+opusreader2_to_hyperSpec(opusreader2_list, data_block = "ab", ...)
+}
+\arguments{
+\item{...}{
+  Arguments passed on to \code{\link[hyperSpec:initialize]{hyperSpec::new_hyperSpec}}
+  \describe{
+    \item{\code{gc}}{(logical) \cr Use garbage collection.
+If option \code{gc} is \code{TRUE}, the initialization will have frequent calls
+to \code{\link[base:gc]{base::gc()}}, which can help to avoid swapping or running out of
+memory. The default value of \code{gc} can be set via \code{\link[hyperSpec:hy_set_options]{hy_set_options()}}.}
+  }}
+
+\item{or2}{An \code{opusreader2_list}.}
+}
+\value{
+A list of \code{hyperSpec::hyperSpec-class} objects.
+}
+\description{
+Spectra are automatically grouped by wavenumbers in \code{data_block}, and a list
+is returned. The spectra must then be resampled/aligned to match a common set
+of wavenumbers before they can be combined.
+}
+\details{
+Some data will not be converted:
+\itemize{
+\item Spectra columns except the \code{spc_column}
+\item Wavenumber columns except the \code{wavelength_column}
+}
+}
+\examples{
+data("opusreader2_list")
+spectra <- opusreader2_to_hyperSpec(opusreader2_list[[1]]) |> str()
+
+}
+\seealso{
+\code{to_hyperSpec()}
+}
+\keyword{from_opusreader2}
+\keyword{to_hyperSpec}

tests/testthat/test-opusreader2_to_hyperSpec.R

+test_that("opusreader2 ➡️ hyperSpec: opus", {
+  skip_if_not_installed("opusreader2")
+  skip_if_not_installed("hyperSpec")
+
+  data(opusreader2_list)
+
+  skip_if_not(exists("opusreader2_list"), "Example data set required for test")
+
+  hy <- opusreader2_list |> opusreader2_to_hyperSpec()
+
+  hy |> lapply(expect_s4_class, "hyperSpec")
+})
+
+test_that("opusreader2 ➡️ hyperSpec: opus-dbg", {
+  skip_if_not_installed("opusreader2")
+  skip_if_not_installed("hyperSpec")
+
+  opusreader2_list <- suppressWarnings(opusreader2::read_opus(
+    file.path(usethis::proj_path(), "data-raw", "opus-dbg")
+  ))
+
+  hy <- opusreader2_list |> opusreader2_to_hyperSpec()
+
+  hy |> lapply(expect_s4_class, "hyperSpec")
+})