From 26508a910e3824b954712caf0a39fb2b8c948921 Mon Sep 17 00:00:00 2001
From: "Joseph W. Brown" <phylo.jwb@gmail.com>
Date: Fri, 23 Apr 2021 14:17:32 -0400
Subject: [PATCH] allow adding a tip "above" root

Allow adding an outgroup tip which diverged before the ingroup MRCA.the `ape::bind.tree` function which `bind.tip` wraps allows this, but the tree to which the tip is added ("x") must have a `root.edge`. The code submitted here does the necessary edits so that `bind.tree` does what is requested with no more arguments required from the user.
---
 R/utilities.R | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

diff --git a/R/utilities.R b/R/utilities.R
index 795a9099..b3f39308 100644
--- a/R/utilities.R
+++ b/R/utilities.R
@@ -1695,7 +1695,13 @@ bind.tip<-function(tree,tip.label,edge.length=NULL,where=NULL,position=0,interac
 	} else pp<-position
 	if(is.null(edge.length)&&is.ultrametric(tree)){
 		H<-nodeHeights(tree)
-		if(where==(Ntip(tree)+1)) edge.length<-max(H)
+		if(where==(Ntip(tree)+1)){
+			edge.length<-max(H)
+			# if adding tip as outgroup that diverged before ingroup MRCA, need to take into account new root height
+			if(position>0){
+				edge.length<-edge.length+position
+			}
+		}
 		else edge.length<-max(H)-H[tree$edge[,2]==where,2]+position
 	}
 	tip<-list(edge=matrix(c(2,1),1,2),
@@ -1703,6 +1709,14 @@ bind.tip<-function(tree,tip.label,edge.length=NULL,where=NULL,position=0,interac
 		edge.length=edge.length,
 		Nnode=1)
 		class(tip)<-"phylo"
+	# if attaching tip creates new root, add root edge to attach to
+	if(where==(Ntip(tree)+1)&&position>0){
+		if(is.null(tree$root.edge)){
+			tree$root.edge<-position
+			pp<-position
+			where<-"root"
+		}
+	}
 	obj<-bind.tree(tree,tip,where=where,position=pp)
 	if(where<=Ntip(tree)&&position==0){
 		nn<-obj$edge[which(obj$edge[,2]==which(obj$tip.label==tip$tip.label)),1]