[Mattice-commits] r49 - pkg/R

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

Author: andrew_hipp
Date: 2008-11-20 22:57:37 +0100 (Thu, 20 Nov 2008)
New Revision: 49

Modified:
   pkg/R/informationCriterion.R
Log:
corrected informationCriterion.R so that introduction of NAs doesn't cause an error

Modified: pkg/R/informationCriterion.R
===================================================================
--- pkg/R/informationCriterion.R	2008-11-20 21:47:43 UTC (rev 48)
+++ pkg/R/informationCriterion.R	2008-11-20 21:57:37 UTC (rev 49)
@@ -8,18 +8,18 @@
     AICc[i] <- u[i] + (2 * K[i] * (n / (n - K[i] - 1)))
     AIC[i] <- u[i] + (2 * K[i])
     BIC[i] <- u[i] + (log(n) * K[i]) }
-  deltaAIC <- as.vector(lapply(AIC, function(x, allX) {x - min(allX)}, allX = AIC), mode = "numeric")
-  deltaAICc <- as.vector(lapply(AICc, function(x, allX) {x - min(allX)}, allX = AICc), mode = "numeric")
-  deltaBIC <- as.vector(lapply(BIC, function(x, allX) {x - min(allX)}, allX = BIC), mode = "numeric")
-  AICwi <- as.vector(lapply(deltaAIC, function(x, allDelta) {exp(-0.5 * x) / sum(exp(-0.5 * allDelta))}, allDelta = deltaAIC), mode = "numeric")
-  AICcwi <- as.vector(lapply(deltaAICc, function(x, allDelta) {exp(-0.5 * x) / sum(exp(-0.5 * allDelta))}, allDelta = deltaAICc), mode = "numeric")
-  BICwi <- as.vector(lapply(deltaBIC, function(x, allDelta) {exp(-0.5 * x) / sum(exp(-0.5 * allDelta))}, allDelta = deltaBIC), mode = "numeric")
+  deltaAIC <- as.vector(lapply(AIC, function(x, allX) {x - min(allX, na.rm = T)}, allX = AIC), mode = "numeric")
+  deltaAICc <- as.vector(lapply(AICc, function(x, allX) {x - min(allX, na.rm = T)}, allX = AICc), mode = "numeric")
+  deltaBIC <- as.vector(lapply(BIC, function(x, allX) {x - min(allX, na.rm = T)}, allX = BIC), mode = "numeric")
+  AICwi <- as.vector(lapply(deltaAIC, function(x, allDelta) {exp(-0.5 * x) / sum(exp(-0.5 * allDelta), na.rm = T)}, allDelta = deltaAIC), mode = "numeric")
+  AICcwi <- as.vector(lapply(deltaAICc, function(x, allDelta) {exp(-0.5 * x) / sum(exp(-0.5 * allDelta), na.rm = T)}, allDelta = deltaAICc), mode = "numeric")
+  BICwi <- as.vector(lapply(deltaBIC, function(x, allDelta) {exp(-0.5 * x) / sum(exp(-0.5 * allDelta), na.rm = T)}, allDelta = deltaBIC), mode = "numeric")
   return(list(names = names, u = u, K = K, AIC = AIC, AICc = AICc, BIC = BIC, AICwi = AICwi, AICcwi = AICcwi, BICwi = BICwi)) }
 
 informationCriterion.hansenBatch <- function(hansenBatch) {
 ## call informationCriterion for a 'hansen.batch' object
 ## Just returns AIC, AICc, and BIC weights for each of the trees analyzed in a hansenBatch object
-  outdata <- list(length(hansenBatch$hansens))
+  outdata <- vector("list", length(hansenBatch$hansens))
   N = hansenBatch$N
   for(i in 1:length(outdata)) {
     temp <- hansenBatch$hansens[[i]]