Individual Homework Assignment 1

Setting

library(haven)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(lubridate)

## 
## Attaching package: 'lubridate'

## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union

library(tidyr)
library(survival)
library(patchwork)
# install.packages("readxl")  # Install package if not installed
library(readxl)

meps.2016 <- read_excel("meps_2016_data.xlsx")
names(meps.2016)

## [1] "ID"       "AGE16X"   "SEX"      "RACETHX"  "DIABDX"   "PCS42"    "MCS42"   
## [8] "TOTEXP16"

Problem 4: Calculating the cost-effectiveness of a hypothetical diabetes cure among adults in the non-institutionalized civilian U.S. adult population (15 pts)

1. Using the CLAD model as well as the MEPS data provided above, please calculate the EQ-5D health utility scores for each respondent in the population. What is the mean EQ- 5D utility score for the population? (1 pt)

# calculate the eq5d score for each respondent
meps.2016 <- meps.2016 %>% 
  mutate(
    eq5d = 0.057867 + 0.010367*PCS42 + 0.00822*MCS42 - 0.000034*PCS42*MCS42 - 0.01067
  )
# mean
summary <- meps.2016 %>% summarise(
              mean.eq5d = mean(eq5d),
              sd.eq5d = sd(eq5d)) %>% print()

## # A tibble: 1 × 2
##   mean.eq5d sd.eq5d
##       <dbl>   <dbl>
## 1     0.897   0.121

2. What is the average EQ-5D score for people with diabetes and those without diabetes? (1 pt)

summary <- meps.2016 %>% 
          group_by(DIABDX) %>%
          summarise(
              mean.eq5d = mean(eq5d),
              sd.eq5d = sd(eq5d)) %>% print()

## # A tibble: 2 × 3
##   DIABDX mean.eq5d sd.eq5d
##   <chr>      <dbl>   <dbl>
## 1 No         0.909   0.113
## 2 Yes        0.809   0.141

3. Is there any sex difference in the average EQ-5D scores for those with diabetes? (1 pt)

summary <- meps.2016 %>% 
          filter(DIABDX == "Yes") %>%
          group_by(SEX) %>%
          summarise(
              mean.eq5d = mean(eq5d),
              sd.eq5d = sd(eq5d)) %>% print()

## # A tibble: 2 × 3
##   SEX    mean.eq5d sd.eq5d
##   <chr>      <dbl>   <dbl>
## 1 Female     0.792   0.142
## 2 Male       0.829   0.139

# # Extract EQ-5D scores for each gender
female_eq5d <- meps.2016 %>%
  filter(DIABDX == "Yes", SEX == "Female") %>%
  pull(eq5d)

male_eq5d <- meps.2016 %>%
  filter(DIABDX == "Yes", SEX == "Male") %>%
  pull(eq5d)
t.test(female_eq5d, male_eq5d, var.equal = FALSE)  # Welch’s t-test (default)

## 
##  Welch Two Sample t-test
## 
## data:  female_eq5d and male_eq5d
## t = -6.4762, df = 2433.9, p-value = 1.134e-10
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.04765900 -0.02550551
## sample estimates:
## mean of x mean of y 
## 0.7924023 0.8289845

4. What is the average annual healthcare expenditure for people with diabetes and those without diabetes? (1 pt)

total healthcare expenditures (including out-of-pocket expenditures, TOTEXP16)

head(meps.2016)

## # A tibble: 6 × 9
##      ID AGE16X SEX    RACETHX            DIABDX PCS42 MCS42 TOTEXP16  eq5d
##   <dbl>  <dbl> <chr>  <chr>              <chr>  <dbl> <dbl>    <dbl> <dbl>
## 1     1     44 Female Non-Hispanic White No      57.8  57.1     2684 1.00 
## 2     2     43 Male   Non-Hispanic White No      59.1  54.1      809 0.996
## 3     3     66 Male   Non-Hispanic Black Yes     22.4  53.1    24665 0.676
## 4     4     20 Male   Non-Hispanic Black No      56.7  62.4        0 1.03 
## 5     5     34 Male   Non-Hispanic Black No      63.7  46.8      210 0.991
## 6     6     69 Female Non-Hispanic Black No      46.4  49.1     1401 0.854

