############################################################################### # # WriteXLS.R - from WriteXLS2 # # Write R data frames to an Excel binary file using a Perl script # # Copyright 2013, Marc Schwartz # Edited by Rick Saporta # # This software is distributed under the terms of the GNU General # Public License Version 2, June 1991. # Excel 2003 specifications and limitations # http://office.microsoft.com/en-us/excel/HP051992911033.aspx # Excel 2007 specifications and limitations # http://office.microsoft.com/en-us/excel-help/excel-specifications-and-limits-HP010073849.aspx ## NOTE: This requires excel to be installed on the machine WriteXLS <- function(x, ExcelFileName = "R.xls", SheetNames = NULL, perl = "perl", verbose = FALSE, Encoding = c("UTF-8", "latin1"), row.names = FALSE, col.names = TRUE, AdjWidth = FALSE, AutoFilter = FALSE, BoldHeaderRow = FALSE, FreezeRow = 0, FreezeCol = 0, AddCommentRow=c("AUTO", "YES", "NO"), CommentRowName = "[Info for Column]: ", envir = globalenv()) { ## This function is intended to overwite the natural version in the WriteXLS package ## This message confirms we're using teh right one cat("This is the correct version of WriteXLS\n") if (!exists("is.data.table")) is.data.table <- function(x) FALSE ## Interpret AddCommentRow to be one of either "AUTO", "YES" or "NO" ## NULL & NAs are interpreted to mean AUTO ## TRUE/FALSE are interpreted to mean YES/NO, respectively ## Other user-inputed values are error ## Note that if the field is blank, it will default to "AUTO" if (is.null(AddCommentRow) || is.na(AddCommentRow)) AddCommentRow <- "AUTO" if (is.logical(AddCommentRow)) AddCommentRow <- ifelse(AddCommentRow, "YES", "NO") AddCommentRow <- toupper(AddCommentRow) AddCommentRow <- match.arg(AddCommentRow) # Fix up ExcelFileName to support tilde expansion, etc. ExcelFileName <- normalizePath(ExcelFileName, mustWork = FALSE) # Set flag for XLSX file versus XLS file XLSX <- grepl("\\.XLSX$", toupper(ExcelFileName)) # If 'x' is a single name, it is either a single data frame or a list of data frames # If 'x' is >1 names in a character vector, it is presumed to be a vector of data frame names. # If not a list name, create a list of data frames from the vector, for consistency in subsequent processing. if (length(x) == 1) { TMP <- get(as.character(x), envir = envir) # is TMP a list and not single data frame if ((is.list(TMP)) & (!is.data.frame(TMP))) { DF.LIST <- TMP } else { DF.LIST <- list(TMP) names(DF.LIST) <- x } } else { DF.LIST <- sapply(as.character(x), function(x) get(x, envir = envir), simplify = FALSE) names(DF.LIST) <- x } # Check to be sure that each element of DF.LIST is a data frame if (!all(sapply(DF.LIST, is.data.frame))) stop("One or more of the objects named in 'x' is not a data frame or does not exist") if (XLSX) { # Additional checks for Excel 2007 limitations # 16,384 columns, including rownames, if included # 1,048,576 rows (including header row) if (!all(sapply(DF.LIST, function(x) (nrow(x) <= 1048576) & (ncol(x) <= 16384)))) stop("One or more of the data frames named in 'x' exceeds 1,048,576 rows or 16,384 columns") } else { # Additional checks for Excel 2003 limitations # 256 columns, including rownames, if included # 65,536 rows (including header row) if (!all(sapply(DF.LIST, function(x) (nrow(x) <= 65535) & (ncol(x) <= 256)))) stop("One or more of the data frames named in 'x' exceeds 65,535 rows or 256 columns") } Encoding <- match.arg(Encoding) # Check to see if SheetNames is specified and if so: # check for duplications # they are same length as the number of dataframes # check to see if any SheetNames are >31 chars, which is the Excel Limit # check for invalid characters: []:*?/\ # ELSE # check to see if first 31 characters of data frame names are unique if (!is.null(SheetNames)) { if (any(duplicated(SheetNames))) { message("At least one entry in 'SheetNames' is duplicated. Excel worksheets must have unique names.") return(invisible(FALSE)) } if (length(DF.LIST) != length(SheetNames)) { message("The number of 'SheetNames' specified does not equal the number of data frames in 'x'") return(invisible(FALSE)) } if (any(nchar(SheetNames) > 31)) { message("At least one of 'SheetNames' is > 31 characters, which is the Excel limit") return(invisible(FALSE)) } if (any(grep("\\[|\\]|\\*|\\?|:|/|\\\\", SheetNames))) { message("Invalid characters found in at least one entry in 'SheetNames'. Invalid characters are: []:*?/\\") return(invisible(FALSE)) } names(DF.LIST) <- SheetNames } else { if (any(duplicated(substr(names(DF.LIST), 1, 31)))) { message("At least one data frame name in 'x' is duplicated up to the first 31 characters. Excel worksheets must have unique names.") return(invisible(FALSE)) } if (any(grep("\\[|\\]|\\*|\\?|:|/|\\\\", names(DF.LIST)))) { message("Invalid characters found in at least one data frame name in 'x'. Invalid characters are: []:*?/\\") return(invisible(FALSE)) } } # Get path to WriteXLS.pl or WriteXLSX.pl Perl.Path <- system.file("Perl", package = "WriteXLS") PerlScript <- ifelse(XLSX, "WriteXLSX.pl", "WriteXLS.pl") Fn.Path <- file.path(Perl.Path, PerlScript) # Get path for Tmp.Dir for CSV files Tmp.Dir <- file.path(tempdir(), "WriteXLS") # Remove Tmp.Dir and Files clean.up <- function() { if (verbose) cat("Cleaning Up Temporary Files and Directory\n\n") unlink(Tmp.Dir, recursive = TRUE) } # Clean up on function exit on.exit(clean.up()) # Cleanup now, in case Tmp.Dir still exists from a prior run if (file.exists(Tmp.Dir)) { if (verbose) cat("Cleaning Up Temporary Files and Directory From Prior Run\n\n") unlink(Tmp.Dir, recursive = TRUE) } # Create Tmp.Dir for new run if (verbose) cat("Creating Temporary Directory for CSV Files: ", Tmp.Dir, "\n\n") dir.create(Tmp.Dir, recursive = TRUE) ## Function to ensure comment(x) returns strings, and no NULLs. Allows for the use of sapply comment.noNull <- function(x) if (is.null(cmnt <- comment(x))) "" else cmnt # Write Comma Delimited CSV files for (i in seq(along = DF.LIST)) { ## Is the current iteration of data a data.table ## If so, we can process more quickly and memory-efficiently isDT <- is.data.table(DF.LIST[[i]]) if (verbose) cat("Creating CSV File: ", i, ".csv", "\n", sep = "") # Get any column comment attributes and pre-pend to the # data frame as the first row. Non-existing comments # will be NULL, so convert to "" so that there is an # entry for each column and we get a vector, not a list. COMMENTS <- sapply(DF.LIST[[i]], comment.noNull) ## Only add this row if (a) flagged to YES or (b) flagged to AUTO and there are comments to add if (AddCommentRow == "YES" || (AddCommentRow == "AUTO" && length(COMMENTS) && !all(COMMENTS == ""))) { # Need to convert all columns in DF.LIST[[i]] to character # to allow for rbinding of COMMENTS, since columns may be of various types. # Everything is going to be output via write.table() as character anyway. # Preserve the rownames from the original DF.LIST, lest they get # re-named to numbers by default. # Set 'optional = TRUE' so that make.names() is not used on non-syntactially # correct column names. DF.LIST[[i]] <- as.data.frame(lapply(DF.LIST[[i]], as.character), stringsAsFactors = FALSE, optional = TRUE, row.names = rownames(DF.LIST[[i]])) ## only convert those columns which are not already character. Saves time and memory NonCharCols <- sapply(DF.LIST[[i]], Negate(is.character)) NonCharCols <- names(NonCharCols)[NonCharCols] # Grab the actual names of those columns needing converting ## Check if there are any columns to process: if (length(NonCharCols)) { if (isDT) { ## data.table syntax: DF.LIST[[i]] [, c(NonCharCols) := lapply(.SD, as.character), .SDcols=NonCharCols] } else { ## Iterate over the NAMES of the DF.list[[i]] ## We wrap them in setNames so that nms is a named vector, where the names are the values nms <- setNames(nm=names(DF.LIST[[i]])) DF.LIST[[i]] <- as.data.frame( lapply(nms, function(nm) if (nm %in% NonCharCols) as.character(DF.LIST[[i]][[nm]]) else DF.LIST[[i]][[nm]] ) , stringsAsFactors = FALSE, optional = TRUE, row.names = rownames(DF.LIST[[i]])) } } ## else, if there are no NonCharCols, no need to process # Pre-pend CommentRowName to each comment so that we can differentiate # the comment row from column names, which may or may not be written # out depending upon 'col.names' argument if (!row.names) COMMENTS <- paste(CommentRowName, COMMENTS) # rbind() COMMENTS to the data frame as the first row # This may result in a renaming of the DF.LIST[[i]] # rownames after rbind()ing which will get picked up in the Excel # file if row.names = TRUE. (eg. What was row '1' will then be row '2'). # Get rownames from DF.LIST[[i]] and reset after rbind()ing. # Set the rowname for the COMMENTS row also, so that if row.names = TRUE, # the rownames will get dumped by write.table() below and the # the first row gets picked up as the comments row in the Perl code. # The Perl code only checks the first parsed field in the CSV file row and # the rownames will be the first column in each row. RowNames <- c(CommentRowName, rownames(DF.LIST[[i]])) if (isDT) { # DT requires vector to be converted to columns first, hence the extra rbind DF.LIST[[i]] <- setnames(rbind(as.data.table(rbind(COMMENTS)), DF.LIST[[i]], use.names=FALSE), names(DF.LIST[[i]])) data.table::setattr(DF.LIST[[i]], "rownames", RowNames) } else { DF.LIST[[i]] <- rbind(COMMENTS, DF.LIST[[i]]) rownames(DF.LIST[[i]]) <- RowNames } } # // end if adding comments # Write out the data frame to the CSV file write.table(DF.LIST[[i]], file = paste(Tmp.Dir, "/", i, ".csv", sep = ""), sep = ",", quote = TRUE, na = "", row.names = row.names, col.names = ifelse(row.names && col.names, NA, col.names)) } # Write 'x' (character vector of data frame names) to file # appending Tmp.Dir and ".csv" to each x x <- paste(Tmp.Dir, "/", seq(length(DF.LIST)), ".csv", sep = "") write(as.matrix(x), file = paste(Tmp.Dir, "/FileNames.txt", sep = "")) if (verbose) cat("Creating SheetNames.txt\n") write(as.matrix(names(DF.LIST)), file = paste(Tmp.Dir, "/SheetNames.txt", sep = "")) if (verbose) cat("\n") # Call Perl script cmd <- paste(perl, " -I", shQuote(Perl.Path), " ", shQuote(Fn.Path), " --CSVPath ", shQuote(Tmp.Dir), " --verbose ", verbose, " --AdjWidth ", AdjWidth, " --AutoFilter ", AutoFilter, " --BoldHeaderRow ", BoldHeaderRow, " --FreezeRow ", FreezeRow, " --FreezeCol ", FreezeCol, " --Encoding ", Encoding, " ", shQuote(ExcelFileName), sep = "") # Call the external Perl script and get the result of the call Result <- system(cmd) # Check to see if Result != 0 in the case of the failure of the Perl script # This should also raise an error for R CMD check for package testing on R-Forge and CRAN if (Result != 0) { err.msg <- paste("The Perl script '", PerlScript, "' failed to run successfully.", sep = "") message(err.msg) return(invisible(FALSE)) } else { return(invisible(TRUE)) } }