R Markdown

PART 1: More Operations in R

1.a. Creating a Vector.

vec1 <- 1:1000

1.b. Sampling.

vec2 <- sample(vec1)

1.c. Creating a Data Frame.

dat <- data.frame(vec1, vec2)

2. Lookup and Indexing.

indices <- vec1[dat$vec2 %in% c(2, 47, 290, 812)]

3. Replacemet.

dat$vec2[indices] <- NA

4. Variable Renaming.

dat <- data.frame(caseid = dat$vec1, wage = dat$vec2)

5. Compute Summary Statistics.

mean(dat$wage, na.rm = TRUE)
## [1] 501.3544
median(dat$wage, na.rm = TRUE)
## [1] 501.5
sd(dat$wage, na.rm = TRUE)
## [1] 288.3622

6. Subsetting.

dat2<-dat[-indices, ]

Part 2A: Summary Statistics

dat<-read.csv("data_health_synth (1).csv")

1. Names of Variables

  1. cost_t
  2. gagne_sum_t
  3. risk_score_t
  4. program_enrolled_t
  5. race

2. Conceptual, Operational, Actualized in context of gagne_sum_t

The variable gagne_sum_t represents the number of active chronic illnesses an individual has. Conceptual: The overall health of an individual, specifically their health conditions. Operational: the number of active chronic illnesses a person has, which gives a measurable way to represent their chronic health conditions. Actualized: The actualized variable is gagne_sum_t, which is the total number of active chronic illnesses recorded for a patient in year t. Thus, gagne_sum_t is the specific measurement of the number of active chronic illnesses that is actually recorded in the data set.

3. Compute + report mean for first four variables

mean(dat$cost_t)
## [1] 7659.716
mean(dat$gagne_sum_t)
## [1] 1.354481
mean(dat$risk_score_t)
## [1] 4.393692
mean(dat$program_enrolled_t)
## [1] 0.009265333

Medical expenditures in year t: 7659.716 Number of active chronic illnesses in year t: 1.354481 Risk score: 4.393692 Program enrollment: 0.009265333

4. Compute + report racial group proportion

mean(dat$race == "white")
## [1] 0.8855772
mean(dat$race == "black")
## [1] 0.1144228

White: 0.8855772 Black: 0.1144228

5. Compute + Report mean medical expenditures & chronic illnesses for each group

mean(dat[dat$race == "white", "cost_t"])
## [1] 7455.773
mean(dat[dat$race == "black", "cost_t"])
## [1] 9238.14
mean(dat[dat$race == "white", "gagne_sum_t"])
## [1] 1.2639
mean(dat[dat$race == "black", "gagne_sum_t"])
## [1] 2.055536

Mean medical expenditures (white): 7455.773 Mean medical expenditures (black): 9238.14 Mean number of chronic illnesses (white): 1.2639 Mean number of chronic illnesses (black): 2.055536

6. dplyr version of question 5

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
dat %>% group_by(race) %>% summarize(mean_cost = mean(cost_t), mean_chronic = mean(gagne_sum_t))
## # A tibble: 2 × 3
##   race  mean_cost mean_chronic
##   <chr>     <dbl>        <dbl>
## 1 black     9238.         2.06
## 2 white     7456.         1.26

7. Comment on the results.

On average, Black patients had both higher medical expenditures and more chronic illnesses than White patients. The average medical expenditure for Black patients was about $9,238, compared to about $7,456 for White patients. Black patients also had an average of about 2.06 chronic illnesses, while White patients had an average of about 1.26. Overall, the results show a noticeable difference between the two racial groups in both medical spending and number of chronic illnesses.

Part 2B: Assessing Program Enrollment

1.a. Patients enrolled in the program

hist(dat$risk_score_t[dat$program_enrolled_t == 1],
     xlim = c(0, 100),
     main = "Risk Score for Enrolled Patients",
     xlab = "Risk Score")

1.b. Patients not enrolled in the program

hist(dat$risk_score_t[dat$program_enrolled_t == 0],
     xlim = c(0, 100),
     main = "Risk Score for Not-Enrolled Patients",
     xlab = "Risk Score")

2. Compare the two histograms and comment

The two histograms show that patients who were enrolled generally had higher risk scores than patients who were not enrolled. However, there does not appear to be a strict threshold that perfectly determines enrollment. The two groups still overlap, and some patients with relatively high risk scores were not enrolled in the program. This does not surprise me based on the Obermeyer et al. (2019) reading because the risk score was related to program enrollment, but it was not the only factor determining who was enrolled.

3. Compute, store, and report 25th & 75th percentiles of risk score

q25 <- quantile(dat$risk_score_t, 0.25)
q75 <- quantile(dat$risk_score_t, 0.75)

25th percentile: 1.443859 75th percentile: 5.350773

4. Compute + report mean enrollment across three groups:

  1. patients whose risk score is below the 25th percentile
mean(dat$program_enrolled_t[dat$risk_score_t < q25])
## [1] 0

report: 0

  1. patients whose risk score is above/equal to the 25th percentile and below the 75th percentile
