source("Functions.R")

##################################################
#                INITIALISING STEP               #
##################################################
# Posterior sample from JAGS model

# Longitudinal parameters
beta0 <- postsamp[[1]][,1]; beta1 <- postsamp[[1]][,2]; beta2 <- postsamp[[1]][,3]
lsigma <- log(postsamp[[2]][,1]); lsigma0 <- log(postsamp[[2]][,2]); lsigma1 <- log(postsamp[[2]][,3])

# Competing risks parameters
gamma1 <- postsamp[[10]]; gamma2 <- postsamp[[9]]
alpha01 <- postsamp[[12]]; alpha02 <- postsamp[[11]]
alpha11 <- postsamp[[14]]; alpha12 <- postsamp[[13]]
lnu1 <- log(postsamp[[6]]); lnu2 <- log(postsamp[[5]])
llambda1 <- postsamp[[8]]; llambda2 <- postsamp[[7]]


##################################################
#                 WEIGHTING STEP                 #
##################################################
# 15-point Gauss-Legendre quadrature
xk <- c(-0.98799251802048542849,-0.937273392400705904308,-0.8482065834104272162006,
        -0.7244177313601700474162,-0.5709721726085388475372,-0.3941513470775633698972,
        -0.2011940939974345223006,0,0.2011940939974345223006,0.3941513470775633698972,
        0.5709721726085388475372,0.7244177313601700474162,0.8482065834104272162006,
        0.9372733924007059043078,0.9879925180204854284896)

wk <- c(0.0307532419961172683546,0.070366047488108124709,0.1071592204671719350119,
        0.1395706779261543144478,0.1662692058169939335532,0.1861610000155622110268,
        0.1984314853271115764561,0.2025782419255612728806,0.198431485327111576456,
        0.1861610000155622110268,0.166269205816993933553,0.139570677926154314448,
        0.10715922046717193501,0.07036604748810812471,0.030753241996117268355)

Q <- 250
require(randtoolbox)
a <- sobol(Q, dim=4, scrambling=1, seed=sample(100000,1))
den.like.long <- den.like.surv <- rep(0,length(beta0))
num.like.long <- num.like.surv <- rep(0,length(beta0))
day1.12 <- 1:length(long12.1); day2.12 <- 1:length(long12.2)
day1.131 <- 1:length(long131.1); day2.131 <- 1:length(long131.2)
Time1.12 <- length(day1.12); Time2.12 <- length(day2.12)
Time1.131 <- length(day1.131); Time2.131 <- length(day2.131)
age12 <- 71; age131 <- 63
delta12 <- 0; delta131 <- 0
K <- 15
hA1.12 <- hA2.12 <- hD1.12 <- hD2.12 <- rep(0,K)
hA1.131 <- hA2.131 <- hD1.131 <- hD2.131 <- rep(0,K)

