]> git.donarmstrong.com Git - ape.git/blobdiff - R/summary.phylo.R
final plot.phylo and change to BOTHlabels() from Janet Young
[ape.git] / R / summary.phylo.R
index cffe0d1da6769e22059ba94c1f32d273a5a47cb9..592050cfe844731d5212f4fd05d05ea76ba91a48 100644 (file)
@@ -1,31 +1,31 @@
-## summary.phylo.R (2007-12-29)
+## summary.phylo.R (2009-05-10)
 
 ##   Print Summary of a Phylogeny
 
-## Copyright 2003-2007 Emmanuel Paradis, and 2006 Ben Bolker
+## Copyright 2003-2009 Emmanuel Paradis, and 2006 Ben Bolker
 
 ## This file is part of the R-package `ape'.
 ## See the file ../COPYING for licensing issues.
 
 Ntip <- function(phy)
 {
-    if (class(phy) != "phylo")
-      stop('object "phy" is not of class "phylo"')
+    if (!inherits(phy, "phylo"))
+        stop('object "phy" is not of class "phylo"')
     length(phy$tip.label)
 }
 
 Nnode <- function(phy, internal.only = TRUE)
 {
-    if (class(phy) != "phylo")
-      stop('object "phy" is not of class "phylo"')
+    if (!inherits(phy, "phylo"))
+        stop('object "phy" is not of class "phylo"')
     if (internal.only) return(phy$Nnode)
     phy$Nnode + length(phy$tip.label)
 }
 
 Nedge <- function(phy)
 {
-    if (class(phy) != "phylo")
-      stop('object "phy" is not of class "phylo"')
+    if (!inherits(phy, "phylo"))
+        stop('object "phy" is not of class "phylo"')
     dim(phy$edge)[1]
 }
 
@@ -121,8 +121,28 @@ print.multiPhylo <- function(x, details = FALSE, ...)
     cat("\n")
 }
 
+"[[.multiPhylo" <- function(x, i)
+{
+    class(x) <- NULL
+    phy <- x[[i]]
+    if (!is.null(attr(x, "TipLabel")))
+        phy$tip.label <- attr(x, "TipLabel")
+    phy
+}
+
+`$.multiPhylo` <- function(x, name) x[[name]]
+
 "[.multiPhylo" <- function(x, i)
 {
+    oc <- oldClass(x)
     class(x) <- NULL
-    structure(x[i], class = "multiPhylo")
+    structure(x[i], TipLabel = attr(x, "TipLabel"),
+              class = oc)
+}
+
+str.multiPhylo <- function(object, ...)
+{
+    class(object) <- NULL
+    cat('Class "multiPhylo"\n')
+    str(object, ...)
 }