R/read.rdf2.R

In rabutler/RWDataPlot: Read, manipulate, and plot data from RiverWareTM (riverware.org), that is saved as rdf (RiverWare data format) files

read_rdf_header2 <- function(con, pos, end){
  
  obj <- list()

  repeat{
    line <- con[pos,1]

    pos <- pos + 1 # advancing line to read
    if(line == end) break
    
    splitLine <- strsplit(line,':')[[1]]
    name <- splitLine[1]
    if(length(splitLine) > 1){
      if(substr(splitLine[2],1,1) == ' ')
        splitLine[2] <- substr(splitLine[2],2,nchar(splitLine[2]))
      contents <- paste(splitLine[2:length(splitLine)],collapse=':')
    } else{
      contents <- NA
    }
    obj[[name]] <- contents
    
    # 1 passed to this function sometimes; when it is, it forces it to read
    # one line and parse
    if(end == 1) break 
    
  }
  
  #returns the object
  
  return(list(data = obj, position = pos))
  
}

read_rdf_meta2 <- function(rdf.mat,rdf.obj){
  rdf.tmp <- read_rdf_header2(rdf.mat,rdf.obj$position,'END_PACKAGE_PREAMBLE')
  rdf.obj[['meta']] <- rdf.tmp$data
  rdf.obj$position <- rdf.tmp$position
  return(rdf.obj)
}

read_rdf_run2 <- function(rdf.mat,rdf.obj){

  this.run <- length(rdf.obj$runs) + 1
  rdf.tmp <- read_rdf_header2(rdf.mat,rdf.obj$position,'END_RUN_PREAMBLE')
  rdf.obj$runs[[this.run]] <- rdf.tmp$data
  rdf.obj$position <- rdf.tmp$position
  
  #time steps
  nts <- as.integer(rdf.obj$runs[[this.run]]$time_steps)
  #for non-mrm files
  if(length(nts) == 0) 
    nts <- as.integer(rdf.obj$runs[[this.run]]$timesteps)
  
  rdf.obj$runs[[this.run]][['times']] <- rdf.mat[rdf.obj$position:(rdf.obj$position + nts -1),1] # readLines(rdf.con,n=nts)
  rdf.obj$position <- rdf.obj$position + nts 

  #Series
  nob <- 0
  repeat{
    
    nob <- nob + 1
    rdf.tmp <- read_rdf_header2(rdf.mat,rdf.obj$position, 'END_SLOT_PREAMBLE')
    rdf.obj$runs[[this.run]][['objects']][[nob]] <- rdf.tmp$data
    rdf.obj$position <- rdf.tmp$position
    
    #name the objecst after their object.slot name
    obj.name <- rdf.obj$runs[[this.run]][['objects']][[nob]]$object_name
    slot.name <- rdf.obj$runs[[this.run]][['objects']][[nob]]$slot_name
    name <- paste(obj.name,slot.name,sep='.')
    names(rdf.obj$runs[[this.run]][['objects']])[nob] <- name
    
    #read in the extr two header pieces
    rdf.tmp <- read_rdf_header2(rdf.mat,rdf.obj$position, 1)
    rdf.obj$runs[[this.run]][['objects']][[nob]]$units <- rdf.tmp$data[[1]]
    rdf.obj$position <- rdf.tmp$position
    rdf.tmp <- read_rdf_header2(rdf.mat,rdf.obj$position, 1)
    rdf.obj$runs[[this.run]][['objects']][[nob]]$scale <- rdf.tmp$data[[1]]
    rdf.obj$position <- rdf.tmp$position
    
    rdf.obj$runs[[this.run]][['objects']][[nob]]$values <- as.numeric(
      rdf.mat[rdf.obj$position:(rdf.obj$position + nts -1),1]
    )
    rdf.obj$position <- rdf.obj$position + nts
    
    #END_COLUMN,END_SLOT, table slots need support here
    #dummy <- readLines(rdf.con,n=2) # just advances position by 2??
    
    
    if(rdf.mat[rdf.obj$position+2,1] == 'END_RUN'){
      #dummy <- readLines(rdf.con,n=1)
      rdf.obj$position <- rdf.obj$position + 3
      break
    } else{
      rdf.obj$position <- rdf.obj$position + 2
    }
  }
  return(rdf.obj)
  
}

#' Read an rdf file into R.
#' 
#' \code{read.rdf2} reads an rdf file into R and formats it as a multi-level list containing
#' all of the metadata included in the rdf file.  Rdf files are generated by RiverWare
#' and are documented in the \href{http://riverware.org/PDF/RiverWare/documentation/}{RiverWare documentation}.
#' 
#' \code{read.rdf2} is faster than \code{read.rdf} since it uses \code{data.table::fread}
#' to read in the file. Two versions will be maintained for a while to ensure they 
#' behave identically.
#' 
#' @param iFile The input rdf file that will be read into R.
#' @return A multi-level list containing all metadata and slot data in the original rdf file.
#' @examples
#' zz <- read.rdf2(system.file('extdata/Scenario/DNF,CT,IG', "KeySlots.rdf", package = "RWDataPlot"))
#' 
#' @export

read.rdf2 <- function(iFile)
{
  rdf.obj <- list()
  # read entire file into memory
  rdf.mat <- as.matrix(data.table::fread(iFile, sep = '\t', header = FALSE, data.table = FALSE))
  rdf.obj$position <- 1 # initialize where to read from
  rdf.obj <- read_rdf_meta2(rdf.mat,rdf.obj)
  
  for(i in 1:as.numeric(rdf.obj$meta$number_of_runs))
    rdf.obj <- read_rdf_run2(rdf.mat,rdf.obj)
  
  rdf.obj$position <- NULL # remove position before returning
  
  return(rdf.obj)
}