In Sheffield-Accelerated-VoI/SAVI-package: SAVI Sheffield Accelerated Value of Information
title: "Value of Information Report"
author: "r input$modelName"
date: "r format(Sys.time(), '%d %B, %Y')"
output: pdf_document
1. Introduction
Welcome to the Sheffield Accelerated Value of Information (SAVI) application report. The results of your Value of Information analyses in SAVI are reported below. The results are presented in a standardised format to help with the interpretation of your results and future reporting.
In section 2 summary results for the probabilistic sensitivity analysis are presented. Summary statistics, and graphical illustrations are provided to verify the results against previous analysis of the data and illustrate the uncertainty in the model.
In section 3 the results of the Expected Value of Perfect Information (EVPI) analysis of the data are presented.
In section 4 the results of single parameter Partial Expected Value of Perfect Information (EVPPI) are reported. The results of the analysis of multiple parameter EVPPI, selected in the application are provided.
lambda <- lambdaOverall
npsa <- nIterate
if(!is.null(costs) | !is.null(effects)) {
nb <- effects * lambda - costs
}
2. Exploring Current Uncertainty: Probabilistic Sensitivity Analysis Results
2.1 Probabilistic Sensitivity Analysis Summary
options(width = 80)
if(!is.null(tableCEplane)) kable(tableCEplane)
2.2 Cost-Effectiveness Plane
The cost-effectiveness plane shows the standardised cost-effectiveness plane per person based on r nIterate model runs in which uncertain model parameters are varied simultaneously in a probabilistic sensitivity analysis. The mean incremental cost of r colnames(costs)[namesDecisions%in%input$decisionOptionCE1] versus r colnames(costs)[namesDecisions%in%input$decisionOptionCE0] is r paste(input$currency, format(incValueCosts, digits=2, nsmall=2), sep=""). This suggests that r input$decisionOptionCE1 is r moreLessCosts costly. The incremental cost is uncertain because the model parameters are uncertain. The 97.5% credible interval for the incremental cost is (r input$currency r format(confIntCE025costs, digits=4, nsmall=2) , r input$currency r format(confIntCE975costs, digits=4, nsmall=2)). The probability that r input$decisionOptionCE1 is cost saving compared to r input$decisionOptionCE0 is r format(pCostsavingVal, digits=2, nsmall=3).
The mean incremental benefit of r colnames(costs)[namesDecisions%in%input$decisionOptionCE1] versus r colnames(costs)[namesDecisions%in%input$decisionOptionCE0] is r format(incValueEffects, digits=2, nsmall=4) r input$unitBens . Again, there is some uncertainty due to model parameters, with the 95% credible interval for the incremental benefit ranging from (r format(confIntCE025effects, digits=4, nsmall=4) r input$unitBens , r format(confIntCE975effects, digits=4, nsmall=4) r input$unitBens). The probability that r colnames(costs)[namesDecisions%in%input$decisionOptionCE1] is more beneficial than r colnames(costs)[namesDecisions%in%input$decisionOptionCE0] is r format(pMorebenVal, digits=2, nsmall=3).
The incremental expected cost per unit of benefit is estimated at r paste(input$currency, format(iCERVal, digits=2, nsmall=2), sep="") per r input$unitBens. There is uncertainty with a r format(pCEVal, digits=2, nsmall=3) probability that r colnames(costs)[namesDecisions%in%input$decisionOptionCE1] is more cost-effective than r colnames(costs)[namesDecisions%in%input$decisionOptionCE0].
if (valuesImportedFLAG(cache, input)) {
makeCEPlanePlot(costs, effects,
lambda=input$lambdaOverall, input$decisionOptionCE1, input$decisionOptionCE0, cache)
}
See section 5.1 in Briggs, Claxton, Sculpher. Decision Modelling for Health Economic Evaluation (Handbooks for Health Economic Evaluation). OUP Oxford; 1 edition (17 Aug 2006). ISBN-13: 978-0198526629
2.3 The Cost-Effectiveness Acceptability Curve
The Cost-Effectiveness Acceptability Curve (CEAC) shows the probability that all strategies are cost-effective at varying thresholds. The results show that at a threshold value for cost-effectiveness of r input$currency r format(lambda, digits = 4) per r input$unitBens, the strategy with the highest probability of being most cost-effective is r if(!is.null(ceac.obj)) {colnames(costs[which.max(ceac.obj$p[which(ceac.obj$l.seq==lambda),])])}, with a probability of r if(!is.null(ceac.obj)) {max(ceac.obj$p[which(ceac.obj$l.seq==lambda),])}.
if (!is.null(ceac.obj)) makeCeacPlot(ceac.obj, lambda, colnames(costs))
More details for how to interpret CEACs are available from the literature
Fenwick & Byford. (2005) A guide to cost-effectiveness acceptability curves. The British Journal of Psychiatry. 187: 106-108.
2.4 Net Benefit of Each Strategy
2.4.1 Absolute Net Benefit
Net benefit (NB) is a calculation to put the costs and the r input$unitBenss onto the same scale. This is done by calculating the monetary value of the r input$unitBenss using a simple multiplication i.e. r input$unitBenss * lambda=r input$currency r format(lambda, digits = 4) per r input$unitBens, where
This is particularly useful when comparing several strategies because the analyst and decision maker can see in one single measure the expected net value of each strategy, rather than looking at many comparisons of incremental cost-effectiveness ratios between different options. Under the rules of decision theory, the strategy with the highest expected net benefit is the one which a decision maker would choose as the optimal startegy.
if(!is.null(tableNetBenefit)) kable(tableNetBenefit)
2.4.2 Incremental Net Benefit of compared with the optimal comparator
The graph shows the incremental expected net benefit of the strategies compared with r if(!is.null(costs) | !is.null(effects)) {colnames(costs[which.max(as.matrix(colMeans(nb)))])}.
if(!is.null(costs) | !is.null(effects)) {
lambda<-lambda
c <- which.max(as.matrix(colMeans(nb)))
inbOpt <- nb-nb[,c]
means <- colMeans(inbOpt)
sd <- apply(inbOpt, 2, sd)
lCI <- apply(inbOpt, 2, quantile, 0.025)
uCI <- apply(inbOpt, 2, quantile, 0.975)
colnames(inbOpt) <- colnames(nb)
mp <- barplot(means,
main = paste("Expected Incremental Net Benefit vs. Optimal Strategy\nOptimal Strategy is",colnames(costs[c])),
xlab = "Strategy", ylab = "INB vs. Optimal Strategy", ylim = c(min(lCI), max(uCI)),
col=0, border=0, names.arg = 1:length(lCI))
segments(mp - 0.2, means, mp + 0.2, means, lwd=2)
segments(mp, lCI, mp, uCI, lwd=2)
segments(mp - 0.1, lCI, mp + 0.1, lCI, lwd=2)
segments(mp - 0.1, uCI, mp + 0.1, uCI, lwd=2)
abline(h=0, lty=2)
}
2.5 Net Benefit Density Plots
2.5.1 Absolute Net Benefit
The absolute monetary net benefit density is calculated for each of the r nInt strategy comparators. The absolute Net Benefit density plot illustrates the overlaid densities for the r nIterate simulation runs in the Probabistic Sensitivity Analysis. This graph illustrates how much overlap their is in the simulated Net Benefit of all strategies. However, the overlap between densities may be due to correlation in simulated outcomes, therefore it is necessary to examine the incremental differences between strategies (as discussed in Naversnik K, 2014).
if(!is.null(costs) | !is.null(effects)) {
lambda<-lambda
d <- ncol(costs)
xmax<-max(nb) + 0.1 * (max(nb) - min(nb))
xmin<-min(nb) - 0.1 * (max(nb) - min(nb))
ymax<-c(1:d)
for (i in 1:d){
den<-density(nb[, i])
ymax[i]<-max(den$y)
}
ymax<-max(ymax)
plot(density(nb[, 1]), type = "l", col = 1, xlim = c(xmin, xmax), ylim = c(0, ymax),
xlab="Net Benefit",main="Net Benefit Densities")
for (i in 2:d){
lines(density(nb[, i]), col = i, lty = i)
}
# Need strategy names adding
legend("topleft", colnames(nb), col=c(1:d), lty = 1:d, cex=0.7)
}
2.5.2 Incremental Net Benefit Density Compared with Optimal Strategy
Densities for the incremental net benefit of each strategy compared with r if(!is.null(costs) | !is.null(effects)) {colnames(costs[which.max(as.matrix(colMeans(nb)))])} (the strategy with maximum expected net benefit) are presented. In this graph it is possible compare strategy densities with correlation removed. It is possible to observe which strategies have simulated Net Benefit greater than the optimal strategy. If there are several strategies with overlapping densities, then several strategies are close in terms of their expected value to a decision maker, and given the relatively large decision uncertainty it might be valuable to consider further research to reduce uncertainty. The value of reducing uncertainty to the decision maker by undertaking further research is the subject of the analyses using expected value of information calculations. These calculations can consider all decision uncertainty (the overall expected value of perfect information (EVPI)) or for particular uncertain parameters within the PSA (expected value of perfect parameter information (EVPPI)).
if(!is.null(costs) | !is.null(effects)) {
lambda<-lambda
c <- which.max(as.matrix(colMeans(nb)))
inbOpt <- nb - nb[,c]
inbOpt <- as.matrix(inbOpt[, -c])
colnames(inbOpt) <- colnames(nb)[-c]
d <- ncol(inbOpt) + ifelse(FALSE, 1, 0) # what does this ifelse do?
xmax <- max(inbOpt) + 0.1 * (max(inbOpt) - min(inbOpt))
xmin <- min(inbOpt) - 0.1 * (max(inbOpt) - min(inbOpt))
ymax <- 1:d
for (i in 1:d) {
den <- density(inbOpt[, i])
ymax[i] <- max(den$y)
}
ymax <- max(ymax)
plot(density(inbOpt[, 1]), type = "l", col = 1, xlim = c(xmin, xmax),
ylim = c(0, ymax), xlab="INB vs. Optimal Strategy",
main = paste("Incremental Net Benefit Density\nOptimal Strategy is",colnames(costs[c])))
if (d>1) {
for (i in 2:d) {
lines(density(inbOpt[, i]), col = i, lty = i)
}
}
# Need strategy names adding
legend("topleft", colnames(inbOpt), col=1:d, lty = 1:d, cex=0.7)
abline(v=0, lty=2)
}
More information about illustrating uncertainty for multiple strategies with correlated output are available in the literature.
Naversnik K (2014) Output correlations in probabilistic models with multiple alternatives. Eur J Health Econ. 2014 Jan 4.
3. Putting a value on the decision uncertainty: Overall Expected Value of Perfect Information Calculation
3.1 Understanding the EVPI
The calculation begins with the existing confidence intervals (or credible intervals) for the model parameters as used in the probabilistic sensitivity analysis. We then imagine a world in which we become absolutely (perfectly) certain about all of the model parameters i.e. the confidence interval for every single parameter is zero. The decision maker would then be absolutely certain which strategy to select and would choose the one with highest net benefit. One can visualise this idea by imagining that instead of seeing the cloud of dots on the cost-effectiveness plane (representing current uncertainty in costs and benefits) and having to choose, the decision maker now knows exactly which dot is the true value (because all of the uncertainty is removed) and so can be certain to choose the strategy which gives the best net benefit. In a two strategy comparison of new versus current care, if the true dot turns out to be below and to the right of the thresholdlambda line, then the decision maker would select the new strategy. If the true dot is above and to the left, then current care would be selected. Under the current uncertainty, the decision maker will choose the strategy based on the expected costs and benefits (essentially on whether the centre of gravity of the cloud is above or below the threshold line).
3.2 Overall EVPI
The overall EVPI per person affected by the decision is estimated at r input$currency r if(!is.null(costs) | !is.null(effects)) {format(calcEvpi(costs, effects, lambda=lambda), digits = 4, nsmall=1)} per person. This is equivalent to r if(!is.null(costs) | !is.null(effects)) {format(calcEvpi(costs, effects, lambda=lambda)/lambda, digits = 4, nsmall=1)} r input$unitBens per person in decision uncertainty when valuing uncertainty on the r input$unitBens scale.
Assuming an annual number of people affected by the decision of r annualPrev, the overall EVPI per year is r input$currency r if(!is.null(costs) | !is.null(effects)) {format(calcEvpiVal * annualPrev, digits = 4, nsmall=1)} for r jurisdiction.
When thinking about the overall expected value of removing decision uncertainty, one needs to consider how long the current comparison will remain relevant e.g. if new treatments of options or even cures are anticipated to become available for a disease. For the specified decision relevance horizon of r horizon years, the overall expected value of removing decision uncertainty for r jurisdiction would in total be r input$currency r if(!is.null(costs) | !is.null(effects)) {format(calcEvpiVal * annualPrev * horizon, digits = 4, nsmall=1)}.
Research or data collection exercises costing more than this amount would not be considered cost-effective use of resources. This is because the return on investment from the research, as measured by the health gain and cost savings of enabling decision makers ability to switch and select other strategies when evidence obtained reduces decision uncertainty, is expected to be no higher than the figure of r input$currency r if(!is.null(costs) | !is.null(effects)) {format(calcEvpiVal * annualPrev * horizon, digits = 4, nsmall=1)}.
The EVPI estimates in the table below quantifies the expected value to decision makers within the jurisdiction of removing all current decision uncertainty at a threshold of r input$currency r format(lambda,digits=4) per r input$unitBens. This will enable comparison against previous analyses to provide an idea of the scale of decision uncertainty in this topic compared with other previous decisions. The EVPI estimate for varying willingness to pay thresholds are illustrated in the figures below.
if(!is.null(tableEVPI)) kable(tableEVPI)
## makes the overall EVPI plot
if(!is.null(costs) | !is.null(effects)) {
lambda.int<-lambda
l.seq <- seq(0, lambda * 10, lambda / 20)
p <- c()
for (lambda.int in l.seq) {
inb.int <- data.frame(as.matrix(effects) * lambda.int - as.matrix(costs))
evpi <- mean(do.call(pmax, inb.int)) - max(colMeans(inb.int))
p <- c(p, evpi)
}
plot(l.seq, p, type="l", main = paste("Overall EVPI per person ", input$currency), xlab = "Threshold willingness to pay", ylab = paste("Annual population EVPI ", input$currency))
abline(v=lambda, lty=2)
points(lambda, p[which(l.seq == lambda)], pch=20, col="black")
#text(lambda, p[which(l.seq == lambda)], round(p[which(l.seq == lambda)],2), pos=1, offset=0.1)
}
## makes the overall EVPI plot
if(!is.null(costs) | !is.null(effects)) {
lambda.int<-lambda
l.seq <- seq(0, lambda * 10, lambda / 20)
p <- c()
for (lambda.int in l.seq) {
inb.int <- as.matrix(effects) * lambda.int - as.matrix(costs)
inb.int <- inb.int - inb.int[, 1]
#inb.int
evpi <- (mean(pmax(inb.int[, 2], inb.int[, 1])) - max(colMeans(inb.int)))*annualPrev
p <- c(p, evpi)
}
plot(l.seq, p, type="l", main = paste("Overall EVPI per annual prevalence ", input$currency), xlab = "Threshold willingness to pay", ylab = paste("Annual population EVPI ", input$currency))
abline(v=lambda, lty=2)
points(lambda, p[which(l.seq == lambda)], pch=20, col="black")
}
## makes the overall EVPI plot
if(!is.null(costs) | !is.null(effects)) {
lambda.int<-lambda
l.seq <- seq(0, lambda * 10, lambda / 20)
p <- c()
for (lambda.int in l.seq) {
inb.int <- as.matrix(effects) * lambda.int - as.matrix(costs)
inb.int <- inb.int - inb.int[, 1]
#inb.int
evpi <- (mean(pmax(inb.int[, 2], inb.int[, 1])) - max(colMeans(inb.int))) * input$annualPrev
evpi <- evpi / lambda.int
p <- c(p, evpi)
}
plot(l.seq, p, type="l", main = paste("Overall EVPI per annual prevalence ", input$unitBens), xlab = "Threshold willingness to pay", ylab = paste("Annual population EVPI ", input$unitBens))
abline(v=lambda, lty=2)
points(lambda, p[which(l.seq == lambda)], pch=20, col="black")
}
if(!is.null(costs) | !is.null(effects)) {
l.seq <- seq(0, lambda * 10, lambda / 20)
p <- c()
for (lambda.int in l.seq) {
inb.int <- as.matrix(effects) * lambda.int - as.matrix(costs)
inb.int <- inb.int - inb.int[, 1]
#inb.int
evpi <- (mean(pmax(inb.int[, 2], inb.int[, 1])) - max(colMeans(inb.int))) * input$annualPrev * input$horizon
p <- c(p, evpi)
}
plot(l.seq, p, type="l", main = paste("Overall EVPI over decision relevance ", input$currency), xlab = "Threshold willingness to pay", ylab = paste("Annual population EVPI ", input$currency))
abline(v=lambda, lty=2)
points(lambda, p[which(l.seq == lambda)], pch=20, col="black")
}
4. Which parameters are causing most of the decision uncertainty and what is the potential value of reducing uncertainty by collecting more data: Partial Expected Value of Perfect Information
4.1 Single parameter EVPPI
if(!is.null(tableEVPPI)) kable(tableEVPPI)
if(!is.null(pEVPI)) {
ord <- order(pEVPI[, 1])
EVPPI <- matrix(pEVPI[ord, 1], ncol = NROW(pEVPI), nrow = 1)
colnames(EVPPI) <- colnames(params[ord])
barplot(EVPPI, horiz = TRUE, cex.names=0.7, las=1, main= "Single parameter Partial EVPI per person", xlab = "Partial EVPI per person")
}
4.1 Group parameter EVPPI
Although EVPPI information about individual parameters is useful, often it is more informative if EVPPI can be computed for groups of associated parameters e.g. all parameters associated with efficacy data. This will enable a maximum value to be put on further research to jointly inform this set of parameters.
if(!is.null(groupTable)) {
numericContent <- unlist(groupTable[, -1])
numericContent <- matrix(numericContent, ncol=5)
rownames(numericContent) <- paste("Set", 1:NROW(numericContent))
df <- data.frame(Parameters = unname(unlist(groupTable[, 1])), numericContent)
kable(df, col.names = c("Parameters", "Per person EVPPI", "Approx Standard error", "Indexed to Overall EVPI",
paste("EVPPI for ", jurisdiction, " Per Year (", currency, ")", sep=""),
paste("EVPPI for ", jurisdiction, " over ", horizon, " years (", currency, ")", sep="")))
}
The table above reports the group EVPPI for the parameter groups selected. For subsets with up to five parameters, the GAM regression method was used. For subsets with five or more parameters the GP regression method was used. See Strong et al (2014) for details.
References
Strong M, Oakley JE, Brennan A. Estimating multi-parameter partial Expected Value of Perfect Information from a probabilistic sensitivity analysis sample: a non-parametric regression approach. Medical Decision Making. 2014;34(3):311-26. Available open access here.
Sheffield-Accelerated-VoI/SAVI-package documentation built on May 9, 2019, 1:25 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
title: "Value of Information Report"
author: "r input$modelName"
date: "r format(Sys.time(), '%d %B, %Y')"
output: pdf_document
1. Introduction
Welcome to the Sheffield Accelerated Value of Information (SAVI) application report. The results of your Value of Information analyses in SAVI are reported below. The results are presented in a standardised format to help with the interpretation of your results and future reporting.
In section 2 summary results for the probabilistic sensitivity analysis are presented. Summary statistics, and graphical illustrations are provided to verify the results against previous analysis of the data and illustrate the uncertainty in the model.
In section 3 the results of the Expected Value of Perfect Information (EVPI) analysis of the data are presented.
In section 4 the results of single parameter Partial Expected Value of Perfect Information (EVPPI) are reported. The results of the analysis of multiple parameter EVPPI, selected in the application are provided.
lambda <- lambdaOverall npsa <- nIterate if(!is.null(costs) | !is.null(effects)) { nb <- effects * lambda - costs }
2. Exploring Current Uncertainty: Probabilistic Sensitivity Analysis Results
2.1 Probabilistic Sensitivity Analysis Summary
options(width = 80) if(!is.null(tableCEplane)) kable(tableCEplane)
2.2 Cost-Effectiveness Plane
The cost-effectiveness plane shows the standardised cost-effectiveness plane per person based on r nIterate model runs in which uncertain model parameters are varied simultaneously in a probabilistic sensitivity analysis. The mean incremental cost of r colnames(costs)[namesDecisions%in%input$decisionOptionCE1] versus r colnames(costs)[namesDecisions%in%input$decisionOptionCE0] is r paste(input$currency, format(incValueCosts, digits=2, nsmall=2), sep=""). This suggests that r input$decisionOptionCE1 is r moreLessCosts costly. The incremental cost is uncertain because the model parameters are uncertain. The 97.5% credible interval for the incremental cost is (r input$currency r format(confIntCE025costs, digits=4, nsmall=2) , r input$currency r format(confIntCE975costs, digits=4, nsmall=2)). The probability that r input$decisionOptionCE1 is cost saving compared to r input$decisionOptionCE0 is r format(pCostsavingVal, digits=2, nsmall=3).
The mean incremental benefit of r colnames(costs)[namesDecisions%in%input$decisionOptionCE1] versus r colnames(costs)[namesDecisions%in%input$decisionOptionCE0] is r format(incValueEffects, digits=2, nsmall=4) r input$unitBens . Again, there is some uncertainty due to model parameters, with the 95% credible interval for the incremental benefit ranging from (r format(confIntCE025effects, digits=4, nsmall=4) r input$unitBens , r format(confIntCE975effects, digits=4, nsmall=4) r input$unitBens). The probability that r colnames(costs)[namesDecisions%in%input$decisionOptionCE1] is more beneficial than r colnames(costs)[namesDecisions%in%input$decisionOptionCE0] is r format(pMorebenVal, digits=2, nsmall=3).
The incremental expected cost per unit of benefit is estimated at r paste(input$currency, format(iCERVal, digits=2, nsmall=2), sep="") per r input$unitBens. There is uncertainty with a r format(pCEVal, digits=2, nsmall=3) probability that r colnames(costs)[namesDecisions%in%input$decisionOptionCE1] is more cost-effective than r colnames(costs)[namesDecisions%in%input$decisionOptionCE0].
if (valuesImportedFLAG(cache, input)) { makeCEPlanePlot(costs, effects, lambda=input$lambdaOverall, input$decisionOptionCE1, input$decisionOptionCE0, cache) }
See section 5.1 in Briggs, Claxton, Sculpher. Decision Modelling for Health Economic Evaluation (Handbooks for Health Economic Evaluation). OUP Oxford; 1 edition (17 Aug 2006). ISBN-13: 978-0198526629
2.3 The Cost-Effectiveness Acceptability Curve
The Cost-Effectiveness Acceptability Curve (CEAC) shows the probability that all strategies are cost-effective at varying thresholds. The results show that at a threshold value for cost-effectiveness of r input$currency r format(lambda, digits = 4) per r input$unitBens, the strategy with the highest probability of being most cost-effective is r if(!is.null(ceac.obj)) {colnames(costs[which.max(ceac.obj$p[which(ceac.obj$l.seq==lambda),])])}, with a probability of r if(!is.null(ceac.obj)) {max(ceac.obj$p[which(ceac.obj$l.seq==lambda),])}.
if (!is.null(ceac.obj)) makeCeacPlot(ceac.obj, lambda, colnames(costs))
More details for how to interpret CEACs are available from the literature
Fenwick & Byford. (2005) A guide to cost-effectiveness acceptability curves. The British Journal of Psychiatry. 187: 106-108.
2.4 Net Benefit of Each Strategy
2.4.1 Absolute Net Benefit
Net benefit (NB) is a calculation to put the costs and the r input$unitBenss onto the same scale. This is done by calculating the monetary value of the r input$unitBenss using a simple multiplication i.e. r input$unitBenss * lambda=r input$currency r format(lambda, digits = 4) per r input$unitBens, where
This is particularly useful when comparing several strategies because the analyst and decision maker can see in one single measure the expected net value of each strategy, rather than looking at many comparisons of incremental cost-effectiveness ratios between different options. Under the rules of decision theory, the strategy with the highest expected net benefit is the one which a decision maker would choose as the optimal startegy.
if(!is.null(tableNetBenefit)) kable(tableNetBenefit)
2.4.2 Incremental Net Benefit of compared with the optimal comparator
The graph shows the incremental expected net benefit of the strategies compared with r if(!is.null(costs) | !is.null(effects)) {colnames(costs[which.max(as.matrix(colMeans(nb)))])}.
if(!is.null(costs) | !is.null(effects)) { lambda<-lambda c <- which.max(as.matrix(colMeans(nb))) inbOpt <- nb-nb[,c] means <- colMeans(inbOpt) sd <- apply(inbOpt, 2, sd) lCI <- apply(inbOpt, 2, quantile, 0.025) uCI <- apply(inbOpt, 2, quantile, 0.975) colnames(inbOpt) <- colnames(nb) mp <- barplot(means, main = paste("Expected Incremental Net Benefit vs. Optimal Strategy\nOptimal Strategy is",colnames(costs[c])), xlab = "Strategy", ylab = "INB vs. Optimal Strategy", ylim = c(min(lCI), max(uCI)), col=0, border=0, names.arg = 1:length(lCI)) segments(mp - 0.2, means, mp + 0.2, means, lwd=2) segments(mp, lCI, mp, uCI, lwd=2) segments(mp - 0.1, lCI, mp + 0.1, lCI, lwd=2) segments(mp - 0.1, uCI, mp + 0.1, uCI, lwd=2) abline(h=0, lty=2) }
2.5 Net Benefit Density Plots
2.5.1 Absolute Net Benefit
The absolute monetary net benefit density is calculated for each of the r nInt strategy comparators. The absolute Net Benefit density plot illustrates the overlaid densities for the r nIterate simulation runs in the Probabistic Sensitivity Analysis. This graph illustrates how much overlap their is in the simulated Net Benefit of all strategies. However, the overlap between densities may be due to correlation in simulated outcomes, therefore it is necessary to examine the incremental differences between strategies (as discussed in Naversnik K, 2014).
if(!is.null(costs) | !is.null(effects)) { lambda<-lambda d <- ncol(costs) xmax<-max(nb) + 0.1 * (max(nb) - min(nb)) xmin<-min(nb) - 0.1 * (max(nb) - min(nb)) ymax<-c(1:d) for (i in 1:d){ den<-density(nb[, i]) ymax[i]<-max(den$y) } ymax<-max(ymax) plot(density(nb[, 1]), type = "l", col = 1, xlim = c(xmin, xmax), ylim = c(0, ymax), xlab="Net Benefit",main="Net Benefit Densities") for (i in 2:d){ lines(density(nb[, i]), col = i, lty = i) } # Need strategy names adding legend("topleft", colnames(nb), col=c(1:d), lty = 1:d, cex=0.7) }
2.5.2 Incremental Net Benefit Density Compared with Optimal Strategy
Densities for the incremental net benefit of each strategy compared with r if(!is.null(costs) | !is.null(effects)) {colnames(costs[which.max(as.matrix(colMeans(nb)))])} (the strategy with maximum expected net benefit) are presented. In this graph it is possible compare strategy densities with correlation removed. It is possible to observe which strategies have simulated Net Benefit greater than the optimal strategy. If there are several strategies with overlapping densities, then several strategies are close in terms of their expected value to a decision maker, and given the relatively large decision uncertainty it might be valuable to consider further research to reduce uncertainty. The value of reducing uncertainty to the decision maker by undertaking further research is the subject of the analyses using expected value of information calculations. These calculations can consider all decision uncertainty (the overall expected value of perfect information (EVPI)) or for particular uncertain parameters within the PSA (expected value of perfect parameter information (EVPPI)).
if(!is.null(costs) | !is.null(effects)) { lambda<-lambda c <- which.max(as.matrix(colMeans(nb))) inbOpt <- nb - nb[,c] inbOpt <- as.matrix(inbOpt[, -c]) colnames(inbOpt) <- colnames(nb)[-c] d <- ncol(inbOpt) + ifelse(FALSE, 1, 0) # what does this ifelse do? xmax <- max(inbOpt) + 0.1 * (max(inbOpt) - min(inbOpt)) xmin <- min(inbOpt) - 0.1 * (max(inbOpt) - min(inbOpt)) ymax <- 1:d for (i in 1:d) { den <- density(inbOpt[, i]) ymax[i] <- max(den$y) } ymax <- max(ymax) plot(density(inbOpt[, 1]), type = "l", col = 1, xlim = c(xmin, xmax), ylim = c(0, ymax), xlab="INB vs. Optimal Strategy", main = paste("Incremental Net Benefit Density\nOptimal Strategy is",colnames(costs[c]))) if (d>1) { for (i in 2:d) { lines(density(inbOpt[, i]), col = i, lty = i) } } # Need strategy names adding legend("topleft", colnames(inbOpt), col=1:d, lty = 1:d, cex=0.7) abline(v=0, lty=2) }
More information about illustrating uncertainty for multiple strategies with correlated output are available in the literature.
Naversnik K (2014) Output correlations in probabilistic models with multiple alternatives. Eur J Health Econ. 2014 Jan 4.
3. Putting a value on the decision uncertainty: Overall Expected Value of Perfect Information Calculation
3.1 Understanding the EVPI
The calculation begins with the existing confidence intervals (or credible intervals) for the model parameters as used in the probabilistic sensitivity analysis. We then imagine a world in which we become absolutely (perfectly) certain about all of the model parameters i.e. the confidence interval for every single parameter is zero. The decision maker would then be absolutely certain which strategy to select and would choose the one with highest net benefit. One can visualise this idea by imagining that instead of seeing the cloud of dots on the cost-effectiveness plane (representing current uncertainty in costs and benefits) and having to choose, the decision maker now knows exactly which dot is the true value (because all of the uncertainty is removed) and so can be certain to choose the strategy which gives the best net benefit. In a two strategy comparison of new versus current care, if the true dot turns out to be below and to the right of the thresholdlambda line, then the decision maker would select the new strategy. If the true dot is above and to the left, then current care would be selected. Under the current uncertainty, the decision maker will choose the strategy based on the expected costs and benefits (essentially on whether the centre of gravity of the cloud is above or below the threshold line).
3.2 Overall EVPI
The overall EVPI per person affected by the decision is estimated at r input$currency r if(!is.null(costs) | !is.null(effects)) {format(calcEvpi(costs, effects, lambda=lambda), digits = 4, nsmall=1)} per person. This is equivalent to r if(!is.null(costs) | !is.null(effects)) {format(calcEvpi(costs, effects, lambda=lambda)/lambda, digits = 4, nsmall=1)} r input$unitBens per person in decision uncertainty when valuing uncertainty on the r input$unitBens scale.
Assuming an annual number of people affected by the decision of r annualPrev, the overall EVPI per year is r input$currency r if(!is.null(costs) | !is.null(effects)) {format(calcEvpiVal * annualPrev, digits = 4, nsmall=1)} for r jurisdiction.
When thinking about the overall expected value of removing decision uncertainty, one needs to consider how long the current comparison will remain relevant e.g. if new treatments of options or even cures are anticipated to become available for a disease. For the specified decision relevance horizon of r horizon years, the overall expected value of removing decision uncertainty for r jurisdiction would in total be r input$currency r if(!is.null(costs) | !is.null(effects)) {format(calcEvpiVal * annualPrev * horizon, digits = 4, nsmall=1)}.
Research or data collection exercises costing more than this amount would not be considered cost-effective use of resources. This is because the return on investment from the research, as measured by the health gain and cost savings of enabling decision makers ability to switch and select other strategies when evidence obtained reduces decision uncertainty, is expected to be no higher than the figure of r input$currency r if(!is.null(costs) | !is.null(effects)) {format(calcEvpiVal * annualPrev * horizon, digits = 4, nsmall=1)}.
The EVPI estimates in the table below quantifies the expected value to decision makers within the jurisdiction of removing all current decision uncertainty at a threshold of r input$currency r format(lambda,digits=4) per r input$unitBens. This will enable comparison against previous analyses to provide an idea of the scale of decision uncertainty in this topic compared with other previous decisions. The EVPI estimate for varying willingness to pay thresholds are illustrated in the figures below.
if(!is.null(tableEVPI)) kable(tableEVPI)
## makes the overall EVPI plot if(!is.null(costs) | !is.null(effects)) { lambda.int<-lambda l.seq <- seq(0, lambda * 10, lambda / 20) p <- c() for (lambda.int in l.seq) { inb.int <- data.frame(as.matrix(effects) * lambda.int - as.matrix(costs)) evpi <- mean(do.call(pmax, inb.int)) - max(colMeans(inb.int)) p <- c(p, evpi) } plot(l.seq, p, type="l", main = paste("Overall EVPI per person ", input$currency), xlab = "Threshold willingness to pay", ylab = paste("Annual population EVPI ", input$currency)) abline(v=lambda, lty=2) points(lambda, p[which(l.seq == lambda)], pch=20, col="black") #text(lambda, p[which(l.seq == lambda)], round(p[which(l.seq == lambda)],2), pos=1, offset=0.1) }
## makes the overall EVPI plot if(!is.null(costs) | !is.null(effects)) { lambda.int<-lambda l.seq <- seq(0, lambda * 10, lambda / 20) p <- c() for (lambda.int in l.seq) { inb.int <- as.matrix(effects) * lambda.int - as.matrix(costs) inb.int <- inb.int - inb.int[, 1] #inb.int evpi <- (mean(pmax(inb.int[, 2], inb.int[, 1])) - max(colMeans(inb.int)))*annualPrev p <- c(p, evpi) } plot(l.seq, p, type="l", main = paste("Overall EVPI per annual prevalence ", input$currency), xlab = "Threshold willingness to pay", ylab = paste("Annual population EVPI ", input$currency)) abline(v=lambda, lty=2) points(lambda, p[which(l.seq == lambda)], pch=20, col="black") }
## makes the overall EVPI plot if(!is.null(costs) | !is.null(effects)) { lambda.int<-lambda l.seq <- seq(0, lambda * 10, lambda / 20) p <- c() for (lambda.int in l.seq) { inb.int <- as.matrix(effects) * lambda.int - as.matrix(costs) inb.int <- inb.int - inb.int[, 1] #inb.int evpi <- (mean(pmax(inb.int[, 2], inb.int[, 1])) - max(colMeans(inb.int))) * input$annualPrev evpi <- evpi / lambda.int p <- c(p, evpi) } plot(l.seq, p, type="l", main = paste("Overall EVPI per annual prevalence ", input$unitBens), xlab = "Threshold willingness to pay", ylab = paste("Annual population EVPI ", input$unitBens)) abline(v=lambda, lty=2) points(lambda, p[which(l.seq == lambda)], pch=20, col="black") }
if(!is.null(costs) | !is.null(effects)) { l.seq <- seq(0, lambda * 10, lambda / 20) p <- c() for (lambda.int in l.seq) { inb.int <- as.matrix(effects) * lambda.int - as.matrix(costs) inb.int <- inb.int - inb.int[, 1] #inb.int evpi <- (mean(pmax(inb.int[, 2], inb.int[, 1])) - max(colMeans(inb.int))) * input$annualPrev * input$horizon p <- c(p, evpi) } plot(l.seq, p, type="l", main = paste("Overall EVPI over decision relevance ", input$currency), xlab = "Threshold willingness to pay", ylab = paste("Annual population EVPI ", input$currency)) abline(v=lambda, lty=2) points(lambda, p[which(l.seq == lambda)], pch=20, col="black") }
4. Which parameters are causing most of the decision uncertainty and what is the potential value of reducing uncertainty by collecting more data: Partial Expected Value of Perfect Information
4.1 Single parameter EVPPI
if(!is.null(tableEVPPI)) kable(tableEVPPI)
if(!is.null(pEVPI)) { ord <- order(pEVPI[, 1]) EVPPI <- matrix(pEVPI[ord, 1], ncol = NROW(pEVPI), nrow = 1) colnames(EVPPI) <- colnames(params[ord]) barplot(EVPPI, horiz = TRUE, cex.names=0.7, las=1, main= "Single parameter Partial EVPI per person", xlab = "Partial EVPI per person") }
4.1 Group parameter EVPPI
Although EVPPI information about individual parameters is useful, often it is more informative if EVPPI can be computed for groups of associated parameters e.g. all parameters associated with efficacy data. This will enable a maximum value to be put on further research to jointly inform this set of parameters.
if(!is.null(groupTable)) { numericContent <- unlist(groupTable[, -1]) numericContent <- matrix(numericContent, ncol=5) rownames(numericContent) <- paste("Set", 1:NROW(numericContent)) df <- data.frame(Parameters = unname(unlist(groupTable[, 1])), numericContent) kable(df, col.names = c("Parameters", "Per person EVPPI", "Approx Standard error", "Indexed to Overall EVPI", paste("EVPPI for ", jurisdiction, " Per Year (", currency, ")", sep=""), paste("EVPPI for ", jurisdiction, " over ", horizon, " years (", currency, ")", sep=""))) }
The table above reports the group EVPPI for the parameter groups selected. For subsets with up to five parameters, the GAM regression method was used. For subsets with five or more parameters the GP regression method was used. See Strong et al (2014) for details.
References
Strong M, Oakley JE, Brennan A. Estimating multi-parameter partial Expected Value of Perfect Information from a probabilistic sensitivity analysis sample: a non-parametric regression approach. Medical Decision Making. 2014;34(3):311-26. Available open access here.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.