[Esm-commits] r2 - in pkg: . ESM ESM/R ESM/man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Nov 9 19:44:59 CET 2009


Author: timotheepoisot
Date: 2009-11-09 19:44:59 +0100 (Mon, 09 Nov 2009)
New Revision: 2

Added:
   pkg/ESM/
   pkg/ESM/DESCRIPTION
   pkg/ESM/R/
   pkg/ESM/R/.Rhistory
   pkg/ESM/R/functions.r
   pkg/ESM/man/
   pkg/ESM/man/GDS.Rd
   pkg/ESM/man/draw.network.Rd
   pkg/ESM/man/getspe.Rd
   pkg/ESM/man/sortmat.byspe.Rd
   pkg/ESM/man/std.matrix.Rd
Log:


Added: pkg/ESM/DESCRIPTION
===================================================================
--- pkg/ESM/DESCRIPTION	                        (rev 0)
+++ pkg/ESM/DESCRIPTION	2009-11-09 18:44:59 UTC (rev 2)
@@ -0,0 +1,11 @@
+Package: ESM
+Version: 0.0.2-01
+Date: 2009-11-06
+Title: Ecological Specificity Measures
+Author: Timothee Poisot <timothee.poisot at univ-montp2.fr>, Michael E Hochberg <michael.hochberg at univ-montp2.fr>
+Maintainer: Timothee Poisot <timothee.poisot at univ-montp2.fr>
+Depends: R (>= 2.1.0)
+Suggests: vegan
+Description: Performs several measures of ecological specificity 
+License: GPL (>= 2) 
+URL: http://homepage.mac.com/tim.poisot
\ No newline at end of file