mean(dat$program_enrolled_t[dat$risk_score_t >= q25 & dat$risk_score_t < q75])
## [1] 0.001435309

report: 0.001435309

  1. patients whose risk scores is above/equal to the 75th percentile
mean(dat$program_enrolled_t[dat$risk_score_t >= q75])
## [1] 0.03408255

report: 0.03408255

5. Comment on the results.

Does there appear to be a relationship between risk score and program enrollment based on this analysis? There appears to be a relationship between risk score and program enrollment. Although the overall enrollment proportions are low, enrollment becomes more common as risk score increases. The proportion enrolled was 0 for patients below the 25th percentile, about 0.14% for patients between the 25th and 75th percentiles, and about 3.41% for patients at or above the 75th percentile. This suggests that patients with higher risk scores were more likely to be enrolled in the program, although enrollment was still relatively uncommon overall.

6. Create a subsetted version of the data.

not_enrolled_high_risk <- dat[dat$program_enrolled_t == 0 & dat$risk_score_t >= q75, ]
nrow(not_enrolled_high_risk)
## [1] 11818

report: there are 11818 patients in this not_enrolled_high_risk subset.

7. (Of new subset) compute and report the mean number of chronic illnesses separately for each racial group.

mean(not_enrolled_high_risk$gagne_sum_t[not_enrolled_high_risk$race == "black"])
## [1] 4.109527
mean(not_enrolled_high_risk$gagne_sum_t[not_enrolled_high_risk$race == "white"])
## [1] 2.824039

report: Black = 4.109527, and white = 2.824039

8. Comment on the results.

There appears to be a potential problem with the program enrollment decision-making that could suggest some form of bias. Among patients who had high risk scores but were not enrolled in the program, Black patients had an average of about 4.11 chronic illnesses, compared to about 2.82 for White patients. This suggests that Black patients who were not enrolled had more chronic illnesses on average, even though they had high risk scores. This difference could indicate that the enrollment process was biased in a way that resulted in some Black patients with substantial health needs being less likely to receive the program.

Part 3: Recreating Figures

Begin by copying lines of code into code chunks:

Chunk 1:

risk_deciles <- quantile(dat$risk_score_t,
probs = seq(from = 0, to = 1, by = 0.1))

Chunk 2:

dat$risk_decile_bin <- as.numeric(
cut(dat$risk_score_t, breaks = risk_deciles, include.lowest = TRUE)
)

Chunk 3:

some_results <-
as.data.frame(
dat %>%
group_by(risk_decile_bin,race) %>%
summarise(mean_illness = mean(gagne_sum_t))
)
## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by risk_decile_bin and race.
## ℹ Output is grouped by risk_decile_bin.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(risk_decile_bin, race))` for per-operation grouping
##   (`?dplyr::dplyr_by`) instead.

Chunk 4:

library(ggplot2)
ggplot(some_results,
aes(x = risk_decile_bin, y = mean_illness, color = race)) +
geom_point() + geom_line()

1. Explain what code chunk 1 is doing.

Chunk 1 uses the quantile() function to find the values of the risk score at every 10th percentile, from the 0th percentile to the 100th percentile. The seq() function creates the sequence from 0 to 1 in increments of 0.1. These values are stored as risk_deciles and are used to divide the risk scores into ten groups.

2. Explain what code chunk 2 is doing.

Chunk 2 uses the cut() function to divide the risk scores into ten groups using the deciles calculated in Chunk 1. It then uses as.numeric() to turn those groups into numbers from 1 to 10. The new variable risk_decile_bin is added to dat and tells us which risk-score decile each patient belongs to.

3. Explain what code chunk 3 is doing.

Chunk 3 groups the data by risk-score decile and race. It then calculates the mean number of chronic illnesses for each racial group within each risk-score decile. The results are stored in a data frame called some_results. This allows us to compare the average number of chronic illnesses for Black and White patients at different levels of risk score.

4. Recreate a simplified figure 3(A).

some_results_cost <-
as.data.frame(
dat %>%
group_by(risk_decile_bin, race) %>%
summarise(mean_cost = mean(cost_t))
)
## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by risk_decile_bin and race.
## ℹ Output is grouped by risk_decile_bin.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(risk_decile_bin, race))` for per-operation grouping
##   (`?dplyr::dplyr_by`) instead.
ggplot(some_results_cost,
       aes(x = risk_decile_bin, y = mean_cost, color = race)) +
  geom_point() +
  geom_line()

5. Describe the key differences between the patterns in Figure 1(A) vs 3(A)

The key difference between Figures 1(A) and 3(A) is that Figure 1(A) shows that Black patients tend to have more chronic illnesses than White patients at the same risk score, while Figure 3(A) shows a more similar relationship between risk score and medical expenditures across the two racial groups. This difference occurs because the algorithm predicts medical expenditures rather than directly measuring a patient’s health. As a result, Black patients can have more chronic illnesses while having a similar risk score to White patients. This can create racial bias because the algorithm may assign lower risk scores to some Black patients even when they have greater health needs, which could make them less likely to be selected for the program.

  • worked with Zayd Aslam