for(k in 1:length(beta0)){
  l1 <- l2 <- l3 <- l4 <- 0
  s1 <- s2 <- s3 <- s4 <- 0
  for(q in 1:Q){
      b0.12 <- exp(lsigma0[k])*qnorm(a[q,1]); b1.12 <- exp(lsigma1[k])*qnorm(a[q,2])
      b0.131 <- exp(lsigma0[k])*qnorm(a[q,3]); b1.131 <- exp(lsigma1[k])*qnorm(a[q,4])    
    
      psi1 <- long12.1 - (beta0[k]+b0.12 + (beta1[k]+b1.12)*day1.12 + beta2[k]*age12)
      psi2 <- long12.2 - (beta0[k]+b0.12 + (beta1[k]+b1.12)*day2.12 + beta2[k]*age12)
      psi3 <- long131.1 - (beta0[k]+b0.131 + (beta1[k]+b1.131)*day1.131 + beta2[k]*age131)
      psi4 <- long131.2 - (beta0[k]+b0.131 + (beta1[k]+b1.131)*day2.131 + beta2[k]*age131)
    
      for(j in 1:K){
          hA1.12[j] <- exp(lnu1[k])*(Time1.12/2*(xk[j]+1))^(exp(lnu1[k])-1) *
                  exp( llambda1[k] + gamma1[k]*age12 + alpha01[k]*b0.12 + alpha11[k]*b1.12*(Time1.12/2*(xk[j]+1)) )
          hA2.12[j] <- exp(lnu1[k])*(Time2.12/2*(xk[j]+1))^(exp(lnu1[k])-1) *
                  exp( llambda1[k] + gamma1[k]*age12 + alpha01[k]*b0.12 + alpha11[k]*b1.12*(Time2.12/2*(xk[j]+1)) )
          hA1.131[j] <- exp(lnu1[k])*(Time1.131/2*(xk[j]+1))^(exp(lnu1[k])-1) *
                  exp( llambda1[k] + gamma1[k]*age131 + alpha01[k]*b0.131 + alpha11[k]*b1.131*(Time1.131/2*(xk[j]+1)) )      
          hA2.131[j] <- exp(lnu1[k])*(Time2.131/2*(xk[j]+1))^(exp(lnu1[k])-1) *
                  exp( llambda1[k] + gamma1[k]*age131 + alpha01[k]*b0.131 + alpha11[k]*b1.131*(Time2.131/2*(xk[j]+1)) )      
      
          hD1.12[j] <- exp(lnu2[k])*(Time1.12/2*(xk[j]+1))^(exp(lnu2[k])-1) *
                  exp( llambda2[k] + gamma2[k]*age12 + alpha02[k]*b0.12 + alpha12[k]*b1.12*(Time1.12/2*(xk[j]+1)) )
          hD2.12[j] <- exp(lnu2[k])*(Time2.12/2*(xk[j]+1))^(exp(lnu2[k])-1) *
                  exp( llambda2[k] + gamma2[k]*age12 + alpha02[k]*b0.12 + alpha12[k]*b1.12*(Time2.12/2*(xk[j]+1)) )
          hD1.131[j] <- exp(lnu2[k])*(Time1.131/2*(xk[j]+1))^(exp(lnu2[k])-1) *
                  exp( llambda2[k] + gamma2[k]*age131 + alpha02[k]*b0.131 + alpha12[k]*b1.131*(Time1.131/2*(xk[j]+1)) )
          hD2.131[j] <- exp(lnu2[k])*(Time2.131/2*(xk[j]+1))^(exp(lnu2[k])-1) *
                  exp( llambda2[k] + gamma2[k]*age131 + alpha02[k]*b0.131 + alpha12[k]*b1.131*(Time2.131/2*(xk[j]+1)) )        
      }
    
      l1 <- l1 + (1/(2*pi*exp(lsigma[k])^2))^(Time1.12/2)*exp(-(1/(2*exp(lsigma[k])^2))*sum(psi1^2))
      s1 <- s1 + exp(-Time1.12/2*( sum(wk*hA1.12) + sum(wk*hD1.12) ))
      l2 <- l2 + (1/(2*pi*exp(lsigma[k])^2))^(Time2.12/2)*exp(-(1/(2*exp(lsigma[k])^2))*sum(psi2^2))
      s2 <- s2 + exp(-Time2.12/2*( sum(wk*hA2.12) + sum(wk*hD2.12) ))
      l3 <- l3 + (1/(2*pi*exp(lsigma[k])^2))^(Time1.131/2)*exp(-(1/(2*exp(lsigma[k])^2))*sum(psi3^2))
      s3 <- s3 + exp(-Time1.131/2*( sum(wk*hA1.131) + sum(wk*hD1.131) ))
      l4 <- l4 + (1/(2*pi*exp(lsigma[k])^2))^(Time2.131/2)*exp(-(1/(2*exp(lsigma[k])^2))*sum(psi4^2))
      s4 <- s4 + exp(-Time2.131/2*( sum(wk*hA2.131) + sum(wk*hD2.131) ))    
    }
    den.like.long[k] <- l1*l3/Q; den.like.surv[k] <- s1*s3/Q
    num.like.long[k] <- l2*l4/Q; num.like.surv[k] <- s2*s4/Q
}

w <- weights * (num.like.long*num.like.surv) / (den.like.long*den.like.surv)
weights <- w/sum(w)


# DEGENERACY CRITERION
ESS <- 1/sum(weights^2)

if(ESS < 1400){ # TRUE: Update

    ##################################################
    #                 RESAMPLING STEP                #
    ##################################################
    n.part <- length(beta0)
    # Longitudinal parameters
    r.beta0 <- sample(beta0,size=n.part,replace=T,prob=weights)
    r.beta1 <- sample(beta1,size=n.part,replace=T,prob=weights)
    r.beta2 <- sample(beta2,size=n.part,replace=T,prob=weights)
    r.lsigma <- sample(lsigma,size=n.part,replace=T,prob=weights)
    r.lsigma0 <- sample(lsigma0,size=n.part,replace=T,prob=weights)
    r.lsigma1 <- sample(lsigma1,size=n.part,replace=T,prob=weights)

    # Competing risks parameters
    r.gamma1 <- sample(gamma1,size=n.part,replace=T,prob=weights)
    r.gamma2 <- sample(gamma2,size=n.part,replace=T,prob=weights)
    r.alpha01 <- sample(alpha01,size=n.part,replace=T,prob=weights)
    r.alpha02 <- sample(alpha02,size=n.part,replace=T,prob=weights)
    r.alpha11 <- sample(alpha11,size=n.part,replace=T,prob=weights)
    r.alpha12 <- sample(alpha12,size=n.part,replace=T,prob=weights)
    r.lnu1 <- sample(lnu1,size=n.part,replace=T,prob=weights)
    r.lnu2 <- sample(lnu2,size=n.part,replace=T,prob=weights)
    r.llambda1 <- sample(llambda1,size=n.part,replace=T,prob=weights)
    r.llambda2 <- sample(llambda2,size=n.part,replace=T,prob=weights)

    ##################################################
    #                   MOVING STEP                  #
    ##################################################
    theta <- cbind(r.beta0,r.beta1,r.beta2,r.lsigma,r.lsigma0,r.lsigma1,r.gamma1,r.gamma2,
             r.alpha01,r.alpha02,r.alpha11,r.alpha12,r.lnu1,r.lnu2,r.llambda1,r.llambda2)

    mu.theta <- as.numeric(apply(theta,2,mean))
    sigma.theta <- as.numeric(apply(theta,2,sd))

    IBIS <- MH.kernel(ysofa,data.patients$time,data.patients$age,mu.theta,sigma.theta,eventA,eventD,pos,M,theta,patient.new.obs,fhat.new)
}