Added: pkg/ESM/R/.Rhistory
===================================================================
--- pkg/ESM/R/.Rhistory	                        (rev 0)
+++ pkg/ESM/R/.Rhistory	2009-11-09 18:44:59 UTC (rev 2)
@@ -0,0 +1,202 @@
+setwd('/Users/Tim/Desktop/ESM/R')
+get.HR <- function(pop)#
+{#
+	Ni <- sum(pop>0)#
+	N <- length(pop)#
+	return(1-Ni/N)#
+}#
+#
+get.SHANNON <- function(pop)#
+{#
+	partiel <- NULL#
+	pop <- as.vector(pop)+0.0000000001#
+	for(i in 1:length(pop))#
+	{#
+		p <- pop[i]/sum(pop)#
+		partiel[i] <- p * log(p)#
+	}#
+	shannon <- ifelse(length(pop)<=1,0,-sum(partiel) / log(length(pop)))#
+	return(shannon)#
+}#
+#
+get.DFP <- function(fit)#
+{#
+	score <- NULL#
+	fit <- as.vector(fit)#
+	fit <- na.exclude(sort(fit,decreasing=TRUE))#
+	vecdiff <- NULL	#
+	for(i in 1:(length(fit)-1))#
+	{#
+		vecdiff[i] <- (fit[i+1]-fit[i])+1#
+	}#
+	score <- prod(abs(vecdiff))#
+	return(1-score)#
+}#
+#
+get.WADFP <- function(fit)#
+{#
+	ngen <- length(fit)#
+	sorted <- sort(fit,decreasing=TRUE)#
+	tempS <- NULL#
+	correc <- (ngen-1)/ngen#
+	for(g in 1:(ngen-1))#
+	{#
+		tempS[g] <- (1+sorted[g]-sorted[g+1])*sorted[g]#
+	}#
+	S <- sum(tempS)/sum(fit)#
+	S <- (S-correc)/(2-correc)#
+	return(S)#
+}#
+#
+get.SSI <- function(occup)#
+{#
+	score <- NULL#
+	fit <- as.vector(occup)#
+	h <- sum(fit>0)#
+	H <- length(occup)#
+	SSI <- sqrt((H/h-1)/(H-1))#
+	return(SSI)#
+}#
+#
+dfp <- function(m)#
+{#
+	spe <- vector('numeric',length=nrow(m))#
+	for(i in 1:nrow(m))#
+	{#
+		spe[i] <- get.DFP(m[i,])#
+	}#
+	return(spe)#
+}#
+#
+wadfp <- function(m)#
+{#
+	spe <- vector('numeric',length=nrow(m))#
+	for(i in 1:nrow(m))#
+	{#
+		spe[i] <- get.WADFP(m[i,])#
+	}#
+	return(spe)#
+}#
+#
+#
+shannon <- function(m)#
+{#
+	spe <- vector('numeric',length=nrow(m))#
+	for(i in 1:nrow(m))#
+	{#
+		spe[i] <- get.SHANNON(as.vector(as.numeric(m[i,])))#
+	}#
+	return(spe)#
+}#
+#
+ssi <- function(m)#
+{#
+	spe <- vector('numeric',length=nrow(m))#
+	for(i in 1:nrow(m))#
+	{#
+		spe[i] <- get.SSI(as.vector(as.numeric(m[i,])))#
+	}#
+	return(spe)#
+}#
+#
+hr <- function(m)#
+{#
+	spe <- vector('numeric',length=nrow(m))#
+	for(i in 1:nrow(m))#
+	{#
+		spe[i] <- get.HR(as.vector(as.numeric(m[i,])))#
+	}#
+	return(spe)#
+}#
+#
+getspe <- function(mat,measure=hr)#
+{#
+	if(max(mat)!=1){mat<-mat/max(mat)}#
+	out <- measure(mat)#
+	names(out) <- rownames(mat)#
+	return(out)#
+}#
+#
+std.matrix <- function(filename,t=TRUE)#
+{#
+	dat <- read.table(filename)#
+	if(t){dat<-t(dat)}#
+	dat <- dat/max(dat)#
+	return(dat)#
+}#
+#
+GDS <- function(mat)#
+{#
+	D <- dim(mat)#
+	N <- prod(D)#
+	Ni <- sum(mat>0)/N#
+	result <- matrix(c(D,N,Ni),nrow=1)#
+	colnames(result) <- c('Resources','Organisms','Size','Completeness')#
+	print(result)#
+}#
+#
+draw.network <- function(data,color='grey',border=NA,...)#
+{#
+	n.elements <- max(dim(data))#
+#
+	pos.h <- seq(from=1,to=n.elements,length.out=ncol(data))#
+	pos.p <- seq(from=1,to=n.elements,length.out=nrow(data))#
+#
+	par(bty='n',xaxt='n',yaxt='n')#
+	symbols(#
+		pos.p,#
+		y = rep(2,length(pos.p)),#
+		circles=rep(0.3,length(pos.p)),#
+		inches=FALSE,#
+		add=FALSE,#
+		ylim=c(0.7,2.3),#
+		bg=color,#
+		fg=border,#
+		...#
+		)#
+#
+	for(p in 1:nrow(data))#
+	{#
+		for(h in 1:ncol(data))#
+		{#
+			if(data[p,h]>0)#
+			{#
+				arrows(pos.p[p],2,pos.h[h],1,lwd=(data[p,h]/1)*3,code=0)#
+			}#
+		}#
+	}#
+#
+	symbols(#
+		pos.p,#
+		y = rep(2,length(pos.p)),#
+		circles=rep(0.4,length(pos.p)),#
+		inches=FALSE,#
+		add=TRUE,#
+		bg=color,#
+		fg=border,#
+		main='Réseau',#
+		xlab='',#
+		ylab=''#
+		)#
+	symbols(#
+		pos.h,#
+		y = rep(1,length(pos.h)),#
+		circles=rep(0.4,length(pos.h)),#
+		inches=FALSE,#
+		add=TRUE,#
+		bg=color,#
+		fg=border#
+		)#
+}#
+#
+sortmat.byspe <- function(mat,spe)#
+{#
+	mat[rank(spe),] <- mat[c(1:nrow(mat)),]#
+	return(mat)#
+}
+sortmat.byspe(library(ESM)
+)
+library(ESM)
+sortmat.byspe
+?sortmat.byspe
+?getspe

