VoI book: graphs of GAM regression"
In voi: Expected Value of Information

Change this path to reflect where you downloaded the Chemotherapy_Book repository

chemo_dir <- system.file("Chemotherapy_Book",package="voi")
setwd(chemo_dir)

library(knitr)
library(voi)
opts_knit$set(root.dir = chemo_dir)
options(digits=3, scipen = 1e+05)

Graph to illustrate GAM regression

set.seed(1)
source("04_analysis/01_model_run.R")
library(ggplot2)
library(mgcv)

nb <- as.data.frame(m_costs_effects[,"Effects",]*20000 - m_costs_effects[,"Costs",])
names(nb) <- c("SoC","Novel")
inb <- nb[,"Novel"] - nb[,"SoC"]
x <- m_params[,"logor_side_effects"]
set.seed(1)
trim_points <- which(inb > 18000 | inb < -10000)

dat <- data.frame(inb, x)
#dat <- data.frame(inb, x)[-trim_points,]
ggplot(dat, aes(x=x, y=inb)) + 
  geom_point(alpha=0.2, col="gray30", fill="gray30", pch=1)
mod <- gam(inb ~ s(x), data=dat)
dat$fitted <- fitted(mod)
dat$frontier <- pmax(dat$fitted, 0)
phi_crit <- min(dat$x[dat$frontier==0])

pointdat <- data.frame(x=-1.4, xpad=-1.42, xend=0.2, 
                       inb=c(mean(dat$inb), mean(dat$frontier)),
                       label=c("Current", "Partial perfect"))
dat2 <- data.frame(x1=-0.25, x2=-0.25, y1=-1000, y2=0)
pdf("~/work/voibook/voibook/Figures/04-evppi/regression_illus.pdf", width=6, height=3.5)
ggplot(dat, aes(x=x, y=inb)) + 
  geom_point(pch=16, col="gray60", size=0.7) + 
  geom_segment(data=pointdat, aes(x=x, xend=xend, y=inb, yend=inb)) +
  geom_vline(aes(xintercept=round(phi_crit,2)), col="gray70") +
  xlab(expression(paste("Parameter ", phi))) + 
  ylab("Incremental net benefit") + 
  xlim(-1.7, 0.2) +
  scale_y_continuous(breaks = c(-2500, round(mean(dat$inb)), 
                                round(mean(dat$frontier)), 2500)) +
  scale_x_continuous(breaks=c(-1.5,-1,round(phi_crit,2),0,0.5)) +
  geom_text(data=pointdat, aes(label=label, x=xpad), hjust=1) +
  geom_line(aes(y = frontier), lwd=5, alpha=0.4) +
  geom_line(aes(y = fitted), lwd=1.5) + 
  theme(legend.position = "none") +
  annotate(x=0,y=-600,geom="text",size=2.7,label="Value gained by",col="blue") +
  annotate(x=0,y=-1000,geom="text",size=2.7,label="changing decision",col="blue") +
  geom_segment(data=dat2, aes(x = x1, y = y1, xend = x2, yend = y2),
               arrow = arrow(length = unit(0.03, "npc")), col="blue") + 
  geom_segment(data=dat2, aes(x = x1, y = y2, xend = x2, yend = y1),
               arrow = arrow(length = unit(0.03, "npc")), col="blue") +
  theme_bw() 
dev.off()

(evppi <- mean(dat$frontier) - mean(dat$inb))

Graph to illustrate GAM regression for variance-based VoI

dat2 <- data.frame(x1=-1.3, x2=-1.3, y1=-700, y2=min(dat$fitted[round(dat$x,2)==-1.33 ]))

pdf("regression_illus_var.pdf", width=6, height=3.5)

ggplot(dat, aes(x=x, y=inb)) + 
  geom_point(pch=16, col="gray60", size=0.7) + 
  xlab(expression(paste("Value of parameter ", phi))) + 
  ylab(expression(paste("Model output quantity of interest   ", alpha))) + 
  xlim(-1.7, 0.2) +
  geom_line(aes(y = fitted), lwd=1.5) + 
  theme(legend.position = "none") +
  geom_segment(data=dat2, aes(x = x1, y = y1, xend = x2, yend = y2),
               arrow = arrow(length = unit(0.03, "npc")), col="blue") + 
  geom_segment(data=dat2, aes(x = x1, y = y2, xend = x2, yend = y1),
               arrow = arrow(length = unit(0.03, "npc")), col="blue") +
  annotate("text", x = -1.5, y = 0,
           label = "Residuals", col="blue") +
  theme_bw()

dev.off()