R/print.tw.r

In zdealveindy/twinspanR: TWo-way INdicator SPecies ANalysis (and its modified version) in R

#' Printing the results of TWINSPAN
#' 
#' Generic \code{print} function applicable on object of class \code{tw}, created by function \code{twinspan}. With appropriate setting of its arguments returns detail results of TWINSPAN (including indicator species or two-way sorted table).
#' @param x Object of class \code{'tw'}, created by \code{twinspan} function.
#' @param what What should be printed. Default = NULL (only standard output, i.e. \code{data.frame} with three columns stored in \code{x$classif} is returned). Should be (partial match to) one of  \code{c('species.names', 'order.plots', 'reading.data', 'input.parameters', 'levels', 'table', 'twi')}. See Details for explanation.
#' @param clusters Vector of integers. For which clusters (in case of modified TWINSPAN) the results should be returned? Default = NULL (i.e. information will be returned for all created clusters).
#' @param ... Arguments passed to default \code{print} function. Not implemented here.
#' @details Function \code{print.tw} can access different outputs generated by TWINSPAN program, namely those stored in \code{tw.PUN} and \code{tw.TWI} files in \code{/exec} subdirectory. Printed output somewhat differ for standard and modified TWINSPAN, since modified TWINSPAN records information separately for each division, while standard TWINSPAN generate only one output files for all divisions. 
#' 
#' Argument \code{what} can have the following values:
#' \itemize{
#' \item \code{species.names} Prints \code{data.frame} with the full species names (columns \code{full.name}) and 8-letter abbreviations generated for TWINSPAN (and used in output files) by function \code{make.cepnames} from \code{vegan} (column \code{abbrev.name}). 
#' \item \code{order.plots} Prints \code{data.frame} with plots sorted by TWINSPAN algorithm (column \code{order} indicates the sequential order of the plots, column \code{plot.no} stores the original plot number).
#' \item \code{reading.data} Prints the header of TWINSPAN output, containing information about which data have be read by the algorithm
#' \item \code{input.parameters} Prints the second section of TWINSPAN output with setting of input parameters.
#' \item \code{levels} Prints the third section of TWINSPAN output with results (e.g. indicator species) for particular levels of division. 
#' \item \code{table} Prints the two-way sorted table of plots and species (the fourth section of TWINSPAN output)
#' \item \code{twi} Prints all four sections of TWINSPAN output (\code{reading.data}, \code{input.parameters}, \code{levels} and \code{table}).}
#' @return If \code{what} is \code{'species.names'} or \code{'order.plots'}, output is a \code{data.frame}. If \code{what} is \code{'reading.data'}, \code{'input.parameters'}, \code{'levels'}, \code{'table'} or \code{'twi'}, output is printed into standard connection, usually console (if not redirected by \code{sinc}). This output can be recorded using \code{capture.output} as a character vector (each element equals to one line of original console output). Such captured output could be e.g. written to file using \code{write.table} function (see Examples).
#' 
#' In case of modified TWINSPAN, the results for individual hierarchical divisions are separated by lines of '@@@@@@@@@@...'.
#' @examples
#' data (danube)
#' tw <- twinspan (danube$spe)
#' print (tw, 'table')
#'
#' ## The output of print function could be captured by "capture.output" function, 
#' ## and writen into a file using e.g. "write.table":
#' \dontrun{
#' write.table (file = 'table.txt', capture.output (print (tw, 'table')), quote = F, row.names = F)
#' system (shell ('notepad.exe table.txt'))}
#' @seealso \code{\link{summary.tw}}, \code{\link{twinspan}}
#' @export
print.tw <- function (x, what = NULL, clusters = NULL, ...)
{
  if (is.null (what)) print (x$classif) else 
  {
    WHAT <- c('species.names', 'order.plots', 'reading.data', 'input.parameters', 'levels', 'table', 'twi')
    what <- WHAT[pmatch (what, WHAT)]
    if (any (is.na (what))) stop ("Argument 'what' must be one of the following: c('species.names', 'reading.data', 'input.parameters', 'levels', 'table', 'twi')")
    if (length (what) > 1) {what <- what[1]; warning (paste ("Argument 'what' has more tha one value - only the first one (", what, ") will be used.", sep = ''))}
    if (what == 'species.names') printSPNAMES (x) else printTWI (x, what = what, clusters = clusters)
  }
}

printTWI <- function (tw, what = NULL, clusters = NULL) 
{
  if (what %in% 'twi') what <- c('reading.data', 'input.parameters', 'levels', 'table')  
  if (!tw$modif & !is.null (clusters)) warning ("Argument 'clusters' is ignored, because it is relevant only for modified TWINSPAN (but you have calculated standard TWINSPAN)")
  if (tw$modif & !is.null (clusters)) if (max (clusters) > length (tw$twi)+1 || clusters < 2) stop (paste ("Values in argument 'clusters' must be between 2 and ", length (tw$twi)+1, ".", sep = ''))
  twi <- tw$twi
  if (tw$modif == FALSE) 
  {
    twi <- readTWI (twi)[what]
    if (any (what %in% 'order.plots')) print (twi$order.plots) else cat (unlist (twi), sep = '\n')
  }
  if (tw$modif == TRUE)
  {
    temp <- lapply (X = if (is.null (clusters)) 2:(length (twi)+1) else clusters, FUN = function (l) 
    {
      twi <- readTWI (twi[[l-1]])[what]
      if (what != 'order.plots')
      {
        cat (' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@', sep = '\n')
        cat (paste (' Modified TWINSPAN - step ',l-1, ' (', l,' clusters)', sep = ''), sep = '\n')
        cat (unlist (twi), sep = '\n') 
      } else twi$order.plots
    })
    if (what == 'order.plots') print (temp)
  }
}


readTWI <- function (twi)
{
  shorten <- function (x) 
  {
    temp <- lapply (x, FUN = function (x0)
    {
      temp <- unlist (strsplit (x0, split = ''))
      temp0 <- temp[1]
      while (temp0 == ' ') {temp <- temp[-1]; temp0 <- temp[1]}
      temp <- paste (temp, collapse = '')
      temp
    })
    return (unlist (temp))
  }
  separators <- which (twi %in% c(' \f', '\f Input parameters:'))
  twi.temp <- list ()
  twi.temp$reading.data <- twi [1:(separators[1])-1]
  twi.temp$input.parameters <- twi [(separators[1]+1):(separators[2]-1)]
  twi.temp$levels <- twi[(separators[2]+1):(separators[3]-1)]
  twi.temp$table <- twi[(separators[3]+1):length (twi)]
    temp1 <- twi.temp$levels [(which (twi.temp$levels == " ORDER OF SAMPLES")+1):length (twi.temp$levels)]
    temp1 <- lapply (temp1, FUN = function (x) substr (x, 2, length (unlist (strsplit (x, split = '')))))
    temp1 <- unlist (strsplit (paste (temp1, collapse = ' !'), split = '!'))
    temp1 <- as.data.frame (list (order = as.numeric (substr (temp1, 1, 5)), plot.no = shorten (substr (temp1, 6, 13))))
  twi.temp$order.plots <- temp1
  return (twi.temp)
}

printSPNAMES <- function (tw) tw$spnames