################################################################David Epstein,
University of York
#31 July 2009
#Programme written for R version 2.6.1
#Copyright © 2007 The R Foundation for Statistical Computing
#Basic model without sequences
#Psoriatic Arthritis
###############################################################
#remove just about everything from the working environment
rm(list = ls())#a ‘clear-all’ statement
options(show.error.messages = TRUE)
set.seed(1001)
#detach all data tables etc
if(“tab.dat1”%in% search())detach(tab.dat1)
if(“tab.dat2”%in% search())detach(tab.dat2)
if(“tab1”%in% search())detach(tab1)
if(“tab2”%in% search())detach(tab2)

setwd(“z:/dme2/psa/rcode”)
tab.dat1<-read.csv(«data1.csv»,header=TRUE)#data input, see Table 33 in Chapter 4, York Economic Assessment
tab.dat2<-read.csv(«data2.csv»,header=TRUE)#data input, see Table 33 in Chapter 4, York Economic Assessment
#sa<−1 #basecase
#deter<−1 #deterministic
#Years <−40 #duration of treatment effect
##########################model
model<-function(sa, deter, Years){

#functions
b.beta<-function(p,var.p){(1-p)*(1-p)*p/var.p}#beta parameter of beta dist
a.beta<-function(p,var.p){p*p*(1-p)/var.p}#alpha parameter of beta dist

a.gamma<-function(m,var.m){m*m/var.m}#shape parameter of gamma dist
s.gamma<-function(m,var.m){var.m/m}#scale parameter of gamma dist

sens.a<-function(t1,q,var){#qth point on normal distribution
#var is variable name in string format
t1[,var]<-qnorm(q,t1[,var],t1[,paste(var,”_SE”,sep=““)])
return(t1)}

c.pasi<−0 #linear costs of PASI (sensitivity analysis)
################################sensitivity analyses, 1= basecase
if (sa==1){#basecase
tab1<-tab.dat1
tab2<-tab.dat2
}
if (sa==2) {# rebound less than initial gain, instead as estimated by expert elicitation
tab1<-tab.dat1
tab1$loss.w<- −0.62
tab2<-tab.dat2
}
if (sa==3) {#high haq progression in natural history & after withdrawal
tab1<-sens.a(tab.dat1,0.975,”HAQ1.w”)
tab2<-tab.dat2
}
if (sa==4) {#utility function, Abbott
tab1<-tab.dat1
tab2<-tab.dat2
tab1$hhaq<- −0.295 #coefficient on haq
tab1$hhaq_SE<−0.0189
tab1$hpasi<- −0.0355 #coefficient on log_pasi
tab1$hpasi_SE<−0.0096
}
if (sa==5) {#no correlation psarc + pasi
tab1<-tab.dat1
tab2<-tab.dat2
tab2$rho<-c(0,0,0)}

if (sa==6) {#no adjustment for plac effect
tab1<-tab.dat1
tab2<-tab.dat2
tab1$plac.effect<−2}

if (sa==7) {#continue only if both psarc & pasi75 & baseline pasi HI
tab1<-tab.dat1
tab2<-tab.dat2
tab1$PASI0<−12.5
tab1$c2.1<−566
tab1$c2.1_SE<−25
tab1$continue<−2}

if (sa==8) {#continue if either response & baseline pasi HI
tab1<-tab.dat1
tab2<-tab.dat2
tab1$PASI0<−12.5
tab1$c2.1<−566
tab1$c2.1_SE<−25
tab1$continue<−4}

if (sa==9) {#Abbott cost -HAQ function, standard errors not used
tab1<-tab.dat1
tab2<-tab.dat2
tab1$alpha<−54.1
tab1$beta<−1.237
}

if (sa==10) {#baseline HAQ
tab1<-tab.dat1
tab2<-tab.dat2
tab1$HAQ0<−1.8
}

if (sa==11) {#baseline PASI HI
tab1<-tab.dat1
tab2<-tab.dat2
tab1$PASI0<−12.5
tab1$c2.1<−566
tab1$c2.1_SE<−25
}

if (sa==12) {#annual inpatient therapy for mild to mod psoriasis instead of UVB
tab1<-tab.dat1
tab2<-tab.dat2
tab1$c2.1<-(7176+2*79)/4
}

if (sa==13) {#cost-HAQ as Michaud US data
tab1<-tab.dat1
tab2<-tab.dat2
tab1$c1 <−189
tab1$c1_SE <−21
}

if (sa==14){#utility function haq-Wyeth
tab1<-tab.dat1
tab2<-tab.dat2
tab1$h1<- −0.455
tab1$h1_SE <−0.027
tab1$h2<−0 #no pasi effect on utility
tab1$h3<−0 #no pasi*haq interaction
}

if (sa==15){#haq progress while on drug
tab1<-sens.a(tab.dat1,0.025,”HAQ1.d”)
tab2<-tab.dat2
}

if (sa==16){#withdrawal hi
tab1<-sens.a(tab.dat1,0.975,”ln.long.yr”)
tab2<-tab.dat2
}
if (sa==17){#withdrawal low
tab1<-sens.a(tab.dat1,0.025,”ln.long.yr”)
tab2<-tab.dat2
}

if (sa==18){#all treatments have equal effectiveness psarc
tab1<-tab.dat1
tab2<-tab.dat2
tab2$p.psarc<-tab2$p.psarc[2]
tab2$p.psarc_SE<-tab2$p.psarc_SE[2]
}

if (sa==19){#all treatments have equal effectiveness pasi50,75,90
tab1<-tab.dat1
tab2<-tab.dat2
tab2$p.pasi.50<-tab2$p.pasi.50[2]
tab2$p.pasi.75<-tab2$p.pasi.75[2]
tab2$p.pasi.90<-tab2$p.pasi.90[2]
tab2$p.pasi.50_SE<-tab2$p.pasi.50_SE[2]
tab2$p.pasi.75_SE<-tab2$p.pasi.75_SE[2]
tab2$p.pasi.90_SE<-tab2$p.pasi.90_SE[2]
}

if (sa==20){#costs of drugs, Wyeth submission
tab1<-tab.dat1
tab2<-tab.dat2
tab2$c.drug1<-c(2282,6286,2282)
tab2$c.drug2<-c(2178,3201,2178)
tab2$c.drug3<-c(2162,3184,2162)
}

if (sa==21){#severe psoriasis with hi costs psoriasis
tab1<-tab.dat1
tab2<-tab.dat2
tab1$PASI0<−12.5
tab1$c2.1<−2133#3month cost of inpatient therapy
tab1$c2.1_SE<−93
}

if (sa==22){#mean change in HAQ same for all psarc responders
tab1<-tab.dat1
tab2<-tab.dat2
tab2$HAQ.no.resp<- −0.1697
tab2$HAQ.no.resp_SE<−0.03382
tab2$HAQ.resp<- −0.5688
tab2$HAQ.resp_SE<−0.03148
tab1$HAQ.resp.plac<- −0.260
tab1$HAQ.resp.plac_SE<- 0.0277
}
if (sa==23){#costs of drugs, 3 vials infliximab
tab1<-tab.dat1
tab2<-tab.dat2
tab2$c.drug1[2]<−4264
tab2$c.drug2[2]<−2809
tab2$c.drug3[2]<−2283
}
if (sa==24){#second biologic, if failed previous biologic for inefficacy
tab1<-tab.dat1
tab2<-tab.dat2
tab1$ln.inef<−0.993#log HR of failure for ineficacy in 2nd drug ∣ inefficacy in 1st drug
tab1$ln.inef_SE<−0.120
tab1$p.inef<- 841/2360#% who failed first drug for inefficacy
tab1$p.ae<−1023/2360#% who failed 1st for AE
}
if (sa==25){#second biologic, if failed previous biologic for AE
tab1<-tab.dat1
tab2<-tab.dat2
tab1$ln.AE<−0.832#log HR of failure for AE in 2nd drug ∣ AE in 1st drug
tab1$ln.AE_SE<−0.106
tab1$p.inef<- 841/2360#% who failed first drug for inefficacy
tab1$p.AE<−1023/2360#% who failed 1st for AE
}
if (sa==26) {# rebound to natural history
tab1<-tab.dat1
tab1$loss.w<- 3 #HAQ after withdrawal will be back to natural history line
tab2<-tab.dat2}

if (sa==27){#costs of drugs, =0, psoriasis = 0
tab1<-tab.dat1
tab2<-tab.dat2
tab2$c.drug1<−0
tab2$c.drug2<−0
tab2$c.drug3<−0
tab1$c2.1<−0
tab1$c2.2<−0
tab1$h2<−0

}

if (sa==28){#costs of psoriasis<−0, HAQ = 0
tab1<-tab.dat1
tab2<-tab.dat2
tab1$c2.1<−0
tab1$c2.2<−0
tab1$c1<−0
tab1$c0<−0

tab1$h1<−0
tab1$h2<−0
}
if (sa==29){#costs haq 0, drugs =0
tab1<-tab.dat1
tab2<-tab.dat2
tab1$c1<−0
tab1$c0<−0
tab2$c.drug1<−0
tab2$c.drug2<−0
tab2$c.drug3<−0
tab1$h1<−0

}

if (sa==30){#no psoriasis
tab1<-tab.dat1
tab2<-tab.dat2
tab1$PASI0<−0
tab1$c2.1<−0
tab1$c2.2<−0
tab1$h2<−0
}
if (sa==31){#no psoriasis costs
tab1<-tab.dat1
tab2<-tab.dat2
tab1$c2.1<−0
tab1$c2.2<−0
}
if (sa==32){#low linear psoriasis costs (SP)
tab1<-tab.dat1
tab2<-tab.dat2
tab1$c2.1<−0
tab1$c2.2<−0
c.pasi<−53
}
if (sa==33){#high linear psoriasis costs (SP)
tab1<-tab.dat1
tab2<-tab.dat2
tab1$c2.1<−0
tab1$c2.2<−0
c.pasi<−167
}
if (sa==34){#high withdrawal
tab1<-tab.dat1
tab2<-tab.dat2
tab1$ln.long.yr<-log(0.11)
}

#deterministic = 1, probabilistic = 2
if (deter ==1){}
if (deter ==2) {

#############################Monte Carlo simulation
attach(tab1)
attach(tab2)
#tab1$h0[1]<-rnorm(1,h0[1],h0_SE[1])#amend? use cholesky
tab1$h1[1]<-rnorm(1,h1[1],h1_SE[1])#utility function
tab1$h2[1]<-rnorm(1,h2[1],h2_SE[1])
tab1$h3[1]<-rnorm(1,h3[1],h3_SE[1])
if (sa==4){#Abbott utility function
tab1$hhaq<- rnorm(1,hhaq,hhaq_SE)
tab1$hpasi<- rnorm(1,hpasi,hpasi_SE)}
tab1$c1[1]<-rnorm(1,c1[1],c1_SE[1])#cost as function of HAQ
if (!(sa==30∣sa==31∣sa==32∣sa==33)){
tab1$c2.1[1]<-rnorm(1,c2.1[1],c2.1_SE[1])#cost with hospital trt for skin
tab1$c2.2[1]<-rnorm(1,c2.2[1],c2.2_SE[1])}#cost with controlled skin
tab1$HAQ1.d<-rnorm(1,HAQ1.d[1],HAQ1.d_SE[1])#HAQ progression on drug
#HAQ1.w is difficult to parameterise/results are non linear in changesi n this parameter
mn<-HAQ1.w#from NOAR
var<-(HAQ1.w_SE^2)
tab1$HAQ1.w<-rgamma(1,shape=a.gamma(mn,var),scale=s.gamma(mn,var))#HAQ progression off drug
#Loss is bounded by the initial gain, so is non-symetric. Difficult to parameterise for prob sa
tab1$loss.w[1]<-rnorm(1,loss.w[1],loss.w_SE[1])#rebound
tab1$ln.R.g.m[1]<-rnorm(1,ln.R.g.m[1],ln.R.g_SE[1])#Gompertz male
tab1$a.g.m[1]<-rnorm(1,a.g.m[1],a.g_SE[1])
tab1$ln.R.g.f[1]<-rnorm(1,ln.R.g.f[1],ln.R.g_SE[1])#Gompertz female
tab1$a.g.f[1]<-rnorm(1,a.g.f[1],a.g_SE[1])
tab1$ln.long.yr[1]<-rnorm(1,ln.long.yr[1],ln.long.yr_SE[1])#long term withdrawal rate
tab1$HAQ.resp.plac<-rnorm(1,HAQ.resp.plac,HAQ.resp.plac_SE)
if (sa==24) {tab1$ln.inef<-rnorm(1,ln.inef,ln.inef_SE)}
if (sa==25) {tab1$ln.AE<-rnorm(1,ln.AE,ln.AE_SE)}

mn<-p.psarc.plac[1]
var<-p.psarc.plac_SE[1]^2
tab1$p.psarc.plac[1]<-rbeta(1,a.beta(mn,var),b.beta(mn,var))#psarc placebo
mn<-p.pasi.50.plac[1]
var<-p.pasi.50.plac_SE[1]^2
tab1$p.pasi.50.plac[1]<-rbeta(1,a.beta(mn,var),b.beta(mn,var))#
mn<-p.pasi.75.plac[1]
var<-p.pasi.75.plac_SE[1]^2
tab1$p.pasi.75.plac[1]<-rbeta(1,a.beta(mn,var),b.beta(mn,var))#
mn<-p.pasi.90.plac[1]
var<-p.pasi.90.plac_SE[1]^2
tab1$p.pasi.90.plac[1]<-rbeta(1,a.beta(mn,var),b.beta(mn,var))#
mn<-p.psarc[1:3]
var<-p.psarc_SE[1:3]^2
tab2$p.psarc[1:3]<-rbeta(3,a.beta(mn,var),b.beta(mn,var))
mn<-p.pasi.50[1:3]
var<-p.pasi.50_SE[1:3]^2
tab2$p.pasi.50[1:3]<-rbeta(3,a.beta(mn,var),b.beta(mn,var))#trt response

mn<-p.pasi.75[1:3]
var<-p.pasi.75_SE[1:3]^2
tab2$p.pasi.75[1:3]<-rbeta(3,a.beta(mn,var),b.beta(mn,var))#trt response
mn<-p.pasi.90[1:3]
var<-p.pasi.90_SE[1:3]^2
tab2$p.pasi.90[1:3]<-rbeta(3,a.beta(mn,var),b.beta(mn,var))#trt response

tab2$HAQ.no.resp[1:3]<-rnorm(3,HAQ.no.resp,HAQ.no.resp_SE)#these may have to be constructed from elemental data
tab2$HAQ.resp[1:3]<-rnorm(3,HAQ.resp,HAQ.resp_SE)
tab2$rho[1:3]<-rnorm(3,rho,rho_SE)#correlation PASI 75 & PsARC
detach(tab1)
detach(tab2)

}# end if
t0<-proc.time()
attach(tab1)
attach(tab2)

#############################functions
#Gompertz hazard for all cause mortality.
#Probability of death during 3month period t+dt given survival up to cycle t
#This could be done by looking up from life tables, but the Gompertz gives a
#very good parametric fit to life table hazards, and requires fewer parameter inputs
p.m<-function(t) {smr*R.g*exp(a.g.1*((t-1)/4+Age))/4}
disc<-function(t){(1+r)^(-(t-1)/4)}#discount rate
#HAQ and PASI are clinical scoring systems for arthritis and skin respectively
#, a higher value of either is a worse health state
if (sa!=4) EQ5D<-function(HAQ,PASI){h0+h1*HAQ+h2*PASI+h3*HAQ*PASI}#EQ5D utility given HAQ
if (sa==4) EQ5D<-function(HAQ,PASI){h0+hhaq*HAQ+hpasi*log(PASI+0.5)}# Abbott utility
if (sa!=9) c.HAQ<-function(HAQ){c0+c1*HAQ}#costs given HAQ
if (sa==9) c.HAQ<-function(HAQ){alpha*exp(beta*HAQ)}#costs given HAQ, Abbott
HAQ.w1<-function(t){HAQ.d(W)+rebound(W)+HAQ1.w*(t-W)}#HAQ at time t after time of withdrawal W(t>=W)
HAQ.w2<-function(t){ifelse(HAQ.w1(t)<3,ifelse(HAQ.w1(t)>0,HAQ.w1(t),0),3)}
HAQ.w<-function(t){ifelse(t>=W,HAQ.w2(t),NA)}
HAQ.d1<-function(t){HAQ0+HAQ1.d*(t-1)}#HAQ while on drug (but not counting initial gain, this is added later)
HAQ.d<-function(t){ifelse(HAQ.d1(t)<3,ifelse(HAQ.d1(t)>0,HAQ.d1(t),0),3)}

#Parameter ‘loss’ is the absolute rebound in HAQ after withdrawal, relative to baseline HAQ
#If loss>=0 then this is rebound at least to initial gain ie:baseline HAQ0 <= Loss <= natural history
#Loss can also be negative, meaning that the HAQ loss on withdrawal is less than the HAQ initial gain
#ie maintain some of the inital gain in the long term after withdrawal
#If loss = 3 then this is rebound in HAQ to ‘natural history ie what it would have been if no antiTNF had been given
rebound<-function(t){ifelse((HAQ1.w-HAQ1.d)*(t-1)>loss,loss,(HAQ1.w-HAQ1.d)*(t-1))}#loss of 0 is rebound to initial gain
#HAQ,if never started on drug (natural history)
HAQ.never1<-function(t){HAQ0+HAQ1.w*(t-1)}
HAQ.never<-function(t){ifelse(HAQ.never1(t)<3,ifelse(HAQ.never1(t)>0,HAQ.never1(t),0),3)}
Mn.logn<-function(mu,se){exp(mu+0.5*se^2)}#Mean(X) if X = exp(Y) and Y∼normal(mu,se)
Var.logn<-function(mu,se){(exp(se^2)−1)*exp(2*mu+se^2)}#Var(X) if X=exp(Y) and Y∼normal(mu,se)
Mn.Pr<-function(odds){exp(odds)/(1+exp(odds))}#probability given odds
#Delta method: Second order Taylor expansion to approximate variance of probability (Wikipedia: «Variance»)
Var.Pr<-function(odds,var.odds){((odds/((1+odds)^2))^2)*var.odds}#variance of probability given odds
#########################Parameter assignment

#parameters (constants)
smr<-ifelse(Male==1,SMRmen,SMRwomen)
#T= number of cycles, each cycle is 3months
T <-Years*4
#All cause survival (only valid for Age > 40)
R.g<- exp(ifelse(Male==1,ln.R.g.m[1],ln.R.g.f[1]))
a.g.1<-ifelse(Male==1,a.g.m,a.g.f) #parameter of Gompertz function
#3 drugs, A E I
#5 types of response in short term
#(1=response skin only,2= response joints only
#, 3= response both, 4 = no response, 5 = adverse effect)

#long term fail rate
#p.long might also depend on whether first or second line, and reason for previous failure
#Expressed as 3m rate of withdrawal, in Bravo Vergel was 0.113
rate.long<-Mn.logn(ln.long.yr,ln.long.yr_SE)#annual withdrawal rate
if (sa ==24){#2nd course of biologics given inefficacy in first course
rate.long<-rate.long*p.inef*exp(ln.inef)+rate.long*(1-p.inef)}
if (sa ==25){#2nd course of biologics given AE in first course
rate.long<-rate.long*p.AE*exp(ln.AE)+rate.long*(1-p.AE)}

p.long<-rep(1-exp(-rate.long/4),3)#lognormal
#response to drug in first 12 weeks after trial
#Here we must make assumptions about the joint probability of skin and arthritis response
#Some data from ADEPT trial, otherwise assume independence of response types

#Rebound
#Loss is a parameter representing the expert opinion of the change in HAQ after withdrawal from drug compared with initial gain
loss<-max(c(loss.w,HAQ.resp))#HAQ ∣response is negative for all drugs.
#Therefore «loss» can take values from HAQ.resp (< 0, represents no change) to 3 (natural history).
#Zero represents return to the initial baseline HAQ0

#PASI responses
p.pasi.0.49.plac<- 1-p.pasi.50.plac
p.pasi.50.70.plac<-p.pasi.50.plac-p.pasi.75.plac
p.pasi.75.89.plac<-p.pasi.75.plac-p.pasi.90.plac
p.pasi.90.100.plac<-p.pasi.90.plac

p.pasi.0.49<- 1-p.pasi.50
p.pasi.50.74<-p.pasi.50-p.pasi.75
p.pasi.75.89<-p.pasi.75-p.pasi.90
p.pasi.90.100<-p.pasi.90
#rho = correlation between pasi75 and psarc
limit<-array(c(1,1,1,−1,−1,−1),dim=c(3,2))#upper and lower limits on rho for each drug
#there is theoretical limit on the correlation coefficient rho given pasi75 and psarc
odds.pasi<-p.pasi.75/(1-p.pasi.75)
odds.psarc<-p.psarc/(1-p.psarc)

if (sa==24){#psarc of 2nd biologic if inefficacy in first biologic
odds.psarc<-odds.psarc/exp(ln.inef)}
p.psarc.new<-odds.psarc/(1+odds.psarc)
#ensure rho is always within logical limits
compare1<-array(c(sqrt(odds.pasi/odds.psarc),sqrt(odds.psarc/odds.pasi)),dim=c(3,2))
compare2<-array(c(-sqrt(odds.pasi*odds.psarc),−1/sqrt(odds.psarc*odds.pasi)),dim=c(3,2))
limit[,1]<-apply(compare1,1,min)#upper limit, always less than 1
limit[,2]<-apply(compare2,1,max)#lower limit, always greater than −1
rho.new<-ifelse(rho>limit[,1],limit[,1],ifelse(rho<limit[,2],limit[,2],rho))

#p.both=rho*SD(x)*SD(y) + Pr(x=1)P(y=1)
#This formula is the SD and not the SE of X, because we are estimating population variability not uncertainty
p.both<-rho.new*sqrt(p.psarc.new*(1-p.psarc.new)*p.pasi.75*(1-p.pasi.75)) + p.pasi.75*p.psarc.
new #prob of both skin and psarc responses
p<-array(NA,dim=c(5,3))#probs of initial response types
colnames(p)<-c(“E”,“I”,“A”)
rownames(p)<-c(“skin only”,“joints only”,“both”,“neither”,“AE”)
p[1,]<-(1-p.adv)*(p.pasi.75-p.both) #response to skin only pasi75
p[2,]<-(1-p.adv)*(p.psarc.new-p.both) #response to joints only psarc
p[3,]<-(1-p.adv)*p.both #response to both skin and joints
p[4,]<-(1-p.adv)*(c(1,1,1)-p[3,]-p[2,]-p[1,])#no response to either
p[5,]<-p.adv #adverse event during first 12 weeks (there might not be any)

#absolute mean change in pasi from t=0 to beginning of t=1 (3months)
#,assuming a ‘pasi 75.90’ gives exactly a 75% reduction etc
#(in reality it will be between 75 and 90%)
PASI.no.resp<- PASI0*(0*p.pasi.0.49+ 0.5*p.pasi.50.74)/(1-p.pasi.75) #change in pasi from baseline ∣no PASI 75 response
PASI.resp<- PASI0*(0.75*p.pasi.75.89+ 0.9*p.pasi.90.100)/p.pasi.75 #change in pasi from baseline ∣yes PASI 75 response

PASI.resp.plac<- PASI0*(0.75*p.pasi.75.89.plac+ 0.9*p.pasi.90.100.plac)/p.pasi.75.plac #change in pasi from baseline ∣yes PASI 75 response

PASI.initial<-array(NA,dim=c(3,5))#reduction in PASI from baseline given response type rownames(PASI.initial)<-c(“E”,“I”,“A”)

#”E”,“I”,“A”
HAQ.initial<-array(NA,dim=c(3,5)) #Change in HAQ from baseline given response type rownames(HAQ.initial)<-c(“E”,“I”,“A”)
#adjustment for placebo effect (Bravo Vergel used scenario 1)
#plac.effect <−1 = regression to mean or subject expectancy trial specific 2 = subject expecancy generalisable to general practice
if (plac.effect ==1){#remove average placebo effect from effectiveness estimates
HAQ.initial[,1]<-HAQ1.w+HAQ.no.resp-p.psarc.plac*HAQ.resp.plac#if only skin response
HAQ.initial[,2]<-HAQ1.w+HAQ.resp-p.psarc.plac*HAQ.resp.plac#if only joints response
HAQ.initial[,3]<-HAQ1.w+HAQ.resp-p.psarc.plac*HAQ.resp.plac#if both respond
HAQ.initial[,4]<-HAQ1.w+HAQ.no.resp-p.psarc.plac*HAQ.resp.plac#if neither respond
HAQ.initial[,5]<-HAQ1.w+HAQ.no.resp-p.psarc.plac*HAQ.resp.plac#in the cycle after an adverse event

PASI.initial[,1]<-PASI.resp-p.pasi.75.plac*PASI.resp.plac #if only skin response (await evidence synthesis)
PASI.initial[,2]<-PASI.no.resp-p.pasi.75.plac*PASI.resp.plac #if only joints response
PASI.initial[,3]<-PASI.resp-p.pasi.75.plac*PASI.resp.plac #if both respond
PASI.initial[,4]<-PASI.no.resp-p.pasi.75.plac*PASI.resp.plac #if neither respond
PASI.initial[,5]<-PASI.no.resp-p.pasi.75.plac*PASI.resp.plac #in the cycle after an adverse event

}
if (plac.effect ==2){#no adjustment for placebo effects, assume that they will be carried forward in general practice
HAQ.initial[,1]<-HAQ1.w+HAQ.no.resp#if only skin response
HAQ.initial[,2]<-HAQ1.w+HAQ.resp#if only joints response
HAQ.initial[,3]<-HAQ1.w+HAQ.resp#if both respond
HAQ.initial[,4]<-HAQ1.w+HAQ.no.resp#if neither respond
HAQ.initial[,5]<-HAQ1.w+HAQ.no.resp#in the cycle after an adverse event
PASI.initial[,1]<-PASI.resp #if only skin response
PASI.initial[,2]<-PASI.no.resp #if only joints response
PASI.initial[,3]<-PASI.resp #if both respond
PASI.initial[,4]<-PASI.no.resp #if neither respond
PASI.initial[,5]<-PASI.no.resp #in the cycle after an adverse event

}

# HAQ at each cycle, given type of response (while on drug)
Q<-array(0,dim=c(3,T,5))
rownames(Q)<-c(«E»,»I»,»A»)
t<−1:T
Q[,,1]<-rep(HAQ.d(t),each=3) + rep(HAQ.initial[,1],times=T)
Q[,,2]<-rep(HAQ.d(t),each=3) + rep(HAQ.initial[,2],times=T)
Q[,,3]<-rep(HAQ.d(t),each=3) + rep(HAQ.initial[,3],times=T)
Q[,,4]<-rep(HAQ.d(t),each=3) + rep(HAQ.initial[,4],times=T)
Q[,,5]<-rep(HAQ.d(t),each=3) + rep(HAQ.initial[,5],times=T)

Q<-ifelse(Q>3,Q,ifelse(Q<0,0,Q))#HAQ max is 3 and min is 0

P<-array(0,dim=c(3,T,5)) #PASI at end of cycle, given each type of response (while on drug)
rownames(P)<-c(“E”,“I”,“A”)
P[,,1]<- rep(PASI0-PASI.initial[,1],times=T)
P[,,2]<- rep(PASI0-PASI.initial[,2],times=T)
P[,,3]<- rep(PASI0-PASI.initial[,3],times=T)
P[,,4]<- rep(PASI0-PASI.initial[,4],times=T)
P[,,5]<- rep(PASI0-PASI.initial[,5],times=T)

P<-ifelse(P>72,P,ifelse(P<0,0,P))#PASI max is 72 and min is 0

QALY<-EQ5D(Q,P)*0.25 #QALYs for one 3m cycle based on HAQ at start of cycle

#costs if joints are controlled
C<-array(NA,dim=c(3,T,5))#3m costs of drugs and admin
C[,1,]<-c.drug1
C[,2,]<-c.drug2
C[,3:T,]<-c.drug3

#additional costs of treating HAQ & PASI
C[,,]<-C[,,]+c.HAQ(Q)+c.pasi*P #3m costs given HAQ score
C[,,1]<-C[,,1]+c2.2 #controlled skin condition
C[,,2]<-C[,,2]+c2.1 #uncontrolled skin condition
C[,,3]<-C[,,3]+c2.2 #controlled skin condition
C[,,4]<-C[,,4]+c2.1 #uncontrolled skin condition
C[,,5]<-C[,,5]+c2.1 #uncontrolled skin condition

#discount rate at time t
t<−1:T
d<-rep((1+r)^(-(t-1)/4),each=3)
d<-array(d,dim=c(3,T,5))
#apply discount rates
C<-C*d
QALY<-QALY*d

##################Calculation of model outputs

#Cumulative future QALYs N(t) from time of withdrawal t=W to T
#assuming death occurs at start of period T, so last period of life confers no costs or benefits
#if no further biologics (ie palliative care)
#Independent of drug in this version of the model
QALY.n<-rep(0,times=T)#qalys after failing drug at time W
Cost.n<-rep(0,times=T)#costs after failing drug at time W

QALY.never<-rep(0,times=(40*4))#qaly if never taken drug
Cost.never<-rep(0,times=(40*4))#costs if never taken drug
#This code calcuates the QALYs and costs of cohort who never started drugs

if (T<(40*4)){
for (cycle in (40*4−1):T){
QALY.never[cycle]<-(1- p.m(cycle))*(EQ5D(HAQ.never(cycle),PASI0)*disc(cycle)*0.25+QALY.
never[cycle+1])
Cost.never[cycle]<-(1-p.m(cycle))*((c.HAQ(HAQ.never(cycle))+c2.1+c.
pasi*PASI0)*disc(cycle)+Cost.never[cycle+1])

}}

for (cycle in (T-1):1){
QALY.never[cycle]<-(1- p.m(cycle))*(EQ5D(HAQ.never(cycle),PASI0)*disc(cycle)*0.25+QALY.
never[cycle+1])
Cost.never[cycle]<-(1-p.m(cycle))*((c.HAQ(HAQ.never(cycle))+c2.1+c.
pasi*PASI0)*disc(cycle)+Cost.never[cycle+1])
}

Q.t.n<-rep(0,times=T)#temporary value holder
C.t.n<-rep(0,times=T)#temporary value holder
#Costs and QALYs after final period of life, no further benefit (assume end of life)
#If model time horizon is < 40 years, assume all withdraw at T years and no further benefit of drugs
Q.t.n[T]<-QALY.never[T]
C.t.n[T]<-Cost.never[T]
QALY.n[T]<-QALY.never[T]
Cost.n[T]<-Cost.never[T]
#This code calcuates the QALYs and costs from time of withdrawal from drug at W to end of lifetime, for every value of W
for (W in 1:(T-1)){ #W= time of withdrawal
for (cycle in (T-1):W){
Q.t.n[cycle]<-(1-p.m(cycle))*(EQ5D(HAQ.w(cycle),PASI0)*disc(cycle)*0.25+Q.t.n[cycle+1])
C.t.n[cycle]<-(1-p.m(cycle))*((c.HAQ(HAQ.w(cycle))+c2.1+c.pasi*PASI0)*disc(cycle)+C.t.n[cycle+1])
}
QALY.n[W]<-Q.t.n[cycle]
Cost.n[W]<-C.t.n[cycle]
}
W<−1

#future net benefit given continuation current drug (1..3), time (1..T),
Q.drug<-array (NA,c(3,T))
C.drug<-array (NA,c(3,T))
rownames(C.drug)<-c(“E”,“I”,“A”)
rownames(Q.drug)<-c(“E”,“I”,“A”)

#Costs and QALYs after final period of life, no further benefit (assume end of life)
#If model time horizon is less than 40 years, assume all withdraw at T years and no further benefit of drugs
C.drug[,T]<-Cost.never[T]
Q.drug[,T]<-QALY.never[T]

#This code calcuates costs and QALYs in each period
#Remember C[choice, cycle, 2] means costs in period “cycle” while on drug “choice” if you are a PsARC responder but not a PASI 75 responder
#and C[choice, cycle, 3] means costs in period “cycle” on drug “choice” if you are PsARC and PASI 75 responder

#It is assumed that withdrawal rate p.long[] is exogenous ie does not depend on current health state.
#First 12 weeks, different response probabilities p
#At the end of 12 weeks, withdrawal is ENDOGENOUS ie a decision that depends on response
#We need a rule about when to continue with a drug or not
#In base-case we continue if patient respond to PsARC
#We can try other rules as sensitivity analyses eg continue if respond to both PsARC and PASI 75
#Continue = 1 = continue if responds to PsARC (irrespective of skin), base-case
#Continue = 2 = continue if reponds to both PsARC and PASI 75
#Continue = 3 = continue if responds to PASI 75 (irrespective of joints)
#Continue = 4 = continue if responds to either
#Continue = 5 = continue regardless of response

if (continue==1) {
for (cycle in (T-1):2){
for (choice in 1: 3) {
#Assume that those who continue on therapy have adequate joint control but might not have adequate skin control (PASI 75 & PsARC)

#and assume that those who do not continue might have adequate control of PASI 75
C.drug[choice,cycle]<-(1-p.long[choice])*((p[2,choice]*C[choice,cycle,2]+p[3,choice]*C[choice, cycle,3])/(p[2,choice]+p[3,choice])+C.drug[choice, cycle+1])
C.drug[choice,cycle]<-C.drug[choice,cycle]+p.long[choice]*((p[1,choice]*C[choice,cycle,1]+p[4, choice]*C[choice,cycle,4])/(p[1,choice]+p[4,choice])+Cost.n[cycle+1])
C.drug[choice,cycle]<-C.drug[choice,cycle]*(1-p.m(cycle))#All cause mortality

Q.drug[choice,cycle]<-(1-p.long[choice])*((p[2,choice]*QALY[choice,cycle,2]+p[3,choice]*QALY[choice,cycle,3])/(p[2,choice]+p[3,choice])+Q.drug[choice, cycle+1])
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+p.long[choice]*((p[1,choice]*QALY[choice,cycle,1] +p[4,choice]*QALY[choice,cycle,4])/(p[1,choice]+p[4,choice])+QALY.n[cycle+1])#if no efficacy at the end of this cycle then switch
Q.drug[choice,cycle]<-Q.drug[choice,cycle]*(1-p.m(cycle))

#print(c(cycle, choice,C.drug[choice,cycle]))#debugging
}} #end choice loop, cycles loops

#If no response then get some benefit in the first cycle but none thereafter relative to palliative care
cycle<−1
for (choice in 1: 3) {
C.drug[choice,cycle]<-(C[choice,cycle,1]+Cost.never[cycle+1])*p[1,choice]#if skin response but no joint response then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,2]+C.drug[choice,cycle+1])*p[2,cho ice]#if joint response but no skin response then continue
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,3]+C.drug[choice,cycle+1])*p[3,cho ice]#if response to both skin & joint then continue
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,4]+Cost.
never[cycle+1])*p[4,choice]#if no response to either then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,5]+Cost.
never[cycle+1])*p[5,choice]#if adverse effect then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]*(1-p.m(cycle)) #adjust for all cause mortality during this cycle
Q.drug[choice,cycle]<-        (QALY[choice,cycle,1]+QALY.never[cycle+1])*p[1,choice]#if skin response but no joint response then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,2]+Q.drug[choice,cycle+1])*p[ 2,choice]#if joint response but no skin response then continue
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,3]+Q.drug[choice,cycle+1])*p[ 3,choice]#if response to both skin & joint then continue
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,4]+QALY.
never[cycle+1])*p[4,choice]#if no response to either then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,5]+QALY.
never[cycle+1])*p[5,choice]#if adverse effect then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]*(1-p.m(cycle)) #adjust for all cause mortality during this cycle
}}#end choice loop, end if
if (continue==2) {#continue only if respond to both psarc + pasi75
for (cycle in (T-1):2){
for (choice in 1: 3) {
#Assume that those who continue on therapy have adequate joint control and adequate skin control (PASI 75 & PsARC)
C.drug[choice,cycle]<-(1-p.long[choice])*(C[choice,cycle,3]+C.drug[choice, cycle+1])
C.drug[choice,cycle]<-C.drug[choice,cycle]+p.long[choice]*((p[1,choice]*C[choice,cycle,1]+p[2 ,choice]*C[choice,cycle,2]+p[4,choice]*C[choice,cycle,4])/(p[1,choice]+p[2,choice]+p[4,choice]) +Cost.n[cycle+1])
C.drug[choice,cycle]<-C.drug[choice,cycle]*(1-p.m(cycle))#All cause mortality

Q.drug[choice,cycle]<-(1-p.long[choice])*(QALY[choice,cycle,3]+Q.drug[choice, cycle+1])
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+p.long[choice]*((p[1,choice]*QALY[choice,cycle,1] +p[2,choice]*QALY[choice,cycle,2]+p[4,choice]*QALY[choice,cycle,4])/(p[1,choice]+p[2,choice] +p[4,choice])+QALY.n[cycle+1])#if no efficacy at the end of this cycle then switch
Q.drug[choice,cycle]<-Q.drug[choice,cycle]*(1-p.m(cycle))

#print(c(cycle, choice,C.drug[choice,cycle]))#debugging
}} #end choice loop, cycles loops
cycle<−1
for (choice in 1: 3) {
C.drug[choice,cycle]<-          (C[choice,cycle,1]+Cost.never[cycle+1])*p[1,choice]#if skin response but no joint response then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,2]+Cost.
never[cycle+1])*p[2,choice]#if joint response but no skin response then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,3]+C.drug[choice,cycle+1])*p[3,cho ice]#if response to both skin & joint then continue
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,4]+Cost.
never[cycle+1])*p[4,choice]#if no response to either then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,5]+Cost.
never[cycle+1])*p[5,choice]#if adverse effect then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]*(1-p.m(cycle)) #adjust for all cause mortality during this cycle
Q.drug[choice,cycle]<-        (QALY[choice,cycle,1]+QALY.never[cycle+1])*p[1,choice]#if skin response but no joint response then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,2]+QALY.
never[cycle+1])*p[2,choice]#if joint response but no skin response then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,3]+Q.drug[choice,cycle+1])*p[ 3,choice]#if response to both skin & joint then continue
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,4]+QALY.
never[cycle+1])*p[4,choice]#if no response to either then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,5]+QALY.
never[cycle+1])*p[5,choice]#if adverse effect then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]*(1-p.m(cycle)) #adjust for all cause mortality during this cycle
}}#end choice loop,end if

