[Xts-commits] r631 - pkg/xts/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jun 14 16:56:59 CEST 2012


Author: bodanker
Date: 2012-06-14 16:56:59 +0200 (Thu, 14 Jun 2012)
New Revision: 631

Modified:
   pkg/xts/R/na.R
Log:
- do.call -> for loop in na.locf.xts (significant speed gains on large objects)


Modified: pkg/xts/R/na.R
===================================================================
--- pkg/xts/R/na.R	2012-06-13 17:55:01 UTC (rev 630)
+++ pkg/xts/R/na.R	2012-06-14 14:56:59 UTC (rev 631)
@@ -97,14 +97,15 @@
     maxgap <- min(maxgap, NROW(object))
     if(length(object) == 0)
       return(object)
-    x <- if(dim(object)[2] > 1) {
-      do.call(cbind.xts, lapply(1:NCOL(object), 
-                            function(n) {
-                              .Call('na_locf', object[,n], fromLast, maxgap, PACKAGE='xts')
-                            } ))
+    if(dim(object)[2] > 1) {
+      x <- object
+      for(n in 1:NCOL(object))
+        x[,n] <- .Call('na_locf', object[,n], fromLast, maxgap, PACKAGE='xts')
       #.xts(apply(object, 2, function(x) .Call('na_locf', x, fromLast, maxgap, PACKAGE='xts')),
       #     .index(object), tzone=indexTZ(object), .indexCLASS=indexClass(object))
-    } else .Call("na_locf", object, fromLast, maxgap, PACKAGE="xts")
+    } else {
+      x <- .Call("na_locf", object, fromLast, maxgap, PACKAGE="xts")
+    }
     if(na.rm) {
       return(structure(na.omit(x),na.action=NULL))
     } else x



More information about the Xts-commits mailing list