[R-gregmisc-users] SF.net SVN: r-gregmisc:[1670] trunk/SASxport
Brought to you by:
warnes
Menu
▾
▴
[R-gregmisc-users] SF.net SVN: r-gregmisc:[1670] trunk/SASxport
|
From: <wa...@us...> - 2013-06-14 16:22:42
|
Revision: 1670
http://sourceforge.net/p/r-gregmisc/code/1670
Author: warnes
Date: 2013-06-14 16:22:39 +0000 (Fri, 14 Jun 2013)
Log Message:
-----------
Complete changes to handle empty datasets in xport files.
Modified Paths:
--------------
trunk/SASxport/R/fstr.R
trunk/SASxport/R/read.xport.R
trunk/SASxport/src/SASxport.c
trunk/SASxport/src/writeSAS.c
trunk/SASxport/tests/Alfalfa_Test.Rout.save
trunk/SASxport/tests/Theoph.Rout.save
trunk/SASxport/tests/cars.Rout.save
trunk/SASxport/tests/testDates.Rout.save
trunk/SASxport/tests/testDuplicateNames.Rout.save
trunk/SASxport/tests/testManyNames.Rout.save
trunk/SASxport/tests/testNegative.Rout.save
trunk/SASxport/tests/testNumeric.Rout.save
trunk/SASxport/tests/testUnnamedComponents.Rout.save
trunk/SASxport/tests/test_as_is.Rout.save
trunk/SASxport/tests/test_fields.Rout.save
trunk/SASxport/tests/xport.Rout.save
trunk/SASxport/tests/xxx.Rout.save
Added Paths:
-----------
trunk/SASxport/tests/testEmpty.R
trunk/SASxport/tests/testEmpty.Rout.save
Modified: trunk/SASxport/R/fstr.R
===================================================================
--- trunk/SASxport/R/fstr.R 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/R/fstr.R 2013-06-14 16:22:39 UTC (rev 1670)
@@ -12,6 +12,8 @@
else
return( paste(name[i], length[i], '.', digits[i], sep='' ) )
}
- sapply( 1:length(name), inner)
-
+ if(length(name)>0)
+ sapply( 1:length(name), inner)
+ else
+ character(0)
}
Modified: trunk/SASxport/R/read.xport.R
===================================================================
--- trunk/SASxport/R/read.xport.R 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/R/read.xport.R 2013-06-14 16:22:39 UTC (rev 1670)
@@ -121,11 +121,6 @@
scat('.')
- if(!length(w)) {
- scat('Empty dataset', k, 'ignored\n')
- next
- }
-
label(w) <- dsLabels[k]
names(label(w)) <- NULL
SAStype(w) <- dsTypes[k]
@@ -145,71 +140,72 @@
ndinfo <- names.tolower(makeNames(dinfo$name, allow=name.chars))
names(lab) <- names(fmt) <- names(formats) <- names(iformats) <- ndinfo
- for(i in 1:length(w)) {
- changed <- FALSE
- x <- w[[i]]
- fi <- fmt[nam[i]];
- names(fi) <- NULL
- if(fi != '' && length(finfo) && (fi %in% names(finfo))) {
- f <- finfo[[fi]]
- if(length(f)) { ## may be NULL because had a range in format
- x <- factor(x, f$value, f$label)
- attr(x, 'SASformat') <- fi
- changed <- TRUE
+ if(length(w)>0)
+ for(i in 1:length(w)) {
+ changed <- FALSE
+ x <- w[[i]]
+ fi <- fmt[nam[i]];
+ names(fi) <- NULL
+ if(fi != '' && length(finfo) && (fi %in% names(finfo))) {
+ f <- finfo[[fi]]
+ if(length(f)) { ## may be NULL because had a range in format
+ x <- factor(x, f$value, f$label)
+ attr(x, 'SASformat') <- fi
+ changed <- TRUE
+ }
}
- }
- if(is.numeric(x)) {
- if(fi %in% sasdateform) {
- x <- importConvertDateTime(x, 'date', 'sas')
- changed <- TRUE
- } else if(fi %in% sastimeform) {
- x <- importConvertDateTime(x, 'time', 'sas')
- changed <- TRUE
- } else if(fi %in% sasdatetimeform) {
- x <- importConvertDateTime(x, 'datetime', 'sas')
- changed <- TRUE
- } else if(force.integer) {
- if(all(is.na(x))) {
- storage.mode(x) <- 'integer'
+ if(is.numeric(x)) {
+ if(fi %in% sasdateform) {
+ x <- importConvertDateTime(x, 'date', 'sas')
changed <- TRUE
- } else if(max(abs(x),na.rm=TRUE) <= (2^31-1) &&
- all(floor(x) == x, na.rm=TRUE)) {
- storage.mode(x) <- 'integer'
+ } else if(fi %in% sastimeform) {
+ x <- importConvertDateTime(x, 'time', 'sas')
changed <- TRUE
+ } else if(fi %in% sasdatetimeform) {
+ x <- importConvertDateTime(x, 'datetime', 'sas')
+ changed <- TRUE
+ } else if(force.integer) {
+ if(all(is.na(x))) {
+ storage.mode(x) <- 'integer'
+ changed <- TRUE
+ } else if(max(abs(x),na.rm=TRUE) <= (2^31-1) &&
+ all(floor(x) == x, na.rm=TRUE)) {
+ storage.mode(x) <- 'integer'
+ changed <- TRUE
}
+ }
+ } else if(possiblyConvertChar && is.character(x)) {
+ if((is.logical(as.is) && !as.is) ||
+ (is.numeric(as.is) && length(unique(x)) < as.is*length(x))) {
+ x <- factor(x, exclude='')
+ changed <- TRUE
+ }
}
- } else if(possiblyConvertChar && is.character(x)) {
- if((is.logical(as.is) && !as.is) ||
- (is.numeric(as.is) && length(unique(x)) < as.is*length(x))) {
- x <- factor(x, exclude='')
- changed <- TRUE
+
+ lz <- lab[nam[i]]
+ if(!is.null(lz) && length(lz)>0 && !is.na(lz) && lz != '') {
+ names(lz) <- NULL
+ label(x) <- lz
+ changed <- TRUE
}
- }
- lz <- lab[nam[i]]
- if(!is.null(lz) && length(lz)>0 && !is.na(lz) && lz != '') {
- names(lz) <- NULL
- label(x) <- lz
- changed <- TRUE
+ if(nam[i] %in% names(formats) && formats[nam[i]] > "" )
+ {
+ SASformat(x) <- formats[[nam[i]]]
+ changed <- TRUE
+ }
+
+ if(nam[i] %in% names(iformats) && iformats[nam[i]] > "" )
+ {
+ SASformat(x) <- formats[[nam[i]]]
+ changed <- TRUE
+ }
+
+ if(changed)
+ w[[i]] <- x
}
- if( formats[nam[i]] > "" )
- {
- SASformat(x) <- formats[[nam[i]]]
- changed <- TRUE
- }
-
- if( iformats[nam[i]] > "" )
- {
- SASformat(x) <- formats[[nam[i]]]
- changed <- TRUE
- }
-
- if(changed)
- w[[i]] <- x
- }
-
scat('.')
res[[j]] <- w
@@ -226,9 +222,11 @@
res$FORMATS <- empty.format.table()
}
-
if(nds > 1 || as.list)
res
else
+ if(class(w)=="list")
+ w[[1]]
+ else
w
}
Modified: trunk/SASxport/src/SASxport.c
===================================================================
--- trunk/SASxport/src/SASxport.c 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/src/SASxport.c 2013-06-14 16:22:39 UTC (rev 1670)
@@ -4,6 +4,7 @@
*
* Copyright 1999-1999 Douglas M. Bates <ba...@st...>,
* Saikat DebRoy <sa...@st...>
+ * Additions copyright 2007-2013 Gregory R. Warnes <gr...@wa...>
*
*
* This program is free software; you can redistribute it and/or modify
Modified: trunk/SASxport/src/writeSAS.c
===================================================================
--- trunk/SASxport/src/writeSAS.c 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/src/writeSAS.c 2013-06-14 16:22:39 UTC (rev 1670)
@@ -4,7 +4,7 @@
*
* Author: Gregory R. Warnes <gr...@wa...>
*
- * Copyright (C) 2007 Gregory R. Warnes <gr...@wa...>
+ * Copyright (C) 2007-2013 Gregory R. Warnes <gr...@wa...>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
Modified: trunk/SASxport/tests/Alfalfa_Test.Rout.save
===================================================================
--- trunk/SASxport/tests/Alfalfa_Test.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/Alfalfa_Test.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -47,4 +47,4 @@
>
> proc.time()
user system elapsed
- 0.908 0.084 0.981
+ 0.952 0.076 1.020
Modified: trunk/SASxport/tests/Theoph.Rout.save
===================================================================
--- trunk/SASxport/tests/Theoph.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/Theoph.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -43,4 +43,4 @@
>
> proc.time()
user system elapsed
- 1.632 0.092 1.811
+ 1.660 0.088 1.787
Modified: trunk/SASxport/tests/cars.Rout.save
===================================================================
--- trunk/SASxport/tests/cars.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/cars.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -64,4 +64,4 @@
>
> proc.time()
user system elapsed
- 0.920 0.128 1.036
+ 0.972 0.084 1.061
Modified: trunk/SASxport/tests/testDates.Rout.save
===================================================================
--- trunk/SASxport/tests/testDates.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/testDates.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -62,4 +62,4 @@
>
> proc.time()
user system elapsed
- 1.092 0.108 1.187
+ 1.132 0.096 1.244
Modified: trunk/SASxport/tests/testDuplicateNames.Rout.save
===================================================================
--- trunk/SASxport/tests/testDuplicateNames.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/testDuplicateNames.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -155,4 +155,4 @@
>
> proc.time()
user system elapsed
- 1.348 0.104 2.636
+ 1.300 0.144 2.626
Added: trunk/SASxport/tests/testEmpty.R
===================================================================
--- trunk/SASxport/tests/testEmpty.R (rev 0)
+++ trunk/SASxport/tests/testEmpty.R 2013-06-14 16:22:39 UTC (rev 1670)
@@ -0,0 +1,16 @@
+library(SASxport)
+
+data(iris)
+write.xport(Iris1=iris[1:2,],
+ empty=data.frame(),
+ Iris2=iris[3:4,],
+ file="testEmpty.xpt")
+
+empty.s <- lookup.xport(file="testEmpty.xpt")
+names(empty.s)
+stopifnot( length(names(empty.s)) == 4 )
+
+dat <- read.xport(file="testEmpty.xpt", verbose=TRUE)
+stopifnot( length(names(dat)) == 3 )
+stopifnot( nrow(dat)!=0 )
+dat
Added: trunk/SASxport/tests/testEmpty.Rout.save
===================================================================
--- trunk/SASxport/tests/testEmpty.Rout.save (rev 0)
+++ trunk/SASxport/tests/testEmpty.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -0,0 +1,73 @@
+
+R version 3.0.1 (2013-05-16) -- "Good Sport"
+Copyright (C) 2013 The R Foundation for Statistical Computing
+Platform: i686-pc-linux-gnu (32-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(SASxport)
+
+Loaded SASxport version 1.3.4 (2013-05-31).
+
+ Type `?SASxport' for usage information.
+
+>
+> data(iris)
+> write.xport(Iris1=iris[1:2,],
++ empty=data.frame(),
++ Iris2=iris[3:4,],
++ file="testEmpty.xpt")
+Warning messages:
+1: In makeSASNames(colnames(df)) : Truncated 4 long names to 8 characters.
+2: In makeSASNames(colnames(df)) : Truncated 4 long names to 8 characters.
+>
+> empty.s <- lookup.xport(file="testEmpty.xpt")
+> names(empty.s)
+[1] "IRIS1" "EMPTY" "IRIS2" "FORMATS"
+> stopifnot( length(names(empty.s)) == 4 )
+>
+> dat <- read.xport(file="testEmpty.xpt", verbose=TRUE)
+### Checking if the specified file has the appropriate header ###
+### Extracting data file information... ###
+### Reading the data file... ###
+### Processing contents... ###
+### Processing SAS dataset IRIS1 ###
+### . ###
+### . ###
+### Processing SAS dataset EMPTY ###
+### . ###
+### . ###
+### Processing SAS dataset IRIS2 ###
+### . ###
+### . ###
+### Done ###
+> stopifnot( length(names(dat)) == 3 )
+> stopifnot( nrow(dat)!=0 )
+> dat
+$iris1
+ SEPAL.LE SEPAL.WI PETAL.LE PETAL.WI SPECIES
+1 5.1 3.5 1.4 0.2 setosa
+2 4.9 3.0 1.4 0.2 setosa
+
+$empty
+data frame with 0 columns and 0 rows
+
+$iris2
+ SEPAL.LE SEPAL.WI PETAL.LE PETAL.WI SPECIES
+1 4.7 3.2 1.3 0.2 setosa
+2 4.6 3.1 1.5 0.2 setosa
+
+>
+> proc.time()
+ user system elapsed
+ 1.296 0.088 1.466
Modified: trunk/SASxport/tests/testManyNames.Rout.save
===================================================================
--- trunk/SASxport/tests/testManyNames.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/testManyNames.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -95,4 +95,4 @@
>
> proc.time()
user system elapsed
- 19.180 0.228 20.097
+ 19.108 0.212 19.530
Modified: trunk/SASxport/tests/testNegative.Rout.save
===================================================================
--- trunk/SASxport/tests/testNegative.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/testNegative.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -48,4 +48,4 @@
>
> proc.time()
user system elapsed
- 1.292 0.116 1.475
+ 1.224 0.112 1.334
Modified: trunk/SASxport/tests/testNumeric.Rout.save
===================================================================
--- trunk/SASxport/tests/testNumeric.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/testNumeric.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -87,4 +87,4 @@
>
> proc.time()
user system elapsed
- 1.604 0.180 1.846
+ 1.548 0.080 1.621
Modified: trunk/SASxport/tests/testUnnamedComponents.Rout.save
===================================================================
--- trunk/SASxport/tests/testUnnamedComponents.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/testUnnamedComponents.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -2163,4 +2163,4 @@
>
> proc.time()
user system elapsed
- 5.872 1.744 12.296
+ 5.896 1.676 12.756
Modified: trunk/SASxport/tests/test_as_is.Rout.save
===================================================================
--- trunk/SASxport/tests/test_as_is.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/test_as_is.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -71,4 +71,4 @@
>
> proc.time()
user system elapsed
- 0.828 0.124 0.942
+ 0.868 0.092 0.946
Modified: trunk/SASxport/tests/test_fields.Rout.save
===================================================================
--- trunk/SASxport/tests/test_fields.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/test_fields.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -32,4 +32,4 @@
>
> proc.time()
user system elapsed
- 0.724 0.092 0.808
+ 0.716 0.092 0.833
Modified: trunk/SASxport/tests/xport.Rout.save
===================================================================
--- trunk/SASxport/tests/xport.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/xport.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -106,4 +106,4 @@
> q()
> proc.time()
user system elapsed
- 0.892 0.128 1.026
+ 0.888 0.132 1.031
Modified: trunk/SASxport/tests/xxx.Rout.save
===================================================================
--- trunk/SASxport/tests/xxx.Rout.save 2013-06-14 15:13:47 UTC (rev 1669)
+++ trunk/SASxport/tests/xxx.Rout.save 2013-06-14 16:22:39 UTC (rev 1670)
@@ -79,4 +79,4 @@
>
> proc.time()
user system elapsed
- 0.872 0.124 0.982
+ 0.896 0.096 0.983
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