if (continue==4) {#continue if respond to either psarc or pasi75
for (cycle in (T-1):2){
for (choice in 1: 3) {
C.drug[choice,cycle]<-(1-p.long[choice])*((p[1,choice]*C[choice,cycle,1]+p[2,choice]*C[choice ,cycle,2]+p[3,choice]*C[choice,cycle,3])/(p[1,choice]+p[2,choice]+p[3,choice])+C.drug[choice, cycle+1])
C.drug[choice,cycle]<-C.drug[choice,cycle]+p.long[choice]*(C[choice,cycle,4]+Cost.n[cycle+1])
C.drug[choice,cycle]<-C.drug[choice,cycle]*(1-p.m(cycle))#All cause mortality
Q.drug[choice,cycle]<-(1-p.long[choice])*((p[1,choice]*QALY[choice,cycle,1]+p[2,choice]*QALY[choice,cycle,2]+p[3,choice]*QALY[choice,cycle,3])/(p[1,choice]+p[2,choice]+p[3,choice])+Q. drug[choice, cycle+1])
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+p.long[choice]*(QALY[choice,cycle,4]+QALY.n[cyc le+1])#if no efficacy at the end of this cycle then switch
Q.drug[choice,cycle]<-Q.drug[choice,cycle]*(1-p.m(cycle))

#print(c(cycle, choice,C.drug[choice,cycle]))#debugging
}} #end choice loop, cycles loops
cycle<−1
for (choice in 1: 3) {
C.drug[choice,cycle]<-          (C[choice,cycle,1]+C.drug[choice,cycle+1])*p[1,choice]#if skin response but no joint response then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,2]+C.drug[choice,cycle+1])*p[2,cho ice]#if joint response but no skin response then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,3]+C.drug[choice,cycle+1])*p[3,cho ice]#if response to both skin & joint then continue
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,4]+Cost.
never[cycle+1])*p[4,choice]#if no response to either then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]+(C[choice,cycle,5]+Cost.
never[cycle+1])*p[5,choice]#if adverse effect then withdraw
C.drug[choice,cycle]<-C.drug[choice,cycle]*(1-p.m(cycle)) #adjust for all cause mortality during this cycle
Q.drug[choice,cycle]<-        (QALY[choice,cycle,1]+Q.drug[choice,cycle+1])*p[1,choice]#if skin response but no joint response then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,2]+Q.drug[choice,cycle+1])*p[ 2,choice]#if joint response but no skin response then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,3]+Q.drug[choice,cycle+1])*p[ 3,choice]#if response to both skin & joint then continue
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,4]+QALY.
never[cycle+1])*p[4,choice]#if no response to either then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]+(QALY[choice,cycle,5]+QALY.
never[cycle+1])*p[5,choice]#if adverse effect then withdraw
Q.drug[choice,cycle]<-Q.drug[choice,cycle]*(1-p.m(cycle)) #adjust for all cause mortality during this cycle
}}#end choice loop,end if

