[Esm-commits] r7 - in pkg/ESM: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 11 23:21:03 CET 2009
Author: timotheepoisot
Date: 2009-11-11 23:21:02 +0100 (Wed, 11 Nov 2009)
New Revision: 7
Modified:
pkg/ESM/DESCRIPTION
pkg/ESM/R/.Rhistory
pkg/ESM/R/functions.r
pkg/ESM/man/draw.network.Rd
Log:
Changes in the draw.network function to allow more customisation
Modified: pkg/ESM/DESCRIPTION
===================================================================
--- pkg/ESM/DESCRIPTION 2009-11-11 19:59:18 UTC (rev 6)
+++ pkg/ESM/DESCRIPTION 2009-11-11 22:21:02 UTC (rev 7)
@@ -1,5 +1,5 @@
Package: ESM
-Version: 0.1.0-01
+Version: 0.1.1-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>
Modified: pkg/ESM/R/.Rhistory
===================================================================
--- pkg/ESM/R/.Rhistory 2009-11-11 19:59:18 UTC (rev 6)
+++ pkg/ESM/R/.Rhistory 2009-11-11 22:21:02 UTC (rev 7)
@@ -200,3 +200,297 @@
sortmat.byspe
?sortmat.byspe
?getspe
+draw.network <- function(data,org.col='grey',res.col='grey',border=NA,sortorg=c(1:nrow(data)),sortres=c(1:ncol(data)),...)#
+{#
+ #
+ data <- sortmat.byspe(data,sortorg)#
+ data <- t(sortmat.byspe(t(data),sortres))#
+ #
+ 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=org.col,#
+ 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=res.col,#
+ fg=border#
+ )#
+}
+library(vegan)
+data(dune)
+sortmat.byspe <- function(mat,spe)#
+{#
+ mat[rank(spe),] <- mat[c(1:nrow(mat)),]#
+ return(mat)#
+}
+setwd('/Users/Tim/Desktop/ESM-DEVELOP/pkg/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#
+ out <- NULL#
+ out$RES <- D[1]#
+ out$ORGA <- D[2]#
+ out$SIZE <- N#
+ out$COMP <- Ni#
+ return(out)#
+}#
+#
+sortmat.byspe <- function(mat,spe)#
+{#
+ mat[rank(spe),] <- mat[c(1:nrow(mat)),]#
+ return(mat)#
+}#
+#
+draw.network <- function(data,org.col='grey',res.col='grey',border=NA,sortorg=c(1:nrow(data)),sortres=c(1:ncol(data)),...)#
+{#
+ #
+ data <- sortmat.byspe(data,sortorg)#
+ data <- t(sortmat.byspe(t(data),sortres))#
+ #
+ 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=org.col,#
+ 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=org.col,#
+ 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=res.col,#
+ fg=border#
+ )#
+}#
+#
+matrix.hr <- function(matrix)#
+{#
+ for(c in 1:ncol(matrix))#
+ {#
+ for(r in 1:nrow(matrix))#
+ {#
+ if(matrix[r,c]>0){matrix[r,c]<-1}#
+ }#
+ }#
+ return(matrix)#
+}
+dune <- dune/max(dune)
+draw.network(dune)
+draw.network(dune,sortorg=rank(getspe(dunehr)))
+draw.network(dune,sortorg=rank(getspe(dune,wadfp)))
+draw.network(dune,sortorg=rank(getspe(dune,dfp)))
+draw.network(dune,sortorg=rank(getspe(dune,ssi)))
+wadfp(dune)
+dune
+as.matrix(dune)
+is.Matrix(dune)
+is.matrix(dune)
+draw.network(dune,sortorg=rank(getspe(dune,hr)))
+draw.network(dune,sortorg=rank(getspe(dune,hr)),org.col='green')
+draw.network(dune,sortorg=rank(getspe(dune,hr)),org.col='palegreen')
+draw.network(dune,sortorg=rank(getspe(dune,hr)),org.col='palegreen',res.col='pink')
Modified: pkg/ESM/R/functions.r
===================================================================
--- pkg/ESM/R/functions.r 2009-11-11 19:59:18 UTC (rev 6)
+++ pkg/ESM/R/functions.r 2009-11-11 22:21:02 UTC (rev 7)
@@ -143,10 +143,11 @@
return(mat)
}
-draw.network <- function(data,color='grey',border=NA,...,sorted=hr)
+draw.network <- function(data,org.col='grey',res.col='grey',border=NA,sortorg=c(1:nrow(data)),sortres=c(1:ncol(data)),...)
{
- data <- sortmat.byspe(data,getspe(data,sorted))
+ data <- sortmat.byspe(data,sortorg)
+ data <- t(sortmat.byspe(t(data),sortres))
n.elements <- max(dim(data))
@@ -161,7 +162,7 @@
inches=FALSE,
add=FALSE,
ylim=c(0.7,2.3),
- bg=color,
+ bg=org.col,
fg=border,
...
)
@@ -183,7 +184,7 @@
circles=rep(0.4,length(pos.p)),
inches=FALSE,
add=TRUE,
- bg=color,
+ bg=org.col,
fg=border,
main='Réseau',
xlab='',
@@ -195,7 +196,7 @@
circles=rep(0.4,length(pos.h)),
inches=FALSE,
add=TRUE,
- bg=color,
+ bg=res.col,
fg=border
)
}
Modified: pkg/ESM/man/draw.network.Rd
===================================================================
--- pkg/ESM/man/draw.network.Rd 2009-11-11 19:59:18 UTC (rev 6)
+++ pkg/ESM/man/draw.network.Rd 2009-11-11 22:21:02 UTC (rev 7)
@@ -4,13 +4,24 @@
\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,sorted=hr,...)
+draw.network(data,org.col='grey',res.col='grey',border=NA,sortorg=c(1:nrow(data)),sortres=c(1:ncol(data)),...)
}
\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{org.col}{The color of organisms (recycled)}
+\item{res.col}{The color of resources (recycled)}
\item{border}{The color of the ball's border}
-\item{sorted}{A function of specificity (see \kbd{getspe}) used to sort the data - default is by host range}
+\item{sortorg}{A vector giving the order in which to sort the organisms (for example using \kbd{rank} and \kbd{getspe})}
+\item{sortres}{Similar to sortorg for resources}
\item{...}{Arguments to be passed to plot}
+}
+
+\examples{
+# Read an interaction matrix
+library(vegan)
+dune <- data(dune)
+dune <- as.matrix(dune/max(dune))
+# Plot
+draw.network(dune,org.col='palegreen',sortorg=rank(getspe(dune,hr)))
}
\ No newline at end of file
More information about the Esm-commits
mailing list