no.surgery <- 0.85 * 1.5 + 0.15 * 7
surgery <- 0.05 * 0 + 0.95 * (0.15 * 5 + 0.85 * (0.5 * 1 + 0.5 *
5))
no.cell.obtained.no.surgery <- 0.5 * (0.85 * 1.5 + 0.15 * 7)
test.no.cell.obtained.no.surgery <- no.cell.obtained.no.surgery +
0.5 * (0.85 * (0.2 * 1.5 + 0.8 * (0.05 * 0 + 0.95 * (0.5 * 1 + 0.5 * 5)))) +
0.5 * (0.15 * (0.95 * 7 + 0.05 * (0.05 * 0 + 0.95 * 5)))
no.cell.obtained.surgery <- 0.5 * (0.05 * 0 + 0.95 * (0.15 * 5 +
0.85 * (0.5 * 1 + 0.5 * 5)))
test.no.cell.obtained.surgery <- no.cell.obtained.surgery + 0.5 *
(0.85 * (0.2 * 1.5 + 0.8 * (0.05 * 0 + 0.95 * (0.5 * 1 + 0.5 * 5)))) + 0.5 *
(0.15 * (0.95 * 7 + 0.05 * (0.05 * 0 + 0.95 * 5)))
Life expectancies from each strategy.
list(no.surgery = no.surgery, surgery = surgery, test.no.cell.obtained.surgery = test.no.cell.obtained.surgery,
test.no.cell.obtained.no.surgery = test.no.cell.obtained.no.surgery)
## $no.surgery
## [1] 2.325
##
## $surgery
## [1] 3.135
##
## $test.no.cell.obtained.surgery
## [1] 3.181
##
## $test.no.cell.obtained.no.surgery
## [1] 2.776
##
In terms of life expectancy, another fine-needle aspiration (surgery if poor sample) is the best followed by immediate surgery, another fine-needle aspiration (no surgery if poor sample), and no surgery.
A.
The most important assumption is that the prolongation of life expectancy is the single most important goal to achieve, which may not be true if we consider quality of life before and after surgey. Also possibility of yet another fine needle aspiration was not considered for simplicity.
B. One-way sensitivity analysis for different prevalence
Define as functions, and graph.
no.surgery <- function(p) p * 1.5 + (1 - p) * 7
surgery <- function(p) 0.05 * 0 + 0.95 * ((1 - p) * 5 + p * (0.5 *
1 + 0.5 * 5))
test.no.cell.obtained.no.surgery <- function(p) 0.5 * (p * 1.5 +
(1 - p) * 7) + 0.5 * (p * (0.2 * 1.5 + 0.8 * (0.05 * 0 + 0.95 * (0.5 * 1 +
0.5 * 5)))) + 0.5 * ((1 - p) * (0.95 * 7 + 0.05 * (0.05 * 0 + 0.95 * 5)))
test.no.cell.obtained.surgery <- function(p) 0.5 * (0.05 * 0 + 0.95 *
((1 - p) * 5 + p * (0.5 * 1 + 0.5 * 5))) + 0.5 * (p * (0.2 * 1.5 + 0.8 *
(0.05 * 0 + 0.95 * (0.5 * 1 + 0.5 * 5)))) + 0.5 * ((1 - p) * (0.95 * 7 +
0.05 * (0.05 * 0 + 0.95 * 5)))
library(ggplot2)
ggplot(data = data.frame(x = 0:1), aes(x)) + stat_function(fun = no.surgery,
aes(color = "No surgery"), lwd = 2) + stat_function(fun = surgery, aes(color = "Surgery"),
lwd = 2) + stat_function(fun = test.no.cell.obtained.no.surgery, aes(color = "Test, if no sample no surgery"),
lwd = 2) + stat_function(fun = test.no.cell.obtained.surgery, aes(color = "Test, if no sample surgery"),
lwd = 2) + scale_color_manual(name = "Function", values = c("red", "green",
"lightblue", "blue"), breaks = c("No surgery", "Surgery", "Test, if no sample no surgery",
"Test, if no sample surgery")) + xlab("Prevalence") + ylab("Life expectancy")
Solve as equations.
no.treat.vs.test.no.cell.no.surgery <- function(p) no.surgery(p) -
test.no.cell.obtained.no.surgery(p)
test.no.cell.no.surgery.vs.surgery <- function(p) test.no.cell.obtained.no.surgery(p) -
test.no.cell.obtained.surgery(p)
test.no.cell.surgery.vs.treat <- function(p) test.no.cell.obtained.surgery(p) -
surgery(p)
result.B <- list(no.treat.vs.test.no.cell.no.surgery = uniroot(no.treat.vs.test.no.cell.no.surgery,
c(0, 1))$root, test.no.cell.no.surgery.vs.surgery = uniroot(test.no.cell.no.surgery.vs.surgery,
c(0, 1))$root, test.no.cell.surgery.vs.treat = uniroot(test.no.cell.surgery.vs.treat,
c(0, 1))$root)
Thresholds are:
result.B
## $no.treat.vs.test.no.cell.no.surgery
## [1] 0.09434
##
## $test.no.cell.no.surgery.vs.surgery
## [1] 0.625
##
## $test.no.cell.surgery.vs.treat
## [1] 0.8879
##
For other information: http://rpubs.com/kaz_yos/
If you find errors: kazky AT mac.com