[R-gregmisc-users] SF.net SVN: r-gregmisc:[1661] trunk/SASxport

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

Revision: 1661
          http://sourceforge.net/p/r-gregmisc/code/1661
Author:   warnes
Date:     2013-05-31 03:02:44 +0000 (Fri, 31 May 2013)
Log Message:
-----------
Correct error in write.xport when a factor contains only NA entries.

Modified Paths:
--------------
    trunk/SASxport/R/make.formats.R

Added Paths:
-----------
    trunk/SASxport/tests/testFactorAllNA.R

Modified: trunk/SASxport/R/make.formats.R
===================================================================
--- trunk/SASxport/R/make.formats.R	2013-05-12 01:48:49 UTC (rev 1660)
+++ trunk/SASxport/R/make.formats.R	2013-05-31 03:02:44 UTC (rev 1661)
@@ -76,14 +76,16 @@
     else
       formatName <- fname
     varLevels <- levels(var)
-    formats <- empty.format.table()    
-    for( j in 1:nlevels(var) )
-      formats <- add.format.entry(formats,
-                                  formatName,
-                                  j,
-                                  j,
-                                  varLevels[j]
-                                  )
+    formats <- empty.format.table()
+
+    if(nlevels(var)>0)
+      for( j in 1:nlevels(var) )
+        formats <- add.format.entry(formats,
+                                    formatName,
+                                    j,
+                                    j,
+                                    varLevels[j]
+                                    )
     formats
   }
 

Added: trunk/SASxport/tests/testFactorAllNA.R
===================================================================
--- trunk/SASxport/tests/testFactorAllNA.R	                        (rev 0)
+++ trunk/SASxport/tests/testFactorAllNA.R	2013-05-31 03:02:44 UTC (rev 1661)
@@ -0,0 +1,16 @@
+library(SASxport)
+
+x <- data.frame(A=1:10,
+                B=letters[1:10],
+                C=factor(rep(NA,10)),
+                D=factor(rep(NA,10), levels=c("A","B","C")),
+                E=as.numeric(rep(NA,10)),
+                stringsAsFactors=FALSE                
+                )
+write.xport(x,file='testFactorAllNA.out.xpt')
+
+y <- read.xport(file='testFactorAllNA.out.xpt')
+
+stopifnot( all.equal(x,y, check.attributes = FALSE) )
+stopifnot( all.equal(levels(x$C), levels(y$C) ) )
+stopifnot( all.equal(levels(x$D), levels(y$D) ) )

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