[Dplr-commits] r759 - pkg/dplR/R

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

Author: mvkorpel
Date: 2014-04-02 14:36:30 +0200 (Wed, 02 Apr 2014)
New Revision: 759

Modified:
   pkg/dplR/R/series.rho.R
Log:
Optimizations


Modified: pkg/dplR/R/series.rho.R
===================================================================
--- pkg/dplR/R/series.rho.R	2014-04-02 11:37:58 UTC (rev 758)
+++ pkg/dplR/R/series.rho.R	2014-04-02 12:36:30 UTC (rev 759)
@@ -1,16 +1,16 @@
-series.rho <- function(rwl,n=NULL,prewhiten=TRUE,biweight=TRUE){
-    nseries <- ncol(rwl)
-    rho.df <- data.frame(rho=rep(NA,nseries),p.val=rep(NA,nseries))
-    rownames(rho.df) <- colnames(rwl)
-    for(i in 1:nseries){
-      tmp <- normalize.xdate(rwl=rwl[,-i],series=rwl[,i],
-                             n=n,prewhiten=prewhiten,biweight=biweight)
-      tmp <- data.frame(series=tmp$series,master=tmp$master)
-      mask <- rowSums(is.na(tmp)) == 0
-      tmp2 <- cor.test(tmp$series[mask], tmp$master[mask],
-                      method = "spearman", alternative = "greater")
-      rho.df[i,1] <- tmp2$estimate
-      rho.df[i,2] <- tmp2$p.val
+series.rho <- function(rwl, n=NULL, prewhiten=TRUE, biweight=TRUE) {
+    nseries <- length(rwl)
+    rho <- numeric(nseries)
+    p.val <- numeric(nseries)
+    rwl.mat <- as.matrix(rwl)
+    for (i in seq_len(nseries)) {
+        tmp <- normalize.xdate(rwl=rwl.mat[, -i, drop=FALSE],
+                               series=rwl.mat[, i], n=n,
+                               prewhiten=prewhiten, biweight=biweight)
+        tmp2 <- cor.test(tmp[["series"]], tmp[["master"]],
+                         method = "spearman", alternative = "greater")
+        rho[i] <- tmp2[["estimate"]]
+        p.val[i] <- tmp2[["p.value"]]
     }
-    rho.df
+    data.frame(rho = rho, p.val = p.val, row.names = names(rwl))
 }