Description Usage Arguments Examples
Note: w is defined on the transformed scale, but for convenience
f
is defined on the original scale.
1 2 3 4 5 6 7 8 9 10 |
f |
function used to derive the weight function w.
|
init |
initial guess for mode of |
dim.theta2 |
|
approx |
Style of approximation (i.e., w) to be created from mode
of
|
link |
character vector that specifies transformations used during
optimization and integration of f(θ_2 | X). While
θ_2 may be defined on arbitrary support, |
link.params |
Optional list of additional parameters for link functions. For example, the logit function can be extended to allow mappings to any closed interval. There should be one list entry for each link function. Specify NA if no additional arguments are passed. |
optim.control |
List of arguments to pass to
|
... |
additional arguments needed for function evaluation. |
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 | # Use BISQuE to approximate the marginal posterior distribution for unknown
# population f(N|c, r) for the fur seals capture-recapture data example in
# Givens and Hoeting (2013), example 7.10.
data('furseals')
# define theta transformation and jacobian
tx.theta = function(theta) {
c(log(theta[1]/theta[2]), log(sum(theta[1:2])))
}
itx.theta = function(u) {
c(exp(sum(u[1:2])), exp(u[2])) / (1 + exp(u[1]))
}
lJ.tx.theta = function(u) {
log(exp(u[1] + 2*u[2]) + exp(2*sum(u[1:2]))) - 3 * log(1 + exp(u[1]))
}
# compute constants
r = sum(furseals$m)
nC = nrow(furseals)
# set basic initialization for parameters
init = list(U = c(-.7, 5.5))
init = c(init, list(
alpha = rep(.5, nC),
theta = itx.theta(init$U),
N = r + 1
))
post.alpha_theta = function(theta2, log = TRUE, ...) {
# Function proportional to f(alpha, U1, U2 | c, r)
alpha = theta2[1:nC]
u = theta2[-(1:nC)]
theta = itx.theta(u)
p = 1 - prod(1-alpha)
res = - sum(theta)/1e3 - r * log(p) + lJ.tx.theta(u) -
nC * lbeta(theta[1], theta[2])
for(i in 1:nC) {
res = res + (theta[1] + furseals$c[i] - 1)*log(alpha[i]) +
(theta[2] + r - furseals$c[i] - 1)*log(1-alpha[i])
}
if(log) { res } else { exp(res) }
}
post.N.mixtures = function(N, params, log = TRUE, ...) {
# The mixture component of the weighted mixtures for f(N | c, r)
dnbinom(x = N-r, size = r, prob = params, log = log)
}
mixparams.N = function(theta2, ...) {
# compute parameters for post.N.mixtures
1 - prod(1 - theta2[1:nC])
}
w.N = wBuild(f = post.alpha_theta, init = c(init$alpha, init$U),
approx = 'gauss', link = c(rep('logit', nC), rep('identity', 2)))
m.N = wMix(f1 = post.N.mixtures, f1.precompute = mixparams.N,
f2 = post.alpha_theta, w = w.N)
# compute posterior mean
m.N$expectation$Eh.precompute(h = function(p) ((1-p)*r/p + r),
quadError = TRUE)
# compute posterior density
post.N.dens = data.frame(N = r:105)
post.N.dens$d = m.N$f(post.N.dens$N)
# plot posterior density
plot(d~N, post.N.dens, ylab = expression(f(N~'|'~bold(c),r)))
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.