# 2 state Cost-Effectiveness Model v16
# Markov model to estimate the impact of serious handling errors on the cost-effectiveness of asthma inhalers
# R MODEL: Developed by Maverex Ltd.

#Copyright (C) 2017 Mundipharma International

#This program is free software: you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation, either version 3 of the License, or
#(at your option) any later version.

#This program is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#GNU General Public License for more details.

#For access to the GNU General Public License, see <http://www.gnu.org/licenses/>.

rm(list = ls())
#Packages must be installed prior to running
#install.packages(c("data.table", "BCEA","ggplot2","gridExtra","plyr","dplyr","openxlsx","matrixStats","gplots","reshape2","latticeExtra"))
library(data.table)
library(BCEA)
library(ggplot2)
library(gridExtra)
library(plyr)
library(dplyr)
library(openxlsx)
library(matrixStats)
library(gplots)
library(reshape2)
library(latticeExtra)


Date<-format(Sys.Date(),"%Y%m%d")

  #wrkng.dir <- "<your directory address>/InhalerMundiRfiles"
#wrkng.dir <- "C:/Users/anton/Box Sync/Project Folder/Mundipharma/KHaler (Asthma)/KHalerRemoved/InhalerMundiRfiles"
wrkng.dir <- "/Users/ammadrigal/Documents/BBIS/Maverex/KHaler/KHalerMundiR/InhalerMundiRfiles_v19_April18"
setwd(wrkng.dir)

## Get the model functions from the /lib folder
 source(file.path(wrkng.dir,"/lib/InhalerFunctions.R"))


#########################    Import data     ###############################
dir.create(file.path(wrkng.dir, "outputDataDir"), showWarnings = FALSE)
outputDataDir<-file.path(wrkng.dir, "outputDataDir")

base.data <- read.csv(file.path(wrkng.dir,"/data/parameters.csv"),stringsAsFactors = FALSE)
eq <- with(base.data, paste(paste(R.name, Base.Case, sep="<-"),collapse=";"))
eval(parse(text=eq)) # Creates and resets variables in model

#########################    GLOBAL PARAMETERS  #############################

# FOR INFO: Run choices:
# HE_Approach (1: RR=OR, 2: Convert OR to RR),
# TM_Choice (1: Bateman; 2:Combescure),
# TimeHorizon : applied for 1,3,5 years in the same run: Fixed
# nSims (default 5000 suggested between 1K and 10K: each 1K about 5 minutes)
# DSAp: Variation for DSA in percentage
# PSArun: 1: Yes; 0:No # PSArun<-0
# DSArun: 1: Yes; 0:No # DSArun<-0
# PPrun: 1: Yes; 0:No  # PPrun<-0

## set global parameters
yearLab<-c("1.years","3.years","5.years")
nCycles<- 260 ## 260 weeks in 5 years
discYear<-rep(0:4,each=52)
n.sims <- nSims
treatNames.a<-gsub("P_E1_","",ls()[grep("P_E1_",ls())]) # alphabetical order
treatNames<-c("Inhaler", treatNames.a[!treatNames.a %in% c("Inhaler","Custom")],"Custom")


## create deterministic base transition matrix and applying handling error logic

## Read chosen Transition Matrix as base
TMbase<-switch(TM_Choice, matrix(c(TP_B_CC_basecase,TP_B_UC_basecase,TP_B_CU_basecase,TP_B_UU_basecase),nrow=2),
               matrix(c(TP_C_CC_basecase,TP_C_UC_basecase,TP_C_CU_basecase,TP_C_UU_basecase),nrow=2))

## Apply handling error probabilities and obtain default RRs

source(file.path(wrkng.dir,"lib/RRgen.R"))


##########################     ANALYSIS    #################################

######## Markov model - deterministic ########

## Deterministic Transition Matrices
TMTreatDet<-TMfn(treatNames,TMbase,RR)

## Deterministic MarkovModel trace
MarkovTreat<-Mmodel(TMTreatDet)


