_dev/rfvs.R

In jstrunk001/RSForInvt: Remote Sensing FORest INVenTory related analysis tasks, especially FUSION, lidR, NVEL

#'@title
#'  read an las file
#'
#'@description
#'  read an las file
#'
#'@details
#'  read an las file
#'
#'\cr
#'Revision History
#' \tabular{ll}{
#'1.0 \tab 2017 March 08 Created\cr
#'}
#'
#'@author
#'
#'Jacob Strunk <strunky@gmail.com>
#'
#'@param path single path
#'@param paths vector of paths for 'read_header()'
#'
#'@return
#'  <Delete and Replace>
#'
#'@examples
#'    files=list.files("C:\\temp\\lidar_test\\",full.names=T)
#'    print(read_header("C:\\temp\\lidar_test\\183_302.las"))
#'    print(read_header(files))
#'
#'@import tools sp
#'
#'@export
#
#'@seealso \code{\link{read_dtm}}\cr \code{\link{gridmetrics}}\cr

fvs_make_keyfiles = function(
  plot_df
  ,processing_dir
  ,path_key_proto = NULL
  ,clear_db = T
  ,clear_keys = T
  ,cluster = NULL
){
  ##divide by cluster if necessary
  plot_df$cluster = 1
  db_dir = paste0(processing_dir,"/db/")
  key_dir = paste0(processing_dir,"/keyfiles/")
  n_cluster = length(cluster)
  if(n_cluster>1){
    clus_n = rep(1:n_cluster,times=(trunc(nrow(plot_df)/n_cluster) + 1))
    plot_df$cluster = clus_n[1:nrow(plot_df)]
  }
  plot_df$output_db = paste0(db_dir,plot_df$cluster,".db")
  ###create directories if they don't exits
  for(a_dir in c(processing_dir,db_dir,key_dir)){
    if(!dir.exists(a_dir)){
      dir.create(a_dir)
    }
  }
  ##create dbs if they don't exist
  sapply(unique(plot_df$output_db),function(x){
    if(!file.exists(x)){
      dbDisconnect(dbConnect(SQLite(),x))
    }
  })

  ###clear current keyfiles
  if(clear_keys){
    paths = dir(key_dir,pattern="key$",full.names=T)
    file.remove(paths)
    paths = dir(key_dir,pattern="out$",full.names=T)
    file.remove(paths)
  }
  ##clear current output db
  if(clear_db){
    sapply(unique(plot_df$output_db),function(x){
      output_con = dbConnect(SQLite(),x)
      tabs = dbListTables(output_con)
      sapply(tabs,function(x){
        dbExecute(output_con,sprintf("delete from %s",x))
      })
      try(dbCommit(output_con),silent=T)
      dbDisconnect(output_con)
    })
  }
  ##add input_db to plot_df
  ##add the keyfile path
  plot_df$key_path = paste0(key_dir,"/",plot_df$cn,".key")
  ##read the key prototype
  if(!is.null(path_key_proto)){
    key_proto = readLines(path_key_proto)
  }else{
    key_proto = .get_keyword_prototype()
  }
  ##use clusters if given
  if(n_cluster>1){
    clusterExport(cluster,c("key_proto"),envir=environment())
  }
  ##function to write key files
  write_batch = function(a_line){
    a_proto = key_proto
    ##these are the values that are substituted in the key file
    parm_list = names(a_line)
    for(a_parm in parm_list){
      a_proto = gsub(paste0("@",a_parm,'@'),a_line[[a_parm]],a_proto)
    }
    writeLines(a_proto,a_line$key_path)
    return(a_line$key_path)
  }
  ##run in parallel or in a single thread
  if(n_cluster>2){
    parLapply(cluster,split(plot_df,1:nrow(plot_df)),write_batch)
  }else{
    lapply(split(plot_df,1:nrow(plot_df)),write_batch)
  }
  return(plot_df)
}


