[Picante-commits] r38 - in pkg: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Mar 3 08:28:55 CET 2008


Author: skembel
Date: 2008-03-03 08:28:55 +0100 (Mon, 03 Mar 2008)
New Revision: 38

Added:
   pkg/R/corr.table.R
   pkg/man/corr.table.R
Removed:
   pkg/R/checkerboard.R
   pkg/R/cij.R
   pkg/R/freq.dist.R
   pkg/R/matchSpeciesMatrix.R
   pkg/R/multiPhylosignal.R
   pkg/R/phylo.dist.R
   pkg/R/randomizeSampleKeepSampRichness.R
   pkg/R/randomizeSampleKeepSppFreq.R
   pkg/R/randomizeSpeciesMatrix.R
   pkg/R/reflect.contrasts.R
   pkg/R/resample.R
   pkg/R/roij.R
   pkg/R/sppFreq.R
   pkg/corr.table.R
   pkg/man/checkerboard.Rd
   pkg/man/cij.Rd
   pkg/man/contrast.cor.table.Rd
   pkg/man/freq.dist.Rd
   pkg/man/matchSpeciesMatrix.Rd
   pkg/man/phylo.dist.Rd
   pkg/man/randomizeSampleKeepSampRichness.Rd
   pkg/man/randomizeSampleKeepSppFreq.Rd
   pkg/man/randomizeSpeciesMatrix.Rd
   pkg/man/reflect.contrasts.Rd
   pkg/man/resample.Rd
   pkg/man/roij.Rd
   pkg/man/sppFreq.Rd
Modified:
   pkg/R/comm.phylo.cor.R
   pkg/R/mnnd.R
   pkg/R/mpd.R
   pkg/R/nri.R
   pkg/R/nti.R
   pkg/R/phylosignal.R
   pkg/R/randomizeSample.R
   pkg/R/species.dist.R
   pkg/R/taxaShuffle.R
   pkg/man/nri.Rd
   pkg/man/nti.Rd
Log:
Merging functions, cleaning up unused functions, renaming functions

Deleted: pkg/R/checkerboard.R
===================================================================
--- pkg/R/checkerboard.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/checkerboard.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,18 +0,0 @@
-`checkerboard` <-
-function(x) {
-	#Gotelli 2000: Checker = Sum (Si - Q)(Sk - Q) / ((R*(R-1))/2)
-	#where Si = total for row(species) i, R = num rows(spp), Q = num sites where both spp present
-	x <- decostand(x,method="pa")
-	Nsites <- dim(x)[1]
-	S <- apply(x,2,sum)
-	R <- length(S)
-	Checker.ij <- matrix(nrow=R,ncol=R,dimnames=list(colnames(x),colnames(x)))
-	for (i in 1:R) {
-		for (j in 1:R) {
-			Q <- sum(x[,i]*x[,j])
-			Checker.ij[i,j] <- ((S[i] - Q)*(S[j] - Q)) / ((R*(R-1))/2)
-		}
-	}
-	as.dist(Checker.ij)
-}
-

Deleted: pkg/R/cij.R
===================================================================
--- pkg/R/cij.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/cij.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,7 +0,0 @@
-`cij` <-
-function(x) {
-	#Schoener index of co-occurrence
-	x <- decostand(x,method="total",MARGIN=2)
-	cij <- dist(t(x),method="manhattan")
-	1 - (0.5 * cij)
-}

Modified: pkg/R/comm.phylo.cor.R
===================================================================
--- pkg/R/comm.phylo.cor.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/comm.phylo.cor.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,7 +1,7 @@
 `comm.phylo.cor` <-
-function(samp,phylo,metric=c("cij","jaccard","roij"),
+function(samp,phylo,metric=c("cij","checkerboard","jaccard","roij"),
 		null.model=c("sample.taxa.labels","pool.taxa.labels",
-					"keepFreq","keepRichness","weighted.sample.pool"),
+					"frequency","richness","weighted.sample.pool"),
 					runs=99)
 {
 	metric <- match.arg(metric)
@@ -26,7 +26,7 @@
 	}
 	else if (null.model=="weighted.sample.pool") for (run in 1:runs)
 	{
-		samp.dist <- species.dist(randomizeSpeciesMatrix(samp,keepSppFreq=TRUE),metric)
+		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")
@@ -40,4 +40,3 @@
 	results$obs.rand.p <- results$obs.rank/(runs+1)
 	results
 }
