[Mattice-commits] r50 - pkg/R

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

Author: andrew_hipp
Date: 2008-11-21 16:30:02 +0100 (Fri, 21 Nov 2008)
New Revision: 50

Modified:
   pkg/R/summarizingAnalyses.R
Log:
updating summary.hansenBatch

Modified: pkg/R/summarizingAnalyses.R
===================================================================
--- pkg/R/summarizingAnalyses.R	2008-11-20 21:57:37 UTC (rev 49)
+++ pkg/R/summarizingAnalyses.R	2008-11-21 15:30:02 UTC (rev 50)
@@ -12,40 +12,43 @@
   icObject <- informationCriterion.hansenBatch(hansenBatch)
   matrixRows <- c('aic', 'aicc', 'bic')
   
-  tree <- 1 # for now ignore all but the first tree
+  for(tree in 1:length(hansenBatch$hansens)) {
+    # 1. sum over nodes
+    aicList <- icObject[[tree]]$AICwi
+    aiccList <- icObject[[tree]]$AICcwi
+    bicList <- icObject[[tree]]$BICwi
+    modelsMatrix <- cbind(aicList, aiccList, bicList) # value: modelsMatrix
+    dimnames(modelsMatrix) = list(icObject[[tree]]$names, matrixRows)
   
-  # 1. sum over nodes
-  aicList <- icObject[[tree]]$AICwi
-  aiccList <- icObject[[tree]]$AICcwi
-  bicList <- icObject[[tree]]$BICwi
-  modelsMatrix <- cbind(aicList, aiccList, bicList) # value: modelsMatrix
-  dimnames(modelsMatrix) = list(icObject[[tree]]$names, matrixRows)
-  
-  nonBrownWI <- 1 # defaults to no brownian motion model weights in case none are present
-  if(hansenBatch$brown) {
-    brownWeights <- modelsMatrix['brown', ] # value: brownWeights
-    nonBrownWI <- 1-brownWeights # this is just to make it easy to normalize the non-Brownian OU models
-    }
+    ## the lines below made the weights on branches ignore the fact that the Brownian motion model was part of the
+    ##   model set; however, I've removed them b/c support for the Brownian motion model does (and should) contribute 
+    ##   to reduced probability of change at any of the nodes.
+    
+    # nonBrownWI <- 1 # defaults to no brownian motion model weights in case none are present
+    # if(hansenBatch$brown) {
+    #   brownWeights <- modelsMatrix['brown', ] # value: brownWeights
+    #   nonBrownWI <- 1-brownWeights # this is just to make it easy to normalize the non-Brownian OU models
+    # }
 
-  nodes <- dimnames(hansenBatch$regimeMatrices[[tree]])[[2]]
-  nodeWeightsMatrix <- matrix(NA, nrow = length(matrixRows), ncol = length(nodes), dimnames = list(matrixRows, nodes)) # value: nodeWeightsMatrix
-  for(i in 1:length(nodes)) {
-    modelsMatrixSubset <- modelsMatrix[hansenBatch$regimeMatrices[[tree]][, i] == 1, ]
-    if(identical(dim(modelsMatrixSubset), NULL)) nodeWeightsMatrix[, i] <- modelsMatrixSubset / nonBrownWI # because extracting a single row yields a vector, and dim returns NULL for a vector
-    else nodeWeightsMatrix[, i] <- apply(modelsMatrixSubset, 2, sum) / nonBrownWI
-    }
+    nodes <- dimnames(hansenBatch$regMatrix[[tree]])[[2]]
+    nodeWeightsMatrix <- matrix(NA, nrow = length(matrixRows), ncol = length(nodes), dimnames = list(matrixRows, nodes)) # value: nodeWeightsMatrix
+    for(i in 1:length(nodes)) {
+      modelsMatrixSubset <- modelsMatrix[hansenBatch$regimeMatrices[[tree]][, i] == 1, ]
+      if(identical(dim(modelsMatrixSubset), NULL)) nodeWeightsMatrix[, i] <- modelsMatrixSubset # because extracting a single row yields a vector, and dim returns NULL for a vector
+      else nodeWeightsMatrix[, i] <- apply(modelsMatrixSubset, 2, sum)
+      }
 
-  # 2. sum over number of parameters
+    # 2. sum over number of parameters
   
-  kCats <- sort(unique(hansenBatch$hansens[[tree]][, 'dof']))
-  kMatrix <- matrix(NA, nrow = length(matrixRows), ncol = length(kCats), dimnames = list(matrixRows, as.character(kCats))) #value: kMatrix
-  for(i in as.character(kCats)) {
-    modelsMatrixSubset <- modelsMatrix[hansenBatch$hansens[[tree]][, 'dof'] == i, ]
-    if(identical(dim(modelsMatrixSubset), NULL)) kMatrix[, i] <- modelsMatrixSubset
-    else kMatrix[, i] <- apply(modelsMatrixSubset, 2, sum) 
-    }
-  
-  outdata <- list(brownWeights = brownWeights, modelsMatrix = modelsMatrix, nodeWeightsMatrix = nodeWeightsMatrix, kMatrix = kMatrix)
+    kCats <- sort(unique(hansenBatch$hansens[[tree]][, 'dof']))
+    kMatrix <- matrix(NA, nrow = length(matrixRows), ncol = length(kCats), dimnames = list(matrixRows, as.character(kCats))) #value: kMatrix
+    for(i in as.character(kCats)) {
+      modelsMatrixSubset <- modelsMatrix[hansenBatch$hansens[[tree]][, 'dof'] == i, ]
+      if(identical(dim(modelsMatrixSubset), NULL)) kMatrix[, i] <- modelsMatrixSubset
+      else kMatrix[, i] <- apply(modelsMatrixSubset, 2, sum) 
+      }
+  }
+  outdata <- list(modelsMatrix = modelsMatrix, nodeWeightsMatrix = nodeWeightsMatrix, kMatrix = kMatrix)
   print(brownWeights)
   print(nodeWeightsMatrix)
   return(outdata)