R/write.txt.wide.R

In GegznaV/hyperSpec2: Work with Hyperspectral Data, i.e. Spectra + Meta Information (Spatial, Time, Concentration, ...)

###-----------------------------------------------------------------------------
###
### write.txt.wide
###
###
##' @param header.lines Toggle one or two line header (wavelengths in the
##'   second header line) for \code{write.txt.wide}
##' @aliases write.txt.wide
##' @rdname textio
##' @export
##' @importFrom utils write.table
##' 

write.txt.wide <- function (object,
                            file = "",
                            cols = NULL,
                            quote = FALSE, sep = "\t",
                            row.names = FALSE,
                            col.names = TRUE,
                            header.lines = 1,   # 1 or 2 line header?
                                        # use labels instead of column names?
                            col.labels = if (header.lines == 1) FALSE else TRUE, 
                            append = FALSE,
                            ...){
  validObject (object)

  if (! is.null (cols))
    object <- object [, cols]

  if (col.names){
    col.spc <- match ("spc", colnames (object@data))

    if (col.labels){
      cln <- match (colnames (object@data), names (object@label))
      cln[!is.na (cln)] <- object@label [cln[!is.na(cln)]]
      cln[is.na (cln)] <- colnames (object@data) [is.na(cln)]
      cln <- sapply (cln, as.character)
                                        #cln [-col.spc] <- object@label []
    } else {
      cln <- colnames (object@data)
    }

    i <- seq_along (cln)

    if (header.lines == 1){
      write.table (matrix (c(if (row.names) "" else NULL,
                             cln [i < col.spc],
                             object@wavelength,
                             cln [i > col.spc]
                             ), nrow = 1),
                   file = file, append = append, quote = quote, sep = sep,
                   row.names = FALSE, col.names = FALSE)
      append = TRUE
    } else if (header.lines == 2) {
      ## 1st line
      write.table (matrix (c (
                              if (row.names) "" else NULL,
                              cln [i < col.spc],
                              if (col.labels) cln [col.spc] else "",
                              rep ("", length (object@wavelength) - 1),
                              cln [i > col.spc]), nrow = 1),
                   file = file, append = append, quote = quote, sep = sep,
                   row.names = FALSE, col.names = FALSE)
      append = TRUE 
      ## 2nd line
      write.table (matrix (c (if (row.names) (if (col.labels) as.character (object@label$.wavelength)
      else "wavelength")
      else NULL,
                              rep ("", sum (i < col.spc)),
                              object@wavelength,
                              rep ("", sum (i > col.spc))
                              ), nrow = 1),
                   file = file, append = append, quote, sep,
                   row.names = FALSE, col.names = FALSE)

    } else {
      stop ("Only 1 or 2 line headers supported.")
    }

  }

  # no AsIs columns!
  for (c in which (sapply (object@data, class) == "AsIs"))
    class (object@data [[c]]) <- NULL
   
  write.table (object@data, file = file, append = append, quote = quote, sep = sep,
               row.names = row.names, col.names = FALSE, ...)
}