-

Copied: pkg/R/corr.table.R (from rev 37, pkg/corr.table.R)
===================================================================
--- pkg/R/corr.table.R	                        (rev 0)
+++ pkg/R/corr.table.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -0,0 +1,20 @@
+corr.table <- function (x, cor.method = "pearson", cor.type=c("standard","contrast")) 
+{
+    cor.type <- match.arg(cor.type)
+    if (identical(cor.type,"standard")) {
+        concorr <- list()
+        concorr$r <- cor(x, method = cor.method)
+        concorr$df <- dim(x)[1] - 2
+        t <- concorr$r * sqrt(concorr$df/(1 - concorr$r^2))
+        concorr$P <- dt(t, concorr$df)
+        concorr
+    }
+    else {
+    	concorr <- list()
+        concorr$r <- cor(rbind(x,x*-1),method=cor.method)
+        concorr$df <- length(x[,1])-1
+        t <- concorr$r * sqrt(concorr$df/(1-concorr$r^2))
+        concorr$P <- dt(t,concorr$df)
+        concorr
+    }
+}

Deleted: pkg/R/freq.dist.R
===================================================================
--- pkg/R/freq.dist.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/freq.dist.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,12 +0,0 @@
-`freq.dist` <-
-function(sppFreq, metric="rank") {
-
-#metric can be "freq" (uses difference in species frequency)
-#or "rank" (default, uses difference in species frequency rank)
-sppFreq <- sppFreq[sort(rownames(sppFreq)),]
-if (metric=="freq") sppFreq[["rank"]] <- NULL
-if (metric=="rank") sppFreq[["freq"]] <- NULL
-dist(sppFreq,method="manhattan")
-
-}
-

Deleted: pkg/R/matchSpeciesMatrix.R
===================================================================
--- pkg/R/matchSpeciesMatrix.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/matchSpeciesMatrix.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,8 +0,0 @@
-`matchSpeciesMatrix` <-
-function (x, y) 
-{
-    mergedFrame <- merge(x, y, all.y = TRUE)
-    mergedFrame[is.na(mergedFrame)] <- 0
-    mergedFrame[,colnames(x)]
-}
-

Modified: pkg/R/mnnd.R
===================================================================
--- pkg/R/mnnd.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/mnnd.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,12 +1,12 @@
 `mnnd` <-
-function(samp,phy.dist) {
+function(samp,dis) {
 	N <- dim(samp)[1]
-	mnnd <- vector()
+	mnnd <- numeric(N)
 	for (i in 1:N) {
 		sppInSample <- names(samp[i,samp[i,]>0])
-		sample.phy.dist <- phy.dist[sppInSample,sppInSample]
-		diag(sample.phy.dist) <- NA
-		mnnd <- c(mnnd,mean(sapply(data.frame(sample.phy.dist),min,na.rm=TRUE)))
+		sample.dis <- dis[sppInSample,sppInSample]
+		diag(sample.dis) <- NA
+		mnnd[i] <- mean(apply(sample.dis,2,min,na.rm=TRUE))
 	}
 	mnnd
 }

Modified: pkg/R/mpd.R
===================================================================
--- pkg/R/mpd.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/mpd.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,11 +1,11 @@
 `mpd` <-
-function(samp,phy.dist) {
+function(samp,dis) {
 	N <- dim(samp)[1]
-	mpd <- vector()
+	mpd <- numeric(N)
 	for (i in 1:N) {
 		sppInSample <- names(samp[i,samp[i,]>0])
-		sample.phy.dist <- phy.dist[sppInSample,sppInSample]
-		mpd <- c(mpd,mean(sample.phy.dist[lower.tri(sample.phy.dist)]))
+		sample.dis <- dis[sppInSample,sppInSample]
+		mpd[i] <- mean(sample.dis[lower.tri(sample.dis)])
 	}
 	mpd
 }

Deleted: pkg/R/multiPhylosignal.R
===================================================================
--- pkg/R/multiPhylosignal.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/multiPhylosignal.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,16 +0,0 @@
-'multiPhylosignal' <-
-function(x,tree,...) {
-	trait <- x[,1]
-	names(trait) <- row.names(x)
-	pruned <- pruneMissing(trait,tree)
-	output <- data.frame(phylosignal(pruned$data,pruned$tree,...))
-	if(length(colnames(x))>1) {
-		for (i in 2:length(colnames(x))) {
-			trait <- x[,i]
-			names(trait) <- row.names(x)
-			pruned <- pruneMissing(trait,tree)
-			output <- rbind(output,phylosignal(pruned$data,pruned$tree,...))
-		}
-	}
-	data.frame(output,row.names=colnames(x))
-}
\ No newline at end of file

Modified: pkg/R/nri.R
===================================================================
--- pkg/R/nri.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/nri.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,16 +1,17 @@
-`nri` <-
-function (samp, phylo.dist, null.model = c("taxa.labels", "sample.pool", 
+`ses.mpd` <-
+function (samp, dis, null.model = c("taxa.labels", "sample.pool", 
     "phylogeny.pool", "weighted.sample.pool"), runs = 99) 
 {
-    mpd.obs <- mpd(samp, phylo.dist)
+    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(phylo.dist)))),
-    	sample.pool = t(replicate(runs, mpd(randomizeSampleKeepSampRichness(samp), phylo.dist))),
-    	phylogeny.pool = t(replicate(runs, mpd(randomizeSampleKeepSampRichness(samp),
-    		taxaShuffle(phylo.dist)))),
-    	weighted.sample.pool = t(replicate(runs, mpd(randomizeSpeciesMatrix(samp,
-    		keepSppFreq = TRUE), phylo.dist))))
+    	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)