summary <- meps.2016 %>% 
          group_by(DIABDX) %>%
          summarise(
              mean.exp = mean(TOTEXP16),
              sd.exp = sd(TOTEXP16)) %>% print()

## # A tibble: 2 × 3
##   DIABDX mean.exp sd.exp
##   <chr>     <dbl>  <dbl>
## 1 No        4558. 13211.
## 2 Yes      12923. 20902.

5. Is there any sex difference in the average annual healthcare expenditure for those with diabetes? (1 pt)

summary <- meps.2016 %>% 
          filter(DIABDX == "Yes") %>%
          group_by(SEX) %>%
          summarise(
              mean.exp = mean(TOTEXP16),
              sd.exp = sd(TOTEXP16)) %>% print()

## # A tibble: 2 × 3
##   SEX    mean.exp sd.exp
##   <chr>     <dbl>  <dbl>
## 1 Female   13749. 22301.
## 2 Male     11974. 19134.

# # Extract EQ-5D scores for each gender
female_exp <- meps.2016 %>%
  filter(DIABDX == "Yes", SEX == "Female") %>%
  pull(TOTEXP16)

male_exp <- meps.2016 %>%
  filter(DIABDX == "Yes", SEX == "Male") %>%
  pull(TOTEXP16)
t.test(female_exp, male_exp, var.equal = FALSE)  # Welch’s t-test (default)

## 
##  Welch Two Sample t-test
## 
## data:  female_exp and male_exp
## t = 2.1285, df = 2467.5, p-value = 0.0334
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##   139.6802 3409.4473
## sample estimates:
## mean of x mean of y 
##  13748.71  11974.15

6. Suppose that a new diabetes drug can cure the disease and has no side effects. The drug must be taken every day and costs $50,000 per year. Suppose that the drug is offered to a cohort of 1,000 diabetes patients over their lifetime. Suppose the life expectancy of each patient treated with the drug is 30 years, and the life expectancy of those not treated with the drug is 20 years. Assuming that the utility scores calculated above represent the average annual health-related quality of life scores for people with diabetes and those without diabetes, would you recommend treatment with this drug? Please assume a willingness-to-pay threshold of $100,000 per QALY gained, and a 3% annual discount rate for both QALYs and costs. Please show your work. Your answer should include the discounted incremental QALYs and costs, the ICER and your recommendation. (10 pts)

# Define parameters
cost_per_year <- 50000  # Cost of treatment per year
life_years_treated <- 30  # Life expectancy with treatment
life_years_untreated <- 20  # Life expectancy without treatment
discount_rate <- 0.03  # 3% discount rate
willingness_to_pay_threshold <- 100000  # $100,000 per QALY threshold

# Assume previously calculated EQ-5D utility scores
utility_treated <- 0.908  # = non-diabetics Example: utility of treated patients
utility_untreated <- 0.809 # = diabetics # Example: utility of untreated patients

# Function to calculate discounted sum over time
discounted_sum <- function(years, rate) {
  sum(1 / (1 + rate)^(0:(years - 1)))
}

# Calculate discounted QALYs
qaly_treated <- utility_treated * discounted_sum(life_years_treated, discount_rate)
qaly_untreated <- utility_untreated * discounted_sum(life_years_untreated, discount_rate)

# Calculate discounted costs
cost_treated <- 12923 + cost_per_year * discounted_sum(life_years_treated, discount_rate)
cost_untreated <- 12923  # No cost for untreated group

# Calculate incremental values
incremental_qaly <- qaly_treated - qaly_untreated
incremental_cost <- cost_treated - cost_untreated

# Compute the ICER
icer <- incremental_cost / incremental_qaly

# Print results
cat("Discounted QALYs (Treated):", round(qaly_treated, 2), "\n")

## Discounted QALYs (Treated): 18.33