########     Markov model - DSA      ########
## DSA: generates two scenarios low and upp varying according to DSAp : default 20%
if (DSArun==1){
dsa.list<-vector(mode="list")
# DSA : Default: takes values from Base.Case
source(file.path(wrkng.dir,"/lib/DSAgen.R"))
dsa.list$rowNames<-dsaList$rowNames
dsa.list$dsa.d$dsa.low<-dsaList$dsa.low
dsa.list$dsa.d$dsa.upp<-dsaList$dsa.upp
eval(parse(text=eq)) #Creates and resets variables in model to Base
# DSA : Scenario 1: fixes Inhaler Cost to 35
Cost_Inhaler<-35
source(file.path(wrkng.dir,"/lib/DSAgen.R"))
dsa.list$dsa.1$dsa.low<-dsaList$dsa.low
dsa.list$dsa.1$dsa.upp<-dsaList$dsa.upp
eval(parse(text=eq)) #Creates and resets variables in model to Base
# DSA : Scenario 2: fixes Inhaler Cost to 38
Cost_Inhaler<-38
source(file.path(wrkng.dir,"/lib/DSAgen.R"))
dsa.list$dsa.2$dsa.low<-dsaList$dsa.low
dsa.list$dsa.2$dsa.upp<-dsaList$dsa.upp
eval(parse(text=eq)) #Creates and resets variables in model to Base
}

########     Markov model - PSA      ########
if (PSArun==1){source(file.path(wrkng.dir,"/lib/PSAgenExc.R"))
psa.1.years<-psa[1:n.sims,]
psa.3.years<-psa[n.sims+1:n.sims,]
psa.5.years<-psa[2*n.sims+1:n.sims,]
eval(parse(text=eq)) #Creates and resets variables in model to Base
}

######### Output Storage in Tables as per Excel version 16 ######
#x.years<-paste(TimeHorizon,".years",sep="")

## output: deterministic tables and DSA
  Output<-vector(mode="list")
  Output<-output.gen(Output)

  ## output: DSA table
  if (DSArun==1){
  OutputDSA<-vector(mode="list")
  OutputDSA<-outputDSA.gen(OutputDSA)
  }

  ## output: PSA table
  if (PSArun==1){
  OutputPSA<-vector(mode="list")
  OutputPSA<-outputPSA.gen(OutputPSA)
  }


#########     Price Premium: Generate and store output       ###########
## find Price for Inhaler that would give a fixed ICER. # PPthresholdQALY is the target

  if (PPrun==1){
    Output$pricePrem<-pricePrem.gen()
  }


#########---------     PLOTS generation in PDFs       ------###########
  ### Plots generation.
  pdf(file= paste(outputDataDir,"/",Date,"_","DeterministicPlots.pdf",sep = ""))

 for (xy in yearLab){

 ## 3-D barplot Patients ####

   pT<-as.matrix(Output[[xy]]$patientTable[,length(treatNames):1])
   cT<-cloud(pT,
         panel.3d.cloud = panel.3dbars,
         xbase = 0.4, ybase = 0.4, zlim = c(0, max(pT)),
         xlab = NULL, ylab = NULL, aspect = c(1, 0.3),
         scales = list(arrows = FALSE, distance = 2.5, just = "right"),
         col.facet = level.colors(pT, at = do.breaks(range(pT), 20),
                                  col.regions = terrain.colors,colors = TRUE),
         colorkey = list(col = terrain.colors, at = do.breaks(range(pT), 20)),
         screen = list(z = 60, x = -60),
         main=paste("Number of patients in each asthma control state \n for each inhaler. Time Horizon:",xy),
         panel.aspect = 0.7)
   class(cT) <- "trellis"
   print(cT)

  ## Stacked barplots Direct Costs
   dC<-Output[[xy]]$directCostTable[,-c(1,8)]
   names(dC)<-gsub("£","GBP",names(dC))
   meltd<- melt(dC, id.vars=1:2)
   meltd.t<-meltd[meltd$Control=="Total",]
   meltd.cu<-meltd[!meltd$Control=="Total",]
   p1<-ggplot(meltd.t, aes(x=Inhaler, y=value, fill=variable)) +
     geom_bar(stat="identity") + facet_grid(~Control) + theme_bw()+
     ggtitle(paste("Direct Costs, Time Horizon",xy))
   p2<-ggplot(meltd.cu, aes(x=Inhaler, y=value, fill=variable)) +
     geom_bar(stat="identity") + facet_grid(~Control) + theme_bw()+
     ggtitle(paste("Direct Costs, Time Horizon",xy))
   grid.arrange(p1,p2,nrow=2)

 ## Stacked barplots Indirect Costs
   dC<-Output[[xy]]$indirectCostTable[,-c(1,6)]
   meltd<- melt(dC, id.vars=1:2)
   meltd.t<-meltd[meltd$Control=="Total",]
   meltd.cu<-meltd[!meltd$Control=="Total",]
   p1<-ggplot(meltd.t, aes(x=Inhaler, y=value, fill=variable)) +
     geom_bar(stat="identity") + facet_grid(~Control) + theme_bw()+
     ggtitle(paste("Indirect Costs, Time Horizon",xy))
   p2<-ggplot(meltd.cu, aes(x=Inhaler, y=value, fill=variable)) +
     geom_bar(stat="identity") + facet_grid(~Control) + theme_bw()+
     ggtitle(paste("Indirect Costs, Time Horizon",xy))
   grid.arrange(p1,p2,nrow=2)

 ## Stacked barplots all Costs
   dC<-Output[[xy]]$allCostsTable
   meltd<- melt(dC, id.vars=1)
   grid.arrange(ggplot(meltd, aes(x=Inhaler, y=value, fill=variable)) +
     geom_bar(stat="identity")  + theme_bw()+
     ggtitle(paste("All Costs, Time Horizon",xy)))

 ## Barplots Exacerbations
   dC<-as.data.frame(cbind(Inhaler=names(Output$ExacerTable),t(Output$ExacerTable[xy,])))
   row.names(dC)<-NULL
   meltd<- melt(dC, id.vars=1)
   grid.arrange(ggplot(meltd, aes(x=Inhaler, y=value, fill=variable)) +
                  geom_bar(stat="identity")  + theme_bw()+
                  ggtitle(paste("Exacerbation Costs, Time Horizon",xy)))

 }
  dev.off()

