[Vegan-commits] r649 - in pkg/vegan: R man

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

Author: jarioksa
Date: 2008-12-21 08:53:35 +0100 (Sun, 21 Dec 2008)
New Revision: 649

Added:
   pkg/vegan/R/print.nestednodf.R
Modified:
   pkg/vegan/R/nestednodf.R
   pkg/vegan/man/nestedtemp.Rd
Log:
Gustavo Carvalho submitted faster code plus print() method for nestednodf

Modified: pkg/vegan/R/nestednodf.R
===================================================================
--- pkg/vegan/R/nestednodf.R	2008-12-19 10:26:29 UTC (rev 648)
+++ pkg/vegan/R/nestednodf.R	2008-12-21 07:53:35 UTC (rev 649)
@@ -1,59 +1,43 @@
-### NODF metric of nestedness.
-### Code submitted as an R-Forge feature request #265 by Gustavo
-### Carvalho.
-nestednodf <- function(comm)
+`nestednodf` <- 
+    function(comm)
 {
-    ## Transform the community matrix to presence/ausence  
     comm <- ifelse(comm > 0, 1, 0)
     ## Order rows and columns
     comm <- comm[order(rowSums(comm), decreasing=TRUE),
-                 order(colSums(comm), decreasing=TRUE)]  
-    ## Two matrices with all possible rows and columns combinations
-    ## used to calculate the paired overlap
-    row.combinations <- t(combn(1:dim(comm)[1],2))
-    col.combinations <- t(combn(1:dim(comm)[2],2))
-    ## Saving a bit of cpu time
-    row.sums <- rowSums(comm)
-    col.sums <- colSums(comm)
-    dimensions <- dim(comm)  
+                 order(colSums(comm), decreasing=TRUE)]    
+    dimensions <- dim(comm)
     fill <- sum(comm)/length(comm)
-
-    ## N.paired for columns
-    combcol <- function(x) {
-        N.paired <- 0
+    N.paired <- 0
+    ## Function to be applied to each combination of rows and columns
+    comb <- function(x, rows) {
+        if (identical(rows,TRUE)) {
+            comb.first <- comm[x[1],]
+            comb.second <- comm[x[2],]
+        }
+        else {
+            comb.first <- comm[,x[1]]
+            comb.second <- comm[,x[2]]
+        }
         ## if MTi > MTj
-        if (diff(col.sums[x]) < 0 && !any(col.sums[x] == 0)) {     
-            paired.overlap <- sum(rowSums(comm[,x]) == 2) / col.sums[x[2]]
+        if (sum(comb.first) > sum(comb.second) && sum(comb.second) > 0) {
+            paired.overlap <- sum((comb.first + comb.second) == 2) /
+                sum(comb.second)
             N.paired <- paired.overlap
         }
         return(N.paired)
     }
-
-    ## N.paired for rows
-    combrow <- function(x) {
-        N.paired <- 0
-        ## If MTk > MTl
-        if (diff(row.sums[x]) < 0 && !any(row.sums[x] == 0)) {
-            paired.overlap <- sum(colSums(comm[x,]) == 2) / row.sums[x[2]]
-            N.paired <- paired.overlap
-        }
-        return(N.paired)
-    }
-
-    ## N.paired for all columns and rows
-    N.paired.columns <- apply(col.combinations, 1, combcol)
-    N.paired.rows <- apply(row.combinations, 1, combrow) 
-
-    ## NODF, N.rows, and N.columns
-    NODF <- (sum(c(N.paired.rows, N.paired.columns)) * 100)/
-        ((dimensions[2] * (dimensions[2] - 1) / 2) +
-         (dimensions[1] * (dimensions[1] - 1) / 2))
-    N.rows <- mean(N.paired.rows) * 100  
+    ## N.paired for all combinations of columns and rows
+    N.paired.rows <- combn(1:dimensions[1],2, comb, rows=TRUE)
+    N.paired.columns <- combn(1:dimensions[2],2, comb, rows=FALSE)
+    ## Index calculations
     N.columns <- mean(N.paired.columns) * 100
-  
-    ## Returned list (changed to make it more similar to what
-    ## nestedtemp returns).
-    out <- list(comm = comm, fill = fill, N.rows = N.rows,
-                N.columns = N.columns, statistic = NODF)
+    N.rows <- mean(N.paired.rows) * 100  
+    NODF <- (sum(c(N.paired.rows, N.paired.columns)) * 100) /
+        ((dimensions[2] * (dimensions[2] - 1) / 2) + 
+         (dimensions[1] * (dimensions[1] - 1) / 2))
+    ## Returned list
+    out <- list(comm = comm, fill = fill, 
+                statistic=c("N.columns" = N.columns, "N.rows" = N.rows, "NODF" = NODF))
+    class(out) <- "nestednodf"
     return(out)
 }

Added: pkg/vegan/R/print.nestednodf.R
===================================================================
--- pkg/vegan/R/print.nestednodf.R	                        (rev 0)
+++ pkg/vegan/R/print.nestednodf.R	2008-12-21 07:53:35 UTC (rev 649)
@@ -0,0 +1,9 @@
+`print.nestednodf` <-
+    function(x)
+{    
+    cat("N columns:", format(x$statistic["N.columns"]), "\n")
+    cat("N rows:", format(x$statistic["N.rows"]), "\n")
+    cat("NODF:", format(x$statistic["NODF"]), "\n")
+    cat("Matrix fill:", format(x$fill), "\n")
+    invisible(x)
+}

Modified: pkg/vegan/man/nestedtemp.Rd
===================================================================
--- pkg/vegan/man/nestedtemp.Rd	2008-12-19 10:26:29 UTC (rev 648)
+++ pkg/vegan/man/nestedtemp.Rd	2008-12-21 07:53:35 UTC (rev 649)
@@ -9,6 +9,7 @@
 \alias{print.nestedn0}
 \alias{print.nesteddisc}
 \alias{print.nestedtemp}
+\alias{print.nestednodf}
 \alias{plot.nestedtemp}
 
 \title{ Nestedness Indices for Communities of Islands or Patches }