[Vegan-commits] r2874 - in pkg/vegan: R inst

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

Author: gsimpson
Date: 2014-08-18 16:19:53 +0200 (Mon, 18 Aug 2014)
New Revision: 2874

Modified:
   pkg/vegan/R/simper.R
   pkg/vegan/inst/ChangeLog
Log:
make simper work with single-member groups; make some of the loop counters robust

Modified: pkg/vegan/R/simper.R
===================================================================
--- pkg/vegan/R/simper.R	2014-06-06 13:00:16 UTC (rev 2873)
+++ pkg/vegan/R/simper.R	2014-08-18 14:19:53 UTC (rev 2874)
@@ -6,12 +6,14 @@
         warning("you have empty rows: results may be meaningless")
     pfun <- function(x, comm, comp, i, contrp) {
         groupp <- group[perm[x,]]
-        ga <- comm[groupp == comp[i, 1], ] 
-        gb <- comm[groupp == comp[i, 2], ]
-        for(j in 1:n.b) {
-            for(k in 1:n.a) {
-                mdp <- abs(ga[k, ] - gb[j, ])
-                mep <- ga[k, ] + gb[j, ]
+        ga <- comm[groupp == comp[i, 1], , drop = FALSE] 
+        gb <- comm[groupp == comp[i, 2], , drop = FALSE]
+        n.a <- nrow(ga)
+        n.b <- nrow(gb)
+        for(j in seq_len(n.b)) {
+            for(k in seq_len(n.a)) {
+                mdp <- abs(ga[k, , drop = FALSE] - gb[j, , drop = FALSE])
+                mep <- ga[k, , drop = FALSE] + gb[j, , drop = FALSE]
                 contrp[(j-1)*n.a+k, ] <- mdp / sum(mep)  
             }
         }
@@ -46,16 +48,16 @@
     if (isParal && !isMulticore && !hasClus) {
         parallel <- makeCluster(parallel)
     }
-    for (i in 1:nrow(comp)) {
-        group.a <- comm[group == comp[i, 1], ]
-        group.b <- comm[group == comp[i, 2], ]
+    for (i in seq_len(nrow(comp))) {
+        group.a <- comm[group == comp[i, 1], , drop = FALSE]
+        group.b <- comm[group == comp[i, 2], , drop = FALSE]
         n.a <- nrow(group.a)
         n.b <- nrow(group.b)
         contr <- matrix(ncol = P, nrow = n.a * n.b)
-        for (j in 1:n.b) {
-            for (k in 1:n.a) {
-                md <- abs(group.a[k, ] - group.b[j, ])
-                me <- group.a[k, ] + group.b[j, ]
+        for (j in seq_len(n.b)) {
+            for (k in seq_len(n.a)) {
+                md <- abs(group.a[k, , drop = FALSE] - group.b[j, , drop = FALSE])
+                me <- group.a[k, , drop = FALSE] + group.b[j, , drop = FALSE]
                 contr[(j-1)*n.a+k, ] <- md / sum(me)	
             }
         }
@@ -69,11 +71,11 @@
 
             if (isParal) {
                 if (isMulticore){
-                    perm.contr <- mclapply(1:nperm, function(d) 
+                    perm.contr <- mclapply(seq_len(nperm), function(d) 
                         pfun(d, comm, comp, i, contrp), mc.cores = parallel)
                     perm.contr <- do.call(cbind, perm.contr)
                 } else {
-                    perm.contr <- parSapply(parallel, 1:nperm, function(d) 
+                    perm.contr <- parSapply(parallel, seq_len(npmer), function(d) 
                         pfun(d, comm, comp, i, contrp))
                 }  
             } else {

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2014-06-06 13:00:16 UTC (rev 2873)
+++ pkg/vegan/inst/ChangeLog	2014-08-18 14:19:53 UTC (rev 2874)
@@ -128,6 +128,9 @@
 	specified through formal arguments `col` and `lty`. Incidental
 	wish of http://stackoverflow.com/q/22714775/429846.
 
+	* simper: now doesn't fail with obscure error when groups have a
+        single member.
+
 Version 2.1-40 (closed December 12, 2013)	
 	
 	* anova.cca: Function is now based on the new code, but the old is