### output: PSA plots

  if (PSArun==1){
    pdf(file= paste(outputDataDir,"/",Date,"_","PSAplots_allCases.pdf",sep = ""))
      for(yl in yearLab){ print(yl) # yl<-yearLab[1]
  psa.x<-get(paste("psa",yl,sep=".")) #e.g.psa.1.years
  psa.qalys <- psa.x[,grep("QALY",names(psa.x))]
  for (ind in c("excl","incl")){ # ind<-"incl" ind<-"excl"
    if (ind == "incl") psa.costs <- psa.x[,grep("totalCost",names(psa.x))]
    if (ind == "excl") psa.costs <- psa.x[,grep("directCost",names(psa.x))]
    textplot(paste("CEplane and CEAC for PSA with \nIndirect Costs",ind,"and \nTime Horizon",yl,sep = " "),
             halign="center", valign="center", cex=1.5)
        for (ii in 2:length(treatNames)){ #ii<-2
          psa.objct <- bcea(c=as.matrix(psa.costs[,c(1,ii)]), e=as.matrix(psa.qalys[,c(1,ii)]),
                      interventions=treatNames[c(1,ii)],ref=2)
          if (range(psa.objct$delta.e)[2]-range(psa.objct$delta.e)[1]!=0){# skipping error when both the same
            ceplane.plot(psa.objct, wtp=20000,ICER.col="blue",
                title=paste("Cost effectiveness plane \n", "Indirect Costs:", ind,yl, #sep = " "))
                             "\n", paste(treatNames[c(1,ii)],collapse  =" vs. "), sep = " "))
            ceac.plot(psa.objct)#,  graph="ggplot2")
      }# if
    } # for treat
  } # for indirect incl/excl
} # for time horizon yearLab
    dev.off()
  }


