[Vegan-commits] r525 - in pkg: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 10 23:13:09 CEST 2008
Author: psolymos
Date: 2008-10-10 23:13:09 +0200 (Fri, 10 Oct 2008)
New Revision: 525
Modified:
pkg/R/permatfull.R
pkg/R/permatswap.R
pkg/R/print.permat.R
pkg/R/print.summary.permat.R
pkg/inst/ChangeLog
pkg/man/permatfull.Rd
Log:
r/c bug fixed, replace arg added to permatfull
Modified: pkg/R/permatfull.R
===================================================================
--- pkg/R/permatfull.R 2008-10-10 09:34:07 UTC (rev 524)
+++ pkg/R/permatfull.R 2008-10-10 21:13:09 UTC (rev 525)
@@ -1,12 +1,25 @@
## permatfull function
`permatfull` <-
-function(m, fixedmar="both", reg=NULL, hab=NULL, mtype="count", times=100)
+function(m, fixedmar="both", reg=NULL, hab=NULL, mtype="count", replace=TRUE, times=100)
{
+## internal function
+indshuffle <- function(x)
+{
+ N <- length(x)
+ n <- sum(x)
+ out <- numeric(N)
+ names(out) <- 1:N
+ y <- table(sample(1:N, n, replace = TRUE))
+ out[names(out) %in% names(y)] <- y
+ names(out) <- NULL
+ return(out)
+}
if (!identical(all.equal(m, round(m)), TRUE))
stop("function accepts only integers (counts)")
mtype <- match.arg(mtype, c("prab", "count"))
count <- mtype == "count"
fixedmar <- match.arg(fixedmar, c("none", "rows", "columns", "both"))
+ sample.fun <- if (replace) indshuffle else sample
m <- as.matrix(m)
n.row <- nrow(m)
n.col <- ncol(m)
@@ -27,27 +40,30 @@
id <- which(str == j)
if (fixedmar == "none")
for (i in 1:times)
- if (count) perm[[i]][id,] <- matrix(sample(m[id,]), length(id), n.col)
+ if (count) perm[[i]][id,] <- matrix(sample.fun(array(m[id,])), length(id), n.col)
else perm[[i]][id,] <- commsimulator(m[id,], method="r00")
if (fixedmar == "rows")
for (i in 1:times)
- if (count) perm[[i]][id,] <- apply(m[id,], 2, sample)
+ if (count) perm[[i]][id,] <- t(apply(m[id,], 1, sample.fun))
else perm[[i]][id,] <- commsimulator(m[id,], method="r0")
if (fixedmar == "columns")
for (i in 1:times)
- if (count) perm[[i]][id,] <- t(apply(m[id,], 1, sample))
+ if (count) perm[[i]][id,] <- apply(m[id,], 2, sample.fun)
else perm[[i]][id,] <- commsimulator(m[id,], method="c0")
if (fixedmar == "both")
for (i in 1:times)
if (count) perm[[i]][id,] <- r2dtable(1, apply(m[id,], 1, sum), apply(m[id,], 2, sum))[[1]]
else perm[[i]][id,] <- commsimulator(m[id,], method="quasiswap")
}
+ if (fixedmar == "both")
+ replace <- NA
specs <- list(reg=reg, hab=hab)
out <- list(call=match.call(), orig=m, perm=perm, specs=specs)
attr(out, "mtype") <- mtype
attr(out, "ptype") <- "full"
attr(out, "fixedmar") <- fixedmar
attr(out, "times") <- times
+ attr(out, "replace") <- replace
class(out) <- c("permat", "list")
return(out)
}
Modified: pkg/R/permatswap.R
===================================================================
--- pkg/R/permatswap.R 2008-10-10 09:34:07 UTC (rev 524)
+++ pkg/R/permatswap.R 2008-10-10 21:13:09 UTC (rev 525)
@@ -56,6 +56,7 @@
attr(out, "ptype") <- "swap"
attr(out, "fixedmar") <- "both"
attr(out, "times") <- times
+ attr(out, "replace") <- NA
class(out) <- c("permat", "list")
return(out)
}
Modified: pkg/R/print.permat.R
===================================================================
--- pkg/R/print.permat.R 2008-10-10 09:34:07 UTC (rev 524)
+++ pkg/R/print.permat.R 2008-10-10 21:13:09 UTC (rev 525)
@@ -6,8 +6,11 @@
restr <- TRUE else restr <- FALSE
cat("Object of class 'permat'\n\nCall: ")
print(x$call)
- cat("Matrix type:", attr(x, "mtype"), "\nPermutation type:", attr(x, "ptype"))
+ cat("\nMatrix type:", attr(x, "mtype"), "\nPermutation type:", attr(x, "ptype"))
cat("\nRestricted:", restr, "\nFixed margins:", attr(x, "fixedmar"))
+ if (!is.na(attr(x, "replace"))) {
+ if (attr(x, "replace")) cat(" (individual based)")
+ else cat(" (sample based)")}
cat("\n\nMatrix dimensions:", nrow(x$orig), "rows,", ncol(x$orig), "columns")
cat("\nSum of original matrix:", sum(x$orig))
cat("\nFill of original matrix:", round(sum(x$orig>0)/(nrow(x$orig)*ncol(x$orig)),digits))
Modified: pkg/R/print.summary.permat.R
===================================================================
--- pkg/R/print.summary.permat.R 2008-10-10 09:34:07 UTC (rev 524)
+++ pkg/R/print.summary.permat.R 2008-10-10 21:13:09 UTC (rev 525)
@@ -8,8 +8,11 @@
x <- x$x
cat("Summary of object of class 'permat'\n\nCall: ")
print(x$call)
- cat("Matrix type:", attr(x, "mtype"), "\nPermutation type:", attr(x, "ptype"))
+ cat("\nMatrix type:", attr(x, "mtype"), "\nPermutation type:", attr(x, "ptype"))
cat("\nRestricted:", restr, "\nFixed margins:", attr(x, "fixedmar"))
+ if (!is.na(attr(x, "replace"))) {
+ if (attr(x, "replace")) cat(" (individual based)")
+ else cat(" (sample based)")}
cat("\n\nMatrix dimensions:", nrow(x$orig), "rows,", ncol(x$orig), "columns")
cat("\nSum of original matrix:", sum(x$orig))
cat("\nFill of original matrix:", round(sum(x$orig>0)/(nrow(x$orig)*ncol(x$orig)),digits))
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2008-10-10 09:34:07 UTC (rev 524)
+++ pkg/inst/ChangeLog 2008-10-10 21:13:09 UTC (rev 525)
@@ -4,6 +4,10 @@
Version 1.16-2 (opened October 10, 2008)
+ * permatfull: bug of row/col marins is fixed, replace argument is
+ added to enable individual and sample based randomisation of
+ count data when not both margins are fixed.
+
* anosim: API and documentation made similar to mrpp to combine
their documentation. Now anosim can take data frame input and find
the dissimilarities internally.
Modified: pkg/man/permatfull.Rd
===================================================================
--- pkg/man/permatfull.Rd 2008-10-10 09:34:07 UTC (rev 524)
+++ pkg/man/permatfull.Rd 2008-10-10 21:13:09 UTC (rev 525)
@@ -20,7 +20,7 @@
\usage{
permatfull(m, fixedmar = "both", reg = NULL,
-hab = NULL, mtype = "count", times = 100)
+hab = NULL, mtype = "count", replace = TRUE, times = 100)
permatswap(m, reg = NULL, hab = NULL, mtype = "count",
method = "swap", times = 100, burnin = 10000, thin = 1000)
\method{plot}{permat}(x, ...)
@@ -35,6 +35,7 @@
\item{mtype}{matrix data type, either \code{"count"} for count data, or \code{"prab"} for presence-absence type incidence data.}
\item{times}{number of permuted matrices.}
\item{method}{character for method used for the swap algorithm (\code{"swap"}, \code{"tswap"}, \code{"backtrack"}) as described for function \code{\link{commsimulator}}. If \code{mtype="count"} only \code{"swap"} is available.}
+ \item{replace}{logical, whether shuffle individuals (\code{TRUE}, default) or samples (cells, \code{FALSE}).}
\item{burnin}{number of null communities discarded before proper analysis in sequential (\code{"swap", "tswap"}) methods.}
\item{thin}{number of discarded permuted matrices between two evaluations in sequential (\code{"swap", "tswap"}) methods.}
\item{x, object}{object of class \code{"permat"}}
@@ -53,6 +54,8 @@
algorithms of \code{\link{commsimulator}} are used for \code{"none", "rows", "columns", "both"} values
of the \code{fixedmar} argument, respectively
+The \code{replace} argument only have effect if the \code{mtype = "count"} and \code{permatfull} function is used with \code{"none", "rows", "columns"} values of \code{fixedmar}. All other cases are for count data are individual based randomisations.
+
The function \code{permatswap} is useful when matrix fill (i.e. the proportion of empty cells) should be kept constant.
\code{permatswap} uses different kinds of swap algorithms, and row and columns sums are fixed in all cases.
For presence-absence data, the \code{swap} and \code{tswap} methods of \code{\link{commsimulator}} can be used.
More information about the Vegan-commits
mailing list