#' Parse OceanInsight converted file
#'
#' Parse OceanInsight (formerly OceanOptics) converted file.
#' <https://www.oceaninsight.com/>
#'
#' @inheritParams lr_parse_generic
#'
#' @inherit lr_parse_generic return details
#'
#' @examples
#' res_jaz <- lr_parse_jaz(system.file("testdata", "jazspec.jaz",
#' package = "lightr"))
#' head(res_jaz$data)
#' res_jaz$metadata
#'
#' res_jazirrad <- lr_parse_jazirrad(system.file("testdata", "irrad.JazIrrad",
#' package = "lightr"))
#' head(res_jazirrad$data)
#' res_jazirrad$metadata
#'
#' res_usb4000 <- lr_parse_jaz(system.file("testdata", "OOusb4000.txt",
#' package = "lightr"))
#' head(res_usb4000$data)
#' res_usb4000$metadata
#'
#' res_transmission <- lr_parse_jaz(
#' system.file("testdata", "FMNH6834.00000001.Master.Transmission",
#' package = "lightr")
#' )
#' head(res_transmission$data)
#' res_transmission$metadata
#'
#' @export
#'
lr_parse_jaz <- function(filename) {
# METADATA
content <- readLines(filename, skipNul = TRUE)
# Convert to ASCII
content <- vapply(content, iconv, to = "ASCII", sub = "", character(1))
# Can be:
# - Spectrometer
# - Spectrometers
# - Spectrometer Serial Number
# - Espectr?metros
specID <- grep("^(Spectrometers?( Serial Number)?|Espectr.metros): [[:graph:]]+$",
content,
value = TRUE)
specID <- gsub("^(Spectrometers?( Serial Number)?|Espectr.metros): ", "", specID)
author <- grep("^(User|Usuario): [[:print:]]*$", content, value = TRUE)
author <- gsub("^(User|Usuario): ", "", author)
savetime <- grep("^(Date|Fecha): .*", content, value = TRUE)
savetime <- gsub("^(Date|Fecha): ", "", savetime)
oo_savetime_regex <- "^(\\w{3} \\w{3} \\d{2} \\d{2}:\\d{2}:\\d{2}) (\\w+ )?(\\d{4})$"
tz <- ""
if (grepl(oo_savetime_regex, savetime)) {
tz <- trimws(gsub(oo_savetime_regex, "\\2", savetime))
savetime <- gsub(oo_savetime_regex, "\\1 \\3", savetime)
}
if (tz == "") {
tz <- "UTC"
}
# OceanOptics files use locale-dependent date formats but it looks like they
# are always using English for this, even when the locale is not set to
# English
orig_locale <- Sys.getlocale("LC_TIME")
on.exit(Sys.setlocale("LC_TIME", orig_locale))
Sys.setlocale("LC_TIME", "C")
savetime <- as.POSIXct(
savetime,
tz = tz,
tryFormats = c("%c", "%m-%d-%Y, %H:%M:%S")
)
savetime <- format(savetime, tz = "UTC")
specmodel <- NA_character_
# For those, be careful, the line ends with '(specID)' so no $
int <- grep("^(Integration Time|Tiempo de integraci.n) (.+): [[:digit:]]+", content, value = TRUE)
inttime <- gsub("^(Integration Time|Tiempo de integraci.n) \\(.+\\): ([[:digit:]]+).*", "\\2", int)
inttime_unit <- gsub("^(Integration Time|Tiempo de integraci.n) \\((.+)\\):.*", "\\2", int)
if (identical(unname(inttime_unit), "usec")) {
inttime <- as.numeric(inttime) / 1000
}
average <- grep("^(Spectra Averaged|Promedio de Espectros Hechos un): [[:digit:]]+", content, value = TRUE)
average <- gsub("^(Spectra Averaged|Promedio de Espectros Hechos un): ([[:digit:]]+).*", "\\2", average)
boxcar <- grep("^(Boxcar Smoothing|El Alisar Del Furg.n): [[:digit:]]+", content, value = TRUE)
boxcar <- gsub("^(Boxcar Smoothing|El Alisar Del Furg.n): ([[:digit:]]+).*", "\\2", boxcar)
dark_inttime <- white_inttime <- scope_inttime <- inttime
dark_average <- white_average <- scope_average <- average
dark_boxcar <- white_boxcar <- scope_boxcar <- boxcar
metadata <- c(author, savetime, specmodel, specID,
dark_inttime, white_inttime, scope_inttime,
dark_average, white_average, scope_average,
dark_boxcar, white_boxcar, scope_boxcar)
# SPECTRA
data_start <- grep(
"^(>>>>>Begin (Processed )?Spectral Data<<<<<|>>>>> Comienza Data<<<<< Espectral Procesado Del EL)$",
content
)
data_end <- grep(
"^(>>>>>End (Processed )?Spectral Data<<<<<|>>>>> Data<<<<< Espectral Procesado Extremo)$",
content
)
# Some files are missing the ending "tag". Let's then assume that data go to
# the end of file.
if (length(data_end) == 0) {
data_end <- length(content)
}
# Some files have an extra header for the data, some don't...
# If they do, it looks like this header will always start with W
has_header <- startsWith(content[data_start + 1], "W")
data <- content[seq(ifelse(has_header, data_start + 2, data_start + 1),
data_end - 1)]
# Depending on the user locale, some files might use ',' as a decimal sep
data <- gsub(",", ".", data, fixed = TRUE)
data <- do.call(rbind, strsplit(data, "\t", fixed = TRUE))
if (has_header) {
colnames(data) <- strsplit(content[data_start + 1], "\t", fixed = TRUE)[[1]]
} else {
colnames(data) <- c("W", "P")
}
storage.mode(data) <- "numeric"
cornames <- c("wl" = "W",
"dark" = "D",
"white" = "R",
"scope" = "S",
"processed" = "P")
data_final <- setNames(
as.data.frame(matrix(NA_real_, nrow = nrow(data), ncol = 5)),
names(cornames)
)
data_final[match(colnames(data), cornames)] <- data
return(list("data" = data_final, "metadata" = unname(metadata)))
}
#' @rdname lr_parse_jaz
#'
#' @export
#'
lr_parse_jazirrad <- lr_parse_jaz
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.