[Mattice-commits] r87 - in pkg: . R

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

Author: andrew_hipp
Date: 2008-12-15 16:49:31 +0100 (Mon, 15 Dec 2008)
New Revision: 87

Modified:
   pkg/R/batchHansen.R
   pkg/R/ouSim.hansenBatch.R
   pkg/R/ouSimHead.R
   pkg/R/plot.ouSim.R
   pkg/R/regimes.R
   pkg/TODO
Log:
modifications to simulations and plots to make default coloring more straightforward

Modified: pkg/R/batchHansen.R
===================================================================
--- pkg/R/batchHansen.R	2008-12-15 14:39:36 UTC (rev 86)
+++ pkg/R/batchHansen.R	2008-12-15 15:49:31 UTC (rev 87)
@@ -13,11 +13,11 @@
 #  "ouchTrees" = list of OUCH-style trees
 #  "characterStates" = vector of character states, either extracted from an ouch-style tree data.frame or a named vector
 #  REMOVED: "SEM"= standard error of the mean, vector extracted from an ouch-style tree data.frame
-#  "rescale" = factor to multiply against (times / max(times)) -- choose based on trial analyses; set at <= 0 if you don't want to rescale trees
+#  REMOVED: "rescale" = factor to multiply against (times / max(times)) -- choose based on trial analyses; set at <= 0 if you don't want to rescale trees
 #  "cladeMembersList" = list of vectors containing names of the members of each clade (except for the root of the tree)
 #  "brown" = whether to analyse the data under a Brownian motion model
 #  "..." = additional arguments to pass along to hansen
-function(ouchTrees, characterStates, cladeMembersList, filePrefix = NULL, di = NULL, nodeNames = NULL, maxNodes = NULL, regimeTitles = NULL, brown = F, rescale = 1, alpha = 1, sigma = 1, ...) {
+function(ouchTrees, characterStates, cladeMembersList, filePrefix = NULL, di = NULL, nodeNames = NULL, maxNodes = length(cladeMembersList), regimeTitles = NULL, brown = F, ...) {
   ## do all the objects in ouchTrees inherit ouchtree?
   if(is(ouchTrees,'ouchtree')) ouchTrees <- list(ouchTrees)
   treeCheck <- unlist(lapply(ouchTrees, function(x) is(x,'ouchtree')))
@@ -48,6 +48,8 @@
     if(stopFlag) stop("Correct discrepancies between trees and data and try again!")
     }
   if(!identical(di, NULL)) dir.create(di)
+  if(class(try(alpha, silent = T)) == 'try-error') alpha = 1
+  if(class(try(sigma, silent = T)) == 'try-error') sigma = 1
   ar = regimeVectors(ouchTrees, cladeMembersList, maxNodes)
   hansenBatch <- list(length(ouchTrees))
   thetas <- list(length(ouchTrees))

Modified: pkg/R/ouSim.hansenBatch.R
===================================================================
--- pkg/R/ouSim.hansenBatch.R	2008-12-15 14:39:36 UTC (rev 86)
+++ pkg/R/ouSim.hansenBatch.R	2008-12-15 15:49:31 UTC (rev 87)
@@ -24,5 +24,6 @@
   variance <- as.vector(su$sigma.squared)
   tree <- ouchtree(analysis at nodes, analysis at ancestors, analysis at times) 
   outdata <- ouSim.ouchtree(tree, rootState, alpha, variance, theta, ...)
+  outdata$colors <- analysis at regimes[[1]]
   return(outdata)
 }
\ No newline at end of file

