[Caic-commits] r85 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Dec 9 12:54:38 CET 2008
Author: davidorme
Date: 2008-12-09 12:54:38 +0100 (Tue, 09 Dec 2008)
New Revision: 85
Modified:
pkg/DESCRIPTION
pkg/R/brunch.R
pkg/R/contrCalc.R
pkg/R/crunch.R
Log:
Moved node depth calculation in crunch/brunch from a separate and expensive node2tip call to use the tree traversal in contrCalc
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2008-10-31 11:34:45 UTC (rev 84)
+++ pkg/DESCRIPTION 2008-12-09 11:54:38 UTC (rev 85)
@@ -1,7 +1,7 @@
Package: CAIC
Type: Package
Title: Comparative Analyses using Independent Contrasts
-Version: 1.0.4-83
+Version: 1.0.4-85
Date: 2008-10-01
Author: David Orme, Rob Freckleton, Gavin Thomas
Maintainer: David Orme <d.orme at imperial.ac.uk>
Modified: pkg/R/brunch.R
===================================================================
--- pkg/R/brunch.R 2008-10-31 11:34:45 UTC (rev 84)
+++ pkg/R/brunch.R 2008-12-09 11:54:38 UTC (rev 85)
@@ -190,20 +190,23 @@
ContrObj$nodalVals$explanatory <- contr$nodVal[as.numeric(rownames(contr$nodVal)) >= root,-1,drop=FALSE]
ContrObj$contrVar <- contr$var.contr
ContrObj$nChild <- contr$nChild
+ ContrObj$nodeDepth <- contr$nodeDepth[as.numeric(names(contr$nodeDepth)) >= root]
+ ## THE NEXT SECTION WAS FAR TOO SLOW AND FAR TOO MEMORY HUNGRY WITH BIG TREES
+ ## - NODE DEPTH CALCULATIONS (FILTERING NODES WHERE NO CONTRASTS ARE CALCULATED)
+ ## ARE NOW WRITTEN INTO THE TREE TRAVERSAL OF contrCalc SO SHOULD BE FAR MORE EFFICIENT!
- # get the node depth using the tree for which we have complete data
- # and then match those nodes up against the analysis tree
- tipsWithNAdata <- tipLabs[! complete.cases(mf)]
- if(length(tipsWithNAdata) > 0){
- compPhy <- drop.tip(analysisPhy, tipsWithNAdata)
- } else { compPhy <- analysisPhy }
+ ## # get the node depth using the tree for which we have complete data
+ ## # and then match those nodes up against the analysis tree
+ ## tipsWithNAdata <- tipLabs[! complete.cases(mf)]
+ ## if(length(tipsWithNAdata) > 0){
+ ## compPhy <- drop.tip(analysisPhy, tipsWithNAdata)
+ ## } else { compPhy <- analysisPhy }
-
- nd <- node2tip(compPhy) # slow because it uses clade matrix
- names(nd) <- with( compPhy, c(tip.label, node.label))
- nd <- nd[match(analysisPhy$node.label, names(nd))]
- ContrObj$nodeDepth <- nd
+ ## nd <- node2tip(compPhy) # slow because it uses clade matrix
+ ## names(nd) <- with( compPhy, c(tip.label, node.label))
+ ## nd <- nd[match(analysisPhy$node.label, names(nd))]
+ ## ContrObj$nodeDepth <- nd
# gather the row ids of NA nodes to drop from the model
validNodes <- with(ContrObj$contr, complete.cases(explanatory) & complete.cases(response))
Modified: pkg/R/contrCalc.R
===================================================================
--- pkg/R/contrCalc.R 2008-10-31 11:34:45 UTC (rev 84)
+++ pkg/R/contrCalc.R 2008-12-09 11:54:38 UTC (rev 85)
@@ -18,13 +18,20 @@
# DESIGN THOUGHTS - simpler to maintain with a single function for each type of contrast
# - create an initialize function to do these shared first steps?
+ # 13/12/08 - added code to keep track of node depth. Cheap to do whilst traversing the tree for contrasts
+ # and avoids having to use the currently rather expensive node2tip (uses clade.matrix)
+
Root <- with(phy, (max(edge)-Nnode)+1)
IntNd <- Root:max(phy$edge)
nIntNd <- phy$Nnode
contrMat <- matrix(NA, ncol=dim(vals)[2], nrow=nIntNd, dimnames=list(IntNd, dimnames(vals)[[2]]))
nodVal <- rbind(vals, contrMat)
-
+
+ # node depth vector
+ nodeDepth <- rep(c(1,NA), times=c(length(phy$tip.label), nIntNd))
+ names(nodeDepth) <- rownames(nodVal)
+
# vector of number of children and variance used in calculation
nChild <- numeric(nIntNd)
names(nChild) <- IntNd
@@ -316,9 +323,16 @@
parInd <- with(phy, match(parent, edge[,2]))
if(! parent == Root){
phy$edge.length[parInd] <- phy$edge.length[parInd] + currBlAdj}
+
+ # track the node depth of nodes with contrasts
+ if(sum(compChild) < 2){ # i.e. a node with data for one tip being passed through or with no data
+ nodeDepth[parent] <- max(nodeDepth[children])
+ } else { # a contrast has been calculated and this node has a greater depth
+ nodeDepth[parent] <- max(nodeDepth[children]) + 1
+ }
}
- RET <- list(contrMat=contrMat, nodVal=nodVal, var.contr=contrVar, nChild=nChild)
+ RET <- list(contrMat=contrMat, nodVal=nodVal, var.contr=contrVar, nChild=nChild, nodeDepth=nodeDepth)
attr(RET, "contr.type") <- picMethod
return(RET)
Modified: pkg/R/crunch.R
===================================================================
--- pkg/R/crunch.R 2008-10-31 11:34:45 UTC (rev 84)
+++ pkg/R/crunch.R 2008-12-09 11:54:38 UTC (rev 85)
@@ -183,21 +183,25 @@
ContrObj$nodalVals$explanatory <- contr$nodVal[as.numeric(rownames(contr$nodVal)) >= root,-1,drop=FALSE]
ContrObj$contrVar <- contr$var.contr
ContrObj$nChild <- contr$nChild
+ ContrObj$nodeDepth <- contr$nodeDepth[as.numeric(names(contr$nodeDepth)) >= root]
+ ## THE NEXT SECTION WAS FAR TOO SLOW AND FAR TOO MEMORY HUNGRY WITH BIG TREES
+ ## - NODE DEPTH CALCULATIONS (FILTERING NODES WHERE NO CONTRASTS ARE CALCULATED)
+ ## ARE NOW WRITTEN INTO THE TREE TRAVERSAL OF contrCalc SO SHOULD BE FAR MORE EFFICIENT!
- # get the node depth using the tree for which we have complete data
- # and then match those nodes up against the analysis tree
- tipsWithNAdata <- tipLabs[! complete.cases(mf)]
- if(length(tipsWithNAdata) > 0){
- compPhy <- drop.tip(analysisPhy, tipsWithNAdata)
- } else { compPhy <- analysisPhy }
+ ## # get the node depth using the tree for which we have complete data
+ ## # and then match those nodes up against the analysis tree
+ ## tipsWithNAdata <- tipLabs[! complete.cases(mf)]
+ ## if(length(tipsWithNAdata) > 0){
+ ## compPhy <- drop.tip(analysisPhy, tipsWithNAdata)
+ ## } else { compPhy <- analysisPhy }
-
- nd <- node2tip(compPhy) # slow because it uses clade matrix
- names(nd) <- with( compPhy, c(tip.label, node.label))
- nd <- nd[match(analysisPhy$node.label, names(nd))]
- ContrObj$nodeDepth <- nd
+ ## nd <- node2tip(compPhy) # slow because it uses clade matrix
+ ## names(nd) <- with( compPhy, c(tip.label, node.label))
+ ## nd <- nd[match(analysisPhy$node.label, names(nd))]
+ ## ContrObj$nodeDepth <- nd
+
# gather the row ids of NA nodes to drop from the model
validNodes <- with(ContrObj$contr, complete.cases(explanatory) & complete.cases(response))
More information about the Caic-commits
mailing list