R/read.formindData.r

In fjbohn/fast: Forest analysing and simulating toolbox

#' read.formindData
#' @description runs FORMIND using a CMDfile and check run for errors.
#'
#' @param projectName Name of the result files generated by a formind simulation
#' @param path Character string specifying the location of the results folder. Default: "results/". Note string has to end with "/".
#' @param fileTypes Character string specifying a set of data type (e.g "default", which loads biomass, basal area, and stem number result files) load or a single file suffix (e.g. "res" for res-file) or a string vector containing several suffixes of files (e.g c("ba", "env")). Further options are: "hectare" loads all available data files which contain data aggregated on the hectare level; "patch" for plot level aggergated data; "cohort" for cohort level data; "patch_height" for data aggregated for every plot and height layer;"hectare_dbhClass" for data aggregated for every dbh class on the hectare level
#' @param returnObejct Character string specifying the class of the return object. The default is "Forest", which returns a Forest object. "data.table" return data.table.
#' 
#' @seealso \code{\link{Forest-class}}
#' 
#' @import data.table
#' @export

# todo error meassage leere result files.

read.formindData<-function(
  projectName = "experiment"  # name of the outputfiles
  ,path = "results/"    # or alternative path to result folder
  ,fileTypes="default"      # resultfiles are agregated on"hectare" level or "patch" level "patch_height" "hectare_dhbClass"level or "cohort"
  ,returnObejct="Forest"     # data.table
  # or a vector or file-suffixes of same spatial resolution
  # TODO fire? gap? landslide
  # lai
)
{
  # list of result files
  hectare_suffixes<-c("ba","ba_th","bt","bt_th","cflux","div","div_th","env","mort","in","lai_mean","n","n_th","prod","seed","stree","sv","water")
  plot_suffixes<-c("lai_plot","cfluxplot","waterplot")
  cohort_suffixes<-c("res")
  patch_height_suffixes<-c("lai_plot_layer")
  hectare_dbhClass_suffixes<-c("dia","diagr")
  default_suffixes<-c("ba","bt","n")
  
  # create list of suffixes
  suffixes<-fileTypes
  if(length(fileTypes)==1){
    switch(fileTypes,
           hectare={suffixes<-hectare_suffixes}, 
           plot={suffixes<-plot_suffixes}, 
           cohort={suffixes<-cohort_suffixes}, 
           default={suffixes<-default_suffixes},
           patch_height={suffixes<-patch_heightsuffixes},
           hectare_dbhClass={suffixes<-hectare_dbhClass_suffixes},
           {}
    )
  }
  
  
  if(sum(suffixes=="gap" )>0)stop("not testet suffixes were selected")
  
  
  
  # get names of files, which will be read--------------------------
  
  files<-data.table("file_name"=rep("not found",length(suffixes))
                    ,"file_type"=suffixes
                    ,"read"=rep(FALSE,length(suffixes))
  )
  if(is.na(projectName)){
    
    files_dir<-dir(path)
    names<-vector()
    for( i in 1:length(files_dir)){
      names[i]<-strsplit(files_dir[i],"[.]")[[1]][1]
    }
    name<-names(table(names))
  }else{
    files_dir<-dir(path)
  }
  
  for( n in 1:length(projectName)){  
    for( i in 1:nrow(files)){
      datei<-files_dir[which(files_dir==paste0(projectName[n],".",files[i,file_type]))]
      if(length(datei)>=1)files$file_name[i]<-datei
    }
    
    # test of all files in folder ---------------------------------
    if(nrow(files[file_name=="not found"])>0 & nrow(files[file_name=="not found"])<nrow(files) ){
      not_found<-vector()
      for( i in 1:length(files[file_name=="not found"]$file_type))
        not_found<-paste(not_found,files[file_name=="not found"]$file_type[i],sep=" ")
      warning("warning: files with the following suffixes are not found:", not_found, call.=FALSE )
      
    }
    if(nrow(files[file_name=="not found"])==nrow(files)){
      stop("ERROR: no files found")
    }
    # TODO test for correct combinations
    if(length(nrow(files)>1) & length(files[file_type=="res"])==1)
      stop("ERROR: RES-file combined with others")
    
    ## cleaning up ------------------------
    files<-files[file_name!="not found"]
    dateiname<-strsplit(files$file_name[1], "[.]")[[1]][1]
    
    # read files
    for( i in 1:nrow(files)){
      resDaten<-read.table(paste0(path,files$file_name[i]),skip=2,header=T)
      
      if(nrow(resDaten)==0)stop(paste0("empty result file: ",files$file_name[i] ))
      
      if(i == 1) {
        daten<-resDaten
        einheiten<-as.vector(t(read.table(paste0(path,files$file_name[i]),skip=1,nrows=1,sep="\t")))
      }else{
        daten<-cbind(daten,resDaten)
        einheiten<-c(einheiten,as.vector(t(read.table(paste0(path,files$file_name[i]),skip=1,nrows=1,sep="\t"))))
      } 
      set(files,i,"read",TRUE)
      
    }
    
    notTimeData<-which(colnames(daten)!="Time")
    daten<-daten[,c(1,notTimeData)]
    daten<-cbind(daten,n)
    colnames(daten)[ncol(daten)]<-"ID"
    
    if(n ==1){
      allDaten<-daten
    }else{
      allDaten<-rbind(allDaten,daten)
    }
    
  }
  # check for NAs in data
  for(i in 1:ncol(allDaten)){
    nas<-which(is.na(allDaten[,i]))
    if(length(nas)>0)warning("There are NAs in your data!?! This should not happen using the FORMIND model.")
  }
  
  # as data table
  if(returnObejct=="data.table"){
    allDaten<-data.table(allDaten[,c(1,which(colnames(allDaten)!="Time"))])
    allDaten[,file:=dateiname]
    
    # write labels as attributes
    label<-readLines(paste0(path,files$file_name[i]))[2]
    #attr(daten, "labels") <- strsplit(label,"\t")
    setattr(allDaten,"labels",strsplit(label,"\t"))
  }
  # as Forest object
  if(returnObejct=="Forest"){
    einheiten<-einheiten[c(1,which(einheiten!="Time [a1]"))]
    einheiten<-einheiten[which(einheiten!="Time [a]")]
    einheiten<-transformUnits(einheiten)
    einheiten<-c(einheiten,"fileID")
    
    allDaten<-Forest(data=allDaten,units=einheiten)
    
  }
  # message wich files where read:
  message("the follwing simulations were read:")
  for( i in projectName){
    message(i)
  }
  
  message("")
  
  message("and the following fileTypes were read:")
  for( i in 1:nrow(files))
    if(files[i,read] ) message(strsplit(files[i,file_name],"[.]")[[1]][2])
  
  
  # return 
  return (allDaten)
}