##################Print outputs

#print(«QALY, cost with drugs»)
#print(Q.drug[,1])
#print(C.drug[,1])#first period outcomes and costs
#print(«QALY, cost without drug»)
#print(QALY.never[1])
#print(Cost.never[1])#no drug
#print(«Run time in seconds»)
t1<-proc.time()
time<-t1-t0#running time, seconds
#print(time[3])
out<-array(0,dim=c(4,2))
rownames(out)<-c(“N”,”E”,”I”,”A”)
colnames(out)<-c(“Q”,”C”)
out[2:4,1]<-Q.drug[,1]
out[2:4,2]<-C.drug[,1]
out[1,1]<-QALY.never[1]
out[1,2]<-Cost.never[1]
detach(tab1)
detach(tab2)
return(out)
}#end of model

sims.mn<-function(m){#mean values of simulations
m.Q<-apply(m[,,1],2,mean)
m.C<-apply(m[,,2],2,mean)
out<-data.frame(Q=m.Q,C=m.C)
return(out)}

sims<-function(NSims,sa1,Yr){#Run model NSims times
#deter=1 & NSims=1, deterministic; deter=2, prob sens analysis
#Yr time horizon
m<-array(NA,dim=c(NSims,4,2))
#colnames(m)<-c(“QN”,”QE”,”QI”,”QA”,”CN”,”CE”,”CI”,”CA”)
dimnames(m)<-list(NULL,c(“N”,”E”,”I”,”A”),c(“Q”,”C”))
for (i in 1:NSims){
m[i,,]<-model(sa=sa1,deter=2, Years=Yr)#basecase
}#end loop
write.csv(m, file = paste(“Results\\sa”,scenario,”\\probsa.csv”,sep=““))

return(m)
}#end sims

