.gitignore

@@ -0,0 +1,49 @@
+# History files
+.Rhistory
+.Rapp.history
+
+# Session Data files
+.RData
+
+# User-specific files
+.Ruserdata
+
+# Example code in package build process
+*-Ex.R
+
+# Output files from R CMD build
+/*.tar.gz
+
+# Output files from R CMD check
+/*.Rcheck/
+
+# RStudio files
+.Rproj.user/
+
+# produced vignettes
+vignettes/*.html
+vignettes/*.pdf
+
+# OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
+.httr-oauth
+
+# knitr and R markdown default cache directories
+*_cache/
+/cache/
+
+# Temporary files created by R markdown
+*.utf8.md
+*.knit.md
+
+# R Environment Variables
+.Renviron
+
+# pkgdown site
+docs/
+
+# translation temp files
+po/*~
+
+# Folders
+DPT/
+OPUS*/

AutoConversion.cmd

@@ -1,2 +0,0 @@
-Rscript OpusData.R Rng02_Rng2630_01.0
-pause

OpusData.R

@@ -1,35 +1,28 @@
 #!/usr/bin/env Rscript
 
-# Package installation, execute once
-#install.packages("remotes")
-#remotes::install_github("philipp-baumann/simplerspec")
-
-# Attach package to workspace, execute with every new session
-#library("simplerspec")
-rm(list = ls())
-setwd("C:/Users/harte/Dokumente/git/opus-data-r")
-
+# Attach packages to workspace, execute with every new session
 source("ReadOpus.R")
 
 # Determine file path
-path <- paste(getwd(), "/OPUS/", sep = "")
-file_name <- "Rng02_Rng2630_01.0"
-file_path <- paste(path, file_name, sep = "")
+file_path <- commandArgs(trailingOnly = TRUE)[1]
 
 # Convert opus binary file into dataframe
-data <- read_opus_univ(file_path)
+tryCatch(data <- read_opus_univ(file_path, 5), error=function(e){
+		print("Failed converting OPUS file")
+		exit()
+	}
+)
 
-# Set working directory to path where the result file should appear
-setwd(paste(path, "..\\DPT", sep = ""))
+# Determine target, where the result should appear
+target_path <- paste0("/tmp/", sub('.*\\/', "", file_path))
 
-# Replace last "." with "_", add ".DPT" and create file
-file_name <- paste(sub(".([^.]*)$", "_\\1", file_name), ".DPT", sep = "")
-file.create(file_name)
+# Create file
+file.create(target_path)
 
 # Fill file with dataframe
-write.table(data, file_name, row.names = FALSE, col.names = FALSE, sep = ",")
-
-
-
+write.table(data, target_path, row.names = FALSE, col.names = FALSE, sep = ",")
+
+# Call python script
+system(paste('./transfer-data.sh', target_path))
 
 

ReadOpus.R

@@ -1,6 +1,6 @@
 #Code adapted from github.com/philipp-baumann/simplerspec
 
