R/write_is_file.R

In jhilaire/guidr: This package is a wrapper to the GUIDE algorithm for decision-tree methods (Loh 2002)

#' Create a GUIDE importance scoring batch input file
#'
#' This function generates a GUIDE importance scoring batch input file
#' @param i_singleTree
#' @param i_treeType
#' @param i_treeOptions
#' @param i_fpath
#' @param i_fname
#' @param VERBOSE=FALSE
#' @keywords GUIDE, input, batch file
#' @export
#'

write_is_file <- function(i_singleTree, i_treeType, i_treeOptions, i_fpath, VERBOSE=FALSE) {

  v_fname_out   <- basename(i_fpath$out)
  v_fname_desc  <- basename(i_fpath$desc)
  v_fname_tex   <- basename(i_fpath$tex)
  v_fname_fn    <- basename(i_fpath$fn)
  v_fname_sfv   <- basename(i_fpath$sfv)
  v_fname_rnam  <- basename(i_fpath$rnam)
  v_fname_isres <- basename(i_fpath$isres)
  v_fname_rcoef <- basename(i_fpath$rcoef)
  v_fname_R     <- basename(i_fpath$R)
  #v_outPath    <- i_fpath$outPath

  # Single trees
  if (i_singleTree) {
    #------ Single tree header -----------------------------------------------------------------------
    catret("GUIDE       (do not edit this file unless you know what you are doing)", file=i_fpath[["is"]])
    catret("  25.4      (version of GUIDE that generated this file)", file=i_fpath[["is"]], append=T)
    catret(" 2          (1=model fitting, 2=importance or DIF scoring, 3=data conversion)", file=i_fpath[["is"]], append=T)
    catret(paste0("\"", v_fname_out, "\"","  (name of output file)"), file=i_fpath[["is"]], append=T)

    # Tree type
    catret(" 2          (1=classification, 2=regression, 3=propensity score grouping)", file=i_fpath[["is"]], append=T)

    #------ Linear trees -------------------------------------------------------------------------------
    if (substr(i_treeType,1,2) == "LS" || substr(i_treeType,1,3) == "LMS") {
      catret(" 1          (1=linear, 2=quantile, 3=Poisson, 4=hazard, 5=multiresponse or itemresponse, 6=longitudinal with T variables)", file=i_fpath[["is"]], append=T)

      #------ Least squares ----------------------------------------------------------------------------
      if (substr(i_treeType,1,2) == "LS") {
        catret(" 1          (1=least squares, 2=least median of squares)", file=i_fpath[["is"]], append=T)
      }

      #------ Least median of squares ------------------------------------------------------------------
      if (substr(i_treeType,1,3) == "LMS") {
        catret(" 2          (1=least squares, 2=least median of squares)", file=i_fpath[["is"]], append=T)
      }

      #------ Single LS/LMS tree footer ---------------------------------------------------------------
      # (all set to default values, all files are generated)
      catret(" 1          (1=interaction tests, 2=skip them)", file=i_fpath[["is"]], append=T)

      catret(paste0("\"", v_fname_desc, "\"","  (name of data description file)"), file=i_fpath[["is"]], append=T)

      catret("  0.01000   (expected fraction of noise selected)", file=i_fpath[["is"]], append=T)

      # Fraction of cases for splitting
      catret(" 2          (1=accept default splitting fraction, 2=change it)", file=i_fpath[["is"]], append=T)
      catret("  0.00000   (frac, where #splits = max(9,fract*n), with n = #cases in node)", file=i_fpath[["is"]], append=T)
      #catret(paste0("  ",format(i_treeOptions$splitfrac, nsmall=4),"     (frac, where #splits = max(9,fract*n), with n = #cases in node)"), file=i_fpath[["is"]], append=T)

      catret(" 2          (1=default max. number of split levels, 2=specify no. in next line)", file=i_fpath[["is"]], append=T)
      catret(paste0("  ",format(i_treeOptions$maxsplits, nsmall=4),"     (frac, where #splits = max(9,fract*n), with n = #cases in node)"), file=i_fpath[["is"]], append=T)

      catret(" 2          (1=default min. node size, 2=specify min. value in next line)", file=i_fpath[["is"]], append=T)
      catret(paste0("  ",format(i_treeOptions$minnbnodes, nsmall=4),"     (frac, where #splits = max(9,fract*n), with n = #cases in node)"), file=i_fpath[["is"]], append=T)

      # Create new description file
      catret(" 2          (1=do not create description file for selected variables, 2=create the file)", file=i_fpath[["is"]], append=T)
      catret(" 1          (1=exclude non-selected variables, 2=exclude selected variables)", file=i_fpath[["is"]], append=T)
      catret(paste0("\"", strsplit(v_fname_desc,".",fixed=TRUE)[[1]][1], "_new.txt", "\"","  (split variable file name)"), file=i_fpath[["is"]], append=T)

      # Create file for importance scores
      catret("  1          (1=create file for importance scores, 2=do not create)", file=i_fpath[["is"]], append=T)
      catret(paste0("\"", v_fname_isres, "\"","  (file name for importance scores)"), file=i_fpath[["is"]], append=T)

    }

    #------ Quantile regression trees ------------------------------------------------------------------
    if (substr(i_treeType,1,1) == "Q") {
      print("Not yet developed")
      stop()
    }

    # Tree ensemble
  } else {
    print("Not yet developed")
    stop()
  }
}