[Adephylo-commits] r104 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Dec 15 14:25:58 CET 2008
Author: jombart
Date: 2008-12-15 14:25:58 +0100 (Mon, 15 Dec 2008)
New Revision: 104
Added:
pkg/R/table.phylo4d.R
pkg/man/table.phylo4d.Rd
Removed:
pkg/R/s.phylo4d.R
pkg/man/s.phylo4d.Rd
Modified:
pkg/DESCRIPTION
pkg/R/ppca.R
pkg/TODO
pkg/man/carni19.Rd
pkg/man/carni70.Rd
pkg/man/distRoot.Rd
pkg/man/lizards.Rd
pkg/man/maples.Rd
pkg/man/mjrochet.Rd
pkg/man/orthobasis.Rd
pkg/man/orthogram.Rd
pkg/man/palm.Rd
pkg/man/ppca.Rd
pkg/man/procella.Rd
pkg/man/proxTips.Rd
pkg/man/tithonia.Rd
pkg/man/treePart.Rd
Log:
Replaced s.phylo4d with table.phylo4d
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/DESCRIPTION 2008-12-15 13:25:58 UTC (rev 104)
@@ -9,4 +9,4 @@
Description: Multivariate tools to analyze comparative data, i.e. a phylogeny and some traits measured for each taxa.
License: GPL (>=2)
LazyLoad: yes
-Collate: utils.R partition.R s.phylo4d.R distances.R proximities.R orthobasis.R ppca.R orthogram.R abouheif.R moran.R zzz.R
\ No newline at end of file
+Collate: utils.R partition.R table.phylo4d.R distances.R proximities.R orthobasis.R ppca.R orthogram.R abouheif.R moran.R zzz.R
\ No newline at end of file
Modified: pkg/R/ppca.R
===================================================================
--- pkg/R/ppca.R 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/R/ppca.R 2008-12-15 13:25:58 UTC (rev 104)
@@ -162,7 +162,7 @@
args$ratio.tree <- 0.5
}
args <- c(obj,args)
- do.call(s.phylo4d, args)
+ do.call(table.phylo4d, args)
return(invisible(match.call()))
} # end scatter.ppca
Deleted: pkg/R/s.phylo4d.R
===================================================================
--- pkg/R/s.phylo4d.R 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/R/s.phylo4d.R 2008-12-15 13:25:58 UTC (rev 104)
@@ -1,253 +0,0 @@
-#############
-## s.phylo4d
-#############
-s.phylo4d <- function(x, treetype=c("phylogram","cladogram"), symbol=c("circles", "squares"),
- center=TRUE, scale=TRUE, legend=TRUE, grid=TRUE, box=TRUE,
- show.tip.label=TRUE, show.node.label=TRUE, show.var.label=TRUE,
- ratio.tree=1/3, font=3,
- tip.label=x at tip.label, var.label=colnames(x at tip.data),
- cex.symbol=1, cex.label=1, cex.legend=1, coord.legend=NULL, ...)
-{
-
- ## preliminary stuff and checks
- if (is.character(chk <- check_phylo4(x))) stop("bad phylo4d object: ",chk)
- # if (is.character(chk <- check_data(x))) stop("bad phylo4d object: ",chk) <- needed?
-
- if(!require(ape)) stop("the ape package is required")
- if(cex.label<0.1) {
- show.tip.label <- FALSE
- show.node.label <- FALSE
- show.var.label <- FALSE
- }
-
- cex <- par("cex")
- symbol <- match.arg(symbol)
- treetype <- match.arg(treetype)
-
- SYMBSCALE <- 0.2 # i.e. max size of a plotted symbol is 0.2*cex.symbol inches
-
- ## convert the tree into phylo
- tre <- suppressWarnings(as(x,"phylo"))
- tre$node.label <- x at node.label # this should be done by the as(x,"phylo")
- ## plot only tree if no tip data
- if(ncol(tdata(x,which="tip")) == 0) {
- plot.phylo(tre, type=treetype, direction="rightwards", show.tip.label=show.tip.label,
- show.node.label=show.node.label, cex=cex.label,
- no.margin=FALSE, x.lim=NULL, y.lim=NULL, ...)
- return(invisible())
- }
-
-#### data handling
- ## retrieve data
- dat <- tdata(x, which="tip")
- clas <- lapply(dat,class)
- isNum <- sapply(clas, function(e) e %in% c("integer","numeric"))
- ## keep only numeric data
- dat <- dat[isNum]
- var.label <- var.label[isNum]
- ## order data like tips
- E <- edges(x)
- tips.ord <- E[,2][!E[,2] %in% E[,1]]
- dat <- dat[tips.ord,,FALSE]
- tip.label <- tip.label[tips.ord] # reorder tip labels
- ## centring / scaling
- dat <- as.data.frame(scale(dat,center=center,scale=scale))
-
- ## compute bottom margin
- ## ! use inches as units still these won't be changed by plot.phylo
- temp <- var.label[which.max(nchar(var.label))] # longest tip label
- lab.height <- strwidth(temp, units="inches", cex=cex.label) # height required by the longest var label
- lab.height <- lab.height / par("pin")[1] # returned as a fraction of the plot region
-
-#### define plot region
- plotreg <- plotreg0 <- par("plt")
- plotreg.width <- plotreg0[2] - plotreg0[1]
- plotreg.height <- plotreg0[4] - plotreg0[3]
- plotreg[2] <- plotreg[1] + (ratio.tree)*plotreg.width # restrain the width for phylo
- plotreg[3] <- plotreg[3] + plotreg.height*ifelse(show.var.label,lab.height+0.05,0.05) ## add internal vertical margins
- plotreg[4] <- plotreg[4] - plotreg.height*0.05 # add internal vertical margins
-
-#### plot the tree
- par(plt = plotreg)
- plotres <- plot.phylo(tre, type=treetype, direction="rightwards", show.tip.label=FALSE,
- show.node.label=show.node.label, cex=cex.label,
- no.margin=FALSE, x.lim=NULL, y.lim=NULL, ...)
-
-#### plot the data
- par(plt=plotreg0)
- cur.usr.width <- par("usr")[2] - par("usr")[1] # beware: par("usr") does not adapt to the new plot region
- usr.width <- cur.usr.width / ratio.tree
- usr.height <- par("usr")[4] - par("usr")[3]
-
- ## x.inset is the space between tree/data and data/tip.labels (in usr units)
- x.inset <- SYMBSCALE * cex.symbol * usr.width / par("pin")[1]
- y.inset <- SYMBSCALE * cex.symbol * usr.height / par("pin")[2]
- x.base <- plotres$x.lim[2] + x.inset # start plotting from x.base rightwards
- if(show.tip.label){
- temp <- x at tip.label[which.max(nchar(x at tip.label))] # longest tip label
- lab.width <- strwidth(temp, units="user", cex=cex.label) # compute the width to keep for tip labels
- } else{
- lab.width <- 0
- }
- xrange.data <- c(x.base , (par("usr")[1]+usr.width) - lab.width - 2*x.inset) # plot data within this range
-
- if(diff(xrange.data) < (x.inset*ncol(dat))) stop("No room left to plot data; please try reducing ratio.tree or cex.label.")
-
- ## define x and y coordinates
- x.grid <- seq(xrange.data[1],xrange.data[2], length=ncol(dat))
- if(ncol(dat)==1) {x.grid <- mean(c(xrange.data[1],xrange.data[2]))}
- y.grid <- seq(plotres$y.lim[1],plotres$y.lim[2],length=plotres$Ntip)
- temp <- expand.grid(y.grid, x.grid) # here are coordinates for data
- xy.data <- data.frame(x=temp[,2],y=temp[,1])
-
- ## merge data and their coordinates
- alldat <- cbind.data.frame(xy.data, unlist(dat))
- ## fac <- factor(rep(1:ncol(dat), rep(nrow(dat),ncol(dat))))
- ## alldat <- split(alldat, fac)
-
- ## need to "reboot" the plot region without changing coordinates
- ## seems that box does the job.
- if(box) {box()} else {box(col="transparent")}
- if(grid){
- ## vertical segments
- segments(x0=x.grid, y0=rep(min(y.grid),plotres$Ntip),
- x1=x.grid, y1=rep(max(y.grid),plotres$Ntip), col="grey")
- ## horizontal segments
- segments(x0=rep(min(x.grid),plotres$Ntip), y0=y.grid,
- x1=rep(max(x.grid),plotres$Ntip), y1=y.grid, col="grey")
- }
-
- ## auxiliary function to plot a single variable
- ## max size of a symbol is set to SYMBSCALE*cex inches
- plotaux <- function(x,y,var,symbol,cex){
- if(any(var[!is.na(var)]<0)) {
- usebw <- TRUE
- } else {
- usebw <- FALSE
- }
-
- if(usebw){
- ispos <- var>0
- fg.col <- rep("black",length(var))
- fg.col[ispos] <- "white"
- bg.col <- rep("white",length(var))
- bg.col[ispos] <- "black"
-
- if(symbol == "squares"){
- symbols(x=x, y=y, squares=abs(var), inches=SYMBSCALE*cex, fg=fg.col, bg=bg.col, add=TRUE)
- } # end squares
-
- if(symbol == "circles"){
- symbols(x=x, y=y, circles=abs(var), inches=SYMBSCALE*cex, fg=fg.col, bg=bg.col, add=TRUE)
- } # end circles
-
- } else {
-
- if(symbol == "squares"){
- symbols(x=x, y=y, squares=var, inches=SYMBSCALE*cex, fg="white", bg="black", add=TRUE)
- } # end squares
-
- if(symbol == "circles"){
- symbols(x=x, y=y, circles=var, inches=SYMBSCALE*cex, fg="white", bg="black", add=TRUE)
- } # end circles
- } # end else
-
- if(any(is.na(var))){
- isNA <- is.na(var)
- points(x[isNA],y[isNA],pch=4,cex=cex.symbol)
- }
- } # end plotaux
-
-
- ## finally plot the data
- ## carefull : all variables must be plotted in as a single vector, so that
- ## scaling is the same for all variables
- ## lapply(alldat, function(X) plotaux(X[,1],X[,2],X[,3],symbol,cex.symbol))
- plotaux(alldat[,1],alldat[,2],alldat[,3],symbol,cex.symbol)
-
-#### plot labels for variables
- if(show.var.label) text(x=x.grid, y=rep(min(y.grid)-1.5*y.inset, ncol(dat)), lab=var.label,
- adj=1, srt=90, cex=cex.label)
-
-#### plot tip labels
- if(show.tip.label){
- x.base <- xrange.data[2] + x.inset
- text(x=rep(x.base,plotres$Ntip), y=1:plotres$Ntip, lab=tip.label, font=font, cex=cex.label, pos=4)
- }
-
-#### add a legend for symbols
- if(legend){
-
- ## Auxiliary function to add the legend
- ## (x,y): coordinates of the lower-left annotation
- ## z: a numeric vector whose values are being legended
- addLegend <- function(x,y,z,cex.legend,cex.label,cex.symbol){
- z <- z*cex.legend
- leg.values <- pretty(z,n=4, min.n=1)
- temp <- length(leg.values)
- ## make sure to get maximum 4 symbols
- if(temp>4) {
- leg.values <- leg.values[c(1,2,temp-1,temp)]
- }
-
- leg.txt <- as.character(leg.values)
-
- ## compute the maximum size taken by symbols in usr coordinates
- usr.w <- (par("usr")[2]-par("usr")[1]) / ratio.tree # because par("usr") is the one of plot.phylo
- usr.h <- par("usr")[4]-par("usr")[3]
- sym.w <- usr.w *
- ((abs(leg.values)/max(abs(leg.values))) * SYMBSCALE * cex.symbol * cex.legend) / par("pin")[1]
- sym.h <- usr.h * (SYMBSCALE * cex.symbol * cex.legend) / par("pin")[2]
-
- ## compute the maximum size taken by annotations in usr coordinates
- ann.w <- strwidth(leg.txt,units="user",cex=cex.label*cex.legend)
- ann.h <- strheight(leg.txt,units="user",cex=cex.label*cex.legend)
-
- ## retain relevant spaces between symbols / annotations
- space.w.sym <- sapply(1:(length(sym.w)-1),function(i) sum(sym.w[c(i,i+1)]))
- space.w.ann <- sapply(1:(length(ann.w)-1),function(i) sum(ann.w[c(i,i+1)])) / 2
- temp <- cbind(space.w.sym, space.w.ann)
- space.w <- apply(temp,1,max)
- space.w <- space.w + 0.01*usr.w
- space.h <- sym.h + ann.h + 0.01*usr.h
-
- ## define coordinates of annotations and symbols
- ann.coordX <- c(x, x + cumsum(space.w)) + max(sym.w[1],ann.w[1]) + 0.01*usr.w
- ann.coordY <- y
- sym.coordX <- ann.coordX
- sym.coordY <- y + space.h
-
- ## plot annotations
- text(ann.coordX, ann.coordY, leg.txt, cex=cex.label*cex.legend)
-
- ## plot symbols
- plotaux(sym.coordX, sym.coordY, leg.values, symbol, cex.symbol*cex.legend)
- } # end addLegend
-
- if(!is.null(coord.legend)){
- x.leg <- coord.legend$x
- y.leg <- coord.legend$y
- } else {
- usr.w <- (par("usr")[2]-par("usr")[1]) / ratio.tree
- usr.h <- par("usr")[4]-par("usr")[3]
-
- temp <- lab.height * usr.height / (1 - lab.height) ## need to substract temp from par("usr")[3]
- y.base <- par("usr")[3] - temp - y.inset ## to get closer the actual par("usr")[3] !
-
- x.leg <- par("usr")[1] + 0.01 * usr.w
- y.leg <- y.base ## remember to use y.base instead of par("usr3")[3], which is wrong
- }
-
- addLegend(x=x.leg, y=y.leg, z=alldat[,3],
- cex.legend=cex.legend, cex.label=cex.label, cex.symbol=cex.symbol)
- ## FIXME ##
- ## draw a rectangle around the legend
- #rect.size <- c(diff(range(leg.x)) , diff(c(y.base, max(leg.y))) )
- #rect(min(leg.x)- rect.size[1]*0.05,
- # min(y.base) - rect.size[2]*0.05,
- # max(leg.x) + rect.size[1]*0.05,
- # max(y.base) + rect.size[2]*0.05)
- } ## end legend
-
- return(invisible())
-} # end s.phylo4d
Added: pkg/R/table.phylo4d.R
===================================================================
--- pkg/R/table.phylo4d.R (rev 0)
+++ pkg/R/table.phylo4d.R 2008-12-15 13:25:58 UTC (rev 104)
@@ -0,0 +1,253 @@
+#############
+## table.phylo4d
+#############
+table.phylo4d <- function(x, treetype=c("phylogram","cladogram"), symbol=c("circles", "squares"),
+ center=TRUE, scale=TRUE, legend=TRUE, grid=TRUE, box=TRUE,
+ show.tip.label=TRUE, show.node.label=TRUE, show.var.label=TRUE,
+ ratio.tree=1/3, font=3,
+ tip.label=x at tip.label, var.label=colnames(x at tip.data),
+ cex.symbol=1, cex.label=1, cex.legend=1, coord.legend=NULL, ...)
+{
+
+ ## preliminary stuff and checks
+ if (is.character(chk <- check_phylo4(x))) stop("bad phylo4d object: ",chk)
+ # if (is.character(chk <- check_data(x))) stop("bad phylo4d object: ",chk) <- needed?
+
+ if(!require(ape)) stop("the ape package is required")
+ if(cex.label<0.1) {
+ show.tip.label <- FALSE
+ show.node.label <- FALSE
+ show.var.label <- FALSE
+ }
+
+ cex <- par("cex")
+ symbol <- match.arg(symbol)
+ treetype <- match.arg(treetype)
+
+ SYMBSCALE <- 0.2 # i.e. max size of a plotted symbol is 0.2*cex.symbol inches
+
+ ## convert the tree into phylo
+ tre <- suppressWarnings(as(x,"phylo"))
+ tre$node.label <- x at node.label # this should be done by the as(x,"phylo")
+ ## plot only tree if no tip data
+ if(ncol(tdata(x,which="tip")) == 0) {
+ plot.phylo(tre, type=treetype, direction="rightwards", show.tip.label=show.tip.label,
+ show.node.label=show.node.label, cex=cex.label,
+ no.margin=FALSE, x.lim=NULL, y.lim=NULL, ...)
+ return(invisible())
+ }
+
+#### data handling
+ ## retrieve data
+ dat <- tdata(x, which="tip")
+ clas <- lapply(dat,class)
+ isNum <- sapply(clas, function(e) e %in% c("integer","numeric"))
+ ## keep only numeric data
+ dat <- dat[isNum]
+ var.label <- var.label[isNum]
+ ## order data like tips
+ E <- edges(x)
+ tips.ord <- E[,2][!E[,2] %in% E[,1]]
+ dat <- dat[tips.ord,,FALSE]
+ tip.label <- tip.label[tips.ord] # reorder tip labels
+ ## centring / scaling
+ dat <- as.data.frame(scale(dat,center=center,scale=scale))
+
+ ## compute bottom margin
+ ## ! use inches as units still these won't be changed by plot.phylo
+ temp <- var.label[which.max(nchar(var.label))] # longest tip label
+ lab.height <- strwidth(temp, units="inches", cex=cex.label) # height required by the longest var label
+ lab.height <- lab.height / par("pin")[1] # returned as a fraction of the plot region
+
+#### define plot region
+ plotreg <- plotreg0 <- par("plt")
+ plotreg.width <- plotreg0[2] - plotreg0[1]
+ plotreg.height <- plotreg0[4] - plotreg0[3]
+ plotreg[2] <- plotreg[1] + (ratio.tree)*plotreg.width # restrain the width for phylo
+ plotreg[3] <- plotreg[3] + plotreg.height*ifelse(show.var.label,lab.height+0.05,0.05) ## add internal vertical margins
+ plotreg[4] <- plotreg[4] - plotreg.height*0.05 # add internal vertical margins
+
+#### plot the tree
+ par(plt = plotreg)
+ plotres <- plot.phylo(tre, type=treetype, direction="rightwards", show.tip.label=FALSE,
+ show.node.label=show.node.label, cex=cex.label,
+ no.margin=FALSE, x.lim=NULL, y.lim=NULL, ...)
+
+#### plot the data
+ par(plt=plotreg0)
+ cur.usr.width <- par("usr")[2] - par("usr")[1] # beware: par("usr") does not adapt to the new plot region
+ usr.width <- cur.usr.width / ratio.tree
+ usr.height <- par("usr")[4] - par("usr")[3]
+
+ ## x.inset is the space between tree/data and data/tip.labels (in usr units)
+ x.inset <- SYMBSCALE * cex.symbol * usr.width / par("pin")[1]
+ y.inset <- SYMBSCALE * cex.symbol * usr.height / par("pin")[2]
+ x.base <- plotres$x.lim[2] + x.inset # start plotting from x.base rightwards
+ if(show.tip.label){
+ temp <- x at tip.label[which.max(nchar(x at tip.label))] # longest tip label
+ lab.width <- strwidth(temp, units="user", cex=cex.label) # compute the width to keep for tip labels
+ } else{
+ lab.width <- 0
+ }
+ xrange.data <- c(x.base , (par("usr")[1]+usr.width) - lab.width - 2*x.inset) # plot data within this range
+
+ if(diff(xrange.data) < (x.inset*ncol(dat))) stop("No room left to plot data; please try reducing ratio.tree or cex.label.")
+
+ ## define x and y coordinates
+ x.grid <- seq(xrange.data[1],xrange.data[2], length=ncol(dat))
+ if(ncol(dat)==1) {x.grid <- mean(c(xrange.data[1],xrange.data[2]))}
+ y.grid <- seq(plotres$y.lim[1],plotres$y.lim[2],length=plotres$Ntip)
+ temp <- expand.grid(y.grid, x.grid) # here are coordinates for data
+ xy.data <- data.frame(x=temp[,2],y=temp[,1])
+
+ ## merge data and their coordinates
+ alldat <- cbind.data.frame(xy.data, unlist(dat))
+ ## fac <- factor(rep(1:ncol(dat), rep(nrow(dat),ncol(dat))))
+ ## alldat <- split(alldat, fac)
+
+ ## need to "reboot" the plot region without changing coordinates
+ ## seems that box does the job.
+ if(box) {box()} else {box(col="transparent")}
+ if(grid){
+ ## vertical segments
+ segments(x0=x.grid, y0=rep(min(y.grid),plotres$Ntip),
+ x1=x.grid, y1=rep(max(y.grid),plotres$Ntip), col="grey")
+ ## horizontal segments
+ segments(x0=rep(min(x.grid),plotres$Ntip), y0=y.grid,
+ x1=rep(max(x.grid),plotres$Ntip), y1=y.grid, col="grey")
+ }
+
+ ## auxiliary function to plot a single variable
+ ## max size of a symbol is set to SYMBSCALE*cex inches
+ plotaux <- function(x,y,var,symbol,cex){
+ if(any(var[!is.na(var)]<0)) {
+ usebw <- TRUE
+ } else {
+ usebw <- FALSE
+ }
+
+ if(usebw){
+ ispos <- var>0
+ fg.col <- rep("black",length(var))
+ fg.col[ispos] <- "white"
+ bg.col <- rep("white",length(var))
+ bg.col[ispos] <- "black"
+
+ if(symbol == "squares"){
+ symbols(x=x, y=y, squares=abs(var), inches=SYMBSCALE*cex, fg=fg.col, bg=bg.col, add=TRUE)
+ } # end squares
+
+ if(symbol == "circles"){
+ symbols(x=x, y=y, circles=abs(var), inches=SYMBSCALE*cex, fg=fg.col, bg=bg.col, add=TRUE)
+ } # end circles
+
+ } else {
+
+ if(symbol == "squares"){
+ symbols(x=x, y=y, squares=var, inches=SYMBSCALE*cex, fg="white", bg="black", add=TRUE)
+ } # end squares
+
+ if(symbol == "circles"){
+ symbols(x=x, y=y, circles=var, inches=SYMBSCALE*cex, fg="white", bg="black", add=TRUE)
+ } # end circles
+ } # end else
+
+ if(any(is.na(var))){
+ isNA <- is.na(var)
+ points(x[isNA],y[isNA],pch=4,cex=cex.symbol)
+ }
+ } # end plotaux
+
+
+ ## finally plot the data
+ ## carefull : all variables must be plotted in as a single vector, so that
+ ## scaling is the same for all variables
+ ## lapply(alldat, function(X) plotaux(X[,1],X[,2],X[,3],symbol,cex.symbol))
+ plotaux(alldat[,1],alldat[,2],alldat[,3],symbol,cex.symbol)
+
+#### plot labels for variables
+ if(show.var.label) text(x=x.grid, y=rep(min(y.grid)-1.5*y.inset, ncol(dat)), lab=var.label,
+ adj=1, srt=90, cex=cex.label)
+
+#### plot tip labels
+ if(show.tip.label){
+ x.base <- xrange.data[2] + x.inset
+ text(x=rep(x.base,plotres$Ntip), y=1:plotres$Ntip, lab=tip.label, font=font, cex=cex.label, pos=4)
+ }
+
+#### add a legend for symbols
+ if(legend){
+
+ ## Auxiliary function to add the legend
+ ## (x,y): coordinates of the lower-left annotation
+ ## z: a numeric vector whose values are being legended
+ addLegend <- function(x,y,z,cex.legend,cex.label,cex.symbol){
+ z <- z*cex.legend
+ leg.values <- pretty(z,n=4, min.n=1)
+ temp <- length(leg.values)
+ ## make sure to get maximum 4 symbols
+ if(temp>4) {
+ leg.values <- leg.values[c(1,2,temp-1,temp)]
+ }
+
+ leg.txt <- as.character(leg.values)
+
+ ## compute the maximum size taken by symbols in usr coordinates
+ usr.w <- (par("usr")[2]-par("usr")[1]) / ratio.tree # because par("usr") is the one of plot.phylo
+ usr.h <- par("usr")[4]-par("usr")[3]
+ sym.w <- usr.w *
+ ((abs(leg.values)/max(abs(leg.values))) * SYMBSCALE * cex.symbol * cex.legend) / par("pin")[1]
+ sym.h <- usr.h * (SYMBSCALE * cex.symbol * cex.legend) / par("pin")[2]
+
+ ## compute the maximum size taken by annotations in usr coordinates
+ ann.w <- strwidth(leg.txt,units="user",cex=cex.label*cex.legend)
+ ann.h <- strheight(leg.txt,units="user",cex=cex.label*cex.legend)
+
+ ## retain relevant spaces between symbols / annotations
+ space.w.sym <- sapply(1:(length(sym.w)-1),function(i) sum(sym.w[c(i,i+1)]))
+ space.w.ann <- sapply(1:(length(ann.w)-1),function(i) sum(ann.w[c(i,i+1)])) / 2
+ temp <- cbind(space.w.sym, space.w.ann)
+ space.w <- apply(temp,1,max)
+ space.w <- space.w + 0.01*usr.w
+ space.h <- sym.h + ann.h + 0.01*usr.h
+
+ ## define coordinates of annotations and symbols
+ ann.coordX <- c(x, x + cumsum(space.w)) + max(sym.w[1],ann.w[1]) + 0.01*usr.w
+ ann.coordY <- y
+ sym.coordX <- ann.coordX
+ sym.coordY <- y + space.h
+
+ ## plot annotations
+ text(ann.coordX, ann.coordY, leg.txt, cex=cex.label*cex.legend)
+
+ ## plot symbols
+ plotaux(sym.coordX, sym.coordY, leg.values, symbol, cex.symbol*cex.legend)
+ } # end addLegend
+
+ if(!is.null(coord.legend)){
+ x.leg <- coord.legend$x
+ y.leg <- coord.legend$y
+ } else {
+ usr.w <- (par("usr")[2]-par("usr")[1]) / ratio.tree
+ usr.h <- par("usr")[4]-par("usr")[3]
+
+ temp <- lab.height * usr.height / (1 - lab.height) ## need to substract temp from par("usr")[3]
+ y.base <- par("usr")[3] - temp - y.inset ## to get closer the actual par("usr")[3] !
+
+ x.leg <- par("usr")[1] + 0.01 * usr.w
+ y.leg <- y.base ## remember to use y.base instead of par("usr3")[3], which is wrong
+ }
+
+ addLegend(x=x.leg, y=y.leg, z=alldat[,3],
+ cex.legend=cex.legend, cex.label=cex.label, cex.symbol=cex.symbol)
+ ## FIXME ##
+ ## draw a rectangle around the legend
+ #rect.size <- c(diff(range(leg.x)) , diff(c(y.base, max(leg.y))) )
+ #rect(min(leg.x)- rect.size[1]*0.05,
+ # min(y.base) - rect.size[2]*0.05,
+ # max(leg.x) + rect.size[1]*0.05,
+ # max(y.base) + rect.size[2]*0.05)
+ } ## end legend
+
+ return(invisible())
+} # end table.phylo4d
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/TODO 2008-12-15 13:25:58 UTC (rev 104)
@@ -70,7 +70,7 @@
# LOW PRIORITY / MINOR ISSUES
===========================
===========================
-* draw a rectangle around legend in s.phylo4d
+* draw a rectangle around legend in table.phylo4d
# LONG TERM
Modified: pkg/man/carni19.Rd
===================================================================
--- pkg/man/carni19.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/carni19.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -23,6 +23,6 @@
data(carni19)
tre <- read.tree(text=carni19$tre)
x <- phylo4d(tre, data.frame(carni19$bm))
-s.phylo4d(x, ratio=.5, center=FALSE)
+table.phylo4d(x, ratio=.5, center=FALSE)
}
\keyword{datasets}
Modified: pkg/man/carni70.Rd
===================================================================
--- pkg/man/carni70.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/carni70.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -25,10 +25,10 @@
data(carni70)
tre <- read.tree(text=carni70$tre)
x <- phylo4d(tre, carni70$tab)
-s.phylo4d(x)
+table.phylo4d(x)
par(mar=rep(.1,4))
-s.phylo4d(x,cex.lab=.5, show.n=FALSE, ratio=.5)
+table.phylo4d(x,cex.lab=.5, show.n=FALSE, ratio=.5)
## transform size in log and test for a phylogenetic signal
Modified: pkg/man/distRoot.Rd
===================================================================
--- pkg/man/distRoot.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/distRoot.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -59,7 +59,7 @@
## plot these distances along with the tree
temp <- phylo4d(x, D)
-s.phylo4d(temp, show.node=FALSE, cex.lab=.6)
+table.phylo4d(temp, show.node=FALSE, cex.lab=.6)
}
}
\keyword{manip}
Modified: pkg/man/lizards.Rd
===================================================================
--- pkg/man/lizards.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/lizards.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -36,14 +36,14 @@
data(lizards)
liz.tr <- read.tree(tex=lizards$hprA) # make a tree
liz <- phylo4d(liz.tr, lizards$traits) # make a phylo4d object
-s.phylo4d(liz)
+table.phylo4d(liz)
## compute and plot principal components
if(require(ade4)){
liz.pca1 <- dudi.pca(lizards$traits, cent=TRUE, scale=TRUE, scannf=FALSE, nf=2) # PCA of traits
myPC <- phylo4d(liz.tr, liz.pca1$li) # store PC in a phylo4d object
varlab <- paste("Principal \ncomponent", 1:2) # make labels for PCs
-s.phylo4d(myPC, ratio=.8, var.lab=varlab) # plot the PCs
+table.phylo4d(myPC, ratio=.8, var.lab=varlab) # plot the PCs
add.scatter.eig(liz.pca1$eig,2,1,2,posi="topleft", inset=c(0,.15))
title("Phylogeny and the principal components")
Modified: pkg/man/maples.Rd
===================================================================
--- pkg/man/maples.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/maples.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -40,7 +40,7 @@
## look at the two variables onto the phylogeny
temp <- phylo4d(tre, data.frame(dom,bif, row.names=tre$tip.label))
-s.phylo4d(temp) # correlation is strongly linked to phylogeny
+table.phylo4d(temp) # correlation is strongly linked to phylogeny
## use ape's PIC (phylogenetic independent contrasts)
pic.bif <- pic(bif, tre)
Modified: pkg/man/mjrochet.Rd
===================================================================
--- pkg/man/mjrochet.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/mjrochet.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -49,7 +49,7 @@
mjr <- phylo4d(tre, traits)
## see data
-s.phylo4d(mjr,cex.lab=.5,show.node=FALSE,symb="square")
+table.phylo4d(mjr,cex.lab=.5,show.node=FALSE,symb="square")
## perform Abouheif's test for each trait
mjr.tests <- abouheif.moran(mjr, nrep=499)
Modified: pkg/man/orthobasis.Rd
===================================================================
--- pkg/man/orthobasis.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/orthobasis.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -68,7 +68,7 @@
## plot the 10 first vectors
obj <- phylo4d(x, as.data.frame(ME[,1:10]))
-s.phylo4d(obj, cex.sym=.7, cex.lab=.7)
+table.phylo4d(obj, cex.sym=.7, cex.lab=.7)
## removing phylogenetic autocorrelation in a model ##
@@ -85,7 +85,7 @@
orthogram(resid2, tre) # there is no longer phylogenetic autocorrelation
## see the difference
-s.phylo4d(phylo4d(tre, cbind.data.frame(resid1, resid2)))
+table.phylo4d(phylo4d(tre, cbind.data.frame(resid1, resid2)))
}
\keyword{manip}
Modified: pkg/man/orthogram.Rd
===================================================================
--- pkg/man/orthogram.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/orthogram.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -94,7 +94,7 @@
## plot the two traits and the residuals of lm1
x <- phylo4d(tre, cbind.data.frame(afbw, neonatw, residuals=resid))
-s.phylo4d(x) # residuals are surely not independant
+table.phylo4d(x) # residuals are surely not independant
## default orthogram for residuals of lm1
orthogram(resid, tre)
Modified: pkg/man/palm.Rd
===================================================================
--- pkg/man/palm.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/palm.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -40,7 +40,7 @@
## plot data
par(mar=rep(.1,4))
-s.phylo4d(x, cex.lab=.6)
+table.phylo4d(x, cex.lab=.6)
## test phylogenetic autocorrelation
if(require(ade4)){
Modified: pkg/man/ppca.Rd
===================================================================
--- pkg/man/ppca.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/ppca.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -21,7 +21,7 @@
object, including the decomposition of eigenvalues of all axes\cr
- \code{scatter.ppca}: plot principal components using
- \code{\link{s.phylo4d}}\cr
+ \code{\link{table.phylo4d}}\cr
- \code{screeplot.ppca}: graphical display of the decomposition of
pPCA eigenvalues\cr
@@ -70,7 +70,7 @@
\item{nfnega}{an integer giving the number of negative eigenvalues retained
('local structures').}
\item{\dots}{further arguments passed to other methods. Can be used to
- provide arguments to \code{\link{s.phylo4d}} in \code{plot} method.}
+ provide arguments to \code{\link{table.phylo4d}} in \code{plot} method.}
\item{object}{a \code{ppca} object.}
\item{printres}{a logical stating whether results should be printed on
the screen (TRUE, default) or not (FALSE).}
@@ -150,7 +150,7 @@
x <- phylo4d(tre, maples$tab)
omar <- par("mar")
par(mar=rep(.1,4))
-s.phylo4d(x, cex.lab=.5, cex.sym=.6, ratio=.1) # note NAs in last trait ('x')
+table.phylo4d(x, cex.lab=.5, cex.sym=.6, ratio=.1) # note NAs in last trait ('x')
## function to replace NA
f1 <- function(vec){
@@ -179,7 +179,7 @@
highContrib <- a[a< quantile(a,0.1) | a>quantile(a,0.9)]
datSel <- cbind.data.frame(dat[, names(highContrib)], ppca1$li)
temp <- phylo4d(tre, datSel)
-s.phylo4d(temp) # plot of most structured traits
+table.phylo4d(temp) # plot of most structured traits
## phylogenetic autocorrelation tests for these traits
prox <- proxTips(tre, method="Abouheif")
Modified: pkg/man/procella.Rd
===================================================================
--- pkg/man/procella.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/procella.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -36,7 +36,7 @@
tre <- read.tree(text=procella$tre)
x <- phylo4d(tre, procella$traits)
par(mar=rep(.1,4))
-s.phylo4d(x,cex.lab=.7)
+table.phylo4d(x,cex.lab=.7)
## test phylogenetic autocorrelation in traits
if(require(ade4)){
Modified: pkg/man/proxTips.Rd
===================================================================
--- pkg/man/proxTips.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/proxTips.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -136,7 +136,7 @@
## see what one proximity looks like
M <- proxTips(x)
obj <- phylo4d(x,as.data.frame(M))
-s.phylo4d(obj,symbol="sq")
+table.phylo4d(obj,symbol="sq")
}
}
\keyword{manip}
Deleted: pkg/man/s.phylo4d.Rd
===================================================================
--- pkg/man/s.phylo4d.Rd 2008-12-14 17:23:23 UTC (rev 103)
+++ pkg/man/s.phylo4d.Rd 2008-12-15 13:25:58 UTC (rev 104)
@@ -1,111 +0,0 @@
-\name{s.phylo4d}
-\alias{s.phylo4d}
-\title{scatterplot for a phylogeny and traits}
-\description{
- This function displays scatterplots of traits provided for the tips of
- a phylogeny. Plotted objects must be valid \linkS4class{phylo4d}
- objects (implemented by the \code{phylobase} package). Current version
- allows plotting of a tree and one or more quantitative traits
- (possibly containing missing data, represented by an 'x').\cr
-
- The plot of phylogenies is performed by a call to \code{\link[pkg:ape]{plot.phylo}}
- from the \code{ape} package. Hence, many of the arguments of
- \code{\link[pkg:ape]{plot.phylo}} can be passed to \code{s.phylo4d},
- through the \dots argument, but their names must be complete.
-}
-\usage{
-s.phylo4d(x, treetype=c("phylogram","cladogram"), symbol=c("circles", "squares"),
- center=TRUE, scale=TRUE, legend=TRUE, grid=TRUE, box=TRUE,
- show.tip.label=TRUE, show.node.label=TRUE, show.var.label=TRUE,
- ratio.tree=1/3, font=3,
- tip.label=x at tip.label, var.label=colnames(x at tip.data),
- cex.symbol=1, cex.label=1, cex.legend=1, coord.legend=NULL, \dots)
-}
-\arguments{
- \item{x}{a \linkS4class{phylo4d} object}
- \item{treetype}{the type of tree to be plotted ("phylogram" or "cladogram")}
- \item{symbol}{the type of symbol used to represent data ("circles" or "squares")}
- \item{center}{a logical stating whether variables should be centred
- (TRUE, default) or not (FALSE)}
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/adephylo -r 104
More information about the Adephylo-commits
mailing list