[Dplr-commits] r944 - in pkg/dplR: R tests/testthat

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

Author: mvkorpel
Date: 2015-01-20 19:09:10 +0100 (Tue, 20 Jan 2015)
New Revision: 944

Modified:
   pkg/dplR/R/net.R
   pkg/dplR/tests/testthat/test-dplR.R
Log:
In net(), if the user sets one of the weights to zero while the other
weight is non-zero, possible NAs from the "zeroed" statistic should
arguably not propagate to the result ("just give me variability" or
"just give me Gegenlaufigkeit").  This commit addresses the issue by
explicitly checking for zero weights and only computing what is
needed.  In the case of both weights being zero, the result is set to
NA_real (average is NaN).


Modified: pkg/dplR/R/net.R
===================================================================
--- pkg/dplR/R/net.R	2015-01-20 17:14:31 UTC (rev 943)
+++ pkg/dplR/R/net.R	2015-01-20 18:09:10 UTC (rev 944)
@@ -26,9 +26,23 @@
         delta[isNA] <- 0
         pos <- rowSums(delta > 0)
         neg <- rowSums(delta < 0)
-        c(NA_real_, pmax(pos, neg) / N)
+        res <- c(NA_real_, pmax(pos, neg) / N)
+        names(res) <- rownames(mat)
+        res
     }
-    NetJ <- weights2[1] * variability(x2) + weights2[2] * (1 - gleichlauf(x2))
+    w1 <- weights2[1]
+    w2 <- weights2[2]
+    do1 <- w1 != 0
+    do2 <- w2 != 0
+    NetJ <- if (do1 && do2) {
+        w1 * variability(x2) + w2 * (1 - gleichlauf(x2))
+    } else if (do1) {
+        w1 * variability(x2)
+    } else if (do2) {
+        w2 * (1 - gleichlauf(x2))
+    } else {
+        structure(rep.int(NA_real_, dimX[1]), names = rownames(x2))
+    }
     Net <- mean(NetJ, na.rm = TRUE)
     list(all = NetJ, average = Net)
 }

Modified: pkg/dplR/tests/testthat/test-dplR.R
===================================================================
--- pkg/dplR/tests/testthat/test-dplR.R	2015-01-20 17:14:31 UTC (rev 943)
+++ pkg/dplR/tests/testthat/test-dplR.R	2015-01-20 18:09:10 UTC (rev 944)
@@ -611,7 +611,7 @@
         seq.dec <- seq.int(from = -1, to = -10)
         testFrame2 <- data.frame(seq.inc, seq.inc, seq.inc, seq.dec)
         exp1 <- c(NA_real_, rep.int(2.25, 9))
-        exp2 <- c(NA_real_, rep.int(2, 9))
+        exp2 <- rep.int(2, 10)
         exp3 <- c(NA_real_, rep.int(0.25, 9))
         expect_equal(net(testFrame2)[["all"]], exp1)
         expect_equal(net(testFrame2, weights=c(v=1, 0))[["all"]], exp2)