cat("Discounted QALYs (Untreated):", round(qaly_untreated, 2), "\n")

## Discounted QALYs (Untreated): 12.4

cat("Incremental QALYs:", round(incremental_qaly, 2), "\n")

## Incremental QALYs: 5.93

cat("Discounted Cost (Treated):", round(cost_treated, 2), "\n")

## Discounted Cost (Treated): 1022346

cat("Incremental Cost:", round(incremental_cost, 2), "\n")

## Incremental Cost: 1009423

cat("ICER:", round(icer, 2), "per QALY\n")

## ICER: 170103.6 per QALY

# Recommendation based on willingness-to-pay threshold
if (icer <= willingness_to_pay_threshold) {
  cat("Recommendation: The treatment is cost-effective and should be recommended.\n")
} else {
  cat("Recommendation: The treatment is NOT cost-effective and should not be recommended.\n")
}

## Recommendation: The treatment is NOT cost-effective and should not be recommended.

Problem 5: Cost-utility analysis of HIV treatment. (25 pts)

2. Annual HIV-related health care costs ($)

## convert into 2019 cost
#Acute HIV
30.00 * 497.3 /387.1

## [1] 38.54043

Cost of HIV testing (cost per test), $

48.00 * 497.3 /387.1

## [1] 61.66469

4. HIV infection is characterized by five stages: primary stage, acute stage, asymptomatic stage, symptomatic stage, and the AIDS stage. Suppose that a 20-year-old individual becomes infected with HIV in year 2019. Population-level data suggest that people infected with HIV at age 20 can expect to 55 additional years (that is, up to age 75), with appropriate care. HIV-positive individuals spend on average 9 weeks in the primary stage of infection, and progress rapidly the acute stage of infection. Suppose that with antiretroviral treatment, infected individuals live 15 years with acute infection, 20 years with asymptomatic infection, and 15 years with symptomatic infection. The rest of their life expectancy is spent in the AIDS stage of infection. Suppose that the 20-year-old individual described above immediately initiates treatment with ART when infection is detected and adheres to the treatment throughout her/his life course. Suppose the life course of this individual is as described above for the population. What are the undiscounted and discounted expected incremental lifetime HIV-related health care costs, expressed in 2019 dollars, for this 20-year-old individual? (5 pts)

# Define annual costs for each stage of HIV (in 2019 dollars)
annual_costs <- list(
  primary_HIV = 0,  # Cost per year in primary stage
  acute_HIV = 30.00 *497.3 /387.1,  # Cost per year in acute stage
  asymptomatic_HIV = 0,  # Cost per year in asymptomatic stage
  symptomatic_HIV = 6181 *497.3 /414.3,  # Cost per year in symptomatic stage
  AIDS_HIV = 9950 *497.3 /414.3,  # Cost per year in AIDS stage
  ART_cost = 15000 *497.3 /414.3,  # Annual ART cost
  CD4_test = 52*497.3 /387.1 *2, 
  viral_load_test = 48*497.3 /387.1 *2, 
  genotype_test = 177*497.3 /387.1 * 2  # Twice per year
)

# Define duration of each stage
years_primary <- 9 / 52  # Convert 9 weeks to years
years_acute <- 15
years_asymptomatic <- 20
years_symptomatic <- 15
years_AIDS <- 55 - (years_primary + years_acute + years_asymptomatic + years_symptomatic)

# Define discount rate
discount_rate <- 0.03  # 3% per year

# Function to compute discounted sum over time
discounted_sum <- function(years, rate) {
  sum(1 / (1 + rate)^(0:(years - 1)))
}

# Compute Undiscounted Lifetime Costs
undiscounted_cost <- sum(
  annual_costs$primary_HIV * years_primary,
  annual_costs$acute_HIV * years_acute,
  annual_costs$asymptomatic_HIV * years_asymptomatic,
  annual_costs$symptomatic_HIV * years_symptomatic,
  annual_costs$AIDS_HIV * years_AIDS,
  annual_costs$ART_cost * (years_acute + years_asymptomatic + years_symptomatic + years_AIDS)
)

