# Author: Walter Xie
# Accessed on 10 Mar 2016
#' Create folder from \code{\link{file.path}} if not exist.
#'
#' @param dir.path The folder path constructed by \code{\link{file.path}}.
#' @keywords IO
#' @export
#' @examples
#' figDir <- file.path(workingPath, "figures")
#' ComMA::mkdir(figDir)
mkDir <- function(dir.path) {
require(tools)
if (!file.exists(dir.path)) {
dir.create(dir.path)
cat("Config : create folder", dir.path, "\n")
} else {
cat("Folder", dir.path, "exists.\n")
}
}
#' Split a file path into folder names vector
#'
#' @param path The file path to be split.
#' @source \url{http://stackoverflow.com/questions/29214932/split-a-file-path-into-folder-names-vector}
#' @return
#' A the reversed vector of folder names.
#' @keywords IO
#' @export
#' @examples
#' split_path("/home/foo/stats/index.html")
#' [1] "index.html" "stats" "foo" "home"
#' split_path("C:\\Windows\\System32")
#' [1] "System32" "Windows" "C:"
splitPath <- function(path) {
rev(setdiff(strsplit(path,"/|\\\\")[[1]], ""))
}
#' Read a file to a data frame.
#'
#' If the file extension is \emph{csv},
#' then use \code{\link{read.csv}}, otherwise use \code{\link{read.table}}.
#'
#' @param file The 1st row is column names, the 1st column is row names.
#' @param row.names A vector of row names. This can be a vector giving the actual row names,
#' or a single number giving the column of the table which contains the row names,
#' or character string giving the name of the table column containing the row names.
#' If there is a header and the first row contains one fewer field than the number of columns,
#' the first column in the input is used for the row names.
#' Otherwise if row.names is NULL, the rows are numbered. Default to 1.
#' Using row.names = NULL forces row numbering.
#' @param header A logical value indicating whether the file contains
#' the names of the variables as its first line. Default to TRUE.
#' @param sep Only used for non \emph{csv} file. Default to tab "\\t".
#' @param msg.file,msg.col,msg.row The message regarding file, column and row, if verbose=TRUE.
#' @param verbose More details. Default to TRUE.
#' @param ... Other arguments passed to \code{\link{read.table}}.
#' @return
#' A data frame from the file, such as
#' \tabular{rrrr}{
#' OTU_id \tab plot01 \tab plot02\tab ...\cr
#' OTU_1 \tab 1 \tab 0 \tab ...\cr
#' OTU_2 \tab 100 \tab 200 \tab ...\cr
#' OTU_3 \tab 56 \tab 3 \tab ...
#' }
#' @export
#' @keywords IO
#' @examples
#' community.matrix <- readFile("16S.txt", msg.file="16S OTU table", msg.col="samples", msg.row="OTUs")
#' taxa.table <- readFile("16S_taxonomy_table.txt", msg.file="16S taxonomy table", msg.row="OTUs")
#' env <- readFile("env_data.txt", msg.file="enviornmental data", msg.row="samples")
#' taxa.phyla <- readFile("taxonomy97phyla.txt", row.names=NULL)
readFile <- function(file, sep="\t", header=TRUE, row.names=1, verbose=TRUE,
msg.file="file", msg.col="columns", msg.row="rows", ...) {
suppressMessages(require(tools))
# sep="\t" only work for non csv file
if (tolower(file_ext(file))=="csv") {
df <- read.csv(file, header=header, row.names=row.names,
check.names=FALSE, stringsAsFactors=FALSE, ...)
} else {
# be careful read.table bug
df <- read.table(file, sep=sep, header=header, row.names=row.names,
check.names=FALSE, stringsAsFactors=FALSE, ...)
}
if (verbose) {
if (header)
msg.row <- paste(msg.row, "excluding column names from row 1")
if (!is.null(row.names))
msg.col <- paste(msg.col, "excluding row names from column", row.names)
cat("\nUpload", msg.file, ":", ncol(df), paste0(msg.col, ","),
nrow(df), paste0(msg.row, ","), "from file", file, "\n")
}
return(df)
}
#' Write the data fram (table) to a file.
#'
#' @param df A data frame.
#' @param file If the file extension is \emph{csv},
#' then use \code{\link{write.csv}},
#' otherwise use \code{\link{write.table}}.
#' @param first.col.name The 1st column name when
#' \code{row.names == TRUE && col.names == TRUE}.
#' Default to "row.names".
#' @param ... Other arguments passed to \code{\link{write.table}}.
#' @export
#' @keywords IO
#' @examples
#' writeTable(df, file.path)
writeTable <- function(df, file, append = FALSE, quote = FALSE, sep = "\t",
row.names = TRUE, col.names = TRUE, first.col.name="row.names",
msg.file="file", msg.col="columns", msg.row="rows",
verbose=TRUE, ...) {
suppressMessages(require(tools))
if (tolower(file_ext(file))=="csv") {
write.csv(df, file, append = append, quote = quote,
row.names = row.names, col.names = col.names, ...)
} else if (row.names == TRUE && col.names == TRUE) {
cat(paste(c(first.col.name, colnames(df)), collapse = sep), file = file, sep = "\n")
write.table(df, file, append = TRUE, quote = quote, sep = sep,
row.names = TRUE, col.names = FALSE, ...)
} else {# .tsv .txt
#write.table bug: if row.names = TRUE, mistake to start col names from the 1st cell
write.table(df, file, append = append, quote = quote, sep = sep,
row.names = row.names, col.names = col.names, ...)
}
if (verbose) {
cat("\nWrite", msg.file, ":", ncol(df), paste0(msg.col, ","),
nrow(df), paste0(msg.row, ","), "to file", file, "\n")
}
}
#' Print data fram (table) as Latex format to either file or console,
#' which is extened from \code{\link{xtable}}.
#'
#' @param df A data frame.
#' @param caption Latex table caption.
#' @param label Latex table label.
#' @param file If NULL, then print the results to console,
#' otherwise print them to the file. Default to NULL.
#' @param invalid.char If it is TRUE, then add \\ to all
#' _ or \% for Latex. Default to TRUE.
#' @param include.rownames,caption.placement
#' Refer to \code{\link{print.xtable}}.
#' @param ... Other arguments passed to \code{\link{xtable}}.
#' @export
#' @keywords IO
#' @examples
#' tableFile <- file.path(workingPath, "report.tex")
#' printXTable(data.frame, caption = "Phylogenetic beta diversity",
#' label = "tab:pd:beta", file=tableFile)
printXTable <- function(df, file=NULL, caption="The table of", label="tab:label",
invalid.char=TRUE, include.rownames=TRUE,
caption.placement="top", ...) {
if (invalid.char) {
rownames(df) <- gsub("_", "\\\\_", rownames(df))
colnames(df) <- gsub("_", "\\\\_", colnames(df))
df <- ComMA::gsubDF("_", "\\\\_", df)
df <- ComMA::gsubDF("%", "\\\\%", df)
#df <- ComMA::convertType(df, FUN=as.numeric)
}
suppressMessages(require(xtable))
if (is.null(file)) {
print(xtable(df, caption = caption, label = label, caption.placement = caption.placement, ...),
sanitize.text.function = function(x){x}, include.rownames=include.rownames)
} else {
print(xtable(df, caption = caption, label = label, caption.placement = caption.placement, ...),
sanitize.text.function = function(x){x}, include.rownames=include.rownames,
file=file, append=TRUE)
}
}
# for Latex file
mkValidTex <- function(file) {
# change all _, %
system(paste("sed -i.bak 's/\\_/\\\\_/g;' ", report.file))
system(paste("sed -i.bak 's/\\%/\\\\%/g;' ", file))
}
#' Read File Line By Line
#'
#' @param file The file to read.
#' @param rm.empty.line If TRUE, as default, remove all empty lines.
#' @return
#' A character vector of length the number of lines read. Refer to \code{\link{readLines}}.
#' @keywords IO
#' @export
#' @examples
#' lines <- readFileLineByLine("time.txt")
readFileLineByLine <- function(file, rm.empty.line=T) {
conn <- file(file,open="r")
lines <-readLines(conn)
if (rm.empty.line)
lines <- lines[which(ComMA::trimSpace(lines)!="")]
close(conn)
return(lines)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.