[R-gregmisc-users] SF.net SVN: r-gregmisc:[1952] trunk/gdata/R/write.fwf.R

[<wa...@us...>]

Revision: 1952
          http://sourceforge.net/p/r-gregmisc/code/1952
Author:   warnes
Date:     2015-04-23 22:41:46 +0000 (Thu, 23 Apr 2015)
Log Message:
-----------
- write.fwf() now properly supports matrix objects, including matrix
  objects wihtout column names. (Reported by Carl Witthoft.)

Modified Paths:
--------------
    trunk/gdata/R/write.fwf.R

Modified: trunk/gdata/R/write.fwf.R
===================================================================
--- trunk/gdata/R/write.fwf.R	2015-04-23 21:55:42 UTC (rev 1951)
+++ trunk/gdata/R/write.fwf.R	2015-04-23 22:41:46 UTC (rev 1952)
@@ -44,6 +44,8 @@
     colnames(x)[1] <- rowColVal
   }
   colnamesMy <- colnames(x)
+  if(length(colnamesMy)==0)
+      colnamesMy <- paste( "V", 1:ncol(x), sep="")
 
   nRow <- nrow(x)
   nCol <- length(colnamesMy)
@@ -67,18 +69,20 @@
                           stringsAsFactors=FALSE)
 
   ## Which columns are numeric like
-  isNum <- sapply(x, is.numeric)
+  isNum <- apply(x, 2, is.numeric)
   ## is.numeric picks also Date and POSIXt
-  isNum <- isNum & !(sapply(x, inherits, what="Date") |
-                     sapply(x, inherits, what="POSIXt"))
+  isNum <- isNum & !(apply(x, 2, inherits, what="Date") |
+                     apply(x, 2, inherits, what="POSIXt"))
 
   ## Which columns are factors --> convert them to character
-  isFac <- sapply(x, is.factor)
-  x[, isFac] <- lapply(x[, isFac, drop=FALSE], as.character)
+  isFac <- apply(x, 2, is.factor)
+  x[, isFac] <- apply(x[, isFac, drop=FALSE], 2, as.character)
 
   ## Collect information about how format() will format columns.
   ## We need to get this info now, since format will turn all columns to character
-  tmp <- lapply(x, format.info, ...)
+browser()
+  
+  tmp <- apply(x, 2, format.info, ...)
   tmp1 <- sapply(tmp, length)
   tmp <- t(as.data.frame(tmp))
   retFormat$width <- tmp[, 1]
@@ -137,7 +141,7 @@
 
   ## Number of levels for "non-numeric"" columns
   if(any(!isNum)) {
-    retFormat[!isNum, "nlevels"] <- sapply(x[, !isNum, drop=FALSE],
+    retFormat[!isNum, "nlevels"] <- apply(x[, !isNum, drop=FALSE], 2,
                                            function(z) length(unique(z)))
   }
 

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.