Modified: pkg/R/nti.R
===================================================================
--- pkg/R/nti.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/nti.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,17 +1,17 @@
-`nti` <-
-function (samp, phylo.dist, null.model = c("taxa.labels", "sample.pool", 
+`ses.mnnd` <-
+function (samp, dis, null.model = c("taxa.labels", "sample.pool", 
     "phylogeny.pool", "weighted.sample.pool"), runs = 99) 
 {
-    mnnd.obs <- mnnd(samp, phylo.dist)
+    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(phylo.dist)))), sample.pool = t(replicate(runs, 
-        mnnd(randomizeSampleKeepSampRichness(samp), phylo.dist))), 
-        phylogeny.pool = t(replicate(runs, mnnd(randomizeSampleKeepSampRichness(samp), 
-            taxaShuffle(phylo.dist)))),
-        weighted.sample.pool = t(replicate(runs, 
-            mnnd(randomizeSpeciesMatrix(samp, keepSppFreq = TRUE),
-            	phylo.dist))))
+    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)

Deleted: pkg/R/phylo.dist.R
===================================================================
--- pkg/R/phylo.dist.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/phylo.dist.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,8 +0,0 @@
-`phylo.dist` <-
-function (phylo) 
-{
-    phylo.d <- cophenetic(phylo)
-    phylo.d <- phylo.d[sort(rownames(phylo.d)), sort(colnames(phylo.d))]
-    as.dist(phylo.d)
-}
-

Modified: pkg/R/phylosignal.R
===================================================================
--- pkg/R/phylosignal.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/phylosignal.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -55,3 +55,20 @@
     data.frame(K,PIC.variance.obs=obs.var.pic,PIC.variance.rnd.mean=mean(var.pics),PIC.variance.P=var.pics.p, PIC.variance.Z=var.pics.z)
 
 }
+
+'multiPhylosignal' <-
+function(x,tree,...) {
+	trait <- x[,1]
+	names(trait) <- row.names(x)
+	pruned <- pruneMissing(trait,tree)
+	output <- data.frame(phylosignal(pruned$data,pruned$tree,...))
+	if(length(colnames(x))>1) {
+		for (i in 2:length(colnames(x))) {
+			trait <- x[,i]
+			names(trait) <- row.names(x)
+			pruned <- pruneMissing(trait,tree)
+			output <- rbind(output,phylosignal(pruned$data,pruned$tree,...))
+		}
+	}
+	data.frame(output,row.names=colnames(x))
+}
\ No newline at end of file

Modified: pkg/R/randomizeSample.R
===================================================================
--- pkg/R/randomizeSample.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/randomizeSample.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,9 +1,40 @@
 `randomizeSample` <-