# Compute Discounted Lifetime Costs
discounted_cost <- sum(
  annual_costs$primary_HIV * discounted_sum(years_primary, discount_rate),
  annual_costs$acute_HIV * discounted_sum(years_acute, discount_rate),
  annual_costs$asymptomatic_HIV * discounted_sum(years_asymptomatic, discount_rate),
  annual_costs$symptomatic_HIV * discounted_sum(years_symptomatic, discount_rate),
  annual_costs$AIDS_HIV * discounted_sum(years_AIDS, discount_rate),
  annual_costs$ART_cost * discounted_sum(years_acute + years_asymptomatic + years_symptomatic + years_AIDS, discount_rate)
)

# Print Results
cat("Undiscounted Lifetime HIV-Related Healthcare Costs (2019 $):", round(undiscounted_cost, 2), "\n")

## Undiscounted Lifetime HIV-Related Healthcare Costs (2019 $): 1156680

cat("Discounted Lifetime HIV-Related Healthcare Costs (2019 $):", round(discounted_cost, 2), "\n")

## Discounted Lifetime HIV-Related Healthcare Costs (2019 $): 630317.1

5. Suppose that it is recommended that HIV-positive individuals treated with ART monitor their CD4 cell count, HIV viral load, and test for resistance to their ART regimen (HIV genotype testing) twice a year, for each year on treatment. What are the undiscounted and discounted expected incremental lifetime HIV-related costs, expressed in 2019 dollars, for this 20-year-old individual? (5 pts)

# Compute Undiscounted Lifetime Costs
undiscounted_cost <- sum(
  annual_costs$primary_HIV * years_primary,
  annual_costs$acute_HIV * years_acute,
  annual_costs$asymptomatic_HIV * years_asymptomatic,
  annual_costs$symptomatic_HIV * years_symptomatic,
  annual_costs$AIDS_HIV * years_AIDS,
  annual_costs$ART_cost * (years_acute + years_asymptomatic + years_symptomatic + years_AIDS),
  (annual_costs$CD4_test + annual_costs$viral_load_test + annual_costs$genotype_test) * 
    (years_acute + years_asymptomatic + years_symptomatic + years_AIDS)
)

# Compute Discounted Lifetime Costs
discounted_cost <- sum(
  annual_costs$primary_HIV * discounted_sum(years_primary, discount_rate),
  annual_costs$acute_HIV * discounted_sum(years_acute, discount_rate),
  annual_costs$asymptomatic_HIV * discounted_sum(years_asymptomatic, discount_rate),
  annual_costs$symptomatic_HIV * discounted_sum(years_symptomatic, discount_rate),
  annual_costs$AIDS_HIV * discounted_sum(years_AIDS, discount_rate),
  annual_costs$ART_cost * discounted_sum(years_acute + years_asymptomatic + years_symptomatic + years_AIDS, discount_rate),
  annual_costs$ART_cost * discounted_sum(years_acute + years_asymptomatic + years_symptomatic + years_AIDS, discount_rate),
  (annual_costs$CD4_test + annual_costs$viral_load_test + annual_costs$genotype_test) * 
    discounted_sum(years_acute + years_asymptomatic + years_symptomatic + years_AIDS, discount_rate)
)

# Print Results
cat("Undiscounted Lifetime HIV-Related Healthcare Costs (2019 $):", round(undiscounted_cost, 2), "\n")

## Undiscounted Lifetime HIV-Related Healthcare Costs (2019 $): 1195701

cat("Discounted Lifetime HIV-Related Healthcare Costs (2019 $):", round(discounted_cost, 2), "\n")

## Discounted Lifetime HIV-Related Healthcare Costs (2019 $): 1142689

6. Using the information on the health trajectory of the 20-year-old individual described above, and the data in Table 2 below, please calculate the total lifetime QALYs for this individual over her/his life course with HIV. (5 pts)