Modified: pkg/R/ouSimHead.R
===================================================================
--- pkg/R/ouSimHead.R	2008-12-15 14:39:36 UTC (rev 86)
+++ pkg/R/ouSimHead.R	2008-12-15 15:49:31 UTC (rev 87)
@@ -1,5 +1,9 @@
 ouSim <- function(tree, ...) {
 # right now this is just a switcher, but eventually these should be turned into proper methods of a generic ouSim
+  if(class(try(colors, silent = T)) == 'try-error') {
+    if("colors" %in% names(ouSim)) colors <- ouSim$colors
+    else colors <- rep("black", length(ouSim$branchList))
+    }
   switch(class(tree), 
          phylo = ouSim.phylo(tree, ...), # original function
          ouchtree = ouSim.ouchtree(tree, ...), # completed

Modified: pkg/R/plot.ouSim.R
===================================================================
--- pkg/R/plot.ouSim.R	2008-12-15 14:39:36 UTC (rev 86)
+++ pkg/R/plot.ouSim.R	2008-12-15 15:49:31 UTC (rev 87)
@@ -1,6 +1,10 @@
-plot.ouSimPhylo <- function(ouSim, nodeColor = "blue", nodeDotSize = 1.4, colors = rep("black", length(ouSim$branchList)), ...) {
+plot.ouSimPhylo <- function(ouSim, nodeColor = "blue", nodeDotSize = 1.4, colors = NULL, ...) {
 ## To plot different clades, set the colors vector according to the branches in the original 
 ## only passes the ... along to lines
+  if(identical(colors, NULL)) {
+    if("colors" %in% names(ouSim)) colors <- ouSim$colors
+    else colors <- rep("black", length(ouSim$branchList))
+    }
   branches = length(ouSim$branchList)
   plot(1:ouSim$steps, ylim = range(unlist(ouSim$branchList)), type = "n", ylab = "Trait value", xlab = "Time")
   for(i in 1:branches) lines(ouSim$timesList[[i]], ouSim$branchList[[i]], col = colors[i], ...)

Modified: pkg/R/regimes.R
===================================================================
--- pkg/R/regimes.R	2008-12-15 14:39:36 UTC (rev 86)
+++ pkg/R/regimes.R	2008-12-15 15:49:31 UTC (rev 87)
@@ -48,6 +48,8 @@
   times <- tree at times # class = "numeric"
   ## ------------------ end ouchtree block -------------------
   
+  if(class(regimeShiftNodes) == "list") regimeShiftNodes <- unlist(lapply(regimeShiftNodes, mrcaOUCH, tree = tree))
+  regimeShiftNodes <- unique(c(as.character(tree at root), regimeShiftNodes))
   if(identical(regimeTitles, NULL)) regimeTitles <- as.character(regimeShiftNodes)
   names(regimeTitles) = as.character(regimeShiftNodes)
   colorsVector = character(length(node))
@@ -85,6 +87,8 @@
       
       # 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)
+      colorsVector <- as.factor(colorsVector)
+      names(colorsVector) <- tree at nodes
   return(colorsVector) }
 
 regimeMaker <- function(ouchTrees, regMatrix, nodeMembers) {
@@ -158,7 +162,7 @@
     temp <- c(rep(0, (i-1)), 1)
     remainder <- n - i
     if (maxNodes > 1 && remainder > 0) {
-      nextMat <- regMatRec(remainder, maxNodes - 1)
+      nextMat <- regimeMatrix(remainder, maxNodes - 1)
       temp <- cbind(matrix(temp, dim(nextMat)[1], length(temp), byrow = T), nextMat)
       }
     else temp[(i+1):n] <- rep(0, length((i+1):n))

Modified: pkg/TODO
===================================================================
--- pkg/TODO	2008-12-15 14:39:36 UTC (rev 86)
+++ pkg/TODO	2008-12-15 15:49:31 UTC (rev 87)
@@ -1,9 +1,9 @@
-1. make allPossibleRegimes more efficient when maxNodes < length(nodes)
-2. DROP or AVERAGE: is the k-matrix a sensible statistic? fix it so it works on the revised batchHansen
-3. change paintBranches so that it automatically adds the root and knows what to do if it is handed a list of node vectors instead of a vector of nodes
+1. DONE: make allPossibleRegimes more efficient when maxNodes < length(nodes)
+2. is the k-matrix a sensible statistic? fix it so it works on the revised batchHansen; average weight, or drop it
+3. DONE: change paintBranches so that it automatically adds the root and knows what to do if it is handed a list of node vectors instead of a vector of nodes
 4. make plot.ouSim smart enough to paint the branches according to the theta vector if no colors are provided
 5. make a "simulate" method for a hansenBatch object that simulates the data using model-averaged parameters (including theta)
-6. make paintBranches return a complete regime ready to plug into hansen, and modify calling functions accordingly
+6. DONE: make paintBranches return a complete regime ready to plug into hansen, and modify calling functions accordingly
 7. give plot.ouSim a way to highlight or circle or otherwise set off changeNodes 
 8. make it easy to pass colors into plot.ouSim... the regime should pop out easily
 9. make it possible to pass in a vector of lty or lwd to plot.ouSim so the branches can be different widths or patterns
\ No newline at end of file