(Bayesian). A new test for multinucleoside-resistant (MNR) human immunodeficiency virus type 1 (HIV-1) variants was recently developed. The test maintains 96% sensitivity, meaning that, for those with the disease, it will correctly report “positive” for 96% of them. The test is also 98% specific, meaning that, for those without the disease, 98% will be correctly reported as “negative.” MNR HIV-1 is considered to be rare (albeit emerging), with about a .1% or .001 prevalence rate. Given the prevalence rate, sensitivity, and specificity estimates, what is the probability that an individual who is reported as positive by the new test actually has the disease? If the median cost (consider this the best point estimate) is about $100,000 per positive case total and the test itself costs $1000 per administration, what is the total first-year cost for treating 100,000 individuals?
prev <- 0.001
sens <- 0.96
spec <- 0.98
calc_bayesian_prob <- function(prior, sens, spec, res = "pos, correct"){
fpr <- signif((1 - spec), 2) #false pos rate
fnr <- signif((1 - sens), 2) #false neg rate
if (res == "pos, correct"){
p <- (prior * sens) / ((prior * sens) + ((1 - prior) * (fpr)))
}else if (res == "neg, correct"){
p <- (prior * fnr) / ((prior * fnr) + ((1 - prior) * (spec)))
}
p
}
p <- signif(calc_bayesian_prob(prior = prev, sens = sens, spec = spec), 3)
format_cur <- function(x){
x <- format(round(as.numeric(x), 2), nsmall=2,
scientific=FALSE, big.mark=",")
x <- paste("$", x, sep = "")
x
}
format_csn <- function(x){
x <- format(round(as.numeric(x), 0), nsmall=0,
scientific=FALSE, big.mark=",")
x <- as.character(x)
}
test_batch_size <- 1000000
fpr <- signif((1 - spec), 2) #false pos rate
correct_positive_results_per_million_tests <- sens * prev * test_batch_size
false_positive_results_per_million_tests <- fpr * prev * test_batch_size
people_with_positive_results <- 100000
num_tests_needed <- ceiling((people_with_positive_results / (correct_positive_results_per_million_tests + false_positive_results_per_million_tests)) * test_batch_size)
cost_per_test <- 1000
testing_costs <- num_tests_needed * cost_per_test
cost_per_treatment <- 100000
treatment_costs <- people_with_positive_results * cost_per_treatment
total_first_year_costs <- sum(testing_costs, treatment_costs)
printable_vars <- list(
a = format_csn(correct_positive_results_per_million_tests),
b = format_csn(false_positive_results_per_million_tests),
c = format_csn(people_with_positive_results),
d = format_csn(num_tests_needed),
e = format_cur(cost_per_test),
f = format_cur(testing_costs),
g = format_cur(cost_per_treatment),
h = format_cur(treatment_costs),
i = format_cur(total_first_year_costs)
)The probability that an individual who is reported as positive by the new test actually has the disease is 0.0458.
For every million people tested, 960 will get a correct positive result. Another 20 will get a false positive result. So for 100,000 people to have received positive test results, ~102,040,817 people need to have been tested.
At $1,000.00 per test, that is $102,040,817,000.00 in testing costs.
At $100,000.00 per positive case total treatment, that is $10,000,000,000.00 in treatment costs.
So the total first year costs would be $112,040,817,000.00.
(Binomial). The probability of your organization receiving a Joint Commission inspection in any given month is .05. What is the probability that, after 24 months, you received exactly 2 inspections? What is the probability that, after 24 months, you received 2 or more inspections? What is the probability that your received fewer than 2 inspections? What is the expected number of inspections you should have received? What is the standard deviation?
x <- 2
p <- 0.05
s <- 24
p_exactly2 <- dbinom(x = x, size = s, prob = p)
p_2ormore <- pbinom(q = x, size = s, prob = p, lower.tail = FALSE)
p_fewerthan2 <- pbinom(q = x, size = s, prob = p, lower.tail = TRUE)
expected <- p * s
st_dev <- expected * (1 - p)
printable_vars2 <- list(
a = round(p_exactly2, 3),
b = round(p_2ormore, 3),
c = round(p_fewerthan2, 3)
)Prob. Exactly 2 Inspections: 0.223
Prob. 2 or More Inspections: 0.116
Prob. Fewer than 2 Inspections: 0.884
Expected Inspections: 1.2
Standard Deviation: 1.14
(Poisson). You are modeling the family practice clinic and notice that patients arrive at a rate of 10 per hour. What is the probability that exactly 3 arrive in one hour? What is the probability that more than 10 arrive in one hour? How many would you expect to arrive in 8 hours? What is the standard deviation of the appropriate probability distribution? If there are three family practice providers that can see 24 templated patients each day, what is the percent utilization and what are your recommendations?
t <- 1 #hour
lambda <- 10 #patients per hour
e <- exp(1)
calc_poisson_prob <- function(t = 1, lambda, k){
p <- ((lambda * t)^k * e^(-1 * lambda * t)) / factorial(k)
p
}
occurrences = 3
p_exactly3 <- calc_poisson_prob(t = 1, lambda = 10, k = occurrences)
occurrences = 10
p_morethan10 <- 1 - sum(calc_poisson_prob(t = 1, lambda = 10, k = 0:occurrences))
t <- 8
expected <- lambda * t
st_dev <- lambda^0.5
providers <- 3
patients_per <- 24
perc_util <- round(100 * (expected / (providers * patients_per)), 2)
printable_vars3 <- list(
a = round(p_exactly3, 3),
b = round(p_morethan10, 3),
c = round(st_dev, 2),
d = paste(perc_util, "%", sep = "")
)Prob. Exactly 3 Patients in One Hour: 0.008
Prob. More than 10 Patients in One Hour: 0.417
Expected Patients in 8 Hours: 80
Standard Deviation: 3.16
Percent Utilization: 111.11%
My recommendation would be to hire another family provider since the three existing providers can’t handle the expected number of daily patients by themselves.
(Hypergeometric). Your subordinate with 30 supervisors was recently accused of favoring nurses. 15 of the subordinate’s workers are nurses and 15 are other than nurses. As evidence of malfeasance, the accuser stated that there were 6 company-paid trips to Disney World for which everyone was eligible. The supervisor sent 5 nurses and 1 non-nurse. If your subordinate acted innocently, what was the probability he/she would have selected five nurses for the trips? How many nurses would we have expected your subordinate to send? How many non-nurses would we have expected your subordinate to send?
N <- 30
nurses <- 15
non_nurses <- 15
nurses_drawn <- 5
non_nurses_drawn <- 1
draws <- 6
calc_hypergeom_prob <- function(k, N, K, n){
a <- factorial(K) / (factorial(k) * factorial(K - k))
b <- factorial(N - K) / (factorial(n - k) * factorial(N - K - n + k))
c <- factorial(N) / (factorial(n) * factorial(N - n))
p <- (a * b) / c
p
}
p_exactly5 <- calc_hypergeom_prob(k = nurses_drawn, N = N, K = nurses, n = draws)
expected_nurses <- (draws * nurses) / N
expected_non <- (draws * non_nurses) / N
printable_vars4 <- list(
a = round(p_exactly5, 3)
)Prob. Exactly 5 Nurses Selected: 0.076
Expected Nurses Selected: 3
Expected Non-Nurses Selected: 3
(Geometric). The probability of being seriously injured in a car crash in an unspecified location is about .1% per hour. A driver is required to traverse this area for 1200 hours in the course of a year. What is the probability that the driver will be seriously injured during the course of the year? In the course of 15 months? What is the expected number of hours that a driver will drive before being seriously injured? Given that a driver has driven 1200 hours, what is the probability that he or she will be injured in the next 100 hours?
prob <- 0.001
hrs <- 1200
calc_geom_prob <- function(prob, k){
p <- ((1 - prob)^(k - 1)) * prob
p
}
p_12months <- sum(calc_geom_prob(prob = prob, k = 1:hrs))
p_15months <- sum(calc_geom_prob(prob = prob, k = 1:(hrs * 1.25)))
expected <- 1 / prob
p_100hrs <- sum(calc_geom_prob(prob = prob, k = 1:(hrs / 12)))
printable_vars5 <- list(
a = round(p_12months, 3),
b = round(p_15months, 3),
c = round(p_100hrs, 3)
)Prob. Injured in 12 Months: 0.699
Prob. Injured in 15 Months: 0.777
Expected Hours Before Being Injured: 1000
Prob. Injured in Next 100 Hours: 0.095
You are working in a hospital that is running off of a primary generator which fails about once in 1000 hours. What is the probability that the generator will fail more than twice in 1000 hours? What is the expected value?
x <- 2
p <- 0.001
s <- 1000
p_morethan2 <- pbinom(q = (x + 1), size = s, prob = p, lower.tail = FALSE)
expected <- p * s
printable_vars6 <- list(
a = round(p_morethan2, 3)
)Prob. More than 2 Failures in 1,000 Hours: 0.019
Expected Failures in 1,000 Hours: 1
A surgical patient arrives for surgery precisely at a given time. Based on previous analysis (or a lack of knowledge assumption), you know that the waiting time is uniformly distributed from 0 to 30 minutes. What is the probability that this patient will wait more than 10 minutes? If the patient has already waited 10 minutes, what is the probability that he/she will wait at least another 5 minutes prior to being seen? What is the expected waiting time?
x <- 10
minval <- 0
maxval <- 30
p_morethan10 <- punif(q = x, min = minval, max = maxval, lower.tail = FALSE)
calc_unif_cum_dist_cond <- function(max, cond1, cond2){
p <- (maxval - cond2) * (1 / (maxval - cond1))
p
}
p_morethan10_and_morethan15 <- calc_unif_cum_dist_cond(max = maxval, cond1 = x, cond2 = (x + 5))
expected <- (minval + maxval) / 2
printable_vars7 <- list(
a = round(p_morethan10, 3)
)Prob. Waiting More than 10 Min: 0.667
Prob. Waiting 15 or More Min After Waiting 10: 0.75
Expected Wait: 15 Min
Your hospital owns an old MRI, which has a manufacturer’s lifetime of about 10 years (expected value). Based on previous studies, we know that the failure of most MRIs obeys an exponential distribution. What is the expected failure time? What is the standard deviation? What is the probability that your MRI will fail after 8 years? Now assume that you have owned the machine for 8 years. Given that you already owned the machine 8 years, what is the probability that it will fail in the next two years?
lambda <- 0.1
expected <- 10 #years, calculated as 1 / lambda
st_dev <- expected #since variance = 1 / lambda^2
x = 8 #years
p_after8yrs <- pexp(q = x, rate = lambda, lower.tail = FALSE)
x = 2 #years
p_8to10yrs <- pexp(q = x, rate = lambda, lower.tail = TRUE)
printable_vars8 <- list(
a = round(p_after8yrs, 3),
b = round(p_8to10yrs, 3)
)Expected Failure Time: 10 Years
Standard Deviation: 10
Prob. Failure After 8 Years: 0.449
Prob. Failure in Next 2 Years After Owning 8: 0.181