Hips model 1: Closed form estimates for each strata -give results for "exact" columns in Table 2

Spiegelhalter, D.J. and Best, N.G. “Bayesian approaches to multiple sources of evidence and uncertainty in complex cost-effectiveness modelling”. Statistics in Medicine 22, (2003), 3687-3709.
No updates are required for this model; just load data and compile, then obtain values for C, mean.C, sd.C, BL, mean.BL, sd.BL, BQ, mean.BQ and sd.BQ using the node tool from the Info menu.


model {

for(k in 1 : K) { # loop over strata

# Cost and benefit equations in closed form:
####################################

# Costs
for(t in 1 : N) {
   ct[k, t] <- inprod(pi[k, t, ], c[]) / pow((1 + delta.c), t - 1)
}
C[k] <- C0 + sum(ct[k, ])

# Benefits - life expectancy
for(t in 1:N) {
   blt[k, t] <- inprod(pi[k, t, ], bl[]) / pow((1 + delta.b), t - 1)
}
BL[k] <- sum(blt[k, ])

# Benefits - QALYs
for(t in 1 : N) {
   bqt[k, t] <- inprod(pi[k,t, ], bq[]) / pow((1 + delta.b), t - 1)
}
BQ[k] <- sum(bqt[k, ])

# Markov model probabilities:
#######################

# Transition matrix
for(t in 2 : N) {
Lambda[k, t, 1, 1] <- 1 - gamma[k, t] - lambda[k, t]
Lambda[k, t, 1, 2] <- gamma[k, t] * lambda.op
Lambda[k, t, 1, 3] <- gamma[k, t] * (1 - lambda.op)
Lambda[k, t, 1, 4] <- 0
Lambda[k, t, 1, 5] <- lambda[k, t]

Lambda[k, t, 2, 1] <- 0
Lambda[k, t, 2, 2] <- 0
Lambda[k, t, 2, 3] <- 0
Lambda[k, t, 2, 4] <- 0
Lambda[k, t, 2, 5] <- 1

Lambda[k, t, 3, 1] <- 0
Lambda[k, t, 3, 2] <- 0
Lambda[k, t, 3, 3] <- 0
Lambda[k, t, 3, 4] <- 1 - lambda[k, t]
Lambda[k, t, 3, 5] <- lambda[k, t]

Lambda[k, t, 4, 1] <- 0
Lambda[k, t, 4, 2] <- rho * lambda.op
Lambda[k, t, 4, 3] <- rho * (1 - lambda.op)
Lambda[k, t, 4, 4] <- 1 - rho - lambda[k, t]
Lambda[k, t, 4, 5] <- lambda[k,t]

Lambda[k, t, 5, 1] <- 0
Lambda[k, t, 5, 2] <- 0
Lambda[k, t, 5, 3] <- 0
Lambda[k, t, 5, 4] <- 0
Lambda[k, t, 5, 5] <- 1

gamma[k, t] <- h[k] * (t - 1)
}

# Marginal probability of being in each state at time 1
pi[k,1,1] <- 1 - lambda.op pi[k,1, 2]<-0 pi[k,1,3] <- 0
         pi[k,1, 4] <- 0 pi[k,1, 5] <- lambda.op

# Marginal probability of being in each state at time t>1
for(t in 2:N) {
   for(s in 1:S) {
      pi[k, t, s] <- inprod(pi[k, t - 1, ], Lambda[k, t, , s])
   }
   }

}

# Mean and sd of costs and benefits over strata
#######################################

mean.C <- inprod(p.strata[], C[])
for(k in 1:12) {
         dev.C[k] <- pow(C[k] - mean.C, 2)
      }
var.C <- inprod(p.strata[], dev.C[])
sd.C <- sqrt(var.C)

mean.BL <- inprod(p.strata[], BL[])
for(k in 1:12) {
         dev.BL[k] <- pow(BL[k] - mean.BL, 2)
      }
var.BL <- inprod(p.strata[], dev.BL[])
sd.BL <- sqrt(var.BL)

mean.BQ <- inprod(p.strata[], BQ[])
for(k in 1:12) {
         dev.BQ[k] <- pow(BQ[k] - mean.BQ, 2)
      }
var.BQ <- inprod(p.strata[], dev.BQ[])
sd.BQ <- sqrt(var.BQ)
}