# Define HRQoL values from Table 2 for each HIV stage
HRQoL <- list(
  primary = 0.86,
  acute = 0.88,
  asymptomatic_1 = 0.89,  # First year of asymptomatic stage
  asymptomatic_2 = 0.91,  # After first year
  symptomatic = 0.83,
  AIDS = 0.82
)
# Define years spent in each stage
years <- list(
  primary = 9 / 52,  # Convert 9 weeks to years
  acute = 15,
  asymptomatic_1 = 1,  # First year of asymptomatic stage
  asymptomatic_2 = 19,  # Remaining years in asymptomatic stage
  symptomatic = 15,
  AIDS = 55 - (9/52 + 15 + 20 + 15)  # Remaining years
)

# Define discount rate (3% per year)
discount_rate <- 0.03

# Function to calculate discounted QALYs for each stage
discounted_qaly <- function(hrqol, years, rate, start_year) {
  sum(hrqol * (1 / (1 + rate))^(start_year:(start_year + years - 1)))
}

# Compute undiscounted QALYs
undiscounted_qalys <- sum(
  HRQoL$primary * years$primary,
  HRQoL$acute * years$acute,
  HRQoL$asymptomatic_1 * years$asymptomatic_1,
  HRQoL$asymptomatic_2 * years$asymptomatic_2,
  HRQoL$symptomatic * years$symptomatic,
  HRQoL$AIDS * years$AIDS
)

# Compute discounted QALYs for each stage
discounted_qalys <- sum(
  discounted_qaly(HRQoL$primary, years$primary, discount_rate, 0),
  discounted_qaly(HRQoL$acute, years$acute, discount_rate, years$primary),
  discounted_qaly(HRQoL$asymptomatic_1, years$asymptomatic_1, discount_rate, years$primary + years$acute),
  discounted_qaly(HRQoL$asymptomatic_2, years$asymptomatic_2, discount_rate, years$primary + years$acute + years$asymptomatic_1),
  discounted_qaly(HRQoL$symptomatic, years$symptomatic, discount_rate, years$primary + years$acute + years$asymptomatic_1 + years$asymptomatic_2),
  discounted_qaly(HRQoL$AIDS, years$AIDS, discount_rate, years$primary + years$acute + years$asymptomatic_1 + years$asymptomatic_2 + years$symptomatic)
)

# Print results
cat("Undiscounted Lifetime QALYs:", round(undiscounted_qalys, 2), "\n")

## Undiscounted Lifetime QALYs: 47.94

cat("Discounted Lifetime QALYs:", round(discounted_qalys, 2), "\n")

## Discounted Lifetime QALYs: 24.84

8. Suppose that a new antiretroviral therapy regimen becomes available in 2019, and costs twice as much as the standard ART regimen in Table 1, but results in better health-related quality of life utility scores in certain health states, due to lower side effects, and convenience of use (once weekly as opposed to once daily). Would you recommend this new ART regimen if societal willingness-to-pay threshold was $150,000 per QALY gained? Please justify your answer. Your answer should show the incremental lifetime total costs and incremental effectiveness of treatment with the two ART regimen. (5 pts)

# Define annual costs for each stage of HIV (in 2019 dollars)
annual_costs_standard <- list(
  primary_HIV = 0,  # Cost per year in primary stage
  acute_HIV = 30.00 *497.3 /387.1,  # Cost per year in acute stage
  asymptomatic_HIV = 0,  # Cost per year in asymptomatic stage
  symptomatic_HIV = 6181 *497.3 /414.3,  # Cost per year in symptomatic stage
  AIDS_HIV = 9950 *497.3 /414.3,  # Cost per year in AIDS stage
  ART_cost = 15000 *497.3 /414.3,  # Annual ART cost
  CD4_test = 52*497.3 /387.1 *2, 
  viral_load_test = 48*497.3 /387.1 *2, 
  genotype_test = 177*497.3 /387.1 * 2  # Twice per year
)

