R/summary.phylo.R

   1 ## summary.phylo.R (2009-05-10)
   2
   3 ##   Print Summary of a Phylogeny
   4
   5 ## Copyright 2003-2009 Emmanuel Paradis, and 2006 Ben Bolker
   6
   7 ## This file is part of the R-package `ape'.
   8 ## See the file ../COPYING for licensing issues.
   9
  10 Ntip <- function(phy)
  11 {
  12     if (!inherits(phy, "phylo"))
  13         stop('object "phy" is not of class "phylo"')
  14     length(phy$tip.label)
  15 }
  16
  17 Nnode <- function(phy, internal.only = TRUE)
  18 {
  19     if (!inherits(phy, "phylo"))
  20         stop('object "phy" is not of class "phylo"')
  21     if (internal.only) return(phy$Nnode)
  22     phy$Nnode + length(phy$tip.label)
  23 }
  24
  25 Nedge <- function(phy)
  26 {
  27     if (!inherits(phy, "phylo"))
  28         stop('object "phy" is not of class "phylo"')
  29     dim(phy$edge)[1]
  30 }
  31
  32 summary.phylo <- function(object, ...)
  33 {
  34     cat("\nPhylogenetic tree:", deparse(substitute(object)), "\n\n")
  35     nb.tip <- length(object$tip.label)
  36     nb.node <- object$Nnode
  37     cat("  Number of tips:", nb.tip, "\n")
  38     cat("  Number of nodes:", nb.node, "\n")
  39     if (is.null(object$edge.length))
  40       cat("  No branch lengths.\n")
  41     else {
  42         cat("  Branch lengths:\n")
  43         cat("    mean:", mean(object$edge.length), "\n")
  44         cat("    variance:", var(object$edge.length), "\n")
  45         cat("    distribution summary:\n")
  46         print(summary(object$edge.length)[-4])
  47     }
  48     if (is.null(object$root.edge))
  49       cat("  No root edge.\n")
  50     else
  51       cat("  Root edge:", object$root.edge, "\n")
  52     if (nb.tip <= 10) {
  53         cat("  Tip labels:", object$tip.label[1], "\n")
  54         cat(paste("             ", object$tip.label[-1]), sep = "\n")
  55     }
  56     else {
  57         cat("  First ten tip labels:", object$tip.label[1], "\n")
  58         cat(paste("                       ", object$tip.label[2:10]), sep = "\n")
  59     }
  60     if (is.null(object$node.label))
  61       cat("  No node labels.\n")
  62     else {
  63         if (nb.node <= 10) {
  64             cat("  Node labels:", object$node.label[1], "\n")
  65             cat(paste("              ", object$node.label[-1]), sep = "\n")
  66         }
  67         else {
  68             cat("  First ten node labels:", object$node.label[1], "\n")
  69             cat(paste("                        ", object$node.label[2:10]), sep = "\n")
  70
  71         }
  72     }
  73     if (!is.null(attr(object, "loglik"))) {
  74         cat("Phylogeny estimated by maximum likelihood.\n")
  75         cat("  log-likelihood:", attr(object, "loglik"), "\n\n")
  76         npart <- length(attr(object, "para"))
  77         for (i in 1:npart) {
  78             cat("partition ", i, ":\n", sep = "")
  79             print(attr(object, "para")[[i]])
  80             if (i == 1) next
  81             else cat("  contrast parameter (xi):",
  82                      attr(object, "xi")[i - 1], "\n")
  83         }
  84     }
  85 }
  86
  87 ### by BB:
  88 print.phylo <- function(x, printlen = 6,...)
  89 {
  90     nb.tip <- length(x$tip.label)
  91     nb.node <- x$Nnode
  92     cat(paste("\nPhylogenetic tree with", nb.tip, "tips and", nb.node,
  93               "internal nodes.\n\n"))
  94     cat("Tip labels:\n")
  95     if (nb.tip > printlen) {
  96         cat(paste("\t", paste(x$tip.label[1:printlen],
  97                               collapse=", "), ", ...\n", sep = ""))
  98     } else print(x$tip.label)
  99     if (!is.null(x$node.label)) {
 100         cat("\tNode labels:\n")
 101         if (nb.node > printlen) {
 102             cat(paste("\t", paste(x$node.label[1:printlen],
 103                                  collapse=", "), ",...\n", sep = ""))
 104         } else print(x$node.label)
 105     }
 106     rlab <- if (is.rooted(x)) "Rooted" else "Unrooted"
 107     cat("\n", rlab, "; ", sep="")
 108
 109     blen <- if (is.null(x$edge.length)) "no branch lengths." else
 110     "includes branch lengths."
 111     cat(blen, "\n", sep = "")
 112 }
 113
 114 print.multiPhylo <- function(x, details = FALSE, ...)
 115 {
 116     N <- length(x)
 117     cat(N, "phylogenetic trees\n")
 118     if (details)
 119       for (i in 1:N)
 120         cat("tree", i, ":", length(x[[i]]$tip.label), "tips\n")
 121     cat("\n")
 122 }
 123
 124 "[[.multiPhylo" <- function(x, i)
 125 {
 126     class(x) <- NULL
 127     phy <- x[[i]]
 128     if (!is.null(attr(x, "TipLabel")))
 129         phy$tip.label <- attr(x, "TipLabel")
 130     phy
 131 }
 132
 133 `$.multiPhylo` <- function(x, name) x[[name]]
 134
 135 "[.multiPhylo" <- function(x, i)
 136 {
 137     oc <- oldClass(x)
 138     class(x) <- NULL
 139     structure(x[i], TipLabel = attr(x, "TipLabel"),
 140               class = oc)
 141 }
 142
 143 str.multiPhylo <- function(object, ...)
 144 {
 145     class(object) <- NULL
 146     cat('Class "multiPhylo"\n')
 147     str(object, ...)
 148 }