[Mattice-commits] r140 - pkg/R

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

Author: andrew_hipp
Date: 2009-01-09 19:57:44 +0100 (Fri, 09 Jan 2009)
New Revision: 140

Modified:
   pkg/R/ouSim.hansenBatch.R
   pkg/R/ouSim.phylo.R
   pkg/R/ouSimHead.R
Log:
ouSim is now a generic function, not a switcher

Modified: pkg/R/ouSim.hansenBatch.R
===================================================================
--- pkg/R/ouSim.hansenBatch.R	2009-01-08 22:55:46 UTC (rev 139)
+++ pkg/R/ouSim.hansenBatch.R	2009-01-09 18:57:44 UTC (rev 140)
@@ -1,30 +1,43 @@
-ouSim.hansenBatch <- function(analysis, tree, treeNum = 1, rootState = NULL, ...) {
+ouSim.hansenSummary <- function(object, tree, treeNum = 1, rootState = NULL, ...) {
 ## runs ouSim.ouchtree for a hansenBatch or hansenSummary object, using the model-averaged alpha, sigma.squared, and theta vector from one tree
-  if(class(analysis) == "hansenBatch") analysis <- summary(analysis)
+  analysis <- object
+  # if(class(analysis) == "hansenBatch") analysis <- summary(analysis)
   if(identical(rootState, NULL)) rootState <- analysis$thetaMatrix[treeNum, ][tree at root] # rootstate taken to be the optimum at the root
   outdata <- ouSim(tree, rootState, alpha = analysis$modelAvgAlpha, variance = analysis$modelAvgSigmaSq, theta = analysis$thetaMatrix[treeNum, ], ...)
   class(outdata) <- "ouSim"
   return(outdata)
 }
 
-ouSim.brownHansen <- function(analysis, ...) {
+ouSim.hansenBatch <- function(object, ...) ouSim(summary(object))
+
+ouSim.hansentree <- function(object, ...) {
+  analysis <- object
   su <- summary(analysis)
   if(length(analysis at regimes) > 1) warning("Theta is based on analysis at regimes[[1]]")
   if(dim(su$alpha)[1] != 1) stop("This is a one-character simulation; analysis appears to be based on > 1 character")
-  if(class(analysis) == "browntree") {
-    alpha <- 0
-    theta <- 0
-    rootState <- su$theta[[1]]
-    }
-  if(class(analysis) == "hansentree") {
-    alpha <- as.vector(su$alpha)
-    theta <- su$optima[[1]][analysis at regimes[[1]]]
-    rootState <- theta[analysis at root] # rootstate taken to be the optimum at the root
-    }
+  alpha <- as.vector(su$alpha)
+  theta <- su$optima[[1]][analysis at regimes[[1]]]
+  rootState <- theta[analysis at root] # rootstate taken to be the optimum at the root
   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]]
   class(outdata) <- "ouSim"
   return(outdata)
+}
+
+ouSim.browntree <- function(object, ...) {
+  analysis <- object
+  su <- summary(analysis)
+  if(length(analysis at regimes) > 1) warning("Theta is based on analysis at regimes[[1]]")
+  if(dim(su$alpha)[1] != 1) stop("This is a one-character simulation; analysis appears to be based on > 1 character")
+  alpha <- 0
+  theta <- 0
+  rootState <- su$theta[[1]]
+  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]]
+  class(outdata) <- "ouSim"
+  return(outdata)
 }
\ No newline at end of file

Modified: pkg/R/ouSim.phylo.R
===================================================================
--- pkg/R/ouSim.phylo.R	2009-01-08 22:55:46 UTC (rev 139)
+++ pkg/R/ouSim.phylo.R	2009-01-09 18:57:44 UTC (rev 140)
@@ -1,4 +1,4 @@
-ouSim.phylo <- function(phy, rootState = 0, shiftBranches = NULL, shiftStates = NULL, alpha = 0, variance = 1, theta = rootState, model = "OU", branchMeans = NULL, steps = 1000) {
+ouSim.phylo <- function(object, rootState = 0, shiftBranches = NULL, shiftStates = NULL, alpha = 0, variance = 1, theta = rootState, model = "OU", branchMeans = NULL, steps = 1000) {
 ## function to plot a simulated dataset under brownian motion or Ornstein-Uhlenbeck (OU) model
 ## Arguments:
 ##   phy is an ape-style tree
@@ -12,7 +12,7 @@
 ## July 2008: modified to accomodate a vector of alpha and theta corresponding to branches
 ## Dec 2008: This function I'm leaving as is for the time being and just letting the phylo method be as raw as always.
 ##           New developments will be in the ouchtree, brown, hansen, and hansenBatch methods
-
+phy <- object
 preorderOU <- function(branchList, phy, startNode, startState, alpha, theta) {
 ## Recursive function to generate the data under a Brownian motion or OU model (not needed in the Platt model)
   startBranch = which(phy$edge[,2] == startNode)

Modified: pkg/R/ouSimHead.R
===================================================================
--- pkg/R/ouSimHead.R	2009-01-08 22:55:46 UTC (rev 139)
+++ pkg/R/ouSimHead.R	2009-01-09 18:57:44 UTC (rev 140)
@@ -1,12 +1 @@
-ouSim <- function(object, ...) {
-# right now this is just a switcher, but eventually these should be turned into proper methods of a generic ouSim
-  switch(class(object), 
-         phylo = ouSim.phylo(object, ...), 
-         ouchtree = ouSim.ouchtree(object, ...), 
-         browntree = ouSim.brownHansen(object, ...), 
-         hansentree = ouSim.brownHansen(object, ...),
-         hansenBatch = ouSim.hansenBatch(object, ...), 
-         hansenSummary = ouSim.hansenBatch(object, ...), 
-         stop("Unrecognized tree class")
-         )
-}
\ No newline at end of file
+ouSim <- function(object, ...) UseMethod('ouSim')
\ No newline at end of file