[Mattice-commits] r35 - in pkg: R inst
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Nov 17 22:52:57 CET 2008
Author: andrew_hipp
Date: 2008-11-17 22:52:56 +0100 (Mon, 17 Nov 2008)
New Revision: 35
Added:
pkg/inst/license
Removed:
pkg/inst/license.txt
Modified:
pkg/R/batchHansen.R
pkg/R/treeTraversal.R
Log:
revising functions that create regimes and determine whether regime applies to a given tree
Modified: pkg/R/batchHansen.R
===================================================================
--- pkg/R/batchHansen.R 2008-11-17 18:51:53 UTC (rev 34)
+++ pkg/R/batchHansen.R 2008-11-17 21:52:56 UTC (rev 35)
@@ -1,34 +1,20 @@
# ---------------------------------------------------------------------
# FUNCTIONS FOR PERFORMING A SERIES OF OU ANALYSES ON A BATCH OF TREES
# ---------------------------------------------------------------------
-# Copied from functions used in Hipp 2007 Evolution paper
-# *** To run a hansen (OU) analysis, call runBatchHansenFit ***
-# Utilizes ouch v 1.2-4
-# This is the original set of functions utilized in Hipp 2007 (Evolution 61: 2175-2194) as modified
-# for Lumbsch, Hipp et al. 2008 (BMC Evolutionary Biology 8: 257). At the time of uploade to r-forge,
-# they have not been checked for compatibility with subsequent versions of ouch.
-
-## Project details
-## maticce: Mapping Transitions In Continuous Character Evolution
-## full project name: Continuous Character Shifts on Phylogenies
-## unix name: mattice
-## Project page requested from R-forge on 7 november 2008
-
## Changes needed:
-## 1. calls should be to hansen rather than hansen.fit
## 2. measurement error portions need to be fixed
## 3. Analysis should be conducted over multiple trees, summarizing only over trees for which a given node is present;
## node presence should be checked on each tree by looking to see whether the defining group is monophyletic,
## and probably a matrix created for each multiple-tree analysis that makes summarizing quicker.
-## 4. DONE -- Max number of simultaneous nodes should be set
## 5. In a better world, allow graphical selection of subtrees to test on a single tree, then extract defining taxa
## based on those nodes, using locator() or something like it.
-## 6. IT statistics should use informationCriterion or something else to clean up the code
+## to do: make change to deal with phylogenetic uncertainty, by revising how regimeVectors works. Call a new function regimeMatrix once at the outset of the analysis to create a matrix of change nodes (nodes present or absent for each regime), then once for each tree pass that matrix along with the taxa defining the node into a revisedRegime vectors to (1) check which of the nodes are present in the tree and create a new row in a matrix of nodes (columns) by trees (rows), where 1 indicates the node is present in the tree; and (2) make regime vectors for regimes whose nodes are all present in the tree.
+
runBatchHansen <-
# 11 nov 08: renamed to runBatchHansen
-# Runs batchHansenFit and brown.fit over a list of ouchTrees
+# Runs batchHansenFit and brown over a list of ouchTrees
# Arguments:
# "ouchTrees" = list of OUCH-style trees
# "characterStates" = vector of character states, either extracted from an ouch-style tree data.frame or a named vector
@@ -37,7 +23,8 @@
# "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, maxNodes = NULL, regimeTitles = NULL, brown = F, rescale = 1, ...) {
+
+function(ouchTrees, characterStates, cladeMembersList, nodeNames <- NULL, maxNodes = NULL, regimeTitles = NULL, brown = F, rescale = 1, ...) {
## do all the objects in ouchTrees inherit ouchtree?
if(is(ouchTrees,'ouchtree')) ouchTrees <- list(ouchTrees)
treeCheck <- unlist(lapply(ouchTrees, function(x) is(x,'ouchtree')))
@@ -68,9 +55,11 @@
if(stopFlag) stop("Correct discrepancies between trees and data and try again!")
}
+ nnodes <- length(cladeMembersList)
+ regMatrix <- regimeMatrix(nodeNames = ifelse(identical(nodeNames, NULL), seq(nnodes), nodeNames), digits = nnodes) # only make regMatrix once
+ regimeLists <- regimeMaker(ouchTrees = ouchTrees, regMatrix = regMatrix, nodeMembers = cladeMembersList) # new function... get a list of lists
hansenBatch <- list(length(ouchTrees))
- regimeLists <- list(length(ouchTrees))
- regimeMatrices <- list(length(ouchTrees))
+ # regimeMatrices <- list(length(ouchTrees))
for (i in 1:length(ouchTrees)) {
tree <- ouchTrees[[i]]
rl = regimeVectors(tree, cladeMembersList, maxNodes)
Modified: pkg/R/treeTraversal.R
===================================================================
--- pkg/R/treeTraversal.R 2008-11-17 18:51:53 UTC (rev 34)
+++ pkg/R/treeTraversal.R 2008-11-17 21:52:56 UTC (rev 35)
@@ -215,7 +215,53 @@
# }
outdata <- list(regimeList = outlist, regimeMatrix = outmatrix)
return(outdata) }
+
+regimeMaker <- function(ouchTrees, regMatrix, nodeMembers) {
+## supplants the old 'allPossibleRegimes'
+## Value:
+## regList = a list of regimes for each tree (i.e., a list of lists)
+## nodeMatrix = a matrix of trees (rows) by nodes (columns) indicating whether the node is present in each tree
+ nodeMatrix <- lapply(isMonophyletic
+
+}
+
+regimeMatrix <- function(n = NULL, nodeNames = NULL, regimeNames = NULL, maxNodes = NULL) {
+ if(identical(n, NULL) && identical(nodeNames, NULL)) stop("You have to give regimeMatrix the number of nodes, a vector of node names, or both")
+ if(identical(nodeNames, NULL)) nodeNames <- as.character(seq(n))
+ else n <- length(nodeNames)
+ numberOfRegimes <- ifelse(n == 1, 2, 2^n)
+ outmatrix <- matrix(NA, nrow = numberOfRegimes, ncol = n, dimnames = list(regimeNames, nodeNames))
+ for(i in 1:(numberOfRegimes - 1)) outmatrix[i, ] <- as.binary(i, digits = n)
+ outmatrix[numberOfRegimes, ] <- as.binary(0, digits = n)
+ if(!identical(maxNodes, NULL)) {
+ outmatrix <- outmatrix[apply(outmatrix,1,sum) <= maxNodes, ]
+ dimnames(outmatrix)[[1]] = as.character(seq(dim(outmatrix)[1]))
+ }
+ return(outmatrix)
+}
+
+as.binary <- function(n, base = 2, r = FALSE, digits = NULL)
+# Robin Hankin <initialDOTsurname at soc.soton.ac.uk (edit in obvious way; spam precaution)>
+# submitted to R listserv Thu Apr 15 12:27:39 CEST 2004
+# AH added 'digits' to make it work with regimeMatrix
+# https://stat.ethz.ch/pipermail/r-help/2004-April/049419.html
+
+{
+ out <- NULL
+ while(n > 0) {
+ if(r) {
+ out <- c(out , n%%base)
+ } else {
+ out <- c(n%%base , out)
+ }
+ n <- n %/% base
+ }
+ if(!identical(digits, NULL) && !r) out <- c(rep(0, digits-length(out)), out)
+ if(!identical(digits, NULL) && r) out <- c(out, rep(0, digits-length(out)))
+ return(out)
+}
+
regimeVectors <-
# Generates the list of painted branches representing all possible selective regimes for OU analyses, taking as argument
# species vectors that describe the clades at the bases of which regimes are specified to change.
Copied: pkg/inst/license (from rev 33, pkg/inst/license.txt)
===================================================================
--- pkg/inst/license (rev 0)
+++ pkg/inst/license 2008-11-17 21:52:56 UTC (rev 35)
@@ -0,0 +1,3 @@
+This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
+This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+You should have received a copy of the GNU General Public License along with this program. If not, see <http://www.gnu.org/licenses/>.
\ No newline at end of file
Property changes on: pkg/inst/license
___________________________________________________________________
Name: svn:mergeinfo
+
Deleted: pkg/inst/license.txt
===================================================================
--- pkg/inst/license.txt 2008-11-17 18:51:53 UTC (rev 34)
+++ pkg/inst/license.txt 2008-11-17 21:52:56 UTC (rev 35)
@@ -1,3 +0,0 @@
-This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
-This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
-You should have received a copy of the GNU General Public License along with this program. If not, see <http://www.gnu.org/licenses/>.
\ No newline at end of file
More information about the Mattice-commits
mailing list