[Rd] write.table with quote=TRUE fails on nested data.frames

[Emil Bode]

Looks like I’m bumping a lot into unexpected behaviour lately, but I think I found a bug again, but don’t have access to Bugzilla:
Write.table (from core-package utils) doesn’t handle nested data.frames well, the quote arguments only marks top-level character (or-factor columns) for quoting, so this fails:

df <- data.frame(a='One;Two;Three',
                 b=I(data.frame(c="OtherVal",
                                d='Four;Five;Six',
                                e=4)),
                f=5)
write.table(df, "~/Desktop/Tempfile.csv", quote = T, col.names = NA,
           sep = ";", dec = ",", qmethod = "double")

The “four;five;six” string is stored unquoted, so read.table (or read.csv) breaks down.
This also affects write.csv and write.csv2, but I’ve written a patch,
See here-under.
Anyone who could file this for me?

Best regards,
Emil Bode

New write.table, note that its environment needs to be set to namespace:utils
write.table <- function (x, file = "", append = FALSE, quote = TRUE, sep = " ",
                         eol = "\n", na = "NA", dec = ".", row.names = TRUE, col.names = TRUE,
                         qmethod = c("escape", "double"), fileEncoding = "")
{
  qmethod <- match.arg(qmethod)
  if (is.logical(quote) && (length(quote) != 1L || is.na(quote)))
    stop("'quote' must be 'TRUE', 'FALSE' or numeric")
  quoteC <- if (is.logical(quote))
    quote
  else TRUE
  qset <- is.logical(quote) && quote
  if (!is.data.frame(x) && !is.matrix(x))
    x <- data.frame(x)
  makeRownames <- isTRUE(row.names)
  makeColnames <- is.logical(col.names) && !identical(FALSE,
                                                      col.names)
  if (is.matrix(x)) {
    p <- ncol(x)
    d <- dimnames(x)
    if (is.null(d))
      d <- list(NULL, NULL)
    if (is.null(d[[1L]]) && makeRownames)
      d[[1L]] <- seq_len(nrow(x))
    if (is.null(d[[2L]]) && makeColnames && p > 0L)
      d[[2L]] <- paste0("V", 1L:p)
    if (qset)
      quote <- if (is.character(x))
        seq_len(p)
    else numeric()
  }
  else {
    if (any(sapply(x, function(z) length(dim(z)) == 2 &&
                   dim(z)[2L] > 1))) {
      if (qset) {
        quote <- which(rapply(x, function(x) is.character(x) || is.factor(x)))
      }
      c1 <- names(x)
      x <- as.matrix(x, rownames.force = makeRownames)
      d <- dimnames(x)
    }
    else {
      if (qset)
        quote <- if (length(x))
          which(unlist(lapply(x, function(x) is.character(x) ||
                                is.factor(x))))
      else numeric()
      d <- list(if (makeRownames) row.names(x), if (makeColnames) names(x))
    }
    p <- ncol(x)
  }
  nocols <- p == 0L
  if (is.logical(quote))
    quote <- NULL
  else if (is.numeric(quote)) {
    if (any(quote < 1L | quote > p))
      stop("invalid numbers in 'quote'")
  }
  else stop("invalid 'quote' specification")
  rn <- FALSE
  rnames <- NULL
  if (is.logical(row.names)) {
    if (row.names) {
      rnames <- as.character(d[[1L]])
      rn <- TRUE
    }
  }
  else {
    rnames <- as.character(row.names)
    rn <- TRUE
    if (length(rnames) != nrow(x))
      stop("invalid 'row.names' specification")
  }
  if (!is.null(quote) && rn)
    quote <- c(0, quote)
  if (is.logical(col.names)) {
    if (!rn && is.na(col.names))
      stop("'col.names = NA' makes no sense when 'row.names = FALSE'")
    col.names <- if (is.na(col.names) && rn)
      c("", d[[2L]])
    else if (col.names)
      d[[2L]]
    else NULL
  }
  else {
    col.names <- as.character(col.names)
    if (length(col.names) != p)
      stop("invalid 'col.names' specification")
  }
  if (file == "")
    file <- stdout()
  else if (is.character(file)) {
    file <- if (nzchar(fileEncoding))
      file(file, ifelse(append, "a", "w"), encoding = fileEncoding)
    else file(file, ifelse(append, "a", "w"))
    on.exit(close(file))
  }
  else if (!isOpen(file, "w")) {
    open(file, "w")
    on.exit(close(file))
  }
  if (!inherits(file, "connection"))
    stop("'file' must be a character string or connection")
  qstring <- switch(qmethod, escape = "\\\\\"", double = "\"\"")
  if (!is.null(col.names)) {
    if (append)
      warning("appending column names to file")
    if (quoteC)
      col.names <- paste0("\"", gsub("\"", qstring, col.names),
                          "\"")
    writeLines(paste(col.names, collapse = sep), file, sep = eol)
  }
  if (nrow(x) == 0L)
    return(invisible())
  if (nocols && !rn)
    return(cat(rep.int(eol, NROW(x)), file = file, sep = ""))
  if (is.matrix(x) && !is.atomic(x))
    mode(x) <- "character"
  if (is.data.frame(x)) {
    x[] <- lapply(x, function(z) {
      if (is.object(z) && !is.factor(z))
        as.character(z)
      else z
    })
  }
  invisible(.External2(C_writetable, x, file, nrow(x), p,
                       rnames, sep, eol, na, dec, as.integer(quote), qmethod !=
                         "double"))
}

	[[alternative HTML version deleted]]