R-alpha: generic write()
Kurt Hornik
Kurt.Hornik@ci.tuwien.ac.at
Sun, 25 May 1997 15:35:04 +0200
Attached is a first shot at a generic write with my `old' write.table as
write.data.frame, suitably modified. There is also a stupid generic
latex function, which is just there because it illustrates that the
extra arguments sep and eol are useful.
In playing with it, I noticed a few `problems'.
* The documentation for factor() says,
If exclude is set to a zero length vector, then any NA values in
x are used for form a new level for the factor. This means that
there will be no NA values in the result.
Perhaps I don't really understand this, but
R> x <- factor(c(1:3, NA), exclude=numeric(0))
R> x
[1] 1 2 3 NA
R> levels(x)
[1] "1" "2" "3"
???
* coerce.c has two error messages of the form
error("use \"factor\", \"ordered\", \"cut\" or \"code\" to create factors\n");
but there is no function `code'.
* cat() is a bit inconsistent:
R> cat(x, sep = "&")
1&2&3&4R> cat(x, sep = "&\n")
1&
2&
3&
4
R>
Actually, a final newline is added whenever sep contains a newline.
>From src/main/builtin.c:
nlsep = 0;
for (i = 0; i < LENGTH(sepr); i++)
if (strstr(CHAR(STRING(sepr)[i]), "\n")) nlsep = 1;
...
if ((pwidth != INT_MAX) || nlsep)
Rprintf("\n");
I am not sure this is the right thing to do.
(In particular, it makes it rather messy to incrementally build data
files with `explicit' end-of-line strings (such as "\\") by appending
via cat().)
* I am not sure what should happen with names or dimnames when writing.
* I am also not sure what the optional argument quote should do. Should
it quote UNCONDITIONALLY, or only the character strings?
-k
***********************************************************************
write <- function(x, file = "data", ...) UseMethod("write")
write.default <-
function(x, file = "", append = FALSE, quote = FALSE, sep = " ", eol = "\n",
na = NA, ncolumns = if (is.character(x)) 1 else 5, ...) {
if (is.matrix(x)) {
write.data.frame(x, append = append, quote = quote, sep = sep,
eol = eol, na = na, col.names = FALSE, ...)
}
else {
if (is.factor(x))
x <- levels(x)[x]
else
x <- as.vector(x)
if (is.vector(x)) {
x[is.na(x)] <- na
if (quote)
x <- paste("\"", x, "\"", sep = "")
cat(x, file = file, sep = c(rep(sep, ncolumns - 1), eol),
append = append)
}
else
stop("No suitable write method available")
}
}
write.data.frame <-
function(x, file = "", append = FALSE, quote = FALSE, sep = " ", eol = "\n",
na = NA, row.names = TRUE, col.names = TRUE)
{
if (is.data.frame(x) && is.logical(quote) && quote)
quote <- which(unlist(lapply(x, is.character)))
x <- as.matrix(x)
p <- ncol(x)
d <- dimnames(x)
x[is.na(x)] <- na
if (is.logical(quote))
quote <- if (quote) 1 : p else NULL
else if (is.numeric(quote)) {
if (any(quote < 1 | quote > p))
stop("invalid numbers in quote")
}
else
stop("invalid quote specification")
if (is.logical(row.names)) {
if (row.names)
x <- cbind(d[[1]], x)
}
else {
row.names <- as.character(row.names)
if (length(row.names) == nrow(x))
x <- cbind(row.names, x)
else
stop("invalid row.names specification")
}
if (!is.null(quote) && (p < ncol(x)))
quote <- c(0, quote) + 1
if (is.logical(col.names))
col.names <- if (col.names) d[[2]] else NULL
else {
col.names <- as.character(col.names)
if (length(col.names) != p)
stop("invalid col.names specification")
}
if (!is.null(col.names)) {
if (append)
warning("appending column names to file")
if (!is.null(quote))
col.names <- paste("\"", col.names, "\"", sep = "")
cat(col.names, file = file, sep = rep(sep, p - 1), append = append)
cat(eol, file = file, append = TRUE)
append <- TRUE
}
for (i in quote)
x[, i] <- paste("\"", x[, i], "\"", sep = "")
cat(t(x), file = file, sep = c(rep(sep, ncol(x) - 1), eol),
append = append)
}
latex <- function(x, file = "", ...) UseMethod("latex")
latex.default <-
function(x, file = "", ...) {
write(x, file = file, sep = " & ", eol = " \\\\\n", ...)
}
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To: r-devel-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-