I am trying to fit a model using OpenBUGS. Here is the code:
model {
# N observations
for (i in 1:N) {
y[i] ~ dbin(p.bound[i],1)
p.bound[i]<-max(0,min(1,p[i]))
logit(p[i])<-Xbeta[i]
Xbeta[i] <- a[sp[i]]-0.5*pow(((X1[i]-opt1[sp[i]])/tol1[sp[i]])+((X2[i]-opt2[sp[i]])/tol2[sp[i]])+((X3[i]-opt3[sp[i]])/tol3[sp[i]]))
}
for (j in 1:n.sp) {
a[j] ~ dnorm(a.hat[j],tau.a)
a.hat[j]<-mu.a
opt1[j] ~ dnorm(opt.hat1[j],tau.opt1)
opt.hat1[j]<-mu.opt1
tol1[j] ~ dnorm(tol.hat1[j],tau.tol1)
tol.hat1[j]<-mu.tol1
opt2[j] ~ dnorm(opt.hat2[j],tau.opt2)
opt.hat2[j]<-mu.opt2
tol2[j] ~ dnorm(tol.hat2[j],tau.tol2)
tol.hat2[j]<-mu.tol2
opt3[j] ~ dnorm(opt.hat3[j],tau.opt3)
opt.hat3[j]<-mu.opt3
tol3[j] ~ dnorm(tol.hat3[j],tau.tol3)
tol.hat3[j]<-mu.tol3
}
mu.a~dnorm(0,0.0001)
mu.opt1~dnorm(0,0.0001)
mu.tol1~dunif(0.04,37)
mu.opt2~dnorm(0,0.0001)
mu.tol2~dunif(0.04,37)
mu.opt3~dnorm(0,0.0001)
mu.tol3~dunif(0.04,37)
tau.a<-pow(sigma.a,-2)
sigma.a~dunif(0,100)
tau.opt1<-pow(sigma.opt1,-2)
sigma.opt1~dunif(0,100)
tau.opt2<-pow(sigma.opt2,-2)
sigma.opt2~dunif(0,100)
tau.opt3<-pow(sigma.opt3,-2)
sigma.opt3~dunif(0,100)
tau.tol1<-pow(sigma.tol1,-2)
sigma.tol1~dunif(0,100)
tau.tol2<-pow(sigma.tol2,-2)
sigma.to2~dunif(0,100)
tau.tol3<-pow(sigma.tol3,-2)
sigma.tol3~dunif(0,100)
}
But, When I run this code, I get the error 'expected a comma'.
If anyone can help me to solve this problem that will be great.
The error is in the power function. From the BUGS manual...
pow(e1, e2) e1^e2
At the moment you just have e1;
Xbeta[i] <- a[sp[i]]-0.5*pow(e1)
where e1 = ((X1[i]-opt1[sp[i]])/....
Related
So I want to estimate 5 parameters consist of intercept, age, disease, mdu, and alfa from panel data. And I write the pdf, here's the code of multivariate negative binomial for panel data. I use optim() package to estimate the parameters. Please help me to fix what is wrong with my code..
library(pglm)
library(plm)
data("HealthIns")
dat<- pdata.frame(HealthIns,index = c("id","year"))
y<-data.matrix(dat$mdu)
y[is.na(y)]=0
Y<-matrix(data=y,nrow=5908,ncol=5)
dat$ageclass<-ifelse(dat$age >=30,1,0)
x1<-data.matrix(dat$ageclass)
x1[is.na(x1)]=0
X1<-matrix(data=x1,nrow=5908,ncol=5)
dat$gender <-ifelse(dat$sex=="male",1,0)
x2<-data.matrix(dat$gender)
x2[is.na(x2)]=0
X2<-matrix(data=x2,nrow=5908,ncol=5)
x3<-data.matrix(dat$disease)
x3[is.na(x3)]=0
X3<-matrix(data=x3,nrow=5908,ncol=5)
Function for optim package
po.gam=function(para){
#Lambda(i,t)
{for (i in (1:5908)){
for(t in (1:5)){
lambda<-matrix(para[1] + para[2]*X1 + para[3]*X2 +
para[4]*X3,nrow=5908,ncol=5)}}
}
#Sigma N(i,t) terhadap t
num.claims.of.t <-numeric(nrow(Y))
{for (i in seq(nrow(Y))){
num.claims.of.t[i] <-sum(Y[i,])}
}
#Sigma Lambda(i,t) terhadap t
num.lambda.of.t<-numeric(nrow(Y))
{for (i in seq(nrow(Y))){
num.lambda.of.t[i]<-sum(lambda[i,])}
}
#Produc Exponential Dist
prod.exp<-numeric(nrow(Y))
{for (i in seq(nrow(Y))){
prod.exp[i]<-prod(lambda[i,]^Y[i,]/factorial(Y[i,]))}
}
#JOINT PROBABILITY OF TIMESNYA...
joint.pdf.mvnb<-prod.exp*gamma(num.claims.of.t + (1/para[5]))/gamma(1/para[5])*((1/para[5])/(num.lambda.of.t + (1/para[5])))^(1/para[5])*(num.lambda.of.t + (1/para[5]))^(-num.claims.of.t)
#PRODUC NUMBER OF CLAIMS SEMUA INDIVIDU
-log(prod(joint.pdf.mvnb))
}
start.value <- c(beta0=1,beta1=1,beta2=1,beta3=1,alfa=1)
MLE_estimator<-optim(start.value,po.gam,hessian=TRUE)
MLE_estimator
And here is my result
> MLE_estimator<-optim(start.value,po.gam,hessian=TRUE)
Error in optim(start.value, po.gam, hessian = TRUE) :
function cannot be evaluated at initial parameters
library(mvtnorm)
set.seed(14)
n=10000
sigmatrue<-1
rhotrue<-0.3
b1=0.05
b0=0
y<-arima.sim(model=list(ar=c(0.3)),n=10000 ,sd=sigmatrue)#kataskevi
#xronoseiras
x=rep(0,n)
for(i in 1:n){
x[i]=i
}
for(t in 1:n)
{
y[t]=y[t]+b0+b1*x[t]
}
est=arima(y,order=c(1,0,0),xreg=x,include.mean=TRUE,method="ML",kappa=1e+06)
cens<-rep(0, n)
c=(9/10)*(n*b1+b0)
for (i in 1:n) {
if(y[i]>c){
y[i]<-c
cens[i]<-1
}
}
ll<-function(p){
sigma=matrix(c(p[2]^2/(1-p[3]^2), p[2]^2*p[3]/(1-p[3]^2),p[2]^2*p[3]/(1-p[3]^2),p[2]^2/(1-p[3]^2)),ncol=2,nrow=2,byrow=TRUE)
likelihood<-rep(0,n)
for(t in 2 :n){
if(cens[t]==0 & cens[t-1]==0){
likelihood[t]<-dnorm(((y[t]-(p[1]+p[4]*t)-p[3]*(y[t-1]-(p[1]+p[4]*(t-1)))/p[2]) )/p[2])
}
else if(cens[t]==0 & cens[t-1]==1){
likelihood[t]<-(1/(1-pnorm((c-(p[1]+p[4]*t)*sqrt(1-p[3]^2)/p[2]))*sqrt(1-p[3]^2)/p[2]*dnorm(((y[t]-(p[1]+p[4]*t)*sqrt(1-p[3]^2))/p[2])*(1-pnorm(((c-(p[1]+p[4]*(t))-p[3]*(y[t]-(p[1]+p[4]*(t-1)))/p[2])))))))
}
else if(cens[t]==1 & cens[t-1]==0){
likelihood[t]<-1-pnorm(((c-(p[1]+p[4]*t)-p[3]*(y[t-1]-(p[1]+p[4]*(t-1)))/p[2])))
}
else
{
likelihood[t]<-(((pmvnorm(lower=c, upper=Inf , mean=c(p[1]+p[4]*(t-1),p[1]+p[4]*t),sigma=sigma))/(1-pnorm((c-(p[1]+p[4]*(t-1))*sqrt(1-p[3]^2)/p[2])))))
}
}
f0=(sqrt(1-p[3])/p[2]*dnorm(((y[1]-p[1]-p[4])*sqrt(1-p[3]^2))/p[2]))
likelihood[1]=f0
#Ta prosthesa
if (any(likelihood==0)){
likelihood[likelihood==0] = 0.000001 #poly mikros arithmos
}
if (any(likelihood==Inf)){
likelihood[likelihood==Inf] = 1 #poly megalos h 1, an milame gia pi8anothta
}
if (any(is.nan(likelihood))){
likelihood[is.nan(likelihood)] = 0.000001
}
minusloglike=-sum(log(likelihood))
#l1=list(Minusloglike=minusloglike,Loglikelihood=log(likelihood))
return(minusloglike)
}
fit<-optim(c(0,1,0.3,0.05),ll,method="L-BFGS-B",lower=c(-Inf,0.001,-0.999,-Inf),upper = c(Inf,Inf,0.999,Inf),hessian=TRUE)
fisher.info<-solve(fit$hessian)
fisher.info
prop.sigma<-sqrt(diag(fisher.info))
sigmas<-diag(prop.sigma)
upper<-fit$par+1.96*sigmas
lower<-fit$par-1.96*sigmas
interval<-data.frame(value=fit$par, lower=diag(lower),upper=diag(upper))
interval
I run this code(it is for censored first order autogressive process with covariate , i have 4 cases for x(t) ,x(t-1) either is censored or non-censored and i dont want the likelihood to go near zero and inf).I get error
Error in if (any(likelihood == Inf)) { :
missing value where TRUE/FALSE needed
Called from: fn(par, ...)
The program is working for n=100 but when n is larger than 100 i have this error. I think this error causes bad estimattes of the four parameters(b1,rho,sigma,b0).Does anyone know what can i do?
Thank you for your help.
The model is syntactically correct, I loaded the data but when I compile, I get this error : "multiple definitions of node z". I don't know how to solve it
model{
...
for(i in 1:r){
for(j in 1:r){
z[i,j] <- ((step(x[i,j]-0)*1) + (1-step(x[i,j]-0)*(-1)))/2
}
}
# (zij +1)/2
for (j in 1:r) {
for (i in 1:r) {
z[i, j] ~ dbern(p[j])
}
}
...
}
Some help would be appreciated.
You have defined multiple parts if z twice. BUGS does not allow you to overwrite z (or any other node) in the same model, i.e. you can only write one of z~ or z<- once.
I am trying to compare two distributions by using Likelihood ratio test. I used the maxLik function to obtain mles of both of null and alternative distributions. I want to use BFGSR method because it gives better estimates.
library("maxLik")
library("flexsurv")
n=20
den1=1000
mpar=3
omepar=5
spar=3
Logliknak1=function(param){
m=param[1]
o=param[2]
n*(log(2)+m*log(m)-lgamma(m)-m*log(o))+(2*m-1)*sum(log(y))-(m/o)*sum(y^(2))
}
Loglikgennak= function(param){
s <- param[1]
ome <- param[2]
m<-param[3]
(n*(log(2*s)+m*log(m)-lgamma(m)-m*log(ome))+(2*m*s-1)*sum(log(y))-(m/ome)*sum(y^(2*s)))
}
LR2=rep(0,den1)
ps=0; pome=0; pm=0;
for(i in 1:den1){
repeat
{
x=rgengamma.orig(n,shape=spar,scale=(omepar/mpar),k=mpar)
y=x^0.5
ot=mean(y^2)
mt=(mean(y)*mean(y^2))/(2*(mean(y^3)-(mean(y)*mean(y^2))))
mle2 <- maxLik(logLik=Logliknak1, start = c(m=mt, o=ot),method="BFGSR")
lnull=logLik(mle2)
mm=coef(mle2)[[1]]
mo=coef(mle2)[[2]]
mle3 <- maxLik(logLik=Loglikgennak, start = c(s=1.5,ome=omepar+1,m=mpar+1),method="BFGSR")
lalt=logLik(mle3)
ps=coef(mle3)[[1]]
pome=coef(mle3)[[2]]
pm=coef(mle3)[[3]]
if (lalt>lnull && ps>1 && pome>0 && pm>0)
{break}
}
LR2[i]=2*(lalt-lnull)
print(i)
print(LR2[i])
print(pm)
print(pome)
print(ps)
}
However I keep getting the following error message:
Error in if (all(y == 0)) { : missing value where TRUE/FALSE needed
How do I fix this?
I'm creating a new model and I want to compare this with another model using WAIC. I understand that I need to write a generated quantities block. However, I'm struggling to convert the logsumexp of beta. I would greatly appreciate any leads/help. My model block looks like this:
model {
//prior for phi,b
phi ~ cauchy(0,5);
mu_b ~ normal(0,1);
sigma_b ~ cauchy(0,1);
mu ~ normal(0,1);
sigma ~ cauchy(0,1);
//model
log_b_z ~ normal(0, 1);
theta_raw ~ normal(mu, sigma);
for (i in 1:n) {
vector[number_segments] test;
for (j in 1:number_segments) {
test[j] = beta_lpdf(response[i] | p[j][i]*phi, (1-p[j][i])*phi) + log(prob_segment[j]);
}
target += log_sum_exp(test);
}
}
You need to define a generated quantities block that defines your posterior predictive log likelihood for each data point.
You can do it this way for a mixture with minimal recomputation.
transformed parameters {
vector[n] log_lik;
{
vector[number_semgnents log_prob_segment = log(prob_segment);
for (i in 1:n) {
vector[number_segments] lp = log_prob_segment;
for (j in 1:number_segments) {
lp[j] += beta_lpdf(response[i] | p[j, i] * phi, (1 - p[j, i]) * phi);
log_lik[i] = log_sum_exp(lp);
}
}
...
model {
target += sum(log_lik);
...
You could also define log_lik as a generated quantity---that can be more efficient if you can vectorize the likelihood (which isn't possible yet for mixtures in Stan).
Once you've done that, you can use the loo package to calculate WAIC, etc., as described in the vignette and references.