-function(samp, null.model=c("keepFreq","keepRichness","keepBoth")) {
+function(samp, null.model=c("frequency","richness","both")) {
 	null.model <- match.arg(null.model)
-	switch(null.model,
-	keepFreq = data.frame(apply(samp,2,sample),row.names=row.names(samp)),
-	keepRichness = t(data.frame(apply(samp,1,sample),row.names=colnames(samp))),
-	keepBoth = matchSpeciesMatrix(samp,randomizeSpeciesMatrix(samp,keepSppFreq=TRUE)))
+	if (identical(null.model,"frequency")) {
+	    return(data.frame(apply(samp,2,sample),row.names=row.names(samp)))
+	}
+	if (identical(null.model,"richness")) {
+	    return(t(data.frame(apply(samp,1,sample),row.names=colnames(samp))))
+	}
+	if (identical(null.model,"both")) {
+        #check for presence-absence and warn until abundance implemented
+        x <- decostand(samp, "pa")
+        if (!identical(x,samp)) stop("Null model currently requires a presence-absence matrix.")
+        sppFreq <- apply(x, 2, sum)/ncol(x)
+        siteRichness <- apply(x, 1, sum)
+        sampleList <- vector()
+        sppList <- vector()
+        for (siteNum in 1:length(siteRichness)) {
+            sampleList <- c(sampleList, rep(names(siteRichness)[siteNum], 
+                siteRichness[siteNum]))
+            sppList <- c(sppList, sample(names(sppFreq), siteRichness[siteNum], 
+                replace = FALSE, prob = sppFreq))
+        }
+        shuffledList <- data.frame(sample = sampleList, species = sppList, 
+            p = rep(1, length(sppList)))
+        shuffledMatrix <- tapply(shuffledList$p, list(shuffledList$sample, 
+            shuffledList$species), sum)
+        shuffledMatrix[is.na(shuffledMatrix)] <- 0
+        if (identical(dim(shuffledMatrix),dim(x))) {
+            return(shuffledMatrix[rownames(x), ])        
+        }
+        else
+        {
+            mergedFrame <- merge(shuffledMatrix, x, all.y = TRUE)
+            mergedFrame[is.na(mergedFrame)] <- 0
+            return(mergedFrame[rownames(x),colnames(x)])
+        }
+	}
 }
 

Deleted: pkg/R/randomizeSampleKeepSampRichness.R
===================================================================
--- pkg/R/randomizeSampleKeepSampRichness.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/randomizeSampleKeepSampRichness.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,6 +0,0 @@
-`randomizeSampleKeepSampRichness` <-
-function(samp)
-{
-	t(data.frame(apply(samp,1,sample),row.names=colnames(samp)))
-}
-

Deleted: pkg/R/randomizeSampleKeepSppFreq.R
===================================================================
--- pkg/R/randomizeSampleKeepSppFreq.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/randomizeSampleKeepSppFreq.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,6 +0,0 @@
-`randomizeSampleKeepSppFreq` <-
-function(samp)
-{
-	data.frame(apply(samp,2,sample),row.names=row.names(samp))
-}
-

Deleted: pkg/R/randomizeSpeciesMatrix.R
===================================================================
--- pkg/R/randomizeSpeciesMatrix.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/randomizeSpeciesMatrix.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,22 +0,0 @@
-`randomizeSpeciesMatrix` <-
-function (x, keepSppFreq = TRUE) 
-{
-    if (keepSppFreq) sppFreq <- apply(decostand(x, "pa"), 2, sum)/ncol(x)
-	    else sppFreq <- apply(decostand(x, "pa"), 2, max)/ncol(x)
-    siteRichness <- apply(decostand(x, "pa"), 1, sum)
-    sampleList <- vector()
-    sppList <- vector()
-    for (siteNum in 1:length(siteRichness)) {
-        sampleList <- c(sampleList, rep(names(siteRichness)[siteNum], 
-            siteRichness[siteNum]))
-        sppList <- c(sppList, sample(names(sppFreq), siteRichness[siteNum], 
-            replace = FALSE, prob = sppFreq))
-    }
-    shuffledList <- data.frame(sample = sampleList, species = sppList, 
-        p = rep(1, length(sppList)))
-    shuffledMatrix <- tapply(shuffledList$p, list(shuffledList$sample, 
-        shuffledList$species), sum)
-    shuffledMatrix[is.na(shuffledMatrix)] <- 0
-    shuffledMatrix[rownames(x), ]
-}
-

Deleted: pkg/R/reflect.contrasts.R
===================================================================
--- pkg/R/reflect.contrasts.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/reflect.contrasts.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,5 +0,0 @@
-`reflect.contrasts` <-
-function(x) {
-	rbind(x,x*-1)
-}
-

Deleted: pkg/R/resample.R
===================================================================
--- pkg/R/resample.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/resample.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,5 +0,0 @@
-`resample` <-
-function(x, size, ...)
-  if(length(x) <= 1) { if(!missing(size) && size == 0) x[FALSE] else x
-  } else sample(x, size, ...)
-

Deleted: pkg/R/roij.R
===================================================================
--- pkg/R/roij.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/roij.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,18 +0,0 @@
-`roij` <-
-function(x) {
-	#Hardy's standardized version of checkerboard
-	#roij = (Pij - Pi*Pj)/(Pi*Pj)
-	x <- as.matrix(decostand(x,method="pa"))
-	Nsites <- dim(x)[1]
-	P <- apply(x,2,sum) / Nsites
-	N <- length(P)
-	roij <- matrix(nrow=N,ncol=N,dimnames=list(colnames(x),colnames(x)))
-	for (i in 1:N-1) {
-		for (j in (i+1):N) {
-			Pij <- sum(x[,i]*x[,j])/Nsites
-			roij[i,j] <- ((Pij - (P[i]*P[j]))/(P[i]*P[j]))
-		}
-	}
-	as.dist(t(roij))
-}
-

Modified: pkg/R/species.dist.R
===================================================================
--- pkg/R/species.dist.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/species.dist.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,10 +1,44 @@
 `species.dist` <-
-function (samp, metric=c("cij","jaccard","roij")) {
+function (x, metric=c("cij","jaccard","checkerboard","roij")) {
 	metric <- match.arg(metric)
-    switch(metric,
-    	cij = cij(sortColumns(samp)),
-    	jaccard = ( 1 - vegdist(t(sortColumns(samp)), method = "jaccard")),
-    	roij = roij(sortColumns(samp))
-       	)
+    if (identical(metric,"checkerboard")) {
+        #Gotelli 2000: Checker = Sum (Si - Q)(Sk - Q) / ((R*(R-1))/2)
+        #where Si = total for row(species) i, R = num rows(spp), Q = num sites where both spp present
+        x <- decostand(x,method="pa")
+        Nsites <- dim(x)[1]
+        S <- apply(x,2,sum)
+        R <- length(S)
+        Checker.ij <- matrix(nrow=R,ncol=R,dimnames=list(colnames(x),colnames(x)))
+        for (i in 1:R) {
+            for (j in 1:R) {
+                Q <- sum(x[,i]*x[,j])
+                Checker.ij[i,j] <- ((S[i] - Q)*(S[j] - Q)) / ((R*(R-1))/2)
+            }
+        }
+        return(as.dist(Checker.ij))
+    }
+    if (identical(metric,"cij")) {
+        #Schoener index of co-occurrence
+        x <- decostand(x,method="total",MARGIN=2)
+        return(1 - (0.5 * dist(t(x),method="manhattan")))
+    }    
+    if (identical(metric,"jaccard")) {    
+        return( 1 - vegdist(t(sortColumns(x)), method = "jaccard"))
+    }
+    if (identical(metric,"roij")) {
+        #Hardy's standardized version of checkerboard
+        #roij = (Pij - Pi*Pj)/(Pi*Pj)
+        x <- as.matrix(decostand(x,method="pa"))
+        Nsites <- dim(x)[1]
+        P <- apply(x,2,sum) / Nsites
+        N <- length(P)
+        roij <- matrix(nrow=N,ncol=N,dimnames=list(colnames(x),colnames(x)))
+        for (i in 1:N-1) {
+            for (j in (i+1):N) {
+                Pij <- sum(x[,i]*x[,j])/Nsites
+                roij[i,j] <- ((Pij - (P[i]*P[j]))/(P[i]*P[j]))
+            }
+        }
+        return(as.dist(t(roij)))
+    }
 }
-

Deleted: pkg/R/sppFreq.R
===================================================================
--- pkg/R/sppFreq.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/sppFreq.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,10 +0,0 @@
-`sppFreq` <-
-function(x) {
-
-freqVec <- apply(decostand(x,"pa"),2,sum)/nrow(x)
-rankVec <- rank(1-freqVec,ties.meth="min")
-freqVec <- data.frame("freq"=freqVec,"rank"=rankVec)
-freqVec[sort(rownames(freqVec)),]
-
-}
-

Modified: pkg/R/taxaShuffle.R
===================================================================
--- pkg/R/taxaShuffle.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/R/taxaShuffle.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,11 +1,8 @@
 `taxaShuffle` <-
-function(x, strata) {
-	#shuffle taxa labels on a matrix (usually a phylogenetic or trait distance matrix)
-	#should die if not symmetric - can this be a dist matrix?
-	#xdim <- dim(as.matrix(x))[1]
-	#i <- permuted.index(xdim,strata)
-	#x[i,i]
-	rand.names <- resample(rownames(x))
+function(x) {
+    #todo replace with vegan's permuted.index?
+    if (!is.matrix(x)) x <- as.matrix(x)
+	rand.names <- sample(rownames(x))
 	rownames(x) <- rand.names
 	colnames(x) <- rand.names
 	x

Deleted: pkg/corr.table.R
===================================================================
--- pkg/corr.table.R	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/corr.table.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,20 +0,0 @@
-corr.table <- function (x, cor.method = "pearson", cor.type=c("standard","contrast")) 
-{
-    cor.type <- match.arg(cor.type)
-    if (identical(cor.type,"standard")) {
-        concorr <- list()
-        concorr$r <- cor(x, method = cor.method)
-        concorr$df <- dim(x)[1] - 2
-        t <- concorr$r * sqrt(concorr$df/(1 - concorr$r^2))
-        concorr$P <- dt(t, concorr$df)
-        concorr
-    }
-    else {
-    	concorr <- list()
-        concorr$r <- cor(reflect.contrasts(x),method=cor.method)
-        concorr$df <- length(x[,1])-1
-        t <- concorr$r * sqrt(concorr$df/(1-concorr$r^2))
-        concorr$P <- dt(t,concorr$df)
-        concorr
-    }
-}

Deleted: pkg/man/checkerboard.Rd
===================================================================
--- pkg/man/checkerboard.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/checkerboard.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,24 +0,0 @@
-\name{checkerboard}
-
-\alias{checkerboard}
-
-\title{ Checkerboard statistic }
-
-\description{
-  Calculates the checkerboard statistic of species co-occurrence
-}
-
-\usage{
-checkerboard(x)
-}
-
-\arguments{
-  \item{x}{ Community data matrix }
-}
-
-\value{
-  Return an object of class dist containing checkerboard index of co-occurrence for all species pairs in x.
-}
-\references{ ~put references to the literature/web site here ~ }
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\keyword{univar}

Deleted: pkg/man/cij.Rd
===================================================================
--- pkg/man/cij.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/cij.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,18 +0,0 @@
-\name{cij}
-\alias{cij}
-\title{ Schoener's pairwise index of species co-occurrence }
-\description{
-  Calculates Schoener's pairwise index of species co-occurrence for a community matrix
-}
-\usage{
-cij(x)
-}
-\arguments{
-  \item{x}{ Community data matrix }
-}
-\value{
-  Return an object of class dist containing Schoener's index of co-occurrence for all species pairs in x.
-}
-\references{ Schoener }
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\keyword{univar}

Deleted: pkg/man/contrast.cor.table.Rd
===================================================================
--- pkg/man/contrast.cor.table.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/contrast.cor.table.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,17 +0,0 @@
-\name{contrast.cor.table}
-\alias{contrast.cor.table}
-\title{ Table of PIC correlations }
-\description{
-  Table of PIC correlations with corrected P-values and df
-}
-\usage{
-contrast.cor.table(nodes, cor.method = "pearson")
-}
-%- maybe also 'usage' for other objects documented here.
-\arguments{
-  \item{nodes}{ Data frame of standardized contrasts at nodes }
-  \item{cor.method}{ Correlation method (as \code{\link{cor}}) }
-}
-
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\keyword{univar}

Copied: pkg/man/corr.table.R (from rev 36, pkg/man/contrast.cor.table.Rd)
===================================================================
--- pkg/man/corr.table.R	                        (rev 0)
+++ pkg/man/corr.table.R	2008-03-03 07:28:55 UTC (rev 38)
@@ -0,0 +1,17 @@
+\name{contrast.cor.table}
+\alias{contrast.cor.table}
+\title{ Table of PIC correlations }
+\description{
+  Table of PIC correlations with corrected P-values and df
+}
+\usage{
+contrast.cor.table(nodes, cor.method = "pearson")
+}
+%- maybe also 'usage' for other objects documented here.
+\arguments{
+  \item{nodes}{ Data frame of standardized contrasts at nodes }
+  \item{cor.method}{ Correlation method (as \code{\link{cor}}) }
+}
+
+\author{ Steve Kembel <skembel at berkeley.edu> }
+\keyword{univar}

Deleted: pkg/man/freq.dist.Rd
===================================================================
--- pkg/man/freq.dist.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/freq.dist.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,20 +0,0 @@
-\name{freq.dist}
-\alias{freq.dist}
-
-\title{ Frequency distance }
-\description{
-  Dissimilarity of species occurrence frequencies as a distance object
-}
-\usage{
-freq.dist(sppFreq, metric = "rank")
-}
-%- maybe also 'usage' for other objects documented here.
-\arguments{
-  \item{sppFreq}{ Vector of species frequencies }
-  \item{metric}{ freq or rank }
-}
-\value{
-  A dist object
-}
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\keyword{univar}

Deleted: pkg/man/matchSpeciesMatrix.Rd
===================================================================
--- pkg/man/matchSpeciesMatrix.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/matchSpeciesMatrix.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,20 +0,0 @@
-\name{matchSpeciesMatrix}
-\alias{matchSpeciesMatrix}
-%- Also NEED an '\alias' for EACH other topic documented here.
-\title{ Ensure rows and columns of two community data matrices match }
-\description{
-  Ensure rows and columns of two community data matrices match
-}
-\usage{
-matchSpeciesMatrix(x, y)
-}
-
-\arguments{
-  \item{x}{ Community data matrix 1}
-  \item{y}{ Community data matrix 2}
-}
-\value{
-  Community data matrix 2 but with rows and columns for all sites and species present in community data matrix 1 present (even if those species/sites not present in matrix 2)
-}
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\keyword{manip}

Modified: pkg/man/nri.Rd
===================================================================
--- pkg/man/nri.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/nri.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,5 +1,6 @@
-\name{nri}
+\name{ses.mpd}
 \alias{nri}
+\alias{ses.mpd}
 %- Also NEED an '\alias' for EACH other topic documented here.
 \title{ Net Relatedness Index }
 \description{

Modified: pkg/man/nti.Rd
===================================================================
--- pkg/man/nti.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/nti.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,5 +1,6 @@
-\name{nti}
+\name{ses.mnnd}
 \alias{nti}
+\alias{ses.mnnd}
 
 \title{ Nearest Taxon Index }
 \description{

Deleted: pkg/man/phylo.dist.Rd
===================================================================
--- pkg/man/phylo.dist.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/phylo.dist.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,20 +0,0 @@
-\name{phylo.dist}
-\alias{phylo.dist}
-\title{ Cophenetic phylogenetic distance object }
-\description{
-  Wrapper for cophenetic returns a dist object sorted by species names
-}
-\usage{
-phylo.dist(phylo)
-}
-
-\arguments{
-  \item{phylo}{ phylo object }
-}
-
-\value{
- dist object
-}
-
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\keyword{misc}

Deleted: pkg/man/randomizeSampleKeepSampRichness.Rd
===================================================================
--- pkg/man/randomizeSampleKeepSampRichness.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/randomizeSampleKeepSampRichness.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,19 +0,0 @@
-\name{randomizeSampleKeepSampRichness}
-\alias{randomizeSampleKeepSampRichness}
-
-\title{ Randomize community matrix maintaining sample richness }
-\description{
-  Randomize community matrix maintaining sample richness
-}
-\usage{
-randomizeSampleKeepSampRichness(samp)
-}
-\arguments{
-  \item{samp}{ Community data matrix }
-}
-\value{
- Randomized community data matrix
-}
-\references{ Gotelli. 2000. Ecology. }
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\keyword{manip}

Deleted: pkg/man/randomizeSampleKeepSppFreq.Rd
===================================================================
--- pkg/man/randomizeSampleKeepSppFreq.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/randomizeSampleKeepSppFreq.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,18 +0,0 @@
-\name{randomizeSampleKeepSppFreq}
-\alias{randomizeSampleKeepSppFreq}
-\title{ Randomize community matrix maintaining species frequencies }
-\description{
-  Randomize community matrix maintaining species frequencies
-}
-\usage{
-randomizeSampleKeepSppFreq(samp)
-}
-\arguments{
-  \item{samp}{ Community data matrix }
-}
-\value{
- Randomized community data matrix
-}
-\references{ Gotelli. 2000. Ecology. }
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\keyword{manip}

Deleted: pkg/man/randomizeSpeciesMatrix.Rd
===================================================================
--- pkg/man/randomizeSpeciesMatrix.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/randomizeSpeciesMatrix.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,25 +0,0 @@
-\name{randomizeSpeciesMatrix}
-\alias{randomizeSpeciesMatrix}
-
-\title{ Randomize community matrix }
-\description{
-  Randomize community matrix keeping sample richness constant and with option to keep species frequency constant
-}
-\usage{
-randomizeSpeciesMatrix(x, keepSppFreq = TRUE)
-}
-%- maybe also 'usage' for other objects documented here.
-\arguments{
-  \item{x}{ Community data matrix }
-  \item{keepSppFreq}{ Should species frequencies be maintained? (TRUE or FALSE) }
-}
-
-\value{
-  Randomized community data matrix
-}
-\references{ Gotelli. 2000. Ecology. }
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\section{Warning }{Slow! Works only with presence-absence matrices.}
-\keyword{manip}
-
-

Deleted: pkg/man/reflect.contrasts.Rd
===================================================================
--- pkg/man/reflect.contrasts.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/reflect.contrasts.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,21 +0,0 @@
-\name{reflect.contrasts}
-\alias{reflect.contrasts}
-%- Also NEED an '\alias' for EACH other topic documented here.
-\title{ Reflect nodal contrast values about the origin }
-\description{
-  Reflect nodal contrast values about the origin for correlation calculation.
-}
-\usage{
-reflect.contrasts(x)
-}
-%- maybe also 'usage' for other objects documented here.
-\arguments{
-  \item{x}{ Data frame of nodal PIC values }
-}
-
-\value{
-  Data frame of nodal PIC values reflected about the origin
-}
-
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\keyword{manip}

Deleted: pkg/man/resample.Rd
===================================================================
--- pkg/man/resample.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/resample.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,19 +0,0 @@
-\name{resample}
-\alias{resample}
-%- Also NEED an '\alias' for EACH other topic documented here.
-\title{ Improved sample }
-\description{
-  Utility function cribbed from \code{\link{sample}} documentation.
-}
-\usage{
-resample(x, size, ...)
-}
-\arguments{
-  \item{x}{ Object to be sampled from}
-  \item{size}{ Number of samples to take}
-  \item{...}{ Parameters to be passed on}
-}
-
-
-\seealso{ \code{\link{sample}} }
-\keyword{manip}

Deleted: pkg/man/roij.Rd
===================================================================
--- pkg/man/roij.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/roij.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,21 +0,0 @@
-\name{roij}
-\alias{roij}
-%- Also NEED an '\alias' for EACH other topic documented here.
-\title{ Frequency-insensitive measure of species co-occurrence }
-\description{
-  Frequency-insensitive measure of species co-occurrence, based on modified checkerboard score.
-}
-\usage{
-roij(x)
-}
-%- maybe also 'usage' for other objects documented here.
-\arguments{
-  \item{x}{ Community data matrix }
-}
-
-\value{
-  Dist object of species co-occurrence.
-}
-\references{ Hardy. pers. comm. }
-\author{ Steve Kembel <skembel at berkeley.edu> }
-\keyword{univar}

Deleted: pkg/man/sppFreq.Rd
===================================================================
--- pkg/man/sppFreq.Rd	2008-03-03 05:25:47 UTC (rev 37)
+++ pkg/man/sppFreq.Rd	2008-03-03 07:28:55 UTC (rev 38)
@@ -1,19 +0,0 @@
-\name{sppFreq}
-\alias{sppFreq}
-%- Also NEED an '\alias' for EACH other topic documented here.
-\title{ Calculate species occurrence frequencies }
-\description{
-  Calculate species occurrence frequencies 
-}
-\usage{
-sppFreq(x)
-}
-%- maybe also 'usage' for other objects documented here.
-\arguments{
-  \item{x}{ Community data matrix }
-}
-
-\author{ Steve Kembel <skembel at berkeley.edu> }
-
-\seealso{ \code{\link[vegan]{decostand}} }
-\keyword{univar}



More information about the Picante-commits mailing list