RunOptimisation <- function(propRuns = 0.1) {
# This should be triggered by the renderPlot().
withProgress(min = 0, max = 1, style = 'old', {
# Simulation Loop
time <- proc.time()[[1]]
setProgress(value = 0, message = 'Starting optimisation', detail = 'creating parameter matrix')
# Extract the initial values of a random 10% of simulations from calibration
bestTenPercentCalibInitial <<- GetRandomTenPercentCalibOut(CalibOut = CalibOut, runError = runError, selectedRuns = selectedRuns, propRuns = propRuns)
print(paste("reactiveAdjustCost$switch =", reactiveAdjustCost$switch))
# Account for testing HIV-negatives
AdjustHIVTestCost()
# index counter
iC <- 1L
# output vectors
rFirst90 <- c()
rSecond90 <- c()
rThird90 <- c()
rVS <- c()
rImpact <- c()
rCost <- c()
rRho <- c()
rQ <- c()
rKappa <- c()
rGamma <- c()
rSigma <- c()
rOmega <- c()
rTest <- c()
rLink <- c()
rPreR <- c()
rInit <- c()
rAdhr <- c()
rRetn <- c()
# additional cost vectors
rCostOrg <- c()
rCostTot <- c()
# baseline trackers
bTest <- c()
bLink <- c()
bPreR <- c()
bInit <- c()
bAdhr <- c()
bRetn <- c()
updateButton(session,
inputId = "optimStart",
label = "",
style = "primary",
block = TRUE,
size = "large",
icon = icon("refresh", class = "fa-lg fa-spin", lib = "font-awesome"))
# because seven indicators
for (j in 1:(dim(bestTenPercentCalibInitial)[1] / 7)) {
message(paste('Simulation', j))
# Run Baseline simulation
BaseModel <- CallBaselineModel(runNumber = shuffledRuns[j], initVals = bestTenPercentCalibInitial[1:7 + 7 * (j - 1),])
BaseDALY <- Calc_DALY(BaseModel)
BaseCost <- Calc_Cost(BaseModel)
rCostOrg[j] <- BaseCost
message(paste("\t", scales::comma(BaseDALY), "DALYs, at", scales::dollar(BaseCost)))
# Need some functions to calculate the BASELINE changes to care.
bTest[j] <- BaseModel$CumDiag[251]
bLink[j] <- BaseModel$CumLink[251]
bPreR[j] <- BaseModel$CumPreL[251]
bInit[j] <- BaseModel$CumInit[251]
bAdhr[j] <- BaseModel$CumAdhr[251]
bRetn[j] <- BaseModel$CumLoss[251]
parSteps <- GetParaMatrixRun(cParamOut = CalibParamOut, runNumber = shuffledRuns[j], length = 2)
for (i in 1:dim(parSteps)[1]) {
cat("=")
setProgress(
value = iC / ((dim(bestTenPercentCalibInitial)[1] / 7) * dim(parSteps)[1]),
message = paste('Simulation', j),
detail = paste('Run', i))
# This need modifying
p <- GetOptRunPar(
masterCD4 = MasterData$cd4_2015,
data = MasterData,
iterationParam = parSteps[i,],
calibParamOut = CalibParamOut,
runNumber = shuffledRuns[j])
# Now we need the initials.
y <- GetInitial(
p = p,
iterationResult = bestTenPercentCalibInitial[1:7 + 7 * (j - 1),],
masterCD4 = MasterData$cd4_2015)
p[["beta"]] <- GetBeta(y = y, p = p, iterationInc = CalibIncOut[shuffledRuns[j],])
SimResult <- RunSim_Prop(y = y, p = p)
# These guys keep going
rFirst90[iC] <- Calc_909090_Result( SimResult )[1]
rSecond90[iC] <- Calc_909090_Result( SimResult )[2]
rThird90[iC] <- Calc_909090_Result( SimResult )[3]
rVS[iC] <- Calc_VS( SimResult )
rImpact[iC] <- Calc_DALYsAverted( SimResult , BaseDALY)
rCost[iC] <- Calc_AdditionalCost( SimResult , BaseCost)
rCostTot[iC] <- Calc_Cost(SimResult)
# Care Calculations
rTest[iC] <- Calc_CareTesting(baseResult = BaseModel, simResult = SimResult)
rLink[iC] <- Calc_CareLinkage(baseResult = BaseModel, simResult = SimResult)
rPreR[iC] <- Calc_CarePreRetention(baseResult = BaseModel, simResult = SimResult)
rInit[iC] <- Calc_CareInitiation(baseResult = BaseModel, simResult = SimResult)
rAdhr[iC] <- Calc_CareAdherence(baseResult = BaseModel, simResult = SimResult)
rRetn[iC] <- Calc_CareRetention(baseResult = BaseModel, simResult = SimResult)
# These should always just reference i in all cases (as they repeat)
rRho[iC] <- parSteps[i,"Rho"]
rQ[iC] <- parSteps[i,"Q"]
rKappa[iC] <- parSteps[i,"Kappa"]
rGamma[iC] <- parSteps[i,"Gamma"]
rSigma[iC] <- parSteps[i,"Sigma"]
rOmega[iC] <- parSteps[i,"Omega"]
iC <- iC + 1L
}
cat("\n")
}
optResults <<- data.frame(rFirst90, rSecond90, rThird90, rVS, rCost, rRho, rQ, rKappa, rGamma, rSigma, rOmega, rTest, rLink, rPreR, rInit, rAdhr, rRetn, rCostTot)
colnames(optResults) <<- c("First 90", "Second 90", "Third 90", "VS", "Cost", "Rho", "Q", "Kappa", "Gamma", "Sigma", "Omega", "Testing", "Linkage", "Pre-ART Retention", "Initiation", "Adherence", "ART Retention", "Total Cost")
# Make all the baseline stuff global
BaselineCost <<- rCostOrg
BaselineTest <<- bTest
BaselineLink <<- bLink
BaselinePreR <<- bPreR
BaselineInit <<- bInit
BaselineAdhr <<- bAdhr
BaselineRetn <<- bRetn
setProgress(value = 1, message = "Finished", detail = paste(round(proc.time()[[1]] - time, 0), "seconds"))
updateButton(session,
inputId = "optimStart",
label = "Start",
style = "success",
block = TRUE,
size = "large",
icon = icon("play", class = "fa-lg fa-fw", lib = "font-awesome"))
})
optResults
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.