[Picante-commits] r59 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Apr 26 01:42:55 CEST 2008
Author: skembel
Date: 2008-04-26 01:42:55 +0200 (Sat, 26 Apr 2008)
New Revision: 59
Added:
pkg/R/phylodiversity.R
Removed:
pkg/R/comm.phylo.cor.R
pkg/R/mnnd.R
pkg/R/mpd.R
pkg/R/ses.mnnd.R
pkg/R/ses.mpd.R
Log:
Combine community phylogenetic structure functions into a single file
Deleted: pkg/R/comm.phylo.cor.R
===================================================================
--- pkg/R/comm.phylo.cor.R 2008-04-25 23:41:34 UTC (rev 58)
+++ pkg/R/comm.phylo.cor.R 2008-04-25 23:42:55 UTC (rev 59)
@@ -1,42 +0,0 @@
-`comm.phylo.cor` <-
-function(samp,phylo,metric=c("cij","checkerboard","jaccard","roij"),
- null.model=c("sample.taxa.labels","pool.taxa.labels",
- "frequency","richness","weighted.sample.pool"),
- runs=99)
-{
- metric <- match.arg(metric)
- null.model <- match.arg(null.model)
- results <- list("obs.corr"=NA,"obs.corr.p"=NA,"obs.rank"=NA,"runs"=runs,
- "obs.rand.p"=NA,"random.corrs"=vector(length=runs))
- phylo.dist <- as.dist(cophenetic(sample.prune(samp,phylo)))
- pool.phylo.dist <- as.dist(cophenetic(phylo))
- taxa.names <- rownames(as.matrix(phylo.dist))
- samp.dist <- as.dist(as.matrix(species.dist(samp,metric))[taxa.names,taxa.names])
- results$obs.corr <- cor(phylo.dist,samp.dist,use="pairwise")
- results$obs.corr.p <- cor.test(phylo.dist,samp.dist)$p.value
- if (null.model=="sample.taxa.labels") for (run in 1:runs)
- {
- phylo.dist <- as.dist(taxaShuffle(as.matrix(phylo.dist))[taxa.names,taxa.names])
- results$random.corrs[run] <- cor(phylo.dist,samp.dist,use="pairwise")
- }
- else if (null.model=="pool.taxa.labels") for (run in 1:runs)
- {
- phylo.dist <- as.dist(taxaShuffle(as.matrix(pool.phylo.dist))[taxa.names,taxa.names])
- results$random.corrs[run] <- cor(phylo.dist,samp.dist,use="pairwise")
- }
- else if (null.model=="weighted.sample.pool") for (run in 1:runs)
- {
- samp.dist <- species.dist(randomizeSample(samp,null.model="both"),metric)
- phylo.dist <- as.dist(as.matrix(pool.phylo.dist)[rownames(as.matrix(samp.dist)),
- colnames(as.matrix(samp.dist))])
- results$random.corrs[run] <- cor(phylo.dist,samp.dist,use="pairwise")
- }
- else for (run in 1:runs)
- {
- samp.dist <- species.dist(randomizeSample(samp,null.model),metric)
- results$random.corrs[run] <- cor(phylo.dist,samp.dist,use="pairwise")
- }
- results$obs.rank <- rank(as.vector(c(results$obs.corr,results$random.corrs)))[1]
- results$obs.rand.p <- results$obs.rank/(runs+1)
- results
-}
Deleted: pkg/R/mnnd.R
===================================================================
--- pkg/R/mnnd.R 2008-04-25 23:41:34 UTC (rev 58)
+++ pkg/R/mnnd.R 2008-04-25 23:42:55 UTC (rev 59)
@@ -1,13 +0,0 @@
-`mnnd` <-
-function(samp,dis) {
- N <- dim(samp)[1]
- mnnd <- numeric(N)
- for (i in 1:N) {
- sppInSample <- names(samp[i,samp[i,]>0])
- sample.dis <- dis[sppInSample,sppInSample]
- diag(sample.dis) <- NA
- mnnd[i] <- mean(apply(sample.dis,2,min,na.rm=TRUE))
- }
- mnnd
-}
-
Deleted: pkg/R/mpd.R
===================================================================
--- pkg/R/mpd.R 2008-04-25 23:41:34 UTC (rev 58)
+++ pkg/R/mpd.R 2008-04-25 23:42:55 UTC (rev 59)
@@ -1,12 +0,0 @@
-`mpd` <-
-function(samp,dis) {
- N <- dim(samp)[1]
- mpd <- numeric(N)
- for (i in 1:N) {
- sppInSample <- names(samp[i,samp[i,]>0])
- sample.dis <- dis[sppInSample,sppInSample]
- mpd[i] <- mean(sample.dis[lower.tri(sample.dis)])
- }
- mpd
-}
-
Added: pkg/R/phylodiversity.R
===================================================================
--- pkg/R/phylodiversity.R (rev 0)
+++ pkg/R/phylodiversity.R 2008-04-25 23:42:55 UTC (rev 59)
@@ -0,0 +1,113 @@
+`comm.phylo.cor` <-
+function(samp,phylo,metric=c("cij","checkerboard","jaccard","roij"),
+ null.model=c("sample.taxa.labels","pool.taxa.labels",
+ "frequency","richness","weighted.sample.pool"),
+ runs=99)
+{
+ metric <- match.arg(metric)
+ null.model <- match.arg(null.model)
+ results <- list("obs.corr"=NA,"obs.corr.p"=NA,"obs.rank"=NA,"runs"=runs,
+ "obs.rand.p"=NA,"random.corrs"=vector(length=runs))
+ phylo.dist <- as.dist(cophenetic(sample.prune(samp,phylo)))
+ pool.phylo.dist <- as.dist(cophenetic(phylo))
+ taxa.names <- rownames(as.matrix(phylo.dist))
+ samp.dist <- as.dist(as.matrix(species.dist(samp,metric))[taxa.names,taxa.names])
+ results$obs.corr <- cor(phylo.dist,samp.dist,use="pairwise")
+ results$obs.corr.p <- cor.test(phylo.dist,samp.dist)$p.value
+ if (null.model=="sample.taxa.labels") for (run in 1:runs)
+ {
+ phylo.dist <- as.dist(taxaShuffle(as.matrix(phylo.dist))[taxa.names,taxa.names])
+ results$random.corrs[run] <- cor(phylo.dist,samp.dist,use="pairwise")
+ }
+ else if (null.model=="pool.taxa.labels") for (run in 1:runs)
+ {
+ phylo.dist <- as.dist(taxaShuffle(as.matrix(pool.phylo.dist))[taxa.names,taxa.names])
+ results$random.corrs[run] <- cor(phylo.dist,samp.dist,use="pairwise")
+ }
+ else if (null.model=="weighted.sample.pool") for (run in 1:runs)
+ {
+ samp.dist <- species.dist(randomizeSample(samp,null.model="both"),metric)
+ phylo.dist <- as.dist(as.matrix(pool.phylo.dist)[rownames(as.matrix(samp.dist)),
+ colnames(as.matrix(samp.dist))])
+ results$random.corrs[run] <- cor(phylo.dist,samp.dist,use="pairwise")
+ }
+ else for (run in 1:runs)
+ {
+ samp.dist <- species.dist(randomizeSample(samp,null.model),metric)
+ results$random.corrs[run] <- cor(phylo.dist,samp.dist,use="pairwise")
+ }
+ results$obs.rank <- rank(as.vector(c(results$obs.corr,results$random.corrs)))[1]
+ results$obs.rand.p <- results$obs.rank/(runs+1)
+ results
+}
+
+`mpd` <-
+function(samp,dis) {
+ N <- dim(samp)[1]
+ mpd <- numeric(N)
+ for (i in 1:N) {
+ sppInSample <- names(samp[i,samp[i,]>0])
+ sample.dis <- dis[sppInSample,sppInSample]
+ mpd[i] <- mean(sample.dis[lower.tri(sample.dis)])
+ }
+ mpd
+}
+
+`mnnd` <-
+function(samp,dis) {
+ N <- dim(samp)[1]
+ mnnd <- numeric(N)
+ for (i in 1:N) {
+ sppInSample <- names(samp[i,samp[i,]>0])
+ sample.dis <- dis[sppInSample,sppInSample]
+ diag(sample.dis) <- NA
+ mnnd[i] <- mean(apply(sample.dis,2,min,na.rm=TRUE))
+ }
+ mnnd
+}
+
+`ses.mpd` <-
+function (samp, dis, null.model = c("taxa.labels", "sample.pool",
+ "phylogeny.pool", "weighted.sample.pool"), runs = 99)
+{
+ dis <- as.matrix(dis)
+ mpd.obs <- mpd(samp, dis)
+ null.model <- match.arg(null.model)
+ mpd.rand <- switch(null.model,
+ taxa.labels = t(replicate(runs, mpd(samp, taxaShuffle(dis)))),
+ sample.pool = t(replicate(runs, mpd(randomizeSample(samp,null.model="richness"), dis))),
+ phylogeny.pool = t(replicate(runs, mpd(randomizeSample(samp,null.model="richness"),
+ taxaShuffle(dis)))),
+ weighted.sample.pool = t(replicate(runs, mpd(randomizeSample(samp,
+ null.model = "both"), dis))))
+ mpd.obs.rank <- apply(X = rbind(mpd.obs, mpd.rand), MARGIN = 2,
+ FUN = rank)[1, ]
+ mpd.rand.mean <- apply(X = mpd.rand, MARGIN = 2, FUN = mean, na.rm=TRUE)
+ mpd.rand.sd <- apply(X = mpd.rand, MARGIN = 2, FUN = sd, na.rm=TRUE)
+ mpd.obs.z <- (mpd.obs - mpd.rand.mean)/mpd.rand.sd
+ data.frame(ntaxa=specnumber(samp),mpd.obs, mpd.rand.mean, mpd.rand.sd, mpd.obs.rank,
+ mpd.obs.z, mpd.obs.p=mpd.obs.rank/(runs+1),runs=runs, row.names = row.names(samp))
+}
+
+`ses.mnnd` <-
+function (samp, dis, null.model = c("taxa.labels", "sample.pool",
+ "phylogeny.pool", "weighted.sample.pool"), runs = 99)
+{
+ dis <- as.matrix(dis)
+ mnnd.obs <- mnnd(samp, dis)
+ null.model <- match.arg(null.model)
+ mnnd.rand <- switch(null.model,
+ taxa.labels = t(replicate(runs, mnnd(samp, taxaShuffle(dis)))),
+ sample.pool = t(replicate(runs, mnnd(randomizeSample(samp,null.model="richness"), dis))),
+ phylogeny.pool = t(replicate(runs, mnnd(randomizeSample(samp,null.model="richness"),
+ taxaShuffle(dis)))),
+ weighted.sample.pool = t(replicate(runs, mnnd(randomizeSample(samp,
+ null.model = "both"), dis))))
+ mnnd.obs.rank <- apply(X = rbind(mnnd.obs, mnnd.rand), MARGIN = 2,
+ FUN = rank)[1, ]
+ mnnd.rand.mean <- apply(X = mnnd.rand, MARGIN = 2, FUN = mean, na.rm=TRUE)
+ mnnd.rand.sd <- apply(X = mnnd.rand, MARGIN = 2, FUN = sd, na.rm=TRUE)
+ mnnd.obs.z <- (mnnd.obs - mnnd.rand.mean)/mnnd.rand.sd
+ data.frame(ntaxa=specnumber(samp),mnnd.obs, mnnd.rand.mean, mnnd.rand.sd, mnnd.obs.rank,
+ mnnd.obs.z, mnnd.obs.p=mnnd.obs.rank/(runs+1),runs=runs, row.names = row.names(samp))
+}
Deleted: pkg/R/ses.mnnd.R
===================================================================
--- pkg/R/ses.mnnd.R 2008-04-25 23:41:34 UTC (rev 58)
+++ pkg/R/ses.mnnd.R 2008-04-25 23:42:55 UTC (rev 59)
@@ -1,23 +0,0 @@
-`ses.mnnd` <-
-function (samp, dis, null.model = c("taxa.labels", "sample.pool",
- "phylogeny.pool", "weighted.sample.pool"), runs = 99)
-{
- dis <- as.matrix(dis)
- mnnd.obs <- mnnd(samp, dis)
- null.model <- match.arg(null.model)
- mnnd.rand <- switch(null.model,
- taxa.labels = t(replicate(runs, mnnd(samp, taxaShuffle(dis)))),
- sample.pool = t(replicate(runs, mnnd(randomizeSample(samp,null.model="richness"), dis))),
- phylogeny.pool = t(replicate(runs, mnnd(randomizeSample(samp,null.model="richness"),
- taxaShuffle(dis)))),
- weighted.sample.pool = t(replicate(runs, mnnd(randomizeSample(samp,
- null.model = "both"), dis))))
- mnnd.obs.rank <- apply(X = rbind(mnnd.obs, mnnd.rand), MARGIN = 2,
- FUN = rank)[1, ]
- mnnd.rand.mean <- apply(X = mnnd.rand, MARGIN = 2, FUN = mean, na.rm=TRUE)
- mnnd.rand.sd <- apply(X = mnnd.rand, MARGIN = 2, FUN = sd, na.rm=TRUE)
- mnnd.obs.z <- (mnnd.obs - mnnd.rand.mean)/mnnd.rand.sd
- data.frame(ntaxa=specnumber(samp),mnnd.obs, mnnd.rand.mean, mnnd.rand.sd, mnnd.obs.rank,
- mnnd.obs.z, mnnd.obs.p=mnnd.obs.rank/(runs+1),runs=runs, row.names = row.names(samp))
-}
-
Deleted: pkg/R/ses.mpd.R
===================================================================
--- pkg/R/ses.mpd.R 2008-04-25 23:41:34 UTC (rev 58)
+++ pkg/R/ses.mpd.R 2008-04-25 23:42:55 UTC (rev 59)
@@ -1,23 +0,0 @@
-`ses.mpd` <-
-function (samp, dis, null.model = c("taxa.labels", "sample.pool",
- "phylogeny.pool", "weighted.sample.pool"), runs = 99)
-{
- dis <- as.matrix(dis)
- mpd.obs <- mpd(samp, dis)
- null.model <- match.arg(null.model)
- mpd.rand <- switch(null.model,
- taxa.labels = t(replicate(runs, mpd(samp, taxaShuffle(dis)))),
- sample.pool = t(replicate(runs, mpd(randomizeSample(samp,null.model="richness"), dis))),
- phylogeny.pool = t(replicate(runs, mpd(randomizeSample(samp,null.model="richness"),
- taxaShuffle(dis)))),
- weighted.sample.pool = t(replicate(runs, mpd(randomizeSample(samp,
- null.model = "both"), dis))))
- mpd.obs.rank <- apply(X = rbind(mpd.obs, mpd.rand), MARGIN = 2,
- FUN = rank)[1, ]
- mpd.rand.mean <- apply(X = mpd.rand, MARGIN = 2, FUN = mean, na.rm=TRUE)
- mpd.rand.sd <- apply(X = mpd.rand, MARGIN = 2, FUN = sd, na.rm=TRUE)
- mpd.obs.z <- (mpd.obs - mpd.rand.mean)/mpd.rand.sd
- data.frame(ntaxa=specnumber(samp),mpd.obs, mpd.rand.mean, mpd.rand.sd, mpd.obs.rank,
- mpd.obs.z, mpd.obs.p=mpd.obs.rank/(runs+1),runs=runs, row.names = row.names(samp))
-}
-
More information about the Picante-commits
mailing list