[0f7a81]: R / mcarray.R Maximize Restore History

Download this file

mcarray.R    96 lines (80 with data), 2.6 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
# R package rjags file R/mcarray.R
# Copyright (C) 2007-2009 Martyn Plummer
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version
# 2 as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# A copy of the GNU General Public License is available at
# http://www.r-project.org/Licenses/
#
print.mcarray <- function(x, ...)
{
if (is.null(dim(x)) || is.null(names(dim(x)))) {
NextMethod()
}
print(summary(x, mean))
}
summary.mcarray <- function(object, FUN, ...)
{
if (is.null(dim(object)) || is.null(names(dim(object)))) {
NextMethod()
}
dn <- names(dim(object))
drop.dims <- dn %in% c("iteration","chain")
ans <- list("stat"=apply(object, which(!drop.dims), FUN, ...),
"drop.dims" = dim(object)[drop.dims])
class(ans) <- "summary.mcarray"
return(ans)
}
print.summary.mcarray <- function(x, ...)
{
cat("mcarray:\n")
print(x$stat,...)
if (length(x$drop.dims) > 0) {
cat("\nMarginalizing over:",
paste(paste(names(x$drop.dims), "(", x$drop.dims,")" , sep=""),
collapse=","),"\n")
}
}
as.mcmc.list.mcarray <- function(x, ...)
{
if (is.null(dim(x)) || is.null(names(dim(x)))) {
NextMethod()
}
xdim <- dim(x)
ndim <- length(xdim)
dn <- names(xdim)
which.iter <- which(dn=="iteration")
if (length(which.iter) != 1) {
stop("Bad iteration dimension in mcarray")
}
which.chain <- which(dn=="chain")
if (length(which.chain) > 1) {
stop("Bad chain dimension in mcarray")
}
niter <- xdim[which.iter]
if (length(which.chain) == 0) {
perm <- c((1:ndim)[-which.iter], which.iter)
x <- matrix(aperm(x, perm), nrow=niter, byrow=TRUE)
ans <- mcmc.list(mcmc(x))
}
else {
nchain <- xdim[which.chain]
ans <- vector("list",nchain)
len <- prod(xdim[-which.chain])
perm <- c((1:ndim)[-c(which.iter,which.chain)], which.iter, which.chain)
x <- aperm(x,perm)
for (i in 1:nchain) {
ans[[i]] <- mcmc(matrix(x[1:len + (i-1)*len], nrow=niter,
byrow=TRUE))
}
ans <- mcmc.list(ans)
}
return(ans)
}