[Mattice-commits] r174 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 24 07:27:27 CET 2009
Author: andrew_hipp
Date: 2009-02-24 07:27:27 +0100 (Tue, 24 Feb 2009)
New Revision: 174
Modified:
pkg/R/batchHansen.R
pkg/R/informationCriterion.R
pkg/R/multiModel.R
pkg/R/regimes.R
pkg/R/summarizingAnalyses.R
Log:
changing T to TRUE throughout
Modified: pkg/R/batchHansen.R
===================================================================
--- pkg/R/batchHansen.R 2009-02-24 06:19:14 UTC (rev 173)
+++ pkg/R/batchHansen.R 2009-02-24 06:27:27 UTC (rev 174)
@@ -41,15 +41,15 @@
message("Data assumed to be in the same order as nodes;\nany data not associated with a terminal branch will be ignored")
dataFlag <- 'sameOrderNodes'
}
- if(identical(dataFlag, NULL)) stopFlag <- T
+ if(identical(dataFlag, NULL)) stopFlag <- TRUE
message("-------------------\n")
}
else dataFlag <- 'named'
if(stopFlag) stop("Correct discrepancies between trees and data and try again!")
}
if(!identical(di, NULL)) dir.create(di)
- if(class(try(alpha, silent = T)) == 'try-error') alpha = 1
- if(class(try(sigma, silent = T)) == 'try-error') sigma = 1
+ if(class(try(alpha, silent = TRUE)) == 'try-error') alpha = 1
+ if(class(try(sigma, silent = TRUE)) == 'try-error') sigma = 1
ar = regimeVectors(ouchTrees, cladeMembersList, maxNodes)
hansenBatch <- list(length(ouchTrees))
thetas <- list(length(ouchTrees))
Modified: pkg/R/informationCriterion.R
===================================================================
--- pkg/R/informationCriterion.R 2009-02-24 06:19:14 UTC (rev 173)
+++ pkg/R/informationCriterion.R 2009-02-24 06:27:27 UTC (rev 174)
@@ -9,12 +9,12 @@
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, 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")
+ deltaAIC <- as.vector(lapply(AIC, function(x, allX) {x - min(allX, na.rm = TRUE)}, allX = AIC), mode = "numeric")
+ deltaAICc <- as.vector(lapply(AICc, function(x, allX) {x - min(allX, na.rm = TRUE)}, allX = AICc), mode = "numeric")
+ deltaBIC <- as.vector(lapply(BIC, function(x, allX) {x - min(allX, na.rm = TRUE)}, allX = BIC), mode = "numeric")
+ AICwi <- as.vector(lapply(deltaAIC, function(x, allDelta) {exp(-0.5 * x) / sum(exp(-0.5 * allDelta), na.rm = TRUE)}, allDelta = deltaAIC), mode = "numeric")
+ AICcwi <- as.vector(lapply(deltaAICc, function(x, allDelta) {exp(-0.5 * x) / sum(exp(-0.5 * allDelta), na.rm = TRUE)}, allDelta = deltaAICc), mode = "numeric")
+ BICwi <- as.vector(lapply(deltaBIC, function(x, allDelta) {exp(-0.5 * x) / sum(exp(-0.5 * allDelta), na.rm = TRUE)}, allDelta = deltaBIC), mode = "numeric")
outdata <- list(names = names, u = u, K = K, AIC = AIC, AICc = AICc, BIC = BIC, AICwi = AICwi, AICcwi = AICcwi, BICwi = BICwi)
class(outdata) <- 'informationCriterion'
return(outdata)
Modified: pkg/R/multiModel.R
===================================================================
--- pkg/R/multiModel.R 2009-02-24 06:19:14 UTC (rev 173)
+++ pkg/R/multiModel.R 2009-02-24 06:27:27 UTC (rev 174)
@@ -21,7 +21,7 @@
outMatrix <- matrix(NA, nrow = length(modelsAll), ncol = length(paramHeader), dimnames = list(modelsAll, paramHeader))
compareK <- rep(NA, length(models)); names(compareK) <- models
comparelnL <- rep(NA, length(models)); names(comparelnL) <- models
- modelsSplit <- strsplit(models, ".", fixed = T)
+ modelsSplit <- strsplit(models, ".", fixed = TRUE)
for(i in modelsSplit) {
model <- paste(i[1], ".", i[2], sep = "")
Modified: pkg/R/regimes.R
===================================================================
--- pkg/R/regimes.R 2009-02-24 06:19:14 UTC (rev 173)
+++ pkg/R/regimes.R 2009-02-24 06:27:27 UTC (rev 174)
@@ -111,7 +111,7 @@
for(i in seq(numNodes)) nodeMatrix[, i] <- unlist(lapply(ouchTrees, isMonophyletic, taxa = nodeMembers[[i]]))
for(i in seq(numTrees)) {
tree <- ouchTrees[[i]]
- regMatrices[[i]] <- regMatrix * as.numeric(matrix(nodeMatrix[i, ], dim(regMatrix)[1], dim(regMatrix)[2], byrow = T)) # multiplies regMatrix by nodes present
+ regMatrices[[i]] <- regMatrix * as.numeric(matrix(nodeMatrix[i, ], dim(regMatrix)[1], dim(regMatrix)[2], byrow = TRUE)) # multiplies regMatrix by nodes present
regMatrices[[i]][1:(dim(regMatrices[[i]])[1] - 1), ][which(apply(regMatrices[[i]][1:(dim(regMatrices[[i]])[1] - 1), ], 1, sum) == 0), ] <- rep(NA, numNodes) # set to NA regimes that have no nodes, except for OU1 model
regMatrices[[i]][duplicated(apply(regMatrices[[i]], 1, as.decimal)), ] <- rep(NA, numNodes) ## set to NA non-unique regimes
dimnames(regMatrices[[i]]) <- list(seq(dim(regMatrices[[i]])[1]), dimnames(regMatrices[[i]])[[2]])
@@ -163,7 +163,7 @@
remainder <- n - i
if (maxNodes > 1 && remainder > 0) {
nextMat <- regimeMatrix(remainder, maxNodes - 1)
- temp <- cbind(matrix(temp, dim(nextMat)[1], length(temp), byrow = T), nextMat)
+ temp <- cbind(matrix(temp, dim(nextMat)[1], length(temp), byrow = TRUE), nextMat)
}
else temp[(i+1):n] <- rep(0, length((i+1):n))
outmat <- rbind(outmat, temp)
Modified: pkg/R/summarizingAnalyses.R
===================================================================
--- pkg/R/summarizingAnalyses.R 2009-02-24 06:19:14 UTC (rev 173)
+++ pkg/R/summarizingAnalyses.R 2009-02-24 06:27:27 UTC (rev 174)
@@ -28,24 +28,24 @@
modelsMatrixSubset <- modelsMatrix[[tree]][hansenBatch$regMatrix$overall[, nodes[i]] == 1, ] # subset models that contain node i
if(identical(dim(modelsMatrixSubset), NULL)) # is modelsMatrixSubset a 1-d vector? if so then:
nodeWeightsSummed[, nodes[i]] <- nodeWeightsSummed[, nodes[i]] + replace.matrix(modelsMatrixSubset, NA, 0) # because extracting a single row yields a vector, and dim returns NULL for a vector
- else nodeWeightsSummed[, nodes[i]] <- nodeWeightsSummed[, nodes[i]] + colSums(modelsMatrixSubset, na.rm = T)
+ else nodeWeightsSummed[, nodes[i]] <- nodeWeightsSummed[, nodes[i]] + colSums(modelsMatrixSubset, na.rm = TRUE)
}
- sigmaSqVector[tree] <- weighted.mean(hansenBatch$hansens[[tree]][, 'sigma.squared'], bic, na.rm = T)
+ sigmaSqVector[tree] <- weighted.mean(hansenBatch$hansens[[tree]][, 'sigma.squared'], bic, na.rm = TRUE)
if(hansenBatch$brown) bicOU <- bic[1: (length(bic) - 1)]
alphaVector[tree] <- ifelse(hansenBatch$brown,
- weighted.mean(hansenBatch$hansens[[tree]][1:(nmodels - 1), 'theta / alpha'], bicOU, na.rm = T),
- weighted.mean(hansenBatch$hansens[[tree]][ , 'theta / alpha'], bic, na.rm = T)
+ weighted.mean(hansenBatch$hansens[[tree]][1:(nmodels - 1), 'theta / alpha'], bicOU, na.rm = TRUE),
+ weighted.mean(hansenBatch$hansens[[tree]][ , 'theta / alpha'], bic, na.rm = TRUE)
)
if(hansenBatch$brown) w <- bicOU else w <- bic
thetaMatrix[tree, ] <- apply(hansenBatch$thetas[[tree]], 2,
weighted.mean,
w = w,
- na.rm = T
+ na.rm = TRUE
)
}
# in this matrix, the weight for each node is averaged only over trees that possess that node
- nodeWeightsMatrix.unnormalized <- nodeWeightsSummed / matrix(nodeSums, nrow = dim(nodeWeightsSummed)[1], ncol = nnodes, byrow = T)
+ nodeWeightsMatrix.unnormalized <- nodeWeightsSummed / matrix(nodeSums, nrow = dim(nodeWeightsSummed)[1], ncol = nnodes, byrow = TRUE)
# in this matrix, the weight for each node is averaged over all trees
nodeWeightsMatrix.allNodes <- nodeWeightsSummed / ntrees
@@ -62,8 +62,8 @@
# if(identical(dim(modelsMatrixSubset), NULL)) kMatrix[, i] <- modelsMatrixSubset # is modelsMatrixSubset a 1-d vector?
# else kMatrix[, i] <- apply(modelsMatrixSubset, 2, sum)
#}
- modelAvgAlpha <- mean(alphaVector, na.rm = T)
- modelAvgSigmaSq <- mean(sigmaSqVector, na.rm = T)
+ modelAvgAlpha <- mean(alphaVector, na.rm = TRUE)
+ modelAvgSigmaSq <- mean(sigmaSqVector, na.rm = TRUE)
outdata <- list(modelsMatrix = modelsMatrix, nodeWeightsMatrix = list(unnormalized = nodeWeightsMatrix.unnormalized, allNodes = nodeWeightsMatrix.allNodes), modelAvgAlpha = modelAvgAlpha, modelAvgSigmaSq = modelAvgSigmaSq, thetaMatrix = thetaMatrix)
class(outdata) <- 'hansenSummary'
return(outdata)
More information about the Mattice-commits
mailing list