Added: pkg/ESM/R/functions.r
===================================================================
--- pkg/ESM/R/functions.r	                        (rev 0)
+++ pkg/ESM/R/functions.r	2009-11-09 18:44:59 UTC (rev 2)
@@ -0,0 +1,198 @@
+get.HR <- function(pop)
+{
+	Ni <- sum(pop>0)
+	N <- length(pop)
+	return(1-Ni/N)
+}
+
+get.SHANNON <- function(pop)
+{
+	partiel <- NULL
+	pop <- as.vector(pop)+0.0000000001
+	for(i in 1:length(pop))
+	{
+		p <- pop[i]/sum(pop)
+		partiel[i] <- p * log(p)
+	}
+	shannon <- ifelse(length(pop)<=1,0,-sum(partiel) / log(length(pop)))
+	return(shannon)
+}
+
+get.DFP <- function(fit)
+{
+	score <- NULL
+	fit <- as.vector(fit)
+	fit <- na.exclude(sort(fit,decreasing=TRUE))
+	vecdiff <- NULL	
+	for(i in 1:(length(fit)-1))
+	{
+		vecdiff[i] <- (fit[i+1]-fit[i])+1
+	}
+	score <- prod(abs(vecdiff))
+	return(1-score)
+}
+
+get.WADFP <- function(fit)
+{
+	ngen <- length(fit)
+	sorted <- sort(fit,decreasing=TRUE)
+	tempS <- NULL
+	correc <- (ngen-1)/ngen
+	for(g in 1:(ngen-1))
+	{
+		tempS[g] <- (1+sorted[g]-sorted[g+1])*sorted[g]
+	}
+	S <- sum(tempS)/sum(fit)
+	S <- (S-correc)/(2-correc)
+	return(S)
+}
+
+get.SSI <- function(occup)
+{
+	score <- NULL
+	fit <- as.vector(occup)
+	h <- sum(fit>0)
+	H <- length(occup)
+	SSI <- sqrt((H/h-1)/(H-1))
+	return(SSI)
+}
+
+dfp <- function(m)
+{
+	spe <- vector('numeric',length=nrow(m))
+	for(i in 1:nrow(m))
+	{
+		spe[i] <- get.DFP(m[i,])
+	}
+	return(spe)
+}
+
+wadfp <- function(m)
+{
+	spe <- vector('numeric',length=nrow(m))
+	for(i in 1:nrow(m))
+	{
+		spe[i] <- get.WADFP(m[i,])
+	}
+	return(spe)
+}
+
+
+shannon <- function(m)
+{
+	spe <- vector('numeric',length=nrow(m))
+	for(i in 1:nrow(m))
+	{
+		spe[i] <- get.SHANNON(as.vector(as.numeric(m[i,])))
+	}
+	return(spe)
+}
+
+ssi <- function(m)
+{
+	spe <- vector('numeric',length=nrow(m))
+	for(i in 1:nrow(m))
+	{
+		spe[i] <- get.SSI(as.vector(as.numeric(m[i,])))
+	}
+	return(spe)
+}
+
+hr <- function(m)
+{
+	spe <- vector('numeric',length=nrow(m))
+	for(i in 1:nrow(m))
+	{
+		spe[i] <- get.HR(as.vector(as.numeric(m[i,])))
+	}
+	return(spe)
+}
+
+getspe <- function(mat,measure=hr)
+{
+	if(max(mat)!=1){mat<-mat/max(mat)}
+	out <- measure(mat)
+	names(out) <- rownames(mat)
+	return(out)
+}
+
+std.matrix <- function(filename,t=TRUE)
+{
+	dat <- read.table(filename)
+	if(t){dat<-t(dat)}
+	dat <- dat/max(dat)
+	return(dat)
+}
+
+GDS <- function(mat)
+{
+	D <- dim(mat)
+	N <- prod(D)
+	Ni <- sum(mat>0)/N
+	result <- matrix(c(D,N,Ni),nrow=1)
+	colnames(result) <- c('Resources','Organisms','Size','Completeness')
+	print(result)
+}
+
+sortmat.byspe <- function(mat,spe)
+{
+	mat[rank(spe),] <- mat[c(1:nrow(mat)),]
+	return(mat)
+}
+
+draw.network <- function(data,color='grey',border=NA,...,sorted=hr)
+{
+	
+	data <- sortmat.byspe(data,getspe(data,sorted))
+	
+	n.elements <- max(dim(data))
+	
+	pos.h <- seq(from=1,to=n.elements,length.out=ncol(data))
+	pos.p <- seq(from=1,to=n.elements,length.out=nrow(data))
+	
+	par(bty='n',xaxt='n',yaxt='n')
+	symbols(
+		pos.p,
+		y = rep(2,length(pos.p)),
+		circles=rep(0.3,length(pos.p)),
+		inches=FALSE,
+		add=FALSE,
+		ylim=c(0.7,2.3),
+		bg=color,
+		fg=border,
+		...
+		)
+
+	for(p in 1:nrow(data))
+	{
+		for(h in 1:ncol(data))
+		{
+			if(data[p,h]>0)
+			{
+				arrows(pos.p[p],2,pos.h[h],1,lwd=(data[p,h]/1)*3+0.1,code=0)
+			}
+		}
+	}
+
+	symbols(
+		pos.p,
+		y = rep(2,length(pos.p)),
+		circles=rep(0.4,length(pos.p)),
+		inches=FALSE,
+		add=TRUE,
+		bg=color,
+		fg=border,
+		main='Réseau',
+		xlab='',
+		ylab=''
+		)
+	symbols(
+		pos.h,
+		y = rep(1,length(pos.h)),
+		circles=rep(0.4,length(pos.h)),
+		inches=FALSE,
+		add=TRUE,
+		bg=color,
+		fg=border
+		)
+}
\ No newline at end of file

