R/logger_Buehler_4010.R

In KWB-R/kwb.logger: Functions to read measurement data from logger files

# readLogger_Buehler_4010_Flaschenbericht --------------------------------------

#' Read Logger File from Buehler 4010 (Flaschenbericht)
#' 
#' @param samplerFile full path to file generated by auto sampler
#' @param headerPattern pattern matching the header row
#' @param endPattern pattern matching the end of the table
#' @param tz time zone. Default: "Etc/GMT+1
#' 
#' @export
#' 
readLogger_Buehler_4010_Flaschenbericht <- function(
  samplerFile, 
  headerPattern = paste0(
    "Flasche\\s+Datum\\s+Zeit\\s+F.llzeit\\s+PN Soll",
    "\\s+PN Ist\\s+P/E"
  ), 
  endPattern = "---", 
  tz = "Etc/GMT+1"
)
{
  content <- .read_Flaschenbericht.raw(samplerFile, headerPattern, endPattern)
  
  # fill spaces with "0" in date column 
  content$myDate <- .spacesToZero(content$myDate)
  
  # filter for rows with a valid date 
  valid <- kwb.datetime::hasTimeFormat(content$myDate, "%d.%m.%Y")
  content <- content[valid, ]
  
  # create timestamps
  from <- .spacesToZero(substr(content$myTime, 1, 5))
  to <- .spacesToZero(substr(content$myTime, 9, 13))
  
  format <- "%d.%m.%Y %H:%M"

  to_posix <- function(x) {
    as.POSIXct(paste(content$myDate, x), format = format, tz = tz)
  }
    
  content$timeFrom <- to_posix(from)
  content$timeTo <- to_posix(to)
  
  # if timeTo is smaller than timeFrom add one day to timeTo and give a warning
  indicesNextDay <- which(content$timeTo < content$timeFrom)
  
  if (! kwb.utils::isNullOrEmpty(indicesNextDay)) {
    
    content$timeTo[indicesNextDay] <- content$timeTo[indicesNextDay] + 86400
    
    message("End time is assumed to be next day:")
    
    print(content[indicesNextDay, ])
  }
  
  kwb.utils::selectColumns(content, c(
    "bottle", "timeFrom", "timeTo", "fillTime", "pnSoll", "pnIst", "pOrE"
  ))
}

# .spacesToZero ----------------------------------------------------------------

.spacesToZero <- function(x)
{
  gsub(" ", "0", x)
}

# .read_Flaschenbericht.raw ----------------------------------------------------

.read_Flaschenbericht.raw <- function(samplerFile, headerPattern, endPattern)
{
  # Read file as text
  file.lines <- readLines(samplerFile)
  
  # Find the header row or stop
  headerRow <- grep(headerPattern, file.lines)
  
  if (length(headerRow) == 0) {
    
    stop(
      "Could not find the header row. I was looking for the pattern '", 
      headerPattern, "' in file '", samplerFile, "'"
    )
  }
  
  # Remove the lines above and including the header row
  file.lines <- file.lines[- seq_len(headerRow)]
  
  # Find the end of the table or stop
  endRow <- grep(endPattern, file.lines)
  
  if (length(endRow) == 0) {
    
    stop(
      "Could not find the end of the table. I was looking for the pattern '",
      endPattern, "'"
    )
  }
  
  # Select the lines above the table end
  file.lines <- file.lines[seq_len(endRow - 1)]
  
  data.frame(
    bottle = as.integer(substr(file.lines, 1, 7)),
    myDate = substr(file.lines, 13, 22),
    myTime = substr(file.lines, 25, 37),
    fillTime = substr(file.lines, 40, 44),
    pnSoll = as.integer(substr(file.lines, 53, 59)),
    pnIst = as.integer(substr(file.lines, 63, 68)),
    pOrE = kwb.utils::hsTrim(substr(file.lines, 74, 76)),
    stringsAsFactors = FALSE
  )  
}

# readLogger_Buehler_4010_Infospeicher -----------------------------------------

#' Read Logger File from Buehler 4010 (Infospeicher)
#' 
#' @param samplerFile full path to file generated by auto sampler Buehler 4010
#'   (Infospeicher)
#' @param unprocessed if TRUE, the information is returned "raw", i.e. without
#'   any aggregation
#' @param \dots arguments passed to \code{.read_Infospeicher.raw}, e.g.
#'   \emph{tz}, see there
#' 
#' @export
#' 
readLogger_Buehler_4010_Infospeicher <- function(
  samplerFile, unprocessed = TRUE, ...
)  
{
  x <- .read_Infospeicher.raw(samplerFile, ...)
  
  if (unprocessed) {
    
    return(x)
    
  } else {
    
    stop("Not implemented for unprocessed = FALSE!")
    
  #   bottleChange <- grepl("Flaschenwechsel", x$event)
  #   sampleToBottle <- grepl("Prb\\. genommen \\(Fl\\.\\)", x$event)
  #   
  #   nearestBottleChangeIndex <- function(x) {
  #     max(which(which(bottleChange) < x))
  #   }
  #   
  #   indices <- sapply(which(sampleToBottle), nearestBottleChangeIndex)
  #   
  #   data.frame(
  #     from = x$myDateTime[bottleChange],
  #     to = x$myDateTime[sampleToBottle],
  #     bottle = gsub("-> ", "", x$appendix[which(bottleChange)[indices]])
  #   )
    
  }
}

# .read_Infospeicher.raw -------------------------------------------------------

.read_Infospeicher.raw <- function(
  txt, timeformat = "%d.%m.%Y %H:%M", tz = "Etc/GMT+1"
)
{
  content.raw <- readLines(txt)
  
  valid <- kwb.utils::stringStartsWith(
    content.raw, kwb.datetime:::timeFormatToRegex(timeformat = timeformat)
  )
  
  content <- content.raw[valid]
  
  x <- data.frame(
    myDateTime = kwb.utils::hsTrim(sapply(content, substr, 1, 16)),
    event = kwb.utils::hsTrim(sapply(content, substr, 19, 39)),
    appendix = kwb.utils::hsTrim(sapply(content, function(x) {substr(x, 40, nchar(x))})),
    stringsAsFactors = FALSE
  )
  
  x$myDateTime <- as.POSIXct(x$myDateTime, format = timeformat, tz = tz)
  
  x
}