[Esm-commits] r25 - pkg/ESM/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Feb 4 14:40:00 CET 2010
Author: timotheepoisot
Date: 2010-02-04 14:40:00 +0100 (Thu, 04 Feb 2010)
New Revision: 25
Added:
pkg/ESM/man/.Rhistory
pkg/ESM/man/cv.Rd
pkg/ESM/man/last.Rd
Log:
Added: pkg/ESM/man/.Rhistory
===================================================================
--- pkg/ESM/man/.Rhistory (rev 0)
+++ pkg/ESM/man/.Rhistory 2010-02-04 13:40:00 UTC (rev 25)
@@ -0,0 +1,522 @@
+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
+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')
+setwd('/Users/Tim/Desktop/ESM-DEVELOP/pkg/ESM/man')
+\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,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{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{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#
+intmat <- matrix(runif(100,0,1),ncol=10)#
+# Plot#
+draw.network(intmat,org.col='palegreen',sortorg=rank(getspe(dune,hr)))#
+}
Added: pkg/ESM/man/cv.Rd
===================================================================
--- pkg/ESM/man/cv.Rd (rev 0)
+++ pkg/ESM/man/cv.Rd 2010-02-04 13:40:00 UTC (rev 25)
@@ -0,0 +1,16 @@
+\name{cv}
+\Rdversion{1.1}
+\alias{cv}
+\title{Variation coefficient}
+\description{Returns the ratio of s.e.m over mean of a vector}
+\usage{
+cv(d)
+}
+
+\arguments{
+\item{d}{Any numeric vector}
+}
+
+\value{
+ \item{}{The variation coefficient}
+}
Added: pkg/ESM/man/last.Rd
===================================================================
--- pkg/ESM/man/last.Rd (rev 0)
+++ pkg/ESM/man/last.Rd 2010-02-04 13:40:00 UTC (rev 25)
@@ -0,0 +1,16 @@
+\name{last}
+\Rdversion{1.1}
+\alias{last}
+\title{Last element of a vector}
+\description{Returns the last element of a vector}
+\usage{
+last(d)
+}
+
+\arguments{
+\item{d}{Any vector}
+}
+
+\value{
+ \item{}{The last element of the vector}
+}
More information about the Esm-commits
mailing list