annual_costs_new <- list(
  primary_HIV = 0,  # Cost per year in primary stage
  acute_HIV = 30.00 *497.3 /387.1,  # Cost per year in acute stage
  asymptomatic_HIV = 0,  # Cost per year in asymptomatic stage
  symptomatic_HIV = 6181 *497.3 /414.3,  # Cost per year in symptomatic stage
  AIDS_HIV = 9950 *497.3 /414.3,  # Cost per year in AIDS stage
  ART_cost = 30000 *497.3 /414.3,  # Annual ART cost
  CD4_test = 52*497.3 /387.1 *2, 
  viral_load_test = 48*497.3 /387.1 *2, 
  genotype_test = 177*497.3 /387.1 * 2  # Twice per year
)

# Define HRQoL values from Table 2 for each HIV stage
HRQoL_standard <- list(
  primary = 0.86,
  acute = 0.88,
  asymptomatic_1 = 0.89,  # First year of asymptomatic stage
  asymptomatic_2 = 0.91,  # After first year
  symptomatic = 0.83,
  AIDS = 0.82
)

HRQoL_new<- list(
  primary = 0.86,
  acute = 0.92,
  asymptomatic_1 = 0.90,  # First year of asymptomatic stage
  asymptomatic_2 = 0.94,  # After first year
  symptomatic = 0.87,
  AIDS = 0.85
)

# Define years spent in each stage
years <- list(
  primary = 9 / 52,  # Convert 9 weeks to years
  acute = 15,
  asymptomatic_1 = 1,  # First year of asymptomatic stage
  asymptomatic_2 = 19,  # Remaining years in asymptomatic stage
  symptomatic = 15,
  AIDS = 55 - (9/52 + 15 + 20 + 15)  # Remaining years
)

discount_rate <- 0.03  # 3% discount rate
WTP_threshold <- 150000  

# Function to calculate discounted values
discounted_sum <- function(years, rate) {
  sum(1 / (1 + rate)^(0:(years - 1)))
}

# Function to compute discounted QALYs
discounted_qaly <- function(hrqol, years, rate, start_year) {
  sum(hrqol * (1 / (1 + rate))^(start_year:(start_year + years - 1)))
}

# Compute discounted lifetime costs for Standard ART
discounted_cost_standard <- sum(
  annual_costs_standard$primary_HIV * discounted_sum(years$primary, discount_rate),
  annual_costs_standard$acute_HIV * discounted_sum(years$acute, discount_rate),
  annual_costs_standard$asymptomatic_HIV * discounted_sum(years$asymptomatic_1 + years$asymptomatic_2, discount_rate),
  annual_costs_standard$symptomatic_HIV * discounted_sum(years$symptomatic, discount_rate),
  annual_costs_standard$AIDS_HIV * discounted_sum(years$AIDS, discount_rate),
  annual_costs_standard$ART_cost * discounted_sum(sum(years$acute, years$asymptomatic_1, years$asymptomatic_2, years$symptomatic, years$AIDS), discount_rate),
  (annual_costs_standard$CD4_test + annual_costs$viral_load_test + annual_costs$genotype_test) * 
    discounted_sum(sum(years$acute, years$asymptomatic_1, years$asymptomatic_2, years$symptomatic, years$AIDS), discount_rate)
)

# Compute discounted lifetime costs for New ART
discounted_cost_new <- sum(
  annual_costs_new$primary_HIV * discounted_sum(years$primary, discount_rate),
  annual_costs_new$acute_HIV * discounted_sum(years$acute, discount_rate),
  annual_costs_new$asymptomatic_HIV * discounted_sum(years$asymptomatic_1 + years$asymptomatic_2, discount_rate),
  annual_costs_new$symptomatic_HIV * discounted_sum(years$symptomatic, discount_rate),
  annual_costs_new$AIDS_HIV * discounted_sum(years$AIDS, discount_rate),
  annual_costs_new$ART_cost * discounted_sum(sum(years$acute, years$asymptomatic_1, years$asymptomatic_2, years$symptomatic, years$AIDS), discount_rate),
  (annual_costs_new$CD4_test + annual_costs_new$viral_load_test + annual_costs_new$genotype_test) * 
    discounted_sum(sum(years$acute, years$asymptomatic_1, years$asymptomatic_2, years$symptomatic, years$AIDS), discount_rate)
)