rfvs_load=function(webpath="https://sourceforge.net/code-snapshots/svn/o/op/open-fvs/code/open-fvs-code-r3840-rFVS-R.zip", out=NA){

  #download files to package directory

  #source files


}


###run in fvs#############################################
fvs_run = function(
  key_df
  ,cluster=NULL
  ,clear_db = T
){
  t1 = Sys.time()
  print(paste("FVS runs started at",t1))
  ##clear output DBs if specified
  if(clear_db){
    sapply(unique(key_df$output_db),function(x){
      output_con = dbConnect(SQLite(),x)
      tabs = dbListTables(output_con)
      sapply(tabs,function(x){
        dbExecute(output_con,sprintf("delete from %s",x))
      })
      try(dbCommit(output_con),silent=T)
      dbDisconnect(output_con)
    })
  }
  fvs_runs = paste0(key_df$fvs_path," --keywordfile=",gsub("/","\\\\",key_df$key_path))
  if(is.null(cluster)){ ##run in series
    lapply(fvs_runs,function(x){
      system(x)
    })
  }else{ ###run in parallel but split so each cluster uses the same DB in series
    pieces = split(fvs_runs,key_df$cluster)
    parLapply(cluster,pieces,function(set_of_paths){
      lapply(set_of_paths,function(x){
        system(x)
      })
    })
  }
  t2 = Sys.time()
  print(paste("FVS runs finished at",t2))
  print(difftime(t2,t1,units="mins"))
}




#####################################################
#returns the keyword prototype #####################

fvs_make_keyfile_prototype = function(
  title = "!!title: FVS key prototype"
  ,invyr = "InvYear       2009"
  ,timint = "TimeInt                 10 "
  ,numcycle = "NumCycle     1 "
  ,notriple = "NoTriple"
  ,nodgl =    "NODGL"
  ,dgstdev =   "DGSTDEV           0 "
  ,treelist =    "TREELIST          0                                                           1"
  ,compute =    "COMPUTE           0"
){
  return(
    c(
      title,
      "StdIdent",
      "@cn@",
      "StandCN",
      "@cn@",
      "MgmtId",
      "A002",
      invyr
      ,timint
      ,numcycle
      ,notriple
      ,nodgl
      ,dgstdev
      ,treelist
      ,compute,
      "END",
      "*Database information",
      "DATABASE",
      "DSNIn",
      "@input_db@",
      "StandSQL",
      "SELECT *",
      "FROM @stand_table@",
      "WHERE Stand_CN = '%Stand_CN%'",
      "EndSQL",
      "TreeSQL",
      "SELECT *",
      "FROM @tree_table@",
      "WHERE Stand_CN ='%Stand_CN%'",
      "EndSQL",
      "END",
      "*Output Datatabase information",
      "DataBase",
      "DSNOut",
      "@output_db@",
      "* OUtput FVS_Summary, FVS_Compute, TREELIST",
      "Summary            2",
      "Compute            0         1",
      "TREELIST           2         1",
      "END",
      "* End database block",
      "*Clear output tables",
      "DelOTab            1",
      "DelOTab            2",
      "DelOTab            4",
      "* COMPUTE variables",
      "COMPUTE            0",
      "BA0 = SPMCDBH(2,0,0,0,999,0,999,0)",
      "BA4 = SPMCDBH(2,0,0,4,999,0,999,0)",
      "BA8 = SPMCDBH(2,0,0,8,999,0,999,0)",
      "BA16 = SPMCDBH(2,0,0,16,999,0,999,0)",
      "BA24 = SPMCDBH(2,0,0,24,999,0,999,0)",
      "COV0 = SPMCDBH(7,0,0,4,999,0,999,0)",
      "COV4 = SPMCDBH(7,0,0,4,999,0,999,0)",
      "COV8 = SPMCDBH(7,0,0,8,999,0,999,0)",
      "COV16 = SPMCDBH(7,0,0,16,999,0,999,0)",
      "COV24 = SPMCDBH(7,0,0,16,999,0,999,0)",
      "END",
      "Process",
      "Stop")
  )
}