[Phylobase-commits] r404 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Dec 26 17:51:00 CET 2008
Author: francois
Date: 2008-12-26 17:50:59 +0100 (Fri, 26 Dec 2008)
New Revision: 404
Added:
pkg/R/printphylo-deprecated.R
Modified:
pkg/R/methods-phylo4.R
pkg/R/methods-phylo4d.R
Log:
printphylo is now deprecated, print and summary work on empty/new objects
Modified: pkg/R/methods-phylo4.R
===================================================================
--- pkg/R/methods-phylo4.R 2008-12-24 16:57:29 UTC (rev 403)
+++ pkg/R/methods-phylo4.R 2008-12-26 16:50:59 UTC (rev 404)
@@ -185,10 +185,16 @@
})
-printphylo4 <- function(x, printall = TRUE){
- if (printall)
- print(as(x, 'data.frame'))
- else print(head(as(x, 'data.frame')))
+printphylo4 <- function(x, printall=TRUE) {
+ if(!nrow(x at edge)) {
+ msg <- paste("Empty \'", class(x), "\' object\n", sep="")
+ cat(msg)
+ }
+ else {
+ if (printall)
+ print(as(x, 'data.frame'))
+ else print(head(as(x, 'data.frame')))
+ }
}
## hack for print/show
## from http://tolstoy.newcastle.edu.au/R/e2/devel/06/12/1363.html
@@ -197,53 +203,8 @@
setMethod("print", "phylo4", printphylo4)
setMethod("show", "phylo4", function(object) printphylo4(object))
##
-# Alternative print method for phylo4, showing the contents of the tree data.
-## Not sure if it works for unrooted trees
-printphylo <- function (x,printlen=6,...) {
- printlen <- max(1,printlen)
- nb.tip <- length(x$tip.label)
- nb.node <- x$Nnode
- nb.edge <- length(x$edge.label)
- cat(paste("\nPhylogenetic tree with", nb.tip, "tips and",
- nb.node, "internal nodes\n"))
- ## print tip labels
- cat("\nTip labels:\n")
- if (nb.tip > printlen) {
- cat(paste("\t", paste(x$tip.label[1:printlen], collapse = ", "),
- ", ...\n", sep = ""))
- } else print(x$tip.label)
-
- ## print node labels
- cat("\nNode labels:\n")
- if (nb.node > printlen) {
- cat(paste("\t", paste(x$node.label[1:printlen], collapse = ", "),
- ", ...\n", sep = ""))
- } else print(x$node.label)
-
- ## print edge labels
- cat("\nEdge labels:\n")
- if (nb.edge > printlen) {
- cat(paste("\t", paste(x$edge.label[1:printlen], collapse = ", "),
- ", ...\n", sep = ""))
- } else print(x$edge.label)
-
- ## slots
- ## cat("\nSlots:\n")
- ## cat(paste("@", names(x)[1:4], sep=""),sep="\t")
- ## cat("\n")
- ## cat(paste("@", names(x)[5:7], sep=""),sep="\t")
- ## cat("\n")
-
- rlab <- if (isRooted(x)) "Rooted" else "Unrooted"
- cat("\n", rlab, "; ", sep = "")
- blen <- if (hasEdgeLength(x))
- "includes branch lengths"
- else "no branch lengths"
- cat(blen, "\n\n", sep = "")
-}
-
#################
## summary phylo4
#################
@@ -267,7 +228,7 @@
}
## check for polytomies
- if (any(tabulate(na.omit(edges(object)[,1]))>2)){ # if there are polytomies
+ if (nrow(edges(x)) != 0 && any(tabulate(na.omit(edges(object)[,1]))>2)){ # if there are polytomies
E <- edges(x)
temp <- tabulate(na.omit(E[,1]))
degree <- temp[na.omit(E[,1])] # contains the degree of the ancestor for all edges
@@ -300,7 +261,7 @@
cat(" Number of tips :", res$nb.tips, "\n")
cat(" Number of nodes :", res$nb.nodes, "\n")
## cat(" ")
- if(is.null(x at edge.length)) {
+ if(!length(x at edge.length)) {
cat(" Branch lengths : No branch lengths.\n")
} else {
cat(" Branch lengths:\n")
@@ -309,12 +270,12 @@
cat(" distribution :\n")
print(res$sumry.el)
}
- if(hasPoly(x)){
+ if(nrow(edges(x)) != 0 && hasPoly(x)){
cat("\nDegree of the nodes :\n")
print(res$degree)
cat("\n")
cat("Types of polytomy:\n")
- print(res$polytomy)
+ print(res$npolytomy)
cat("\n")
}
Modified: pkg/R/methods-phylo4d.R
===================================================================
--- pkg/R/methods-phylo4d.R 2008-12-24 16:57:29 UTC (rev 403)
+++ pkg/R/methods-phylo4d.R 2008-12-26 16:50:59 UTC (rev 404)
@@ -63,7 +63,7 @@
nodedata <- data.frame(label=rep("",nNodes(x)))
} else
nodedata <- data.frame(label=x at node.label)
- }
+ }
else {
nodedata <- tdata(x, "node", label.type="column")
}
@@ -82,14 +82,14 @@
tdata <- data.frame(label=data.names,tdata)
if ( identical(label.type,"row.names") ) {
- if ( identical(data.names,unique(data.names)) ||
+ if ( identical(data.names,unique(data.names)) ||
!(any(is.na(data.names))) ) {
tdata <- data.frame(tdata[,-1,drop=FALSE])
row.names(tdata) <- data.names
}
else {
- stop("Non-unique or missing labels found, labels cannot be
- coerced to tdata row.names. Use the label.type argument to
+ stop("Non-unique or missing labels found, labels cannot be
+ coerced to tdata row.names. Use the label.type argument to
include labels as first column of data.")
}
}
@@ -124,7 +124,7 @@
## Marguerite Butler & Peter Cowan
setMethod("summary", "phylo4d", function(object) {
x <- object
- summary(extractTree(object))
+ summary(as(x, "phylo4"))
tips <- tdata(object, "tip")
nodes <- tdata(object, "node")
cat("\nComparative data:\n")
Added: pkg/R/printphylo-deprecated.R
===================================================================
--- pkg/R/printphylo-deprecated.R (rev 0)
+++ pkg/R/printphylo-deprecated.R 2008-12-26 16:50:59 UTC (rev 404)
@@ -0,0 +1,46 @@
+## Alternative print method for phylo4, showing the contents of the tree data.
+## Not sure if it works for unrooted trees
+printphylo <- function (x,printlen=6,...) {
+ .Deprecated("print", package="phylobase")
+ printlen <- max(1,printlen)
+ nb.tip <- length(x at tip.label)
+ nb.node <- x at Nnode
+ nb.edge <- length(x at edge.label)
+ cat(paste("\nPhylogenetic tree with", nb.tip, "tips and",
+ nb.node, "internal nodes\n"))
+
+ ## print tip labels
+ cat("\nTip labels:\n")
+ if (nb.tip > printlen) {
+ cat(paste("\t", paste(x at tip.label[1:printlen], collapse = ", "),
+ ", ...\n", sep = ""))
+ } else print(x at tip.label)
+
+ ## print node labels
+ cat("\nNode labels:\n")
+ if (nb.node > printlen) {
+ cat(paste("\t", paste(x at node.label[1:printlen], collapse = ", "),
+ ", ...\n", sep = ""))
+ } else print(x at node.label)
+
+ ## print edge labels
+ cat("\nEdge labels:\n")
+ if (nb.edge > printlen) {
+ cat(paste("\t", paste(x at edge.label[1:printlen], collapse = ", "),
+ ", ...\n", sep = ""))
+ } else print(x at edge.label)
+
+ ## slots
+ ## cat("\nSlots:\n")
+ ## cat(paste("@", names(x)[1:4], sep=""),sep="\t")
+ ## cat("\n")
+ ## cat(paste("@", names(x)[5:7], sep=""),sep="\t")
+ ## cat("\n")
+
+ rlab <- if (isRooted(x)) "Rooted" else "Unrooted"
+ cat("\n", rlab, "; ", sep = "")
+ blen <- if (hasEdgeLength(x))
+ "includes branch lengths"
+ else "no branch lengths"
+ cat(blen, "\n\n", sep = "")
+}
More information about the Phylobase-commits
mailing list