[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