R/IMPORT-nmr-proc.R

In jmstrat/NMR.Utils: Importing and processing Bruker NMR data

#' Read procisition Parameters
#'
#' This function reads processing pararameters for NMR Data.
#' @param procfile Path to proc(N)s file
#' @return A list of parameters
#' @export
#' @examples
#' read.proc("/path/to/nmr/expName/expNo/pdata/1/")
read.proc <- function(dir) {
  proc <- list()
  path <- paste0(dir, "/procs")
  if (file.exists(path)) {
    proc$proc <- .read.proc(path)
    path <- paste0(dir, "/proc2s")
    if (file.exists(path)) {
      proc$proc2 <- .read.proc(path)
      path <- paste0(dir, "/proc4s")
      if (file.exists(path)) {
        proc$proc3 <- .read.proc(path)
        path <- paste0(dir, "/proc4s")
        if (file.exists(path)) {
          proc$proc4 <- .read.proc(path)
        }
      }
    }
  }
  return(proc)
}

.read.proc <- function(path) {
  jms.classes::log.info("Reading processing parameters from %s", path)
  con <- file(path, open="r")
  head0 <- readLines(con)
  close(con)
  position <- grep("^\\$\\$", head0)[[1]]
  proc <- list()
  proc$file <- gsub("^\\$\\$ ", "", head0[[position + 1]])
  proc$date <- as.POSIXct(sub("^\\$\\$ ([^[:space:]]* [^[:space:]]* [^[:space:]]*) .*$", "\\1", head0[[position]]))

  get_pat <- function(pat) {
    gsub(pat, "", head0[grepl(pat, head0)])
  }

  proc$absf1   <- suppressWarnings(as.numeric(get_pat("^##\\$ABSF1= ")))
  proc$absf2   <- suppressWarnings(as.numeric(get_pat("^##\\$ABSF2= ")))
  proc$absg    <- suppressWarnings(as.numeric(get_pat("^##\\$ABSG= ")))
  proc$absl    <- suppressWarnings(as.numeric(get_pat("^##\\$ABSL= ")))
  proc$alpha   <- suppressWarnings(as.numeric(get_pat("^##\\$ALPHA= ")))
  proc$aqorder <- suppressWarnings(as.numeric(get_pat("^##\\$AQORDER= ")))
  proc$assfac  <- suppressWarnings(as.numeric(get_pat("^##\\$ASSFAC= ")))
  proc$assfaci <- suppressWarnings(as.numeric(get_pat("^##\\$ASSFACI= ")))
  proc$assfacx <- suppressWarnings(as.numeric(get_pat("^##\\$ASSFACX= ")))
  proc$asswid  <- suppressWarnings(as.numeric(get_pat("^##\\$ASSWID= ")))
  proc$aunmp   <- suppressWarnings(as.character(get_pat("^##\\$AUNMP= ")))
  proc$axleft  <- suppressWarnings(as.numeric(get_pat("^##\\$AXLEFT= ")))
  proc$axname  <- suppressWarnings(as.numeric(get_pat("^##\\$AXNAME= ")))
  proc$axnuc   <- suppressWarnings(as.character(get_pat("^##\\$AXNUC= ")))
  proc$axright <- suppressWarnings(as.numeric(get_pat("^##\\$AXRIGHT= ")))
  proc$axtype  <- suppressWarnings(as.numeric(get_pat("^##\\$AXTYPE= ")))
  proc$axunit  <- suppressWarnings(as.character(get_pat("^##\\$AXUNIT= ")))
  proc$azfe    <- suppressWarnings(as.numeric(get_pat("^##\\$AZFE= ")))
  proc$azfw    <- suppressWarnings(as.numeric(get_pat("^##\\$AZFW= ")))
  proc$bcfw    <- suppressWarnings(as.numeric(get_pat("^##\\$BCFW= ")))
  proc$bc_mod  <- suppressWarnings(as.numeric(get_pat("^##\\$BC_mod= ")))
  proc$bytordp <- suppressWarnings(as.numeric(get_pat("^##\\$BYTORDP= ")))
  proc$coroffs <- suppressWarnings(as.numeric(get_pat("^##\\$COROFFS= ")))
  proc$cy      <- suppressWarnings(as.numeric(get_pat("^##\\$CY= ")))
  proc$datmod  <- suppressWarnings(as.numeric(get_pat("^##\\$DATMOD= ")))
  proc$dc      <- suppressWarnings(as.numeric(get_pat("^##\\$DC= ")))
  proc$dfilt   <- suppressWarnings(as.character(get_pat("^##\\$DFILT= ")))
  proc$dtypp   <- suppressWarnings(as.numeric(get_pat("^##\\$DTYPP= ")))
  proc$eretic  <- suppressWarnings(as.character(get_pat("^##\\$ERETIC= ")))
  proc$f1p     <- suppressWarnings(as.numeric(get_pat("^##\\$F1P= ")))
  proc$f2p     <- suppressWarnings(as.numeric(get_pat("^##\\$F2P= ")))
  proc$fcor    <- suppressWarnings(as.numeric(get_pat("^##\\$FCOR= ")))
  proc$ftsize  <- suppressWarnings(as.numeric(get_pat("^##\\$FTSIZE= ")))
  proc$ft_mod  <- suppressWarnings(as.numeric(get_pat("^##\\$FT_mod= ")))
  proc$gamma   <- suppressWarnings(as.numeric(get_pat("^##\\$GAMMA= ")))
  proc$gb      <- suppressWarnings(as.numeric(get_pat("^##\\$GB= ")))
  proc$intbc   <- suppressWarnings(as.numeric(get_pat("^##\\$INTBC= ")))
  proc$intscl  <- suppressWarnings(as.numeric(get_pat("^##\\$INTSCL= ")))
  proc$isen    <- suppressWarnings(as.numeric(get_pat("^##\\$ISEN= ")))
  proc$lb      <- suppressWarnings(as.numeric(get_pat("^##\\$LB= ")))
  proc$lev0    <- suppressWarnings(as.numeric(get_pat("^##\\$LEV0= ")))
  proc$lpbin   <- suppressWarnings(as.numeric(get_pat("^##\\$LPBIN= ")))
  proc$maxi    <- suppressWarnings(as.numeric(get_pat("^##\\$MAXI= ")))
  proc$mc2     <- suppressWarnings(as.numeric(get_pat("^##\\$MC2= ")))
  proc$mean    <- suppressWarnings(as.numeric(get_pat("^##\\$MEAN= ")))
  proc$me_mod  <- suppressWarnings(as.numeric(get_pat("^##\\$ME_mod= ")))
  proc$mi      <- suppressWarnings(as.numeric(get_pat("^##\\$MI= ")))
  proc$ncoef   <- suppressWarnings(as.numeric(get_pat("^##\\$NCOEF= ")))
  proc$nc_proc <- suppressWarnings(as.numeric(get_pat("^##\\$NC_proc= ")))
  proc$nlev    <- suppressWarnings(as.numeric(get_pat("^##\\$NLEV= ")))
  proc$noisf1  <- suppressWarnings(as.numeric(get_pat("^##\\$NOISF1= ")))
  proc$noisf2  <- suppressWarnings(as.numeric(get_pat("^##\\$NOISF2= ")))
  proc$nsp     <- suppressWarnings(as.numeric(get_pat("^##\\$NSP= ")))
  proc$nth_pi  <- suppressWarnings(as.numeric(get_pat("^##\\$NTH_PI= ")))
  proc$nzp     <- suppressWarnings(as.numeric(get_pat("^##\\$NZP= ")))
  proc$offset  <- suppressWarnings(as.numeric(get_pat("^##\\$OFFSET= ")))
  proc$pc      <- suppressWarnings(as.numeric(get_pat("^##\\$PC= ")))
  proc$phc0    <- suppressWarnings(as.numeric(get_pat("^##\\$PHC0= ")))
  proc$phc1    <- suppressWarnings(as.numeric(get_pat("^##\\$PHC1= ")))
  proc$ph_mod  <- suppressWarnings(as.numeric(get_pat("^##\\$PH_mod= ")))
  proc$pknl    <- suppressWarnings(as.character(get_pat("^##\\$PKNL= ")))
  proc$pparmod <- suppressWarnings(as.numeric(get_pat("^##\\$PPARMOD= ")))
  proc$ppdiag  <- suppressWarnings(as.numeric(get_pat("^##\\$PPDIAG= ")))
  proc$ppiptyp <- suppressWarnings(as.numeric(get_pat("^##\\$PPIPTYP= ")))
  proc$ppmpnum <- suppressWarnings(as.numeric(get_pat("^##\\$PPMPNUM= ")))
  proc$ppresol <- suppressWarnings(as.numeric(get_pat("^##\\$PPRESOL= ")))
  proc$pscal   <- suppressWarnings(as.numeric(get_pat("^##\\$PSCAL= ")))
  proc$psign   <- suppressWarnings(as.numeric(get_pat("^##\\$PSIGN= ")))
  proc$pynmp   <- suppressWarnings(as.character(get_pat("^##\\$PYNMP= ")))
  proc$reverse <- suppressWarnings(as.character(get_pat("^##\\$REVERSE= ")))
  proc$sf      <- suppressWarnings(as.numeric(get_pat("^##\\$SF= ")))
  proc$si      <- suppressWarnings(as.numeric(get_pat("^##\\$SI= ")))
  proc$sigf1   <- suppressWarnings(as.numeric(get_pat("^##\\$SIGF1= ")))
  proc$sigf2   <- suppressWarnings(as.numeric(get_pat("^##\\$SIGF2= ")))
  proc$sino    <- suppressWarnings(as.numeric(get_pat("^##\\$SINO= ")))
  proc$siold   <- suppressWarnings(as.numeric(get_pat("^##\\$SIOLD= ")))
  proc$spectyp <- suppressWarnings(as.numeric(get_pat("^##\\$SPECTYP= ")))
  proc$sreglst <- suppressWarnings(as.numeric(get_pat("^##\\$SREGLST= ")))
  proc$ssb     <- suppressWarnings(as.numeric(get_pat("^##\\$SSB= ")))
  proc$stsi    <- suppressWarnings(as.numeric(get_pat("^##\\$STSI= ")))
  proc$stsr    <- suppressWarnings(as.numeric(get_pat("^##\\$STSR= ")))
  proc$sw_p    <- suppressWarnings(as.numeric(get_pat("^##\\$SW_p= ")))
  proc$symm    <- suppressWarnings(as.numeric(get_pat("^##\\$SYMM= ")))
  proc$s_dev   <- suppressWarnings(as.numeric(get_pat("^##\\$S_DEV= ")))
  proc$tdeff   <- suppressWarnings(as.numeric(get_pat("^##\\$TDeff= ")))
  proc$tdoff   <- suppressWarnings(as.numeric(get_pat("^##\\$TDoff= ")))
  proc$ti      <- suppressWarnings(as.numeric(get_pat("^##\\$TI= ")))
  proc$tilt    <- suppressWarnings(as.numeric(get_pat("^##\\$TILT= ")))
  proc$tm1     <- suppressWarnings(as.numeric(get_pat("^##\\$TM1= ")))
  proc$tm2     <- suppressWarnings(as.numeric(get_pat("^##\\$TM2= ")))
  proc$toplev  <- suppressWarnings(as.numeric(get_pat("^##\\$TOPLEV= ")))
  proc$userp1  <- suppressWarnings(as.numeric(get_pat("^##\\$USERP1= ")))
  proc$userp2  <- suppressWarnings(as.numeric(get_pat("^##\\$USERP2= ")))
  proc$userp3  <- suppressWarnings(as.numeric(get_pat("^##\\$USERP3= ")))
  proc$userp4  <- suppressWarnings(as.numeric(get_pat("^##\\$USERP4= ")))
  proc$userp5  <- suppressWarnings(as.numeric(get_pat("^##\\$USERP5= ")))
  proc$wdw     <- suppressWarnings(as.numeric(get_pat("^##\\$WDW= ")))
  proc$xdim    <- suppressWarnings(as.numeric(get_pat("^##\\$XDIM= ")))
  proc$ymax_P  <- suppressWarnings(as.numeric(get_pat("^##\\$YMAX_P= ")))
  proc$ymin_P  <- suppressWarnings(as.numeric(get_pat("^##\\$YMIN_P= ")))

  return(proc)
}