aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKen Kellner <ken@kenkellner.com>2018-08-12 06:24:21 -0400
committerKen Kellner <ken@kenkellner.com>2018-08-12 06:24:21 -0400
commitefbb522a929e8558528f6d9ee73ed9290d4cd24a (patch)
tree8e767a498bf96e3780c43cb1959471f8bc54615b
parent243d9fbd2f337cfe1b9f955eb6b7921473160970 (diff)
Improvement to parameter sorting and don't warn for Rhats not actually calculated
-rw-r--r--R/processoutput.R3
-rw-r--r--R/summarymatrix.R21
2 files changed, 15 insertions, 9 deletions
diff --git a/R/processoutput.R b/R/processoutput.R
index 834f0f3..7463ae7 100644
--- a/R/processoutput.R
+++ b/R/processoutput.R
@@ -136,7 +136,8 @@ calc.stats <- function(i){
nullout <- sapply(params.simple,calc.stats)
#Warn user if at least one Rhat value was NA
-if(NA%in%unlist(rhat)&&verbose){
+rhat.sub <- unlist(rhat)[!is.na(unlist(means))]
+if(NA%in%rhat.sub&&verbose){
options(warn=1)
warning('At least one Rhat value could not be calculated.')
options(warn=0,error=NULL)
diff --git a/R/summarymatrix.R b/R/summarymatrix.R
index 8949d44..1fc3d06 100644
--- a/R/summarymatrix.R
+++ b/R/summarymatrix.R
@@ -4,24 +4,29 @@ summary.matrix <- function(output,samples,n.chains,codaOnly){
hold <- unlist(output$mean[!names(output$mean)%in%codaOnly])
toremove <- which(!is.na(hold))
- #Get rownames
- rnames = c()
- for (i in 1:length(output$sd)){
- if(length(output$sd[[i]])>1){
- raw.ind <- which(!is.na(output$sd[[i]]),arr.ind=T)
+ #Get sorted names
+ sort.names = c()
+ for (i in 1:length(output$mean)){
+ if(length(output$mean[[i]])>1){
+ raw.ind <- which(output$mean[[i]]==output$mean[[i]],arr.ind=T)
if(is.matrix(raw.ind)){
ind <- apply(raw.ind,1,paste,collapse=',')
} else {
ind <- raw.ind
}
- newnames <- paste(names(output$sd)[i],'[',ind,']',sep='')
- rnames <- c(rnames,newnames)
+ newnames <- paste(names(output$mean)[i],'[',ind,']',sep='')
+ sort.names <- c(sort.names,newnames)
} else {
- rnames <- c(rnames,names(output$sd[i]))
+ sort.names <- c(sort.names,names(output$mean[i]))
}
}
+
+
+ rnames <- colnames(samples[[1]])
+ sorted.order <- order(match(rnames,sort.names))
+ rnames <- rnames[sorted.order]
cleanup <- function(input,codaOnly){