Description Usage Arguments Value Note Author(s) See Also Examples
Vectorized, single-parameter base log-likelihood functions for geometric GLM using logit link function. The base function(s) can be supplied to the expander function regfac.expand.1par
in order to obtain the full, high-dimensional log-likleihood and its derivatives.
1 | fbase1.geometric.logit(u, y, fgh=2)
|
u |
Varying parameter of the base log-likelihood function. This parameter is intended to be projected onto a high-dimensional space using the familiar regression transformation of |
y |
Fixed slot of the base distribution, corresponding to the response variable in the regression model. For |
fgh |
Integer with possible values 0,1,2. If |
If fgh==0
, the function returns -(y*u+(1+y)*log(1+exp(-u)))
for log
. If fgh==1
, a list is returned with elements f
and g
, where the latter is a vector of length length(u)
, with each element being the first derivative of the above expressions. If fgh==2
, the list will include an element named h
, consisting of the second derivatives of f
with respect to u
.
The logit function must be applied to the probability parameter to give X%*%beta
, which is in turn the inverse of the mean of the geometric distribution. For brevity, we still call the link function 'logit'.
Alireza S. Mahani, Mansour T.A. Sharabiani
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 | ## Not run:
library(sns)
library(MfUSampler)
# using the expander framework and base distributions to define
# log-likelihood function for geometric regression
loglike.geometric <- function(beta, X, y, fgh) {
regfac.expand.1par(beta, X, y, fbase1.geometric.logit, fgh)
}
# generate data for geometric regression
N <- 1000
K <- 5
X <- matrix(runif(N*K, min=-0.5, max=+0.5), ncol=K)
beta <- runif(K, min=-0.5, max=+0.5)
y <- rgeom(N, prob = 1/(1+exp(-X%*%beta)))
# mcmc sampling of log-likelihood
nsmp <- 100
# Slice Sampler
beta.smp <- array(NA, dim=c(nsmp,K))
beta.tmp <- rep(0,K)
for (n in 1:nsmp) {
beta.tmp <- MfU.Sample(beta.tmp
, f=loglike.geometric, X=X, y=y, fgh=0)
beta.smp[n,] <- beta.tmp
}
beta.slice <- colMeans(beta.smp[(nsmp/2+1):nsmp,])
# Adaptive Rejection Sampler
beta.smp <- array(NA, dim=c(nsmp,K))
beta.tmp <- rep(0,K)
for (n in 1:nsmp) {
beta.tmp <- MfU.Sample(beta.tmp, uni.sampler="ars"
, f=function(beta, X, y, grad) {
if (grad)
loglike.geometric(beta, X, y, fgh=1)$g
else
loglike.geometric(beta, X, y, fgh=0)
}
, X=X, y=y)
beta.smp[n,] <- beta.tmp
}
beta.ars <- colMeans(beta.smp[(nsmp/2+1):nsmp,])
# SNS (Stochastic Newton Sampler)
beta.smp <- array(NA, dim=c(nsmp,K))
beta.tmp <- rep(0,K)
for (n in 1:nsmp) {
beta.tmp <- sns(beta.tmp, fghEval=loglike.geometric, X=X, y=y, fgh=2, rnd = n>nsmp/4)
beta.smp[n,] <- beta.tmp
}
beta.sns <- colMeans(beta.smp[(nsmp/2+1):nsmp,])
# compare sample averages with actual values
cbind(beta, beta.sns, beta.slice, beta.ars)
## End(Not run)
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.