diff options
author | Ken Kellner <ken@kenkellner.com> | 2018-08-12 06:24:21 -0400 |
---|---|---|
committer | Ken Kellner <ken@kenkellner.com> | 2018-08-12 06:24:21 -0400 |
commit | efbb522a929e8558528f6d9ee73ed9290d4cd24a (patch) | |
tree | 8e767a498bf96e3780c43cb1959471f8bc54615b | |
parent | 243d9fbd2f337cfe1b9f955eb6b7921473160970 (diff) |
Improvement to parameter sorting and don't warn for Rhats not actually calculated
-rw-r--r-- | R/processoutput.R | 3 | ||||
-rw-r--r-- | R/summarymatrix.R | 21 |
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){ |