[Esm-commits] r33 - in pkg/ESM: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Aug 29 11:59:43 CEST 2010
Author: timotheepoisot
Date: 2010-08-29 11:59:43 +0200 (Sun, 29 Aug 2010)
New Revision: 33
Removed:
pkg/ESM/R/.Rhistory
pkg/ESM/man/.Rhistory
Log:
deleted .Rhistory files here by mistake
Deleted: pkg/ESM/R/.Rhistory
===================================================================
--- pkg/ESM/R/.Rhistory 2010-08-29 09:57:47 UTC (rev 32)
+++ pkg/ESM/R/.Rhistory 2010-08-29 09:59:43 UTC (rev 33)
@@ -1,502 +0,0 @@
-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)
-)
-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')
-get.HS(1)
-get.HS(0)
-get.Hrr(0)
-get.rr(0)
-get.RR(0)
-library(ESM)
-get.RR(1)
Deleted: pkg/ESM/man/.Rhistory
===================================================================
--- pkg/ESM/man/.Rhistory 2010-08-29 09:57:47 UTC (rev 32)
+++ pkg/ESM/man/.Rhistory 2010-08-29 09:59:43 UTC (rev 33)
@@ -1,522 +0,0 @@
-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)))#
-}
More information about the Esm-commits
mailing list