R/logger_Ori_MLog.R

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

# readLogger_Ori_MLog ----------------------------------------------------------

#' Read Water Level File from Radar Probe
#' 
#' @param csv full path to file generated by radar probe
#' @param sep column separator. Default: tabulator character
#' @param dec decimal character. Default: ","
#' @param timeFormat time format string. Default: "\%d.\%m.\%Y \%H:\%M:\%S"
#' @param \dots further arguments passed to \code{readCsvInputFile}, e.g. 
#'   \emph{stopOnMissingColumns}
#' 
#' @references \url{http://www.origmbh.de/fileadmin/user_upload/produkte/sensoren/DA_MLOG_Vega_Radar_Puls_61_en.pdf}
#' 
#' @export
#' 
#' @examples 
#' \dontrun{
#' file <- extdataFile("Ori/example_Ori_MLog_1.csv")
#'   
#' # set separator different from default (tabulator) and do not complain
#' # about missing columns
#' x <- readLogger_Ori_MLog(filepath, sep = ";", stopOnMissingColumns = FALSE)
#'   
#' str(x)
#' }
readLogger_Ori_MLog <- function(
  csv, sep = "\t", dec = ",", 
  timeFormat = c(.defaultTimeFormat("v8"), .defaultTimeFormat("v7")), ...
) 
{
  myData <- kwb.utils::readCsvInputFile(
    csv = csv, sep = sep, dec = dec, headerRow = 1,
    columnDescription = .columnDescriptionMLog(), encoding = "UTF-8", ...
  ) 
  
  # check if the time format complies with the given format    
  timeformat.ok <- kwb.datetime::matchingTimeFormat(
    timestamp = as.character(myData$myDateTime[1]), timeFormats = timeFormat
  )
  
  if (is.null(timeformat.ok)) {
    
    stop("Timestamp does not match any of the assumed patterns")
  }
  
  myData$myDateTime <- kwb.datetime::reformatTimestamp(
    as.character(myData$myDateTime), old.format = timeformat.ok
  )
  
  invalid <- which(is.na(myData$myDateTime))
  
  if (length(invalid)) {
    
    cat("Removing rows with NA timestamps... ")
    myData <- myData[- invalid, ]
    cat("ok.\n")
    
    warning(
      length(invalid), " rows have been removed from '", csv, 
      " since the timestamp could not be recognised."
    )
  }
  
  myData
}

# .columnDescriptionMLog -------------------------------------------------------

.columnDescriptionMLog <- function()
{
  descriptor <- kwb.utils::columnDescriptor
  
  # \u00f6 = oe
  list(
    myDateTime = descriptor(match = "Date & Time"),
    Hraw_m = descriptor(match = "H(oe|\u00f6)he\\s+\\[m\\]"),
    Hraw_cm = descriptor(match = "H(oe|\u00f6)he\\s+\\[cm\\]"),
    Level_cm = descriptor(match = "Level\\s+\\[cm\\]"),
    I_mA = descriptor(match = "I\\s+\\[mA\\]"),
    Battery_V = descriptor(match = "Battery\\s+\\[V\\]"),
    DeviceID = descriptor(match = "DeviceID")
  )
}

# readLogger_Ori_BasicEx1 ------------------------------------------------------

