[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