nb<-function(n){#CEACC
Lnum<−1:101
L<-(Lnum-1)*1000#willingness to pay
u<-n[,,1]
c<-n[,,2]
uL<-apply(u,c(1,2),function(x)x*L)
cL<-apply(c,c(1,2),function(x)x*rep(1,length(L)))
nL<-uL-cL
rownames(nL)<-L
maxnL<-apply(nL,c(1,2),max)
whichmaxnL<-apply(nL,c(1,2),which.max)
p1<-apply(whichmaxnL,1,function(x)match(x,1,0))#no treat
p2<-apply(whichmaxnL,1,function(x)match(x,2,0))#etha
p3<-apply(whichmaxnL,1,function(x)match(x,3,0))#infl
p4<-apply(whichmaxnL,1,function(x)match(x,4,0))#ada

pr<-array(NA,dim=c(length(L),4))#Pr(cost effective)
pr[,1]<-apply(p1,2,mean)
pr[,2]<-apply(p2,2,mean)
pr[,3]<-apply(p3,2,mean)
pr[,4]<-apply(p4,2,mean)
colnames(pr)<-c(“N”,“E”,“I”,“A”)
rownames(pr)<-L
write.csv(pr, file = paste(“Results\\sa”,scenario,“\\ceacc.csv”,sep=“”))
return(list(nL,pr))
}