#' Read Logger File from Ori BasicEx1
#' 
#' @param filepath full path to file generated by automatic sampler
#' @param infotype one or more of the values returned by \code{validInfoTypes}
#' @param blockbegin identification of "block begins"; Default: "ORI BasicEx1"
#' @param warn if TRUE, warnings are generated if a block does not contain
#'   "Probe"
#' @param sep column separator
#' @param dec decimal character
#' @param colnameDate name of date column
#' @param colnameTime name of time column
#' @param dateformat date format string
#' @param timeformat time format string
#' 
#' @references \url{http://www.origmbh.de/fileadmin/user_upload/pdf/basic_ex_1_mobil/ORI_Basic_Ex1_mobil_de.pdf}
#' 
#' @export
#' 
#' @examples 
#' \dontrun{
#' # set path to example file (contained in this package)
#' (file <- extdataFile("Ori/example_Ori_BasicEx1.csv"))
#' 
#' # read the "actions" from the file
#' readLogger_Ori_BasicEx1(file, infotype = "actions")
#'   
#' # read the sample times from the file
#' readLogger_Ori_BasicEx1(
#'   file, infotype = "times", blockbegin = "ORI BasicEx1 TU Berlin"
#' )
#'   
#' # read both at the same time
#' x <- readLogger_Ori_BasicEx1(
#'   file, blockbegin = "ORI BasicEx1 TU Berlin"
#' )
#'   
#' # examine the list structure of the result
#' str(x)  
#' }
#' 
readLogger_Ori_BasicEx1 <- function(
  filepath, infotype = validInfoTypes(), blockbegin = "ORI BasicEx1",
  warn = TRUE, sep = ";", dec = ",", colnameDate = "Datum", 
  colnameTime = "Uhrzeit", dateformat = .defaultTimeFormat("v5"),
  timeformat = .defaultTimeFormat("v1")
)
{
  .stopIfInfoTypesAreInvalid(infotype, validInfoTypes())
  
  textLines <- .addRowNumberLeft(readLines(filepath), sep)
  
  captions <- .getCaptions(textLines, sep, colnameDate, colnameTime)
  
  linesWithDate <- .getLinesWithDate(textLines, sep, dateformat)
  
  result <- list()
  
  if ("actions" %in% infotype) {
    
    result$actions <- .getAllEventRows(
      linesWithDate, captions, sep, dec, colnameDate, colnameTime, dateformat, 
      timeformat
    )
  }
  
  if ("times" %in% infotype) {
    
    linesByType <- .groupLinesByEventType(
      linesWithDate, captions, sep, dec, colnameDate, colnameTime, dateformat, 
      timeformat
    )
    
    result$times <- linesByType$Probe
  }
  
  if (length(result) == 1) {
    
    result[[1]]
    
  } else {
    
    result
  }
}

# validInfoTypes ---------------------------------------------------------------

#' Valid Info Types
#' 
#' @export
#' 
validInfoTypes <- function()
{
  c("actions", "times")
}

# .stopIfInfoTypesAreInvalid ---------------------------------------------------

.stopIfInfoTypesAreInvalid <- function(infotype, validTypes) 
{
  if (! all(infotype %in% validTypes)) {
    
    stop(sprintf(
      "infotypes (%s) must be in c(%s)!", 
      kwb.utils::stringList(infotype), 
      kwb.utils::stringList(validTypes)
    ))
  }
}

# .addRowNumberLeft ------------------------------------------------------------

.addRowNumberLeft <- function(txtlines, sep)
{
  paste(seq_along(txtlines), txtlines, sep = sep)
}

# .getCaptions -----------------------------------------------------------------

.getCaptions <- function(txtlines, sep, colnameDate, colnameTime)
{
  captionPattern <- paste(colnameDate, colnameTime, sep = sep)  
  captionLine <- grep(captionPattern, txtlines, value = TRUE)
  
  captions <- if (kwb.utils::isNullOrEmpty(captionLine)) {
    
    warning(sprintf(
      "Could not find caption line (I was looking for: \"%s\")",
      captionPattern
    ))
    
    NULL    
    
  } else {
    
    strsplit(captionLine, split = sep)[[1]]
  }
  
  captions[1] <- "row"
  
  captions
}

# .getLinesWithDate ------------------------------------------------------------

.getLinesWithDate <- function(txtlines, sep, dateformat)
{
  dataPattern <- paste0(
    "^", "\\d+", sep, kwb.datetime:::timeFormatToRegex(dateformat), sep
  )
  
  grep(dataPattern, txtlines, value = TRUE)
}

# .getAllEventRows -------------------------------------------------------------

.getAllEventRows <- function(
  linesWithDate, captions, sep, dec, colnameDate, colnameTime, dateformat, 
  timeformat
)
{
  x <- utils::read.table(
    text = linesWithDate, sep = sep, dec = dec, fill = TRUE, 
    colClasses = "character", stringsAsFactors = FALSE
  )
  
  # convert row number to integer
  x[[1]] <- as.integer(x[[1]])
  
  .joinDateTimeAndRenameColumns(
    x, captions, colnameDate, colnameTime, dateformat, timeformat
  )
}

# .groupLinesByEventType -------------------------------------------------------