Added: pkg/ESM/man/GDS.Rd
===================================================================
--- pkg/ESM/man/GDS.Rd	                        (rev 0)
+++ pkg/ESM/man/GDS.Rd	2009-11-09 18:44:59 UTC (rev 2)
@@ -0,0 +1,16 @@
+\name{GDS} 
+\Rdversion{1.1} 
+\alias{GDS} 
+\title{Descriptive statistics}
+\description{Print basic description of a dataset}
+\usage{ 
+GDS(mat)
+}
+
+\arguments{ 
+\item{mat}{A matrix giving the performance of each organism on each resource, with organisms as rows} 
+}
+
+\value{
+	\item{}{Print the number of organisms, resources, interactions, and the fraction of interactions >0.}
+}

Added: pkg/ESM/man/draw.network.Rd
===================================================================
--- pkg/ESM/man/draw.network.Rd	                        (rev 0)
+++ pkg/ESM/man/draw.network.Rd	2009-11-09 18:44:59 UTC (rev 2)
@@ -0,0 +1,16 @@
+\name{draw.network} 
+\Rdversion{1.1} 
+\alias{draw.network} 
+\title{Draw the interaction network}
+\description{Draw the interaction network between organisms and resources, with bolder lines for stronger interactions}
+\usage{ 
+draw.network(data,color='grey',border=NA,...)
+}
+
+\arguments{ 
+\item{data}{A matrix giving the performance of each organism on each resource, with organisms as rows}
+\item{color}{The color of the balls (representing organisms or resources)}
+\item{border}{The color of the ball's border} 
+\item{sorted}{A function of specificity (see \kbd{getspe}) used to sort the data} 
+\item{...}{Arguments to be passed to plot} 
+}
\ No newline at end of file

Added: pkg/ESM/man/getspe.Rd
===================================================================
--- pkg/ESM/man/getspe.Rd	                        (rev 0)
+++ pkg/ESM/man/getspe.Rd	2009-11-09 18:44:59 UTC (rev 2)
@@ -0,0 +1,33 @@
+\name{getspe} 
+\Rdversion{1.1} 
+\alias{getspe} 
+\title{Specificity}
+\description{Returns a vector containing the specificity of each organism}
+\usage{ 
+getspe(mat,measure=hr)
+}
+
+\arguments{ 
+\item{mat}{A matrix giving the performance of each organism on each resource, with organisms as rows} 
+\item{measure}{The index of specificity to use. Values can be} 
+}
+
+\value{
+	\item{}{A vector with the specificity of each organism. Uses names if the matrix as such property.}
+}
+ 
+\details{Values of \kbd{measure} can be : \kbd{hr}, the classical host range; \kbd{ssi}, the species specialization index; \kbd{dfp}, the DFP index; \kbd{shannon}, Shannon's entropy; \kbd{wadfp}, the weighted additive DFP.}
+
+\references{For DFP and WADFP, and this package, cite : Poisot, T & Hochberg, M E "..." XXX.
+
+For HS, cite : Schug J, et al. (2005) Promoter features related to tissue specificity as measured by Shannon entropy. Genome biology 6(4):R33
+
+For SSI, cite : Julliard R, Clavel J, Devictor V, Jiguet F, & Couvet D (2006) Spatial segregation of specialists and generalists in bird communities. Ecology Letters 9(11):1237-1244.}
+
+\examples{ 
+# Read an interaction matrix
+MAT <- 'http://www.nceas.ucsb.edu/interactionweb/data/host_parasite/text_matrices/mcgregor_p.txt'
+mat <- t(read.table(MAT))
+# Returns host range
+getspe(mat,hr)
+} 
\ No newline at end of file

Added: pkg/ESM/man/sortmat.byspe.Rd
===================================================================
--- pkg/ESM/man/sortmat.byspe.Rd	                        (rev 0)
+++ pkg/ESM/man/sortmat.byspe.Rd	2009-11-09 18:44:59 UTC (rev 2)
@@ -0,0 +1,17 @@
+\name{sortmat.byspe} 
+\Rdversion{1.1} 
+\alias{sortmat.byspe} 
+\title{Draw the interaction network}
+\description{Draw the interaction network between organisms and resources, with bolder lines for stronger interactions}
+\usage{ 
+sortmat.byspe(mat,spe)
+}
+
+\arguments{ 
+\item{mat}{A matrix giving the performance of each organism on each resource, with organisms as rows}
+\item{spe}{A function to estimate specificity, see \kbd{getspe}}
+}
+
+\value{
+	\item{}{\kbd{mat} (sorted)}
+}

Added: pkg/ESM/man/std.matrix.Rd
===================================================================
--- pkg/ESM/man/std.matrix.Rd	                        (rev 0)
+++ pkg/ESM/man/std.matrix.Rd	2009-11-09 18:44:59 UTC (rev 2)
@@ -0,0 +1,33 @@
+\name{std.matrix} 
+\Rdversion{1.1} 
+\alias{std.matrix} 
+\title{Specificity}
+\description{Returns a vector containing the specificity of each organism}
+\usage{ 
+getspe(mat,measure=hr)
+}
+
+\arguments{ 
+\item{mat}{A matrix giving the performance of each organism on each resource, with organisms as rows} 
+\item{measure}{The index of specificity to use. Values can be} 
+}
+
+\value{
+	\item{}{A vector with the specificity of each organism. Uses names if the matrix as such property.}
+}
+ 
+\details{Values of \kbd{measure} can be : \kbd{hr}, the classical host range; \kbd{ssi}, the species specialization index; \kbd{dfp}, the DFP index; \kbd{shannon}, Shannon's entropy; \kbd{wadfp}, the weighted additive DFP.}
+
+\references{For DFP and WADFP, and this package, cite : Poisot, T & Hochberg, M E "..." XXX.
+
+For HS, cite : Schug J, et al. (2005) Promoter features related to tissue specificity as measured by Shannon entropy. Genome biology 6(4):R33
+
+For SSI, cite : Julliard R, Clavel J, Devictor V, Jiguet F, & Couvet D (2006) Spatial segregation of specialists and generalists in bird communities. Ecology Letters 9(11):1237-1244.}
+
+\examples{ 
+# Read an interaction matrix
+MAT <- 'http://www.nceas.ucsb.edu/interactionweb/data/host_parasite/text_matrices/mcgregor_p.txt'
+mat <- t(read.table(MAT))
+# Returns host range
+getspe(mat,hr)
+} 
\ No newline at end of file



More information about the Esm-commits mailing list