Pass parser arguments as ...

DESCRIPTION

@@ -36,7 +36,7 @@ Suggests:
 URL: https://docs.ropensci.org/lightr/, https://github.com/ropensci/lightr
 BugReports: https://github.com/ropensci/lightr/issues
 License: GPL (>=2)
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.3
 Roxygen: list(markdown = TRUE)
 Language: en-GB
 VignetteBuilder: knitr

NAMESPACE

@@ -4,6 +4,7 @@ export(lr_convert_tocsv)
 export(lr_get_metadata)
 export(lr_get_spec)
 export(lr_parse_abs)
+export(lr_parse_csv)
 export(lr_parse_generic)
 export(lr_parse_irr8)
 export(lr_parse_jaz)
@@ -24,6 +25,7 @@ importFrom(stats,approx)
 importFrom(stats,setNames)
 importFrom(tools,file_ext)
 importFrom(tools,file_path_sans_ext)
+importFrom(utils,read.csv)
 importFrom(utils,write.csv)
 importFrom(xml2,read_xml)
 importFrom(xml2,xml_double)

R/convert_tocsv.R

@@ -23,10 +23,10 @@
 #' @importFrom progressr with_progress progressor
 #'
 #' @export
-lr_convert_tocsv <- function(where = NULL, ext = "txt", decimal = ".",
-                             sep = NULL, subdir = FALSE,
+lr_convert_tocsv <- function(where = NULL, ext = "txt", subdir = FALSE,
                              ignore.case = TRUE, overwrite = FALSE,
-                             metadata = TRUE) {
+                             metadata = TRUE,
+                             ...) {
 
   if (is.null(where)) {
     warning("Please provide a valid location to read and write the files.",
@@ -59,8 +59,9 @@ lr_convert_tocsv <- function(where = NULL, ext = "txt", decimal = ".",
       p()
       tryCatch(
         spec2csv_single(
-          x, decimal = decimal, sep = sep,
-          overwrite = overwrite, metadata = metadata
+          x,
+          overwrite = overwrite, metadata = metadata,
+          ...
         ),
         error = function(e) {
           warning(conditionMessage(e))
@@ -90,9 +91,9 @@ lr_convert_tocsv <- function(where = NULL, ext = "txt", decimal = ".",
 }
 
 #' @noRd
-spec2csv_single <- function(filename, decimal, sep, overwrite, metadata) {
+spec2csv_single <- function(filename, overwrite, metadata, ...) {
 
-  exported <- dispatch_parser(filename, decimal = decimal, sep = sep)
+  exported <- dispatch_parser(filename, ...)
 
   csv_name_data <- paste0(file_path_sans_ext(filename), ".csv")
   csv_name_metadata <- paste0(file_path_sans_ext(filename), "_metadata.csv")

R/dispatch_parser.R

@@ -8,25 +8,25 @@
 #'
 #' @keywords internal
 #'
-dispatch_parser <- function(filename, decimal = ".", sep = NULL,
-                            specnum = 1L) {
+dispatch_parser <- function(filename, ...) {
 
   switch(
     tolower(file_ext(filename)),
-    procspec = lr_parse_procspec(filename),
-    abs      = lr_parse_abs(filename),
-    roh      = lr_parse_roh(filename),
-    trm      = lr_parse_trm(filename),
-    trt      = lr_parse_trt(filename),
-    ttt      = lr_parse_ttt(filename),
-    rfl8     = lr_parse_rfl8(filename, specnum),
-    raw8     = lr_parse_raw8(filename, specnum),
-    irr8     = lr_parse_irr8(filename, specnum),
-    jdx      = lr_parse_jdx(filename),
-    jaz      = lr_parse_jaz(filename),
-    jazirrad = lr_parse_jazirrad(filename),
-    spc      = lr_parse_spc(filename),
-    lr_parse_generic(filename, decimal = decimal, sep = sep)
+    procspec = lr_parse_procspec(filename, ...),
+    abs      = lr_parse_abs(filename, ...),
+    roh      = lr_parse_roh(filename, ...),
+    trm      = lr_parse_trm(filename, ...),
+    trt      = lr_parse_trt(filename, ...),
+    ttt      = lr_parse_ttt(filename, ...),
+    rfl8     = lr_parse_rfl8(filename, ...),
+    raw8     = lr_parse_raw8(filename, ...),
+    irr8     = lr_parse_irr8(filename, ...),
+    jdx      = lr_parse_jdx(filename, ...),
+    jaz      = lr_parse_jaz(filename, ...),
+    jazirrad = lr_parse_jazirrad(filename, ...),
+    spc      = lr_parse_spc(filename, ...),
+    csv      = lr_parse_csv(filename, ...),
+    lr_parse_generic(filename, ...)
   )
 
 }

R/get_metadata.R

@@ -43,9 +43,10 @@
 #'                 ext = "ProcSpec")
 #' }
 
-lr_get_metadata <- function(where = getwd(), ext = "ProcSpec", sep = NULL,
+lr_get_metadata <- function(where = getwd(), ext = "ProcSpec",
                             subdir = FALSE, subdir.names = FALSE,
-                            ignore.case = TRUE) {
+                            ignore.case = TRUE,
+                            ...) {
 
   extension <- paste0("\\.", ext, "$", collapse = "|")
 
@@ -75,9 +76,9 @@ lr_get_metadata <- function(where = getwd(), ext = "ProcSpec", sep = NULL,
 
   message(nb_files, " files found; importing metadata:")
 
-  gmd <- function(ff) {
+  gmd <- function(ff, ...) {
 
-    dispatch_parser(ff, sep = sep)[[2]]
+    dispatch_parser(ff, ...)[[2]]
 
   }
 
@@ -86,7 +87,7 @@ lr_get_metadata <- function(where = getwd(), ext = "ProcSpec", sep = NULL,
     tmp <- future_lapply(files, function(x) {
       p()
       tryCatch(
-        gmd(x),
+        gmd(x, ...),
         error = function(e) {
           warning(conditionMessage(e))
           return(NULL)

R/get_spec.R

@@ -3,8 +3,6 @@
 #' Finds and imports reflectance/transmittance/absorbance data from spectra
 #' files in a given location.
 #'
-#' @inheritParams lr_parse_generic
-#'
 #' @param where Folder in which files are located (defaults to current working
 #' directory).
 #' @param ext File extension to be searched for, without the "." (defaults to
@@ -21,6 +19,7 @@
 #' @param interpolate Boolean indicated whether spectral data should be
 #' interpolated and pruned at every nanometre. Note that this option can only
 #' work if all input data samples the same wavelengths. Defaults to `TRUE`.
+#' @param ... Arguments passed to individual parsers.
 #'
 #' @details
 #' You can customise the type of parallel processing used by this function with
@@ -46,9 +45,9 @@
 #' head(spcs)
 #'
 lr_get_spec <- function(where = getwd(), ext = "txt", lim = c(300, 700),
-                        decimal = ".", sep = NULL, subdir = FALSE,
-                        subdir.names = FALSE, ignore.case = TRUE,
-                        interpolate = TRUE) {
+                        subdir = FALSE, subdir.names = FALSE,
+                        ignore.case = TRUE, interpolate = TRUE,
+                        ...) {
 
   extension <- paste0("\\.", ext, "$", collapse = "|")
 
@@ -81,12 +80,12 @@ lr_get_spec <- function(where = getwd(), ext = "txt", lim = c(300, 700),
   message(nb_files, " files found; importing spectra:")
 
   if (!interpolate) {
-    gsp <- function(f) {
-      dispatch_parser(f, decimal = decimal, sep = sep)[[1]]
+    gsp <- function(f, ...) {
+      dispatch_parser(f, ...)[[1]]
     }
   } else {
-    gsp <- function(f) {
-      df <- dispatch_parser(f, decimal = decimal, sep = sep)[[1]]
+    gsp <- function(f, ...) {
+      df <- dispatch_parser(f, ...)[[1]]
 
       # Trim now because otherwise, approx() can fill the region of interest
       # with bogus data (e.g., if the data is complete between 200-300nm and
@@ -111,7 +110,7 @@ lr_get_spec <- function(where = getwd(), ext = "txt", lim = c(300, 700),
     tmp <- future_lapply(files, function(x) {
       p()
       tryCatch(
-        gsp(x),
+        gsp(x, ...),
         error = function(e) {
           warning(conditionMessage(e))
           return(NULL)

R/parse_avantes_binary.R

@@ -26,7 +26,7 @@
 #'
 #' @export
 #'
-lr_parse_trm <- function(filename) {
+lr_parse_trm <- function(filename, ...) {
 
   # Modified from a matlab script by:
   # Copyright: (cc-by) Kotya Karapetyan, 2011.
@@ -181,7 +181,7 @@ lr_parse_roh <- lr_parse_trm
 #' head(res_rfl8_2$data)
 #' res_rfl8_2$metadata
 #'
-lr_parse_rfl8 <- function(filename, specnum = 1L) {
+lr_parse_rfl8 <- function(filename, specnum = 1L, ...) {
 
   # File structure information provided courtesy of Avantes
 

R/parse_avantes_converted.R

@@ -22,7 +22,7 @@
 #'
 #' @export
 #'
-lr_parse_ttt <- function(filename) {
+lr_parse_ttt <- function(filename, ...) {
 
   # FIXME: grep to find appropriate lines instead of relying on fixed indices
 

R/parse_csv.R

@@ -0,0 +1,34 @@
+#' Parse csv files
+#'
+#' @inheritParams lr_parse_generic
+#'
+#' @inherit lr_parse_generic return details
+#'
+#' @examples
+#' res_csv <- lr_parse_csv(
+#'   system.file("testdata", "spec.csv", package = "lightr"),
+#' )
+#' head(res_csv$data)
+#' # No metadata is extracted with this parser
+#' res_csv$metadata
+#'
+#' @importFrom utils read.csv
+#'
+#' @export
+#'
+
+lr_parse_csv <- function(filename, decimal = ".", sep = ",", ...) {
+
+  data <- setNames(
+    read.csv(filename, dec = decimal, sep = sep, header = FALSE),
+    c("wl", "processed")
+  )
+  data$dark <- data$white <- data$scope <- NA_real_
+
+  # Reorder columns
+  data <- data[, c("wl", "dark", "white", "scope", "processed")]
+
+  metadata <- rep(NA_character_, 13)
+
+  return(list("data" = data, "metadata" = metadata))
+}

R/parse_generic.R

@@ -5,6 +5,7 @@
 #' (defaults to `.`).
 #' @param sep Column delimiting characters to be considered in addition to the
 #' default (which are: tab, space, and ";")
+#' @param ... ignored
 #'
 #' @return A named list of two elements:
 #'   * `data`: a dataframe with columns "wl", "dark", "white", "scope" and
@@ -49,7 +50,7 @@
 #' @export
 #'
 
-lr_parse_generic <- function(filename, decimal = ".", sep = NULL) {
+lr_parse_generic <- function(filename, decimal = ".", sep = NULL, ...) {
 
   seps <- paste0(c("[[:blank:]]", sep), collapse = "|\\")
 

R/parse_jdx.R

@@ -23,7 +23,7 @@
 #'
 #' @export
 #'
-lr_parse_jdx <- function(filename) {
+lr_parse_jdx <- function(filename, ...) {
   content <- readLines(filename)
   author <- grep("^##OWNER=", content, value = TRUE)
   author <- gsub("^##OWNER= ", "", author)[1]

R/parse_oceanoptics_converted.R

@@ -32,7 +32,7 @@
 #'
 #' @export
 #'
-lr_parse_jaz <- function(filename) {
+lr_parse_jaz <- function(filename, ...) {
 
   # METADATA
 

R/parse_procspec.R

@@ -20,7 +20,7 @@
 #'
 #' @export
 #'
-lr_parse_procspec <- function(filename) {
+lr_parse_procspec <- function(filename, ...) {
   # We let R find the suitable tmp folder to extract files
   tmp <- tempdir()
 

R/parse_spc.R

@@ -19,7 +19,7 @@
 #' @export
 #'
 
-lr_parse_spc <- function(filename) {
+lr_parse_spc <- function(filename, ...) {
 
   f <- file(filename, "rb")
   on.exit(close(f))