.groupLinesByEventType <- function(
  linesWithDate, captions, sep, dec, colnameDate, colnameTime, dateformat, 
  timeformat
)
{
  fields <- strsplit(linesWithDate, sep)
  eventtypes <- sapply(fields, "[", 4)
  
  result <- list()
  
  for (eventtype in unique(eventtypes)) {
    
    linesEvent <- linesWithDate[eventtypes == eventtype]

    x <- utils::read.table(
      text = paste(linesEvent, collapse = "\n"), sep = sep, dec = dec, 
      stringsAsFactors = FALSE
    )
    
    x <- kwb.utils::hsDelEmptyCols(x)
    
    result[[eventtype]] <- .joinDateTimeAndRenameColumns(
      x, captions, colnameDate, colnameTime, dateformat, timeformat
    )
  }
  
  result  
}

# .joinDateTimeAndRenameColumns ------------------------------------------------

.joinDateTimeAndRenameColumns <- function(
  x, captions, colnameDate, colnameTime, dateformat, timeformat
)
{
  x <- .renameWithValidCaptions(x, captions)
  
  x[[colnameDate]] <- kwb.datetime::reformatTimestamp(
    paste(x[[colnameDate]], x[[colnameTime]]), 
    old.format = paste(dateformat, timeformat)
  )
  
  kwb.utils::renameColumns(
    x = x[, setdiff(names(x), colnameTime)], 
    renamings = stats::setNames(object = list("myDateTime"), nm = colnameDate)
  )
}

# .renameWithValidCaptions -----------------------------------------------------

.renameWithValidCaptions <- function(x, captions)
{
  indices <- which(captions != "")
  indices <- indices[indices <= ncol(x)]  
  names(x)[indices] <- captions[indices]  
  
  x
}

# .getSampleTimes --------------------------------------------------------------

#' Read Sample Times from Automatic Sampler File
#' 
#' @param filepath full path to file generated by automatic sample
#' @param blockbegin blockbegin
#' @param sep field separator (default: ";") 
#' @param dec decimal separator (default: ",") 
#' @param captionPattern pattern matching the caption line. Default:
#'   "Datum;Uhrzeit"
#' @param warn  should warnings be printed (default: TRUE) 
.getSampleTimes <- function(
  filepath, blockbegin, sep = ";", dec = ",", captionPattern = "Datum;Uhrzeit",
  warn  =TRUE
)
{
  txtlines <- readLines(filepath)
  txtlines <- txtlines[txtlines != ""]
  
  headerpos <- grep(blockbegin, txtlines)
  
  if (! length(headerpos)) {
    
    stop(sprintf(
      "There are no lines containing: \"%s\" (argument \"%s\")",
      blockbegin, "blockbegin"
    ))
  }
  
  timelines.all <- NULL
  
  for (i in seq_along(headerpos)) {
    
    block <- .getProgramBlock(txtlines, headerpos, i)
    
    timelines <- grep(";Probe;", block, value=TRUE)
    
    if (! length(timelines)) {
      
      if (warn) {
        
        warning(sprintf(
          "Could not find \"%s\" in this block of lines:\n%s",
          ";Probe;", paste(block, collapse = "\n")
        ))
      }
    } else {
      
      timelines.all <- rbind(timelines.all, .timelinesToDataFrame(
        timelines, sep = sep, dec = dec
      ))
    }
  }  
  
  # assign column names
  captions <- .getCaptions(txtlines, captionPattern, sep)
  
  if (! kwb.utils::isNullOrEmpty(captions)) {
    
    indices <- which(captions != "")
    colnames <- names(timelines.all)
    colnames[indices] <- captions[indices]
    names(timelines.all) <- colnames
  }
  
  timelines.all
}

# .timelinesToDataFrame --------------------------------------------------------

.timelinesToDataFrame <- function(timelines, sep, dec)
{
  utils::read.table(
    textConnection(paste(timelines, collapse = "\n")), sep = sep, dec = dec, 
    stringsAsFactors = FALSE
  )
}

# .getProgramBlock -------------------------------------------------------------

.getProgramBlock <- function(txtlines, headerpos, i)
{
  firstRow <- headerpos[i]
  
  lastRow <- ifelse(
    i+1 > length(headerpos), length(txtlines), headerpos[i+1] - 1
  )
  
  txtlines[firstRow:lastRow]  
}