[Vegan-commits] r1568 - pkg/vegan/R

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

Author: jarioksa
Date: 2011-04-03 17:07:51 +0200 (Sun, 03 Apr 2011)
New Revision: 1568

Modified:
   pkg/vegan/R/monoMDS.R
Log:
fix istart in local scaling and add some items to the result of monoMDS

Modified: pkg/vegan/R/monoMDS.R
===================================================================
--- pkg/vegan/R/monoMDS.R	2011-04-03 14:44:39 UTC (rev 1567)
+++ pkg/vegan/R/monoMDS.R	2011-04-03 15:07:51 UTC (rev 1568)
@@ -6,9 +6,11 @@
              sratmax=0.99999, ...) 
 {
     model <- match.arg(model)
+    ## dist to mat
+    mat <- as.matrix(dist)
+    nm <- rownames(mat)
     if (model %in% c("global", "linear")) {
         ## global NMDS: lower triangle
-        mat <- as.matrix(dist)
         dist <- mat[lower.tri(mat)]
         iidx <- row(mat)[lower.tri(mat)]
         jidx <- col(mat)[lower.tri(mat)]
@@ -29,13 +31,13 @@
     } else if (model == "local") {
         ## local NMDS: whole matrix without the diagonal, and rows in
         ## a row (hence transpose)
-        mat <- t(as.matrix(dist))
+        mat <- t(mat)
         ## Get missing values
         nas <- is.na(mat)
         ## groups by rows, except missing values
-        rs <- rowSums(!nas)
+        rs <- rowSums(!nas) - 1
         istart <- cumsum(rs)
-        istart <- c(1, istart[-length(istart)] + 1)
+        istart <- c(0, istart[-length(istart)]) + 1
         ## Full matrix expect the diagonal
         dist <- mat[col(mat) != row(mat)]
         iidx <- col(mat)[col(mat) != row(mat)]  # transpose!
@@ -53,7 +55,6 @@
     } else if (model == "hybrid") {
         ## Hybrid NMDS: two lower triangles, first a complete one,
         ## then those with dissimilarities below the threshold
-        mat <- as.matrix(dist)
         dist <- mat[lower.tri(mat)]
         iidx <- row(mat)[lower.tri(mat)]
         jidx <- col(mat)[lower.tri(mat)]
@@ -102,7 +103,11 @@
                  dhat = double(ndis), points = double(k*nobj),
                  stress = double(1), iters = integer(1),
                  icause = integer(1), PACKAGE = "vegan")
+    sol$call <- match.call()
+    sol$model <- model
     sol$points <- matrix(sol$points, nobj, k)
+    rownames(sol$points) <- nm
+    colnames(sol$points) <- paste("MDS", 1:k, sep="")
     class(sol) <- "monoMDS"
     sol
 }