# Compute discounted QALYs for Standard ART
discounted_qaly_standard <- sum(
  discounted_qaly(HRQoL_standard$primary, years$primary, discount_rate, 0),
  discounted_qaly(HRQoL_standard$acute, years$acute, discount_rate, years$primary),
  discounted_qaly(HRQoL_standard$asymptomatic_1, years$asymptomatic_1, discount_rate, years$primary + years$acute),
  discounted_qaly(HRQoL_standard$asymptomatic_2, years$asymptomatic_2, discount_rate, years$primary + years$acute + years$asymptomatic_1),
  discounted_qaly(HRQoL_standard$symptomatic, years$symptomatic, discount_rate, years$primary + years$acute + years$asymptomatic_1 + years$asymptomatic_2),
  discounted_qaly(HRQoL_standard$AIDS, years$AIDS, discount_rate, years$primary + years$acute + years$asymptomatic_1 + years$asymptomatic_2 + years$symptomatic)
)

# Compute discounted QALYs for New ART
discounted_qaly_new <- sum(
  discounted_qaly(HRQoL_new$primary, years$primary, discount_rate, 0),
  discounted_qaly(HRQoL_new$acute, years$acute, discount_rate, years$primary),
  discounted_qaly(HRQoL_new$asymptomatic_1, years$asymptomatic_1, discount_rate, years$primary + years$acute),
  discounted_qaly(HRQoL_new$asymptomatic_2, years$asymptomatic_2, discount_rate, years$primary + years$acute + years$asymptomatic_1),
  discounted_qaly(HRQoL_new$symptomatic, years$symptomatic, discount_rate, years$primary + years$acute + years$asymptomatic_1 + years$asymptomatic_2),
  discounted_qaly(HRQoL_new$AIDS, years$AIDS, discount_rate, years$primary + years$acute + years$asymptomatic_1 + years$asymptomatic_2 + years$symptomatic)
)

# Compute Incremental Cost-Effectiveness Ratio (ICER)
incremental_cost <- discounted_cost_new - discounted_cost_standard
incremental_qaly <- discounted_qaly_new - discounted_qaly_standard
icer <- incremental_cost / incremental_qaly

# Print results
cat("Incremental Cost:", round(incremental_cost, 2), "\n")

## Incremental Cost: 492888.6

cat("Incremental QALYs:", round(incremental_qaly, 2), "\n")

## Incremental QALYs: 0.97

cat("ICER:", round(icer, 2), "per QALY\n")

## ICER: 508082.4 per QALY

# Recommendation
if (icer <= WTP_threshold) {
  cat("Recommendation: The new ART is cost-effective and should be recommended.\n")
} else {
  cat("Recommendation: The new ART is NOT cost-effective and should not be recommended.\n")
}

## Recommendation: The new ART is NOT cost-effective and should not be recommended.

Individual Homework Assignment 1 | Minji.Kim

2025-02-02

Setting

Problem 4: Calculating the cost-effectiveness of a hypothetical diabetes cure among adults in the non-institutionalized civilian U.S. adult population (15 pts)

1. Using the CLAD model as well as the MEPS data provided above, please calculate the EQ-5D health utility scores for each respondent in the population. What is the mean EQ- 5D utility score for the population? (1 pt)

2. What is the average EQ-5D score for people with diabetes and those without diabetes? (1 pt)

3. Is there any sex difference in the average EQ-5D scores for those with diabetes? (1 pt)

4. What is the average annual healthcare expenditure for people with diabetes and those without diabetes? (1 pt)

5. Is there any sex difference in the average annual healthcare expenditure for those with diabetes? (1 pt)

Problem 5: Cost-utility analysis of HIV treatment. (25 pts)

6. Using the information on the health trajectory of the 20-year-old individual described above, and the data in Table 2 below, please calculate the total lifetime QALYs for this individual over her/his life course with HIV. (5 pts)