[Esm-commits] r17 - pkg/ESM/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Nov 17 21:53:51 CET 2009
Author: timotheepoisot
Date: 2009-11-17 21:53:51 +0100 (Tue, 17 Nov 2009)
New Revision: 17
Removed:
pkg/ESM/R/adv.barplot.r
pkg/ESM/R/hist-dis.r
pkg/ESM/R/logplot.r
pkg/ESM/R/mBP.R
pkg/ESM/R/mat2d.r
pkg/ESM/R/nest.r
pkg/ESM/R/partition.var.r
pkg/ESM/R/persp.withcol.r
Log:
Deleted: pkg/ESM/R/adv.barplot.r
===================================================================
--- pkg/ESM/R/adv.barplot.r 2009-11-13 11:48:05 UTC (rev 16)
+++ pkg/ESM/R/adv.barplot.r 2009-11-17 20:53:51 UTC (rev 17)
@@ -1,32 +0,0 @@
-adv.barplot <- function(data,datanames=c(1:length(data)),col='lightgrey',bars=TRUE,barsborder=FALSE,forceylim=c(0,0),...,bartype=1)
-{
- nbars <- length(data)
- yspan <- range(data)
- if(sum(forceylim)>0)
- {
- yspan <- forceylim
- }
- M <- NULL
- SD <- NULL
- bcol <- ifelse(barsborder,1,NA)
- if(length(col)<length(data)){col <- rep(col,length(data))}
- ##
- plot(1,1,col=NA,xlim=c(0.5,nbars+0.5),ylim=yspan,xaxt='n',bty='n',...)
- for(current.data in 1:nbars)
- {
- M[current.data] <- mean(data[[current.data]])
- SD[current.data] <- sd(data[[current.data]])
- rect(current.data-0.4,min(yspan),current.data+0.4,M[current.data],col=col[current.data],border=bcol)
- if(bartype==1)
- {
- arrows(current.data,M[current.data],current.data,M[current.data]+SD[current.data],length=0.075,angle=90,col=1,lwd=2)
- }
- if(bartype==2)
- {
- arrows(current.data,M[current.data]-SD[current.data],current.data,M[current.data]+SD[current.data],length=0.075,angle=90,code=3,col=1,lwd=2)
- }
-
- }
- axis(side=1,tick=FALSE,labels=datanames,at=c(1:nbars))
- return(M)
-}
\ No newline at end of file
Deleted: pkg/ESM/R/hist-dis.r
===================================================================
--- pkg/ESM/R/hist-dis.r 2009-11-13 11:48:05 UTC (rev 16)
+++ pkg/ESM/R/hist-dis.r 2009-11-17 20:53:51 UTC (rev 17)
@@ -1,21 +0,0 @@
-hist.disc <- function(vecteur,as.prop=FALSE,do.plot=FALSE,ylab='',xlab='')
-{
- niveaux <- as.integer(levels(as.factor(vecteur)))
- quantite <- NULL
- for(i in 1:length(niveaux))
- {
- quantite[i] <- sum(match(vecteur,niveaux[i],nomatch=0))
- }
- proportion <- quantite/length(vecteur)
-
- if(as.prop){hauteur <- proportion} else {hauteur <- quantite}
-
- if(do.plot)
- {
- par(lend=1,yaxs='i')
- plot(niveaux,hauteur,type='h',ylim=c(0,max(hauteur)),lwd=12,ylab=ylab,xlab=xlab)
- par(lend=0,yaxs='r',xaxs='r')
- }
-
- return(as.data.frame(cbind(niveaux,quantite,proportion)))
-}
\ No newline at end of file
Deleted: pkg/ESM/R/logplot.r
===================================================================
--- pkg/ESM/R/logplot.r 2009-11-13 11:48:05 UTC (rev 16)
+++ pkg/ESM/R/logplot.r 2009-11-17 20:53:51 UTC (rev 17)
@@ -1,45 +0,0 @@
-drawlogaxis <- function(side,range)
-{
- par(tck=0.02)
- d <- range
- mlog <- floor(min(d))
- Mlog <- ceiling(max(d))
- SeqLog <- c(mlog:Mlog)
- Nlog <- (Mlog-mlog)+1
- axis(side,at=SeqLog,labels=10^SeqLog)
- ats <- log(seq(from=2,to=9,by=1),10)
- mod <- NULL
- for(i in SeqLog)
- {
- mod <- c(mod,rep(i,length(ats)))
- }
- ats <- rep(ats,Nlog)
- ats <- ats+mod
- par(tck=0.02/3)
- axis(side,at=ats,labels=NA)
-}
-
-logplot <- function(x=c(1:length(y)),y,log='xy',forceylim=c(0,0),forcexlim=c(0,0),...)
-{
- par(tck=0.02)
- xlg <- FALSE
- ylg <- FALSE
- if('x'%in%strsplit(log,'')[[1]]){x <- log(x,10);xlg=TRUE}
- if('y'%in%strsplit(log,'')[[1]]){y <- log(y,10);ylg=TRUE}
- yl <- ifelse(forceylim==c(0,0),range(y),forceylim)
- xl <- ifelse(forcexlim==c(0,0),range(x),forcexlim)
- plot(x,y,...,axes=FALSE,ylim=yl,xlim=xl)
- if(xlg){drawlogaxis(1,xl)}else{axis(1,at=pretty(xl),labels=pretty(xl))}
- if(ylg){drawlogaxis(2,yl)}else{axis(2,at=pretty(yl),labels=pretty(yl))}
- box()
-}
-
-addlog <- function(x=c(1:length(y)),y,log='xy',...)
-{
- xlg <- FALSE
- ylg <- FALSE
- if('x'%in%strsplit(log,'')[[1]]){x <- log(x,10);xlg=TRUE}
- if('y'%in%strsplit(log,'')[[1]]){y <- log(y,10);ylg=TRUE}
- points(x,y,...)
-
-}
\ No newline at end of file
Deleted: pkg/ESM/R/mBP.R
===================================================================
--- pkg/ESM/R/mBP.R 2009-11-13 11:48:05 UTC (rev 16)
+++ pkg/ESM/R/mBP.R 2009-11-17 20:53:51 UTC (rev 17)
@@ -1,47 +0,0 @@
-mBP <- function(list.of.lists,...,condnames=0,pal=colorRampPalette(c('grey','cornsilk')),seriesnames=0,legendpos='topleft',legh=TRUE,do.pty='s')
-{
- par(pty=do.pty,mgp=c(1.9,0.8,0),oma=c(0,0,0,0),mar=c(4,3,2,1),bg='transparent',bty='o',tck=0.02,yaxs='i')
- NofList <- length(list.of.lists)
- NofSubList <- length(list.of.lists[[1]])
- if(condnames==0){condnames=c(1:NofList)}
- if(seriesnames==0){seriesnames=c(1:NofSubList)}
- dim.mat.treat <- (NofList+1)*NofSubList
- pos <- c(1:dim.mat.treat)
- pos <- matrix(pos,nrow=(NofList+1))
- nbreaks <- dim.mat.treat+1
- par(xaxs='i',yaxs='i',bty='o')
- plot(0,0,pch=NA,xlim=c(0,nbreaks),ylim=c(min(pretty(range(list.of.lists))),max(pretty(range(list.of.lists)))),xaxt='n',yaxt='n',...)
- calc.ylab <- pretty(range(list.of.lists))
- lab.ylab <- round(calc.ylab,2)
- abline(h=pretty(range(list.of.lists)),lty=3,col='grey',lwd=2)
- abline(h=0,col='darkgrey',lwd=1.4)
- palette <- pal(NofList)
- for(condition in 1:NofList)
- {
- for(treatment in 1:NofSubList)
- {
- CD <- list.of.lists[[condition]][[treatment]]
- CDm <- mean(CD)
- CDv <- sd(CD)
- x.coord <- pos[condition,treatment]
- rect(x.coord,0,x.coord+1,CDm,col=palette[condition])
- arrows(x.coord+0.5,CDm+CDv,x.coord+0.5,CDm-CDv,angle=90,code=3,length=0.05)
- }
- }
- axis(side=2,at=calc.ylab,labels=lab.ylab,tick=TRUE)
- #abline(h=calc.ylab[1])
- abline(h=pretty(range(list.of.lists))[1])
- fills <- c(1:NofList)
- legend(legendpos,legend=condnames,fill=palette[fills],bty='n',horiz=legh,cex=1)
- cl.tab <- (c(1:NofSubList)-1)*NofSubList + NofList/2 +1
- lab.cond <- NULL
- int.lab.cond <- pos[c(1:(nrow(pos)-1)),]
- for(COL in 1:ncol(int.lab.cond))
- {
- lab.cond[COL] <- mean(int.lab.cond[,COL])+0.5
- }
- axis(side=1,at=lab.cond,labels=seriesnames,tick=FALSE)
- par(xaxs='r')
- if(min(pretty(range(list.of.lists)))<0){abline(h=0,lwd=1.1)}
- box()
-}
\ No newline at end of file
Deleted: pkg/ESM/R/mat2d.r
===================================================================
--- pkg/ESM/R/mat2d.r 2009-11-13 11:48:05 UTC (rev 16)
+++ pkg/ESM/R/mat2d.r 2009-11-17 20:53:51 UTC (rev 17)
@@ -1,30 +0,0 @@
-mat2d <- function(x,y,...)
-{
- yule <- function(n)
- {
- return(2*floor(2.5*sqrt(sqrt(length(n)))))
- }
- matrice <- matrix(0,ncol=yule(y),nrow=yule(x))
- effX <- cut(x,yule(x),labels=FALSE)
- effY <- cut(y,yule(y),labels=FALSE)
- rownames(matrice) <- c(1:yule(x))
- colnames(matrice) <- c(1:yule(y))
- X <- range(pretty(range(x)))
- X <- seq(min(X),max(X),length.out=nrow(matrice))
- Y <- range(pretty(range(y)))
- Y <- seq(min(Y),max(Y),length.out=ncol(matrice))
- for(i in 1:nrow(matrice))
- {
- for(j in 1:ncol(matrice))
- {
- matrice[i,j] <- sum(match(effX,as.numeric(rownames(matrice))[i],nomatch=0)*match(effY,as.numeric(colnames(matrice))[j],nomatch=0))
- }
- }
- pal <- colorRampPalette(c('white','black'))
- image(X,Y,matrice,col=pal(100),...)
- rug(x,ticksize = 0.01)
- rug(y,side=2,ticksize = 0.01)
- colnames(matrice) <- Y
- rownames(matrice) <- X
- return(matrice)
-}
\ No newline at end of file
Deleted: pkg/ESM/R/nest.r
===================================================================
--- pkg/ESM/R/nest.r 2009-11-13 11:48:05 UTC (rev 16)
+++ pkg/ESM/R/nest.r 2009-11-17 20:53:51 UTC (rev 17)
@@ -1,41 +0,0 @@
-nest = function(matrice,do.plot)
-{
- perm <- 1
- while(perm != 0)
- {
- perm <- 0
- for(i in 1:(nrow(matrice)-1))
- {
- temp.i <- matrice[i,]
- temp.s <- matrice[(i+1),]
- if(sum(temp.i)<sum(temp.s))
- {
- matrice[i,] <- temp.s
- matrice[(i+1),] <- temp.i
- perm <- perm + 1
- }
- }
- }
- perm <- 1
- while(perm != 0)
- {
- perm <- 0
- for(i in 1:(ncol(matrice)-1))
- {
- temp.i <- matrice[,i]
- temp.s <- matrice[,(i+1)]
- if(sum(temp.i)<sum(temp.s))
- {
- matrice[,i] <- temp.s
- matrice[,(i+1)] <- temp.i
- perm <- perm + 1
- }
- }
- }
- if(do.plot)
- {
- cols <- colorRampPalette(c("#FFFFFF", "#000000"))
- image(matrice,col= cols(5))
- }
- return(matrice)
-}
\ No newline at end of file
Deleted: pkg/ESM/R/partition.var.r
===================================================================
--- pkg/ESM/R/partition.var.r 2009-11-13 11:48:05 UTC (rev 16)
+++ pkg/ESM/R/partition.var.r 2009-11-17 20:53:51 UTC (rev 17)
@@ -1,15 +0,0 @@
-partition.var <- function(comp)
-{
- pdf(file='partition-variance.pdf',width=6,height=3)
- par(mai=c(0,0,0,0))
- plot(0,0,pch=NA,axes=F,xlab='',ylab='',ylim=c(-1,1),xlim=c(0,100))
- rect(0,-0.1,comp[1],0.1,col='darkgrey')
- rect(comp[1],-0.1,sum(comp[1:2]),0.1,col='black')
- rect(sum(comp[1:2]),-0.1,sum(comp[1:3]),0.1,col='lightgrey')
- rect(sum(comp[1:3]),-0.1,sum(comp),0.1,col='white')
-
- text(0,0.2,'Env.',adj=0)
- text(comp[1],-0.2,'Shared',adj=0)
- text(sum(comp[1:2]),0.2,'Phyl.',adj=0)
- dev.off()
-}
\ No newline at end of file
Deleted: pkg/ESM/R/persp.withcol.r
===================================================================
--- pkg/ESM/R/persp.withcol.r 2009-11-13 11:48:05 UTC (rev 16)
+++ pkg/ESM/R/persp.withcol.r 2009-11-17 20:53:51 UTC (rev 17)
@@ -1,20 +0,0 @@
-persp.withcol <- function(x,y,z,pal=heat.colors,nb.col=10,xlg=TRUE,ylg=TRUE,...)
-{
- colnames(z) <- y
- rownames(z) <- x
-
- nrz <- nrow(z)
- ncz <- ncol(z)
-
- color <- pal(nb.col)
- zfacet <- z[-1, -1] + z[-1, -ncz] + z[-nrz, -1] + z[-nrz, -ncz]
- facetcol <- cut(zfacet, nb.col)
- par(xlog=xlg,ylog=ylg)
- persp(
- as.numeric(rownames(z)),
- as.numeric(colnames(z)),
- as.matrix(z),
- col=color[facetcol],
- ...
- )
-}
\ No newline at end of file
More information about the Esm-commits
mailing list