Permalink
Browse files

new S3 methods for rerootingMethod & other stuff

  • Loading branch information...
liamrevell committed Nov 10, 2017
1 parent 7ae5d1f commit 1a85188624a5dd8904358c799353fad51f583914
Showing with 52 additions and 6 deletions.
  1. +4 −4 DESCRIPTION
  2. +3 −0 NAMESPACE
  3. +1 −0 R/ancThresh.R
  4. +44 −2 R/rerootingMethod.R
View
@@ -1,6 +1,6 @@
Package: phytools
Version: 0.6-40
Date: 2017-11-09
Version: 0.6-41
Date: 2017-11-10
Title: Phylogenetic Tools for Comparative Biology (and Other Things)
Author: Liam J. Revell
Maintainer: Liam J. Revell <liam.revell@umb.edu>
@@ -56,6 +56,6 @@ Description: Package contains various functions for phylogenetic analysis.
research.
License: GPL (>= 2)
URL: http://github.com/liamrevell/phytools
Packaged: 2017-11-09 12:00:00 EST
Packaged: 2017-11-10 12:00:00 EST
Repository:
Date/Publication: 2017-11-09 12:00:00 EST
Date/Publication: 2017-11-10 12:00:00 EST
View
@@ -118,6 +118,9 @@ S3method(plot, ancThresh)
S3method(print, evol.rate.mcmc)
S3method(print, threshBayes)
S3method(plot, threshBayes)
S3method(print, rerootingMethod)
S3method(plot, rerootingMethod)
S3method(logLik, rerootingMethod)
importFrom(animation, ani.options, ani.record, ani.replay, saveVideo)
importFrom(ape, .PlotPhyloEnv, .uncompressTipLabel, ace, all.equal.phylo, as.DNAbin, as.phylo, bind.tree, branching.times, collapse.singles)
View
@@ -224,6 +224,7 @@ plot.ancThresh<-function(x,...){
cex=tip.cex)
legend(x=par()$usr[1],y=par()$usr[1],legend=x$seq,pch=21,pt.bg=piecol,
pt.cex=2.2,bty="n")
invisible(PP)
}
# plots ancestral states from the threshold model
View
@@ -1,5 +1,5 @@
## function to compute the marginal posterior probabilities for nodes using the rerooting method
## written by Liam J. Revell 2013, 2015
## written by Liam J. Revell 2013, 2015, 2017
rerootingMethod<-function(tree,x,model=c("ER","SYM"),...){
if(!inherits(tree,"phylo"))
@@ -33,5 +33,47 @@ rerootingMethod<-function(tree,x,model=c("ER","SYM"),...){
rownames(XX)<-1:(tree$Nnode+n)
if(tips) rownames(XX)[1:n]<-tree$tip.label
XX<-if(tips) XX else XX[1:tree$Nnode+n,]
return(list(loglik=YY$logLik,Q=Q,marginal.anc=XX))
obj<-list(loglik=YY$logLik,Q=Q,marginal.anc=XX,tree=tree,x=yy)
class(obj)<-"rerootingMethod"
obj
}
print.rerootingMethod<-function(x,digits=6,printlen=NULL,...){
cat("Ancestral character estimates using re-rooting method\nof Yang et al. (1995):\n")
if(is.null(printlen)) print(round(x$marginal.anc,digits)) else {
print(round(x$marginal.anc[1:printlen,],digits))
cat("...\n")
}
cat("\nEstimated transition matrix,\nQ =\n")
print(round(x$Q,digits))
cat("\n**Note that if Q is not symmetric the marginal\nreconstructions may be invalid.\n")
cat(paste("\nLog-likelihood =",round(x$loglik,digits),"\n\n"))
}
plot.rerootingMethod<-function(x, ...){
args<-list(...)
if(is.null(args$lwd)) args$lwd<-1
if(is.null(args$ylim)) args$ylim<-c(-0.1*Ntip(x$tree),Ntip(x$tree))
if(is.null(args$offset)) args$offset<-0.5
if(is.null(args$ftype)) args$ftype="i"
args$tree<-x$tree
do.call(plotTree,args)
if(hasArg(piecol)) piecol<-list(...)$piecol
else piecol<-setNames(colorRampPalette(c("blue",
"yellow"))(ncol(x$marginal.anc)),
colnames(x$marginal.anc))
if(hasArg(node.cex)) node.cex<-list(...)$node.cex
else node.cex<-0.6
nodelabels(pie=x$marginal.anc[
as.character(1:x$tree$Nnode+Ntip(x$tree)),],
piecol=piecol,cex=node.cex)
if(hasArg(tip.cex)) tip.cex<-list(...)$tip.cex
else tip.cex<-0.4
tiplabels(pie=x$x[x$tree$tip.label,],piecol=piecol,
cex=tip.cex)
legend(x=par()$usr[1],y=par()$usr[1],
legend=colnames(x$marginal.anc),
pch=21,pt.bg=piecol,pt.cex=2.2,bty="n")
}
logLik.rerootingMethod<-function(object,...) object$loglik

0 comments on commit 1a85188

Please sign in to comment.