[Dplr-commits] r948 - in pkg/dplR: . R

[noreply at r-forge.r-project.org]

Author: mvkorpel
Date: 2015-01-21 16:49:05 +0100 (Wed, 21 Jan 2015)
New Revision: 948

Modified:
   pkg/dplR/ChangeLog
   pkg/dplR/DESCRIPTION
   pkg/dplR/NAMESPACE
   pkg/dplR/R/ffcsaps.R
Log:
Improved performance of ffcsaps() by using sparce matrices from the
Matrix package. A quick test reveals that ffcsaps(rnorm(300000)) on
the new version is faster than ffcsaps(rnorm(3000)) on the previous
version.


Modified: pkg/dplR/ChangeLog
===================================================================
--- pkg/dplR/ChangeLog	2015-01-21 12:50:29 UTC (rev 947)
+++ pkg/dplR/ChangeLog	2015-01-21 15:49:05 UTC (rev 948)
@@ -23,6 +23,7 @@
 ---------------
 
 - Importing captureOutput() from R.utils.
+- Importing package Matrix.
 - Exporting net().
 
 Various .R files
@@ -34,6 +35,12 @@
   corr.rwl.seg(), and corr.series.seg() does not have (undocumented)
   column names anymore.
 
+File: ffcsaps.R
+---------------
+
+- Increased performance by using sparse matrices from the Matrix
+  package.
+
 File: latexify.R
 ----------------
 

Modified: pkg/dplR/DESCRIPTION
===================================================================
--- pkg/dplR/DESCRIPTION	2015-01-21 12:50:29 UTC (rev 947)
+++ pkg/dplR/DESCRIPTION	2015-01-21 15:49:05 UTC (rev 948)
@@ -3,7 +3,7 @@
 Type: Package
 Title: Dendrochronology Program Library in R
 Version: 1.6.3
-Date: 2015-01-20
+Date: 2015-01-21
 Authors at R: c(person("Andy", "Bunn", role = c("aut", "cph",
         "cre", "trl"), email = "andy.bunn at wwu.edu"), person("Mikko",
         "Korpela", role = c("aut", "trl")), person("Franco", "Biondi",
@@ -19,8 +19,9 @@
 Maintainer: Andy Bunn <andy.bunn at wwu.edu>
 Depends: R (>= 2.15.0)
 Imports: graphics, grDevices, grid, stats, utils, lattice (>= 0.13-6),
-        digest (>= 0.2.3), gmp (>= 0.5-5), png (>= 0.1-1), R.utils (>=
-        1.32.0), stringi (>= 0.2-2), stringr (>= 0.4), XML (>= 2.1-0)
+        Matrix, digest (>= 0.2.3), gmp (>= 0.5-5), png (>= 0.1-1),
+        R.utils (>= 1.32.0), stringi (>= 0.2-2), stringr (>= 0.4), XML
+        (>= 2.1-0)
 Suggests: Biobase, dichromat (>= 1.2-3), foreach, forecast, iterators,
         knitr, RColorBrewer, testthat (>= 0.8), tikzDevice, waveslim
 Description: This package contains functions for performing tree-ring

Modified: pkg/dplR/NAMESPACE
===================================================================
--- pkg/dplR/NAMESPACE	2015-01-21 12:50:29 UTC (rev 947)
+++ pkg/dplR/NAMESPACE	2015-01-21 15:49:05 UTC (rev 948)
@@ -31,6 +31,8 @@
 importFrom(utils, head, installed.packages, read.fwf, tail,
            packageVersion, write.table)
 
+import(Matrix)
+
 importFrom(XML, xmlEventParse)
 
 export(autoread.ids, bai.in, bai.out, ccf.series.rwl, chron, cms,

Modified: pkg/dplR/R/ffcsaps.R
===================================================================
--- pkg/dplR/R/ffcsaps.R	2015-01-21 12:50:29 UTC (rev 947)
+++ pkg/dplR/R/ffcsaps.R	2015-01-21 15:49:05 UTC (rev 948)
@@ -111,10 +111,10 @@
                         c(0, 0, odx[-1])),
                   arg2, n)
     R2[, 1] <- R2[, 1] - 1
-    forR <- matrix(0, zz2, zz2)
-    forR2 <- matrix(0, zz2, n)
-    forR[R[, 1] + (R[, 2] - 1) * zz2] <- R[, 3]
-    forR2[R2[, 1] + (R2[, 2] - 1) * zz2] <- R2[, 3]
+    forR <- Matrix(0, zz2, zz2, sparse = TRUE)
+    forR2 <- Matrix(0, zz2, n, sparse = TRUE)
+    forR[R[, 1:2, drop=FALSE]] <- R[, 3]
+    forR2[R2[, 1:2, drop=FALSE]] <- R2[, 3]
     ## The following order of operations was tested to be relatively
     ## accurate across a wide range of f and nyrs
     p.inv <- (1 - f) * (cos(2 * pi / nyrs) + 2) /
@@ -124,8 +124,8 @@
     mplier <- 6 - 6 / p.inv # slightly more accurate than 6*(1-1/p.inv)
     ## forR*p is faster than forR/p.inv, and a quick test didn't
     ## show any difference in the final spline
-    u <- solve(mplier * tcrossprod(forR2) + forR * p,
-               diff(diff(yi) / diff.xi))
+    u <- as.numeric(solve(mplier * tcrossprod(forR2) + forR * p,
+                          diff(diff(yi) / diff.xi)))
     yi <- yi - mplier * diff(c(0, diff(c(0, u, 0)) / diff.xi, 0))
     test0 <- xi[-c(1, n)]
     c3 <- c(0, u / p.inv, 0)