Data
list(N = 60, # Number of cycles
K = 12, # Number of age-sex strata
S = 5, # Number of states in Markov model
rho = 0.04, # re-revision rate
lambda.op = 0.01, # post-operative mortality rate
# age-sex specific revision hazard:
h = c(0.0022, 0.0022, 0.0022, 0.0016, 0.0016, 0.0016, 0.0017, 0.0017, 0.0017, 0.0012, 0.0012, 0.0012),
C0 = 4052, # set-up costs of primary operation
c = c(0, 5290, 5290, 0, 0), # additional costs associated with each state (zero except for revision states 2 and 3)
bl = c(1,0,1,1,0), # life-expectancy benefits associated with each state (one except for death states 2 and 5)
bq = c(0.938, -0.622, -0.3387, 0.938, 0), # QALYs associated with each state
delta.c = 0.06, # cost discount
delta.b = 0.06, # health discount
# probablilty of hip replacement by age and sex
p.strata = c(0.02, 0.03, 0.07, 0.13, 0.10, 0.00, 0.02, 0.04, 0.10, 0.22, 0.26, 0.01),
lambda = structure(.Data = c(0.0017, 0.0017, 0.0017, 0.0017, 0.0017, 0.0044, 0.0044,
   0.0044, 0.0044, 0.0044, 0.0044, 0.0044, 0.0044, 0.0044, 0.0044, 0.0138,
   0.0138, 0.0138, 0.0138, 0.0138, 0.0138, 0.0138, 0.0138, 0.0138, 0.0138,
   0.0379, 0.0379, 0.0379, 0.0379, 0.0379, 0.0379, 0.0379, 0.0379, 0.0379,
   0.0379, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912,
   0.0912, 0.0912, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.0044,
   0.0044, 0.0044, 0.0044, 0.0044, 0.0138, 0.0138, 0.0138, 0.0138, 0.0138,
   0.0138, 0.0138, 0.0138, 0.0138, 0.0138, 0.0379, 0.0379, 0.0379, 0.0379,
   0.0379, 0.0379, 0.0379, 0.0379, 0.0379, 0.0379, 0.0912, 0.0912, 0.0912,
   0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.0138, 0.0138, 0.0138, 0.0138,
   0.0138, 0.0379, 0.0379, 0.0379, 0.0379, 0.0379, 0.0379, 0.0379, 0.0379,
   0.0379, 0.0379, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912,
   0.0912, 0.0912, 0.0912, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.0379, 0.0379, 0.0379, 0.0379, 0.0379, 0.0912, 0.0912,
   0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.0912, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.0912,
   0.0912, 0.0912, 0.0912, 0.0912, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958, 0.1958,
   0.1958, 0.1958, 0.0011, 0.0011, 0.0011, 0.0011, 0.0011, 0.0028, 0.0028,
   0.0028, 0.0028, 0.0028, 0.0028, 0.0028, 0.0028, 0.0028, 0.0028, 0.0081,
   0.0081, 0.0081, 0.0081, 0.0081, 0.0081, 0.0081, 0.0081, 0.0081, 0.0081,
   0.022, 0.022, 0.022, 0.022, 0.022, 0.022, 0.022, 0.022, 0.022, 0.022,
   0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.0578,
   0.0578, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.0028, 0.0028,
   0.0028, 0.0028, 0.0028, 0.0081, 0.0081, 0.0081, 0.0081, 0.0081, 0.0081,
   0.0081, 0.0081, 0.0081, 0.0081, 0.022, 0.022, 0.022, 0.022, 0.022,
   0.022, 0.022, 0.022, 0.022, 0.022, 0.0578, 0.0578, 0.0578, 0.0578,
   0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.0081, 0.0081, 0.0081, 0.0081, 0.0081,
   0.022, 0.022, 0.022, 0.022, 0.022, 0.022, 0.022, 0.022, 0.022, 0.022,
   0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.0578,
   0.0578, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.022, 0.022, 0.022, 0.022, 0.022, 0.0578, 0.0578, 0.0578, 0.0578,
   0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.0578, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.0578, 0.0578, 0.0578,
   0.0578, 0.0578, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503,
   0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503, 0.1503
   ), .Dim=c(12,60))
)
Results[hips11]