#########---------     TABLES generation in csvs       ------###########
## output tables per year in csv's
for (xy in yearLab){
  filecsv<-paste(outputDataDir,"/",Date,"_","InhalerMundi_ResultsTables",xy,".csv",sep = "")
  write.table(x=paste("Results for Time Horizon: ",xy,"\n Main Results Table Excluding Indirect Costs",sep = "") ,
              file = filecsv,append = FALSE)
  write.table(x=Output[[xy]]$ResultsIndExcl,
              file = filecsv, row.names = TRUE, col.names = NA, sep = ",", append = TRUE)
  write.table(x=paste("Results for Time Horizon: ",xy,"\n Main Results Table Including Indirect Costs",sep = "") ,
              file = filecsv, append = TRUE)
  write.table(x=Output[[xy]]$ResultsIndIncl,
              file = filecsv,row.names = TRUE, col.names = NA, sep = ",", append = TRUE)
  write.table(x=paste("Results for Time Horizon: ",xy,"\n Direct Costs Table",sep = "") ,
              file = filecsv, append = TRUE)
  write.table(x=Output[[xy]]$directCostTable,
              file = filecsv, row.names = TRUE, col.names = NA, sep = ",", append = TRUE)
  write.table(x=paste("Results for Time Horizon: ",xy,"\n Indirect Costs Table",sep = "") ,
              file = filecsv, append = TRUE)
  write.table(x=Output[[xy]]$indirectCostTable,
              file = filecsv, row.names = TRUE, col.names = NA, sep = ",", append = TRUE)
  write.table(x=paste("Results for Time Horizon: ",xy,"\n All Costs Table",sep = "") ,
              file = filecsv, append = TRUE)
  write.table(x=Output[[xy]]$allCostsTable,
              file = filecsv,row.names = TRUE, col.names = NA, sep = ",", append = TRUE)
  write.table(x=paste("Results for Time Horizon: ",xy,"\n Patients Table",sep = "") ,
              file = filecsv, append = TRUE)
  write.table(x=Output[[xy]]$patientTable,
              file = filecsv,row.names = TRUE, col.names = NA, sep = ",", append = TRUE)
  write.table(x=paste("Results for Time Horizon: ",xy,"\n Exacerbation Costs Table",sep = "") ,
              file = filecsv, append = TRUE)
  write.table(x=Output$ExacerTable[xy,],
              file = filecsv,row.names = TRUE, col.names = NA, sep = ",", append = TRUE)
  if (DSArun==1){
    for (dl in names(dsa.list)[-1]){
      write.table(x=paste("Results for Time Horizon: ",xy,"\n DSA Table. Scenario: Engine ",dl,sep = "") ,
                  file = filecsv, append = TRUE)
      write.table(x=OutputDSA[[paste(xy,dl,sep=".")]]$dsaTable,
                  file = filecsv, row.names = TRUE, col.names = NA, sep = ",", append = TRUE)
      write.table(x=paste("Results for Time Horizon: ",xy,"\n DSA Table Net Monetary Benefit (NMB). Scenario: Engine ",dl,sep = "") ,
                  file = filecsv, append = TRUE)
      write.table(x=OutputDSA[[paste(xy,dl,sep=".")]]$dsaTableNMB,
                  file = filecsv, row.names = TRUE, col.names = NA, sep = ",", append = TRUE)
    } # dl for DSA tables
  }# DSArun
}


## output PricePremium tables in csv
  if (PPrun==1){
    write.table(x="the maximum price chargeable per month for the K-Haler® compared to comparator over time Horizon",
                file = paste(outputDataDir,"/",Date,"_","InhalerMundi_ResultsPricePremium",".csv",sep = ""),
                row.names = FALSE, sep = ",",
                append = FALSE)
    write.table(x=Output$pricePrem,
                file = paste(outputDataDir,"/",Date,"_","InhalerMundi_ResultsPricePremium",".csv",sep = ""),
                row.names = TRUE, col.names = NA, sep = ",",
                append = TRUE)
    }

## Output PSA tables in csv
  if (PSArun==1){
    for(xy in yearLab){ # xy<-yearLab[1]
  for (ind in c("excl","incl")){ # ind<-"incl"
    write.table(x=paste("PSA Result table for horizon ",xy," and Indirect costs",ind),
                file = paste(outputDataDir,"/",Date,"_","InhalerMundi_ResultsPSA",".csv",sep = ""),
                row.names = FALSE, sep = ",",
                append = ifelse((xy==yearLab[1])&(ind=="excl"),FALSE,TRUE))
    write.table(x=OutputPSA[[paste(xy,ind,sep=".")]],
                file = paste(outputDataDir,"/",Date,"_","InhalerMundi_ResultsPSA",".csv",sep = ""),
                row.names = TRUE, col.names = NA,  sep = ",",
                append = TRUE)
  }}
  }


#####################-----     END of CODE     -----####################