-read_opus_univ <- function(file_path){
+read_opus_univ <- function(file_path, limit){
    
    `%do%` <- foreach::`%do%`
    extract <- 'spc'
@@ -13,7 +13,6 @@ read_opus_univ <- function(file_path){
    
    try({
       
-      # file_path <- "data/soilspec_background/yamsys_bg_gold/BF_lo_15_soil_cal.0"
       # Read entire content of file as bytes
       pa <- hexView::readRaw(file_path, offset = 0,
                              nbytes = file.info(file_path)$size, human = "char",
@@ -409,8 +408,9 @@ read_opus_univ <- function(file_path){
       }
       
       ## Allocate and return data from spectra in output list (out) ==============
-      out <- data.frame(wavenumbers[["spc"]], spc[['spc']], row.names = NULL)
+      out <- data.frame(round(wavenumbers[['spc']], limit), round(spc[['spc']], limit), row.names = NULL)
       # Return spectra data and metadata contained as elements in list out
       out
    }) # closes try() function
 }
+

ReadOpus_complete.R

@@ -1,619 +0,0 @@
-read_opus_univ <- function(file_path){
-   
-   `%do%` <- foreach::`%do%`
-   extract <- 'spc'
- 
-  # Avoid `R CMD check` NOTE: no visible binding for global variable ...
-   x <- y <- i <- npt <- NULL
-   if (!file.exists(file_path)){
-     stop(paste0("File does not exist"))
-   }
-   
-   try({
-     
-     # file_path <- "data/soilspec_background/yamsys_bg_gold/BF_lo_15_soil_cal.0"
-     # Read entire content of file as bytes
-     pa <- hexView::readRaw(file_path, offset = 0,
-                            nbytes = file.info(file_path)$size, human = "char",
-                            size = 1, endian = "little")
-     # Get raw vector
-     pr <- pa$fileRaw
-     
-     # Read byte positions for selected 3 letter strings that flag important
-     # spectral information -----------------------------------------------------
-     
-     # Get positions of "END" strings
-     end <- grepRaw("END", pr, all = TRUE) + 11
-     # Get all positions of "NPT" (number of points) string
-     npt_all <- grepRaw("NPT", pr, all = TRUE) + 3
-     # Get frequency of first (FXV) and last point (LXV) positions
-     fxv_all <- grepRaw("FXV", pr, all = TRUE) + 7
-     lxv_all <- grepRaw("LXV", pr, all = TRUE) + 7
-     
-     # For some files, the number of positions where "FXV" and "LXV" occur
-     # are not equal, e.g. for the file in
-     # data/soilspec_esal_bin/BF_mo_01_soil_cal.0 ; As a consequence, the
-     # fist and last point numbers (e.g. wavenumber or points for interferograms)
-     # are not correctly read. This results in an error when trying to calculate
-     # the wavenumbers; The below code is a quick and dirty fix to remove
-     # FXV values that don't have LXV values and vice versa
-     # (difference between "LXV" and "FXV" for a spectral data block
-     # should be 16) ------------------------------------------------------------
-     if (length(fxv_all) > length(lxv_all)) {
-       diff_lxv_fxv <- lapply(lxv_all, function(x) x - fxv_all)
-       # Return list of logical vectors indicating whether difference of fxv
-       # and lxv is 16 (distance of 16 bytes)
-       lxv_fxv_min <- lapply(diff_lxv_fxv, function(x) x == 16)
-       fxv_list <- rep(list(fxv_all), length(fxv_all))
-       fxv_all <- foreach::foreach(
-         x = 1:length(fxv_list), y = 1:length(lxv_fxv_min),
-         .combine = 'c') %do% {
-           fxv_list[[x]][lxv_fxv_min[[y]]]
-         }
-     }
-     
-     if (length(lxv_all) > length(fxv_all)) {
-       diff_fxv_lxv <- lapply(fxv_all, function(x) x - lxv_all)
-       # Return list of logical vectors indicating whether difference of fxv
-       # and lxv is 16 (distance of 16 bytes)
-       fxv_lxv_min <- lapply(diff_fxv_lxv, function(x) x == -16)
-       lxv_list <- rep(list(lxv_all), length(lxv_all))
-       lxv_all <- foreach::foreach(
-         x = 1:length(lxv_list), y = 1:length(fxv_lxv_min),
-         .combine = 'c') %do% {
-           lxv_list[[x]][fxv_lxv_min[[y]]]
-         }
-     }
-     
-     # Reduce size of npt_all -----------------------------------------------------
-     # Some files have an extra "NPT" string without FXV, LXV, and spectral block
-     if (length(npt_all) != length(fxv_all)) {
-       diff_npt_fxv <- lapply(npt_all, function(x) fxv_all - x)
-       min_bigger0_smallerequal40 <- lapply(diff_npt_fxv, function(x) {
-         which_min_bigger0 <- x == min(x[x > 0])
-         which_smallerequal40 <- x <= 40
-         which_min_bigger0 & which_smallerequal40
-       }
-       )
-       which_npt_valid <- sapply(min_bigger0_smallerequal40,
-                                 function(x) any(x == TRUE))
-       npt_all <- npt_all[which_npt_valid]
-     }
-     
-     # --------------------------------------------------------------------------
-     
-     ## Read basic spectral information =========================================
-     
-     # Read all number of points (NPT) at once
-     NPT <- foreach::foreach(npt = npt_all, .combine = 'c') %do% {
-       hexView::readRaw(
-         file_path, offset = npt, nbytes = 12, human = "int", size = 4)[[5]][2]
-     }
-     
-     # Specific error for file: <"data/soilspec_eth_bin/CI_tb_05_soil_cal.2">
-     # "Invalid number of bytes" when trying to read spectra
-     # -> Reason: NPT at position 1 is 995236000 !!!
-     # Omit this entry in NPT and corresponding byte position in npt_all
-     # Quick fix ----------------------------------------------------------------
-     npt_all <- npt_all[NPT < 40000]
-     NPT <- NPT[NPT < 40000]
-     # --------------------------------------------------------------------------
-     
-     # Figure out how many spectral blocks exist and select final spectra
-     # positions; end_spc is vector of offsets where spectra start
-     if (length(end) == 1) {
-       end_spc <- end
-     } else {
-       end_spc <- end[diff(end) > 4 * min(NPT)]
-     }
-     
-     ## Find final spectra information block positions
-     ## that belong to spectra data =============================================
-     
-     # Save positions that contain possible spectra data block
-     # standard parameters
-     spc_param_list <- list(
-       'npt' = npt_all,
-       'fxv' = fxv_all,
-       'lxv' = lxv_all
-     )
-     
-     ## Return list of final parameters corresponding to data blocks that contain
-     ## spectra, elements are npt (number of points),
-     ## fxv (frequency of first point) and lxv (frequency of last point);
-     ## returned values represent byte positions in the file where spectra
-     ## parameters are stored. --------------------------------------------------
-     return_spc_param <- function(end_spc, spc_param_list) {
-       
-       # Difference between any NPT position vector elements end_spc element
-       # (end_spc[i] is a scalar, constant value at iteration i)
-       diff_l <- lapply(end_spc, function(x) npt_all - x)
-       # Test of any vector in list contains -164 (returns list of vectors
-       # TRUE or FALSE)
-       isminus164 <- lapply(diff_l, function(x) x == -164)
-       
-       # Find minimum positive difference within each list
-       if (length(diff_l) == 1) {sel_min <- list(TRUE)} else {
-         sel_min <- lapply(diff_l,
-                           function(x) {if (any(x > 0)) {x == min(x[x > 0])} else {x == -164}})
-       }
-       # Set FALSE repeated vector in sel_min element where TRUE positions are
-       # duplicated
-       which_elem_dupl <- which(duplicated(sapply(sel_min, which)))
-       if (length(which_elem_dupl) > 1) {
-         sel_min[which_elem_dupl] <- NULL
-         # Reduce end_spc with duplicated elements
-         end_spc <- end_spc[- which_elem_dupl]
-       }
-       
-       # Select minimum difference NPT position for each END position
-       npt_min <- Map(function(x, y) x[y],
-                      rep(list(npt_all), length(end_spc)), sel_min)
-       npt_min <- Filter(length, npt_min)
-       
-       # Select spectra parameters that immediately follow END positions before
-       # corresponding spectra
-       param_min <- foreach::foreach(i = 1:length(spc_param_list),
-                                     .final = function(i) setNames(i, names(spc_param_list))) %do% {
-                                       Map(function(x, y) x[y],
-                                           rep(list(spc_param_list[[i]]), length(end_spc)), sel_min)
-                                     }
-       
-       # Test if any difference in list is -164
-       if (any(unlist(isminus164) == TRUE)) {
-         # Find all list element that contain TRUE in logical vector
-         minus164 <- lapply(isminus164, function(x) Find(isTRUE, x))
-         # Return element position of last TRUE in list
-         where <- function(f, x) {
-           vapply(x, f, logical(1))
-         }
-         last_minus164 <- Position(isTRUE, where(isTRUE, minus164),
-                                   right = TRUE)
-         # Replace positions in parameter list are at positions of last
-         # -164 difference between end_spc element and NPT position
-         param_min <- foreach::foreach(i = 1:length(spc_param_list),
-                                       .final = function(i) setNames(i, names(spc_param_list))) %do% {
-                                         param_min[[i]][[last_minus164]] <-
-                                           spc_param_list[[i]][isminus164[[last_minus164]]]
-                                         param_min[[i]]
-                                       }
-       }
-       # Return list of final parameters corresponding to data blocks that
-       # contain spectra
-       param_spc <- lapply(param_min, unlist)
-       param_spc$end_spc <- end_spc
-       param_spc
-     }
-     # Save spectra parameter list
-     param_spc <- return_spc_param(end_spc, spc_param_list)
-     
-     # Create individual vectors containing spectra parameters
-     npt_spc <- param_spc[["npt"]]
-     fxv_spc <- param_spc[["fxv"]]
-     lxv_spc <- param_spc[["lxv"]]
-     end_spc <- param_spc[["end_spc"]]
-     
-     # Read number of points corresponding to spectra in file -------------------
-     
-     NPT_spc <- foreach::foreach(i = 1:length(npt_spc), .combine = 'c') %do% {
-       hexView::readRaw(
-         file_path, offset = npt_spc[i],
-         nbytes = 12, human = "int", size = 4)[[5]][2]
-     }
-     
-     # Delete NPT with negative signs
-     NPT_spc <- NPT_spc[NPT_spc > 0]
-     
-     ## Read all spectra ========================================================
-     
-     spc <- Map(function(end, NPT) hexView::readRaw(file_path, width = NULL,
-                                                    offset = end - 4, nbytes = NPT * 4,
-                                                    human = "real", size = 4, endian = "little")[[5]], end_spc, NPT_spc)
-     
-     # Read FXV and LXV and calculate wavenumbers  ------------------------------
-     
-     FXV_spc <- foreach::foreach(i = 1:length(fxv_spc), .combine = 'c') %do% {
-       hexView::readRaw(file_path,
-                        offset = fxv_spc[i], nbytes = 16, human = "real", size = 8)[[5]][1]
-     }
-     LXV_spc <- foreach::foreach(i = 1:length(lxv_spc), .combine = 'c') %do% {
-       hexView::readRaw(file_path,
-                        offset = lxv_spc[i], nbytes = 16, human = "real", size = 8)[[5]][1]
-     }
-     # Calculate wavenumbers
-     wavenumbers <- foreach::foreach(i = 1:length(FXV_spc)) %do% {
-       rev(seq(LXV_spc[i], FXV_spc[i],
-               (FXV_spc[i] - LXV_spc[i]) / (NPT_spc[i] - 1)))
-     }
-     
-     ## Assigning list of intially read spectra depending on block type =========
-     
-     # Assign an index name to the spectra and parameters for reading
-     names(end_spc) <- paste0("idx", 1:length(end_spc))
-     names(spc) <- paste0("idx", 1:length(spc))
-     names(NPT_spc) <- paste0("idx", 1:length(NPT_spc))
-     names(FXV_spc) <- paste0("idx", 1:length(FXV_spc))
-     names(wavenumbers) <- paste0("idx", 1:length(wavenumbers))
-     
-     # Check if elements in FXV_spc (frequency of first point) are equal to 0;
-     # these are interferogram spectra ------------------------------------------
-     which_Ig <- FXV_spc[which(FXV_spc == 0)]
-     Ig_assigned <- if (length(which_Ig) == 0) {
-       NULL
-     } else if (length(which_Ig) == 1) {
-       list(
-         spc_idx = names(which_Ig),
-         spc_code = "IgSm"
-       )
-     } else if (length(which_Ig) == 3) {
-       list(
-         spc_idx = names(which_Ig)[c(1, 3)],
-         spc_code = c("IgSm", "IgRf")
-       )
-     } else {
-       list(
-         spc_idx = names(which_Ig),
-         spc_code = c("IgSm", "IgRf")
-       )
-     }
-     
-     na_assigned <- list(
-       spc_idx = NULL,
-       spc_code = NULL
-     )
-     if (length(which_Ig) == 3) {
-       # Assign duplicated interferogram spectrum to 'not available' assigned
-       na_assigned <- list(
-         spc_idx = names(which_Ig)[2],
-         spc_code = NA
-       )
-     }
-     
-     # Remove NA assigned spectra in spc list -------------------------------------
-     if (!is.null(na_assigned$spc_idx)) {
-       spc[na_assigned$spc_idx] <- NULL
-       # Remove wavenumbers with NA assigned spectra in spc list
-       wavenumbers[na_assigned$spc_idx] <- NULL
-     }
-     
-     # Assign single channel spectra if present in file -------------------------
-     # Return idx (index names) of all remaining spectra that are not
-     # interferograms
-     notIg <- names(spc)[!names(spc) %in%
-                           c(Ig_assigned$spc_idx, na_assigned$spc_idx)]
-     # Check if the MIR range was measured
-     wavenumbers_mir <- lapply(names(wavenumbers[notIg]),
-                               function(i) spc[[i]][wavenumbers[notIg][[i]] < 2392 &
-                                                      wavenumbers[notIg][[i]] > 2358])
-     is_mir <- any(sapply(wavenumbers_mir, function(x) length(x) != 0))
-     if (isTRUE(is_mir)) {
-       # Calculate peak ratio for absorbance at around 2392 cm^(-1)
-       # and 2358 cm^(-1)
-       peak_ratio <- lapply(
-         lapply(names(wavenumbers[notIg]),
-                function(i) spc[[i]][wavenumbers[notIg][[i]] < 2392 &
-                                       wavenumbers[notIg][[i]] > 2358]),
-         function(j) j[[1]] / j[[length(j)]]
-       )
-       names(peak_ratio) <- names(spc[notIg])
-       # Single channel (Sc) assignment list
-       which_Sc <- names(which(peak_ratio > 2))
-     } else {
-       peak_ratio <- lapply(
-         lapply(names(wavenumbers[notIg]),
-                function(i) spc[[i]][wavenumbers[notIg][[i]] < 5340 &
-                                       wavenumbers[notIg][[i]] > 5318]),
-         function(j) j[[1]] / j[[length(j)]]
-       )
-       names(peak_ratio) <- names(spc[notIg])
-       # Single channel (Sc) assignment list
-       which_Sc <- names(which(peak_ratio < 0.9))
-     }
-     
-     # Check for single channel, exclude spectral blocks already assigned to
-     # interferograms
-     Sc_assigned <- if (length(which_Sc) == 0) {
-       NULL
-     } else if (length(which_Sc) == 1) {
-       list(
-         spc_idx = which_Sc,
-         spc_code = "ScSm"
-       )
-     } else {
-       list(
-         spc_idx = which_Sc,
-         spc_code = c("ScSm", "ScRf")
-       )
-     }
-     # Assign corrected and uncorrected (if present) ----------------------------
-     # AB spectra list
-     which_AB <- names(spc)[!names(spc) %in%
-                              c(Ig_assigned[["spc_idx"]], na_assigned[["spc_idx"]],
-                                Sc_assigned[["spc_idx"]])]
-     AB_assigned <- if (length(which_AB) == 1) {
-       list(
-         spc_idx = which_AB,
-         spc_code = "spc"
-       )
-     } else {
-       list(
-         spc_idx = which_AB,
-         spc_code = c("spc_nocomp", "spc")
-       )
-     }
-     
-     # Read result spectrum with new offset (no `-4`) when atmospheric
-     # compensation was done by the OPUS software; replace the spectrum position
-     # with index name idx that corresponds to final spectrum after atmospheric
-     # compensation; OPUS files from particular spectrometers/OPUS software
-     # versions do still need the same offset end_spc[[spc_idx]] - 4 as the other
-     # spectra types; new argument atm_comp_minus4offset (default FALSE) is a
-     # quick fix to read files with different offsets after atmospheric
-     # compensation -------------------------------------------------------------
-     if (length(which_AB) == 2 && !atm_comp_minus4offset) {
-       spc[[which_AB[length(which_AB)]]] <-
-         hexView::readRaw(file_path, width = NULL,
-                          offset = end_spc[which_AB[length(which_AB)]],
-                          nbytes = NPT_spc[which_AB[length(which_AB)]] * 4,
-                          human = "real", size = 4, endian = "little")[[5]]
-     }
-     
-     # Assign spectra type for final spectra in element names of spc list -------
-     # Combine spectral assignments lists
-     list_assigned <- list(
-       'Ig' = Ig_assigned,
-       'Sc' = Sc_assigned,
-       'AB' = AB_assigned
-     )
-     # Transpose spectra assignment list, first remove NULL elements in list
-     list_assigned_t <- purrr::transpose(
-       Filter(Negate(function(x) is.null(unlist(x))), list_assigned)
-     )
-     # Save spectra index (spc_idx) and spectra code (spc_code)
-     # in character vector
-     spc_idx <- unlist(list_assigned_t[["spc_idx"]])
-     spc_code <- unlist(list_assigned_t[["spc_code"]])
-     # Order spc_idx from 1 to n spectra (n = length of end_spc)
-     order_spc <- as.numeric(
-       sub(".*idx", "", unlist(list_assigned_t[["spc_idx"]])))
-     spc_type <- spc_code[order(order_spc)]
-     # Set spectrum type as element names of spectra list (spc)
-     names(spc) <- spc_type
-     # Set spectrum type in wavenumbers list
-     names(wavenumbers) <- spc_type
-     
-     # Read with new offset when first value of
-     # ScSm  single channel sample spectrumspectrum is 0 and replace previous ---
-     if (any(names(spc) %in% "ScSm" & spc[["ScSm"]][1] == 0)) {
-       spc[["ScSm"]] <-
-         hexView::readRaw(file_path, width = NULL,
-                          offset = end_spc[Sc_assigned$spc_idx[Sc_assigned$spc_code == "ScSm"]],
-                          nbytes = NPT_spc[Sc_assigned$spc_idx[Sc_assigned$spc_code == "ScSm"]]
-                          * 4,
-                          human = "real", size = 4, endian = "little")[[5]]
-     }
-     
-     ## Get additional parameters from OPUS binary file =========================
-     
-     # Instrument parameters ----------------------------------------------------
-     ins <- grepRaw("INS", pr, all = TRUE) # Instrument type
-     INS <- hexView::blockString(
-       hexView::readRaw(
-         file_path, offset = ins[length(ins)] + 7,
-         nbytes = 10, human = "char", size = 1, endian = "little"))
-     lwn <- grepRaw("LWN", pr, all = TRUE)[1] + 7 # Laser wavenumber
-     LWN <- hexView::readRaw(file_path, offset = lwn,
-                             nbytes = 8, human = "real", size=8)[[5]][1]
-     tsc <- grepRaw("TSC", pr, all = TRUE) + 7 # Scanner temperature
-     TSC_all <- lapply(tsc, function(tsc)
-       hexView::readRaw(file_path, offset = tsc,
-                        nbytes = 16, human = "real", size = 8)[[5]][[1]] # can include sample
-       # and background temperature
-     )
-     # Read relative humidity of the interferometer during measurement
-     hum_rel <- grepRaw("HUM", pr, all = TRUE) + 7
-     HUM_rel <- lapply(hum_rel, function(hum_rel)
-       hexView::readRaw(
-         file_path, offset = hum_rel, nbytes = 16,
-         human = "int", size = 8)[[5]][[1]] # can include sample and background
-       # humidity
-     )
-     # Read absolute humidity of the interferometer during measurement
-     hum_abs <- grepRaw("HUA", pr, all = TRUE) + 7
-     HUM_abs <- lapply(hum_abs, function(hum_abs)
-       hexView::readRaw(
-         file_path, offset = hum_abs, nbytes = 16,
-         human = "real", size = 8)[[5]][[1]] # can include sample and background
-       # humidity
-     )
-     
-     # Optics parameters --------------------------------------------------------
-     src <- grepRaw("SRC", pr, all = TRUE) # Source: MIR or NIR
-     SRC <- hexView::blockString(
-       hexView::readRaw(
-         file_path, offset = src[length(src)] + 4,
-         nbytes = 3, human = "char", size = 1, endian = "little"))
-     instr_range <- tolower(paste(INS, SRC, sep = "-")) # instrument range
-     bms <- grepRaw("BMS", pr, all = TRUE) # Beamsplitter
-     BMS <- hexView::blockString(
-       hexView::readRaw(file_path, offset = bms[length(bms)] + 4,
-                        nbytes = 3, human = "char", size = 1, endian = "little"))
-     
-     # Fourier transform parameters ---------------------------------------------
-     zff <- grepRaw("ZFF", pr, all = TRUE)[1] + 5 # Zero filling factor (numeric)
-     ZFF <- hexView::readRaw(file_path, offset = zff,
-                             nbytes = 4, human = "int", size=2)[[5]][1]
-     
-     # (Additional) Standard parameters -----------------------------------------
-     csf_all <- grepRaw("CSF", pr, all = TRUE) + 7 # y-scaling factor
-     # Read only CSF byte positions that correspond to final spectra
-     CSF <- lapply(csf_all[npt_all %in% npt_spc],
-                   function(csf) hexView::readRaw(
-                     file_path, offset = csf, nbytes = 8, human = "real", size = 8)[[5]][1])
-     mxy_all <- grepRaw("MXY", pr, all = TRUE) + 7 # Y-maximum
-     MXY <- unlist(lapply(mxy_all[npt_all %in% npt_spc],
-                          function(mxy) hexView::readRaw(
-                            file_path, offset = mxy, nbytes = 8, human = "real", size = 8)[[5]][1]))
-     mny <- grepRaw("MNY", pr, all = TRUE) + 7 # Y-minimum
-     dxu_all <- grepRaw("DXU", pr, all = TRUE) + 7 # X units
-     DXU <- lapply(dxu_all, function(dxu)
-       hexView::blockString(
-         hexView::readRaw(file_path, offset = dxu,
-                          nbytes = 3, human = "char", size = 1, endian = "little")
-       )
-     )
-     # Y units -> there is no DYU present in file
-     dyu_all <- grepRaw("DYU", pr, all = TRUE) + 7
-     dat <- grepRaw("DAT", pr, all = TRUE) + 7 # Date
-     tim <- grepRaw("TIM", pr, all = TRUE) + 7 # Time
-     time <- unlist(lapply(tim, function(tim)
-       hexView::blockString(
-         hexView::readRaw(file_path, offset = tim,
-                          nbytes = 22, human = "char",
-                          size = 1, endian = "little")))
-     )
-     # Only select "DAT" string positions that are immediately before time
-     dat_sel <- foreach::foreach(i = 1:length(tim), .combine = 'c') %do% {
-       diff_sel <- dat - tim[i]
-       dat[which(diff_sel <= 32 & diff_sel >= -20)]
-     }
-     date <- lapply(dat_sel, function(dat) hexView::blockString(
-       hexView::readRaw(file_path, offset = dat,
-                        nbytes = 10, human = "char", size = 1,
-                        endian = "little"))
-     )
-     
-     date_time <- unique(paste(date, time))
-     # Convert date_time from character to class POSIXct (calendar date and time)
-     date_time <- as.POSIXct(date_time, format = "%d/%m/%Y %H:%M:%S")
-     # , tz = "GMT+1") # tz is argument for time zone
-     
-     # Scale all spectra with y-scaling factor if any of spectra types present
-     # in file are not 1 --------------------------------------------------------
-     # Set names of CSF elements equal to spectra list element names
-     names(CSF) <- names(spc)
-     if (any(unlist(CSF) != 1)) {
-       # Return all elements in CSF that have scaling value not equal to 1
-       CSF_toscale <- Filter(function(x) x != 1, CSF)
-       # Apply scaling for spectra with CSF value not equal to 1;
-       # Map() returns list
-       spc_scaled <- Map(function(CSF, spc) CSF * spc,
-                         unlist(CSF_toscale), spc[names(CSF_toscale)])
-       # Replace all spc list elements that have CSF not equal 1 with
-       # scaled values
-       spc <- replace(x = spc, list = names(CSF_toscale), values = spc_scaled)
-     }
-     
-     # Data aquisition parameters -----------------------------------------------
-     
-     plf <- grepRaw("PLF", pr, all = TRUE) + 4 # Result spectrum
-     PLF_all <- lapply(plf, function(plf) hexView::blockString(
-       hexView::readRaw(file_path, offset = plf,
-                        nbytes = 2, human = "char", size = 1,
-                        endian = "little"))
-     )
-     # Select only result spectra abbreviations that are more than 0 characters
-     # long
-     PLF <- unlist(PLF_all[lapply(PLF_all, nchar) > 0])
-     res <- grepRaw("RES", pr, all = TRUE)[1] + 5 # Resolution (wavenumber)
-     RES <- hexView::readRaw(
-       file_path, offset = res, nbytes = 4, human = "int", size = 2)[[5]][1]
-     
-     ## Create sample metadata objects ==========================================
-     # File name
-     file_name_nopath <- sub(".+/(.+)", "\\1", file_path)
-     # Create sample id from file name;
-     # remove extension .0, .1 etc. from OPUS files
-     sample_id <- sub("(.+)\\.[[:digit:]]+$", "\\1", file_name_nopath)
-     # Extract sample repetition number (rep_no) from file name
-     rep_no <- sub(".+\\.([[:digit:]])+$", "\\1", file_path)
-     snm <- grepRaw("SNM", pr, all = TRUE)[1] + 7
-     SNM <- hexView::blockString(
-       hexView::readRaw(file_path, offset = snm,
-                        nbytes = 30, human = "char", size = 1, endian = "little")
-     )
-     # Create unique_id using file_name and time
-     # ymd_id <- format(max(date_time), "%Y%m%d")
-     ymdhms_id <- max(date_time)
-     unique_id <- paste0(file_name_nopath, "_", ymdhms_id)
-     
-     ## Convert all spectra in list spc into a matrix of 1 row ==================
-     spc_m <- lapply(spc,
-                     function(x) matrix(x, ncol = length(x), byrow = FALSE))
-     # Add dimnames (wavenumbers for columns and unique_id for rows
-     spc_m <- foreach::foreach(i = 1:length(spc_m),
-                               .final = function(i) setNames(i, names(spc_m))) %do% {
-                                 colnames(spc_m[[i]]) <- round(wavenumbers[[i]], 1)
-                                 rownames(spc_m[[i]]) <- unique_id
-                                 data.table::as.data.table(spc_m[[i]])
-                               }
-     
-     # Save all relevant data parameters (metadata)
-     # in tibble data frame (class "data.frame" and "tbl_diff" ==================
-     metadata <- tibble::tibble(
-       unique_id = unique_id,
-       file_id = file_name_nopath, # pb (20170514): changed `scan_id` to `file_id`
-       sample_id = sample_id,
-       rep_no = as.numeric(rep_no),
-       date_time_sm = max(date_time),
-       date_time_rf = min(date_time),
-       sample_name = SNM,
-       instr_name_range = instr_range,
-       resolution_wn = RES,
-       # Result spectrum; e.g. "AB" = Absorbance
-       # result_spc = ifelse(length(unique(PLF)) == 1, unique(PLF), unique(PLF)[2]),
-       # // pb: 2019-11-19: allow NULL value for PLF
-       result_spc <- if (length(unique(PLF)) == 1) {
-         unique(PLF)} else if (length(unique(PLF)) > 1) {
-           unique(PLF)[2]} else { NA },
-       beamspl = BMS,
-       laser_wn = LWN,
-       # `spc_in_file`: character vector of spectra found in OPUS file
-       spc_in_file = paste(unlist(list_assigned_t[["spc_code"]]),
-                           collapse = ";", sep = ";"),
-       zero_filling = ZFF, # Zero filling factor for fourier transformation
-       # Temperature of scanner during sample measurement
-       temp_scanner_sm = TSC_all[[length(TSC_all)]], # select last element
-       # Temperature of scanner during reference measurement;
-       # if there is only one element in TSC_all, temperature during reference
-       # mesurement is not saved
-       temp_scanner_rf = ifelse(length(TSC_all) == 1, NA, TSC_all[[1]]),
-       # Relative humidity
-       hum_rel_sm = HUM_rel[[length(HUM_rel)]], # sample measurement
-       hum_rel_rf = ifelse(length(HUM_rel) == 1, NA, HUM_rel[[1]]), # reference
-       # measurement
-       # Absolute humidity; sample measurement (sm); reference measurment (rf);
-       # note: for Vertex 70 instrument HUA is not present, in this case,
-       # HUM_abs is a list without elements
-       hum_abs_sm = ifelse(length(HUM_abs) != 0, HUM_abs[[length(HUM_abs)]], NA),
-       hum_abs_rf = ifelse(length(HUM_abs) == 1 | length(HUM_abs) == 0, NA,
-                           HUM_abs[[1]]) # reference measurement
-     )
-     
-     ## Allocate and return data from spectra in output list (out) ==============
-     out <- list(
-       'metadata' = metadata,
-       'spc' = spc_m[["spc"]],
-       'spc_nocomp' = if ("spc_nocomp" %in% extract &&
-                          "spc_nocomp" %in% names(spc_m)) {
-         spc_m[["spc_nocomp"]]} else {NULL},
-       'sc_sm' = if ("ScSm" %in% extract && "ScSm" %in% names(spc_m)) {
-         spc_m[["ScSm"]]} else {NULL},
-       'sc_rf' = if ("ScRf" %in% extract && "ScRf" %in% names(spc_m)) {
-         spc_m[["ScRf"]]} else {NULL},
-       'ig_sm' = if ("IgSm" %in% extract && "IgSm" %in% names(spc_m)) {
-         spc_m[["IgSm"]]} else {NULL},
-       'ig_rf' = if ("IgRf" %in% extract && "IgRf" %in% names(spc_m)) {
-         spc_m[["IgRf"]]} else {NULL},
-       # Wavenumbers of final AB spectra
-       wavenumbers = wavenumbers[["spc"]],
-       wavenumbers_sc_sm = if ("ScSm" %in% extract) {
-         wavenumbers[["ScSm"]]} else {NULL},
-       wavenumbers_sc_rf = if ("ScRf" %in% extract) {
-         wavenumbers[["ScRf"]]} else {NULL}
-     )
-     # Return spectra data and metadata contained as elements in list out
-     out
-   }) # closes try() function
-}
-  

transfer-data.sh

@@ -0,0 +1,22 @@
+#!/bin/bash
+
+URL="https://http.bosch-iot-hub.com/telemetry"
+TTD="10"
+KEY="ZGVmaW5tYUB0MzhiYmNjZDE2MjE3NDViODgxMTk5ZGI2ZWQzZGFiNmE6RGVGaW5NYWNoZW4yMDIwIQ=="
+
+# Build name
+# Basename of file with the last dot replaced by a slash and .DPT extension
+NAME=$(basename $1)
+NAME="${NAME%.*}_${NAME##*.}.DPT"
+
+# Build body
+JSON="{\"filename\":\"$NAME\",\"dpt\":["
+while read LINE
+do
+	JSON+="[${LINE%,*},${LINE#*,}],"
+done < $1
+JSON=${JSON::-1}
+JSON+=']}'
+
+# Dispatch curl
+curl -X POST $URL -H "accept: */*" -H "hono-ttd: $TTD" -H "Authorization: Basic $KEY" -H "Content-Type: application/json" -d "$JSON"

usb-detect/10-usb-detect.rules

@@ -0,0 +1 @@
+ACTION=="add", KERNEL=="sd[a-z]1", SUBSYSTEM=="block", RUN+="/home/pi/git/opus-data/usb-detect/usb-detect.sh"

usb-detect/usb-detect.sh

@@ -0,0 +1,61 @@
+#!/bin/bash
+
+# udev script for mounting a block device
+# and processing the files it contains
+
+# To use it, place 10-usb-detect.rules
+# in /etc/udev/rules.d
+
+# Redirect stdout and stderr to log file
+LOGFILE=/var/log/usb-detect.log
+exec &>> $LOGFILE
+
+# Processing function (file name is passed as parameter)
+PROC_FUNC="Rscript /home/pi/git/opus-data/OpusData.R"
+
+# Directory inside which the processing function is run
+PROC_DIR="/home/pi/git/opus-data/"
+
+echo "USB device detected at $DEVNAME"
+
+MOUNTPOINT=/mnt$DEVNAME
+
+echo "Mounting device at $MOUNTPOINT"
+
+mkdir -p $MOUNTPOINT
+mount $DEVNAME $MOUNTPOINT
+
+echo "Extracting data..."
+
+shopt -s nullglob
+found=0
+for f in $MOUNTPOINT/*.?
+do
+	found=1
+	echo "Processing $f..."
+	(
+		cd $PROC_DIR
+		$PROC_FUNC $f
+	) || echo "Failed executing $PROC_FUNC $f in $PROC_DIR"
+	echo "Removing $f..."
+	rm $f
+done
+shopt -u nullglob
+
+[ $found -eq 0 ] && echo "$MOUNTPOINT is empty"
+
+echo "Umounting..."
+umount $MOUNTPOINT
+
+echo "Removing $MOUNTPOINT..."
+rm -r $MOUNTPOINT
+
+if [ -z `ls -A /mnt/dev` ]
+then
+	echo "Removing /mnt/dev/..."
+	rmdir /mnt/dev
+else
+	echo "Not removing /mnt/dev/ as other devices are mounted."
+fi
+
+echo "Done!"