[Mattice-commits] r55 - pkg/R

[noreply at r-forge.r-project.org]

Author: andrew_hipp
Date: 2008-11-25 00:26:58 +0100 (Tue, 25 Nov 2008)
New Revision: 55

Modified:
   pkg/R/regimes.R
   pkg/R/treeTraversal.R
Log:
corrections to regimes.R and treeTraversal.R to allow designation of terminal branches by a single species

Modified: pkg/R/regimes.R
===================================================================
--- pkg/R/regimes.R	2008-11-24 20:00:09 UTC (rev 54)
+++ pkg/R/regimes.R	2008-11-24 23:26:58 UTC (rev 55)
@@ -74,7 +74,7 @@
       if (colorsVector[as.integer(ancestor[ii])] != "") {
         colorsVector[ii] = colorsVector[as.integer(ancestor[ii])]
         break} }
-
+    
     for(j in nodeQ) {
       colorsVector[j] = colorsVector[as.integer(ancestor[j])] } 
       
@@ -82,6 +82,9 @@
 
       # a little hack to fix a problem I don't understand... with the undesired side effect that it colors the stem of some subtrees rather than the crown as originally written
       for(i in 1:length(colorsVector)) if(colorsVector[i] == "") colorsVector[i] <- as.character(i) 
+      
+      # colors terminal branches if any terminal branches are in the regimeShiftNodes
+      for(i in regimeShiftNodes) if(i %in% tree at term) colorsVector[as.numeric(i)] <- as.character(i)
   return(colorsVector) }
 
 regimeMaker <- function(ouchTrees, regMatrix, nodeMembers) {

Modified: pkg/R/treeTraversal.R
===================================================================
--- pkg/R/treeTraversal.R	2008-11-24 20:00:09 UTC (rev 54)
+++ pkg/R/treeTraversal.R	2008-11-24 23:26:58 UTC (rev 55)
@@ -21,7 +21,8 @@
 
 isMonophyletic <- function(tree, taxa) {
 # returns T or F on whether a group of taxa is monophyletic in an ouch tree
-  identical(sort(taxa), sort(nodeDescendents(tree, mrcaOUCH(taxa, tree))))
+  if(length(taxa) == 1) return(taxa %in% tree at nodelabels[tree at term])
+  else(return(identical(sort(taxa), sort(nodeDescendents(tree, mrcaOUCH(taxa, tree))))))
 }
 
 nodeDescendents <- function(tree, startNode) {
@@ -59,17 +60,21 @@
   times <- tree at times # class = "numeric"
   ## ------------------ end ouchtree block -------------------
   
-  tips = match(cladeVector, species) 
-  listOfAncestorLines = lapply(tips, ancestorLine, tree = tree) # 10 nov 08: this is identical to the appropriate subset of tree at lineages
-  latestMatch = listOfAncestorLines[[1]]
-  for (i in listOfAncestorLines) {
-    latestMatch = i[match(latestMatch, i, nomatch = 0)] }
-  timesVector = times[as.integer(latestMatch)]
-  if(length(timesVector) == 1) {
-    if (is.na(timesVector)) mrca = "1"
-      else mrca = timesVector}
-    else mrca = latestMatch[match(max(as.double(timesVector), na.rm = TRUE), timesVector)]
-  return(mrca) }
+  if(length(cladeVector) == 1) return(tree at nodes[tree at nodelabels == cladeVector])
+  else {
+    tips = match(cladeVector, species) 
+    listOfAncestorLines = lapply(tips, ancestorLine, tree = tree) # 10 nov 08: this is identical to the appropriate subset of tree at lineages
+    latestMatch = listOfAncestorLines[[1]]
+    for (i in listOfAncestorLines) {
+      latestMatch = i[match(latestMatch, i, nomatch = 0)] }
+    timesVector = times[as.integer(latestMatch)]
+    if(length(timesVector) == 1) {
+      if (is.na(timesVector)) mrca = "1"
+        else mrca = timesVector}
+      else mrca = latestMatch[match(max(as.double(timesVector), na.rm = TRUE), timesVector)]
+    return(mrca) 
+  }
+}
 
 ancestorLine <-
 # Creates a vector of ancestral nodes for a tip