Thankyou very much to all for your effort in improving the function! all the best paoo ________________________________________ Da: Liam J. Revell <liam.rev...@umb.edu> Inviato: martedì 10 giugno 2014 15.13 A: Jonas Eberle; Paolo Piras; r-sig-phylo@r-project.org Oggetto: Re: edge color in phylomorphospace3d
Thanks Jonas. I had just added this to phytools. Not yet on CRAN but more details (including how to use it) can be seen here: http://blog.phytools.org/2014/06/coloring-edges-in-phylomorphospace3d.html. All the best, Liam Liam J. Revell, Assistant Professor of Biology University of Massachusetts Boston web: http://faculty.umb.edu/liam.revell/ email: liam.rev...@umb.edu blog: http://blog.phytools.org On 6/10/2014 3:26 AM, Jonas Eberle wrote: > Dear Paolo, > > I modified the phylomorphospace3d code some time ago to be able to plot > colored branches (see below). You can use pointcol and edgecol to color > the plot. These can be simple color specifications (such as "black") or > vectors of colors that have the length of your number of tips or edges, > respectively. > > Thank you Liam for this piece of code! It's really usefull for me! I > hope I didn't spoil your code too much :) > > Jonas > > > > > ColoredPhylomorphospace3d <- function (tree, X, A = NULL, label = TRUE, > pointcol="black", edgecol="black", control = list(), > method = c("dynamic", "static"), ...) > { > method <- method[1] > if (class(tree) != "phylo") > stop("tree object must be of class 'phylo.'") > # controls festlegen > con = list(spin = TRUE, axes = TRUE, box = TRUE, simple.axes = FALSE, > lwd = 1, ftype = "reg") > con[(namc <- names(control))] <- control > if (con$simple.axes) > con$box <- con$axes <- FALSE > con$ftype <- which(c("off", "reg", "b", "i", "bi") == con$ftype) - > 1 > if (is.null(A)) > A <- apply(X, 2, function(x, tree) fastAnc(tree, x), > tree = tree) > else A <- A[as.character(1:tree$Nnode + length(tree$tip)), > ] > x <- y <- z <- matrix(NA, nrow(tree$edge), 2) > X <- X[tree$tip.label, ] > for (i in 1:length(tree$tip)) { > x[tree$edge[, 2] == i, 2] <- X[i, 1] > y[tree$edge[, 2] == i, 2] <- X[i, 2] > z[tree$edge[, 2] == i, 2] <- X[i, 3] > } > for (i in length(tree$tip) + 1:tree$Nnode) { > x[tree$edge[, 1] == i, 1] <- x[tree$edge[, 2] == i, > 2] <- A[as.character(i), 1] > y[tree$edge[, 1] == i, 1] <- y[tree$edge[, 2] == i, > 2] <- A[as.character(i), 2] > z[tree$edge[, 1] == i, 1] <- z[tree$edge[, 2] == i, > 2] <- A[as.character(i), 3] > } > if (is.null(colnames(X))) > colnames(X) <- c("x", "y", "z") > if (method == "dynamic") { > params <- get("r3dDefaults") > plot3d(rbind(X, A), xlab = colnames(X)[1], ylab = colnames(X)[2], > zlab = colnames(X)[3], axes = con$axes, box = con$box, > params = params) > spheres3d(X, radius = 0.02 * mean(apply(X, 2, max) - > apply(X, 2, min)), col=pointcol) > for (i in 1:nrow(tree$edge)) segments3d(x[i, ], y[i, ], z[i, ], lwd > = con$lwd, col=edgecol[i]) > ms <- colMeans(X) > rs <- apply(rbind(X, A), 2, range) > if (con$simple.axes) { > lines3d(x = rs[, 1], y = c(rs[1, 2], rs[1, 2]), > z = c(rs[1, 3], rs[1, 3])) > lines3d(x = c(rs[1, 1], rs[1, 1]), y = rs[, 2], > z = c(rs[1, 3], rs[1, 3])) > lines3d(x = c(rs[1, 1], rs[1, 1]), y = c(rs[1, 2], > rs[1, 2]), z = rs[, 3]) > } > rs <- rs[2, ] - rs[1, ] > for (i in 1:length(tree$tip)) { > adj <- 0.03 * rs * (2 * (X[i, ] > ms) - 1) > if (con$ftype) > text3d(X[i, ] + adj, texts = tree$tip.label[i], > font = con$ftype) > } > if (con$spin) { > xx <- spin3d(axis = c(0, 0, 1), rpm = 10) > play3d(xx, duration = 5) > invisible(xx) > } > else invisible(NULL) > } > else if (method == "static") { > if (hasArg(angle)) > angle <- list(...)$angle > else angle <- 30 > if (hasArg(xlim)) > xlim <- list(...)$xlim > else xlim <- NULL > if (hasArg(ylim)) > ylim <- list(...)$ylim > else ylim <- NULL > if (hasArg(zlim)) > zlim <- list(...)$zlim > else zlim = NULL > xx <- scatterplot3d(X, xlab = colnames(X)[1], zlab = colnames(X)[3], > pch = 19, angle = angle, ylab = colnames(X)[2], > asp = 1, cex.symbols = 1.3, xlim = xlim, ylim = > ylim, > zlim = zlim) > aa <- xx$xyz.convert(A) > points(aa$x, aa$y, pch = 19, cex = 0.8) > for (i in 1:nrow(tree$edge)) { > aa <- xx$xyz.convert(x[i, ], y[i, ], z[i, ]) > lines(aa$x, aa$y, lwd = 2) > } > for (i in 1:length(tree$tip.label)) { > aa <- xx$xyz.convert(x[which(tree$edge[, 2] == i), > 2], y[which(tree$edge[, 2] == i), 2], > z[which(tree$edge[, > > 2] == i), 2]) > text(tree$tip.label[i], x = aa$x, y = aa$y, pos = 2) > } > invisible(xx) > } > } > _______________________________________________ R-sig-phylo mailing list - R-sig-phylo@r-project.org https://stat.ethz.ch/mailman/listinfo/r-sig-phylo Searchable archive at http://www.mail-archive.com/r-sig-phylo@r-project.org/
