r - Calculating percent's for different combinations in a dataset - Stack Overflow

admin管理员组

文章数量:1364018

I have this dataset in R:

set.seed(123)

num_patients <- 50
patient_ids <- rep(1:num_patients, each = sample(2:10, num_patients, replace = TRUE))
n_visits <- length(patient_ids)

start_date <- as.Date("2022-01-01")
end_date <- as.Date("2023-12-31")
visit_dates <- sample(seq(start_date, end_date, by = "day"), n_visits, replace = TRUE)

results <- sample(c("miss", "attend"), n_visits, replace = TRUE, prob = c(0.25, 0.75))

patient_visits <- data.frame(
  patient_id = patient_ids,
  visit_date = sort(visit_dates[order(patient_ids)]),
  result = results
)

head(patient_visits)

This dataset shows how different patients either attended or missed their appointments:

 patient_id visit_date result
1          1 2022-01-05   miss
2          1 2022-01-13 attend
3          1 2022-01-20 attend
4          1 2022-01-24 attend
5          2 2022-01-26 attend
6          2 2022-02-03   miss

I want to answer the following question:

- For patients who have exactly 1 appointment: what was the miss rate on their first appointment?

- For patients who have exactly 2 appointments: what was the miss rate on their first appointment? what was the miss rate on their second appointment?

- For patients who have exactly 3 appointments: what was the miss rate on their first appointment? what was the miss rate on their second appointment? what was the miss rate on their third appointment?

- For patients who have exactly 4 appointments: what was the miss rate on their first appointment? what was the miss rate on their second appointment? what was the miss rate on their third appointment? what was their miss rate on all other appointments (lumped into one)?

I tried to do this manually for each combination:

patient_visits <- patient_visits[order(patient_visits$patient_id, patient_visits$visit_date), ]
patient_visits$appt_seq <- unlist(tapply(patient_visits$patient_id, patient_visits$patient_id, FUN = function(x) 1:length(x)))

appt_counts <- table(patient_visits$patient_id)

patients_with_1_appt <- as.numeric(names(appt_counts[appt_counts == 1]))
patients_with_2_appt <- as.numeric(names(appt_counts[appt_counts == 2]))
patients_with_3_appt <- as.numeric(names(appt_counts[appt_counts == 3]))
patients_with_4_appt <- as.numeric(names(appt_counts[appt_counts == 4]))

results_df <- data.frame(
  total_appointments = numeric(),
  appointment_number = character(),
  miss_rate = numeric(),
  stringsAsFactors = FALSE
)

visits_1 <- patient_visits[patient_visits$patient_id %in% patients_with_1_appt, ]
miss_rate_1 <- mean(visits_1$result == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = 1,
  appointment_number = "1",
  miss_rate = miss_rate_1
))

visits_2 <- patient_visits[patient_visits$patient_id %in% patients_with_2_appt, ]
miss_rate_2_first <- mean(visits_2[visits_2$appt_seq == 1, "result"] == "miss")
miss_rate_2_second <- mean(visits_2[visits_2$appt_seq == 2, "result"] == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = c(2, 2),
  appointment_number = c("1", "2"),
  miss_rate = c(miss_rate_2_first, miss_rate_2_second)
))

visits_3 <- patient_visits[patient_visits$patient_id %in% patients_with_3_appt, ]
miss_rate_3_first <- mean(visits_3[visits_3$appt_seq == 1, "result"] == "miss")
miss_rate_3_second <- mean(visits_3[visits_3$appt_seq == 2, "result"] == "miss")
miss_rate_3_third <- mean(visits_3[visits_3$appt_seq == 3, "result"] == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = c(3, 3, 3),
  appointment_number = c("1", "2", "3"),
  miss_rate = c(miss_rate_3_first, miss_rate_3_second, miss_rate_3_third)
))

visits_4 <- patient_visits[patient_visits$patient_id %in% patients_with_4_appt, ]
miss_rate_4_first <- mean(visits_4[visits_4$appt_seq == 1, "result"] == "miss")
miss_rate_4_second <- mean(visits_4[visits_4$appt_seq == 2, "result"] == "miss")
miss_rate_4_third <- mean(visits_4[visits_4$appt_seq == 3, "result"] == "miss")
miss_rate_4_other <- mean(visits_4[visits_4$appt_seq > 3, "result"] == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = c(4, 4, 4, 4),
  appointment_number = c("1", "2", "3", "4+"),
  miss_rate = c(miss_rate_4_first, miss_rate_4_second, miss_rate_4_third, miss_rate_4_other)
))

Is there an easier way to do this in base R?

I have this dataset in R:

set.seed(123)

num_patients <- 50
patient_ids <- rep(1:num_patients, each = sample(2:10, num_patients, replace = TRUE))
n_visits <- length(patient_ids)

start_date <- as.Date("2022-01-01")
end_date <- as.Date("2023-12-31")
visit_dates <- sample(seq(start_date, end_date, by = "day"), n_visits, replace = TRUE)

results <- sample(c("miss", "attend"), n_visits, replace = TRUE, prob = c(0.25, 0.75))

patient_visits <- data.frame(
  patient_id = patient_ids,
  visit_date = sort(visit_dates[order(patient_ids)]),
  result = results
)

head(patient_visits)

This dataset shows how different patients either attended or missed their appointments:

 patient_id visit_date result
1          1 2022-01-05   miss
2          1 2022-01-13 attend
3          1 2022-01-20 attend
4          1 2022-01-24 attend
5          2 2022-01-26 attend
6          2 2022-02-03   miss

I want to answer the following question:

- For patients who have exactly 1 appointment: what was the miss rate on their first appointment?

- For patients who have exactly 2 appointments: what was the miss rate on their first appointment? what was the miss rate on their second appointment?

- For patients who have exactly 3 appointments: what was the miss rate on their first appointment? what was the miss rate on their second appointment? what was the miss rate on their third appointment?

- For patients who have exactly 4 appointments: what was the miss rate on their first appointment? what was the miss rate on their second appointment? what was the miss rate on their third appointment? what was their miss rate on all other appointments (lumped into one)?

I tried to do this manually for each combination:

patient_visits <- patient_visits[order(patient_visits$patient_id, patient_visits$visit_date), ]
patient_visits$appt_seq <- unlist(tapply(patient_visits$patient_id, patient_visits$patient_id, FUN = function(x) 1:length(x)))

appt_counts <- table(patient_visits$patient_id)

patients_with_1_appt <- as.numeric(names(appt_counts[appt_counts == 1]))
patients_with_2_appt <- as.numeric(names(appt_counts[appt_counts == 2]))
patients_with_3_appt <- as.numeric(names(appt_counts[appt_counts == 3]))
patients_with_4_appt <- as.numeric(names(appt_counts[appt_counts == 4]))

results_df <- data.frame(
  total_appointments = numeric(),
  appointment_number = character(),
  miss_rate = numeric(),
  stringsAsFactors = FALSE
)

visits_1 <- patient_visits[patient_visits$patient_id %in% patients_with_1_appt, ]
miss_rate_1 <- mean(visits_1$result == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = 1,
  appointment_number = "1",
  miss_rate = miss_rate_1
))

visits_2 <- patient_visits[patient_visits$patient_id %in% patients_with_2_appt, ]
miss_rate_2_first <- mean(visits_2[visits_2$appt_seq == 1, "result"] == "miss")
miss_rate_2_second <- mean(visits_2[visits_2$appt_seq == 2, "result"] == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = c(2, 2),
  appointment_number = c("1", "2"),
  miss_rate = c(miss_rate_2_first, miss_rate_2_second)
))

visits_3 <- patient_visits[patient_visits$patient_id %in% patients_with_3_appt, ]
miss_rate_3_first <- mean(visits_3[visits_3$appt_seq == 1, "result"] == "miss")
miss_rate_3_second <- mean(visits_3[visits_3$appt_seq == 2, "result"] == "miss")
miss_rate_3_third <- mean(visits_3[visits_3$appt_seq == 3, "result"] == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = c(3, 3, 3),
  appointment_number = c("1", "2", "3"),
  miss_rate = c(miss_rate_3_first, miss_rate_3_second, miss_rate_3_third)
))

visits_4 <- patient_visits[patient_visits$patient_id %in% patients_with_4_appt, ]
miss_rate_4_first <- mean(visits_4[visits_4$appt_seq == 1, "result"] == "miss")
miss_rate_4_second <- mean(visits_4[visits_4$appt_seq == 2, "result"] == "miss")
miss_rate_4_third <- mean(visits_4[visits_4$appt_seq == 3, "result"] == "miss")
miss_rate_4_other <- mean(visits_4[visits_4$appt_seq > 3, "result"] == "miss")
results_df <- rbind(results_df, data.frame(
  total_appointments = c(4, 4, 4, 4),
  appointment_number = c("1", "2", "3", "4+"),
  miss_rate = c(miss_rate_4_first, miss_rate_4_second, miss_rate_4_third, miss_rate_4_other)
))

Is there an easier way to do this in base R?

• r

Share Improve this question Follow asked 5 hours ago user430997user430997 52111 silver badge1111 bronze badges 1

• I don't think you want that each= on the initial rep line to make an appropriate example dataset. – thelatemail Commented 5 hours ago

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 2

I like the tabulation functions for this sort of thing, because they're quite flexible to change the calculation and inputs:

Make a few variables to assist first:

patient_visits$total_appointments <- with(patient_visits, 
                                          ave(patient_id, patient_id, FUN=length))
patient_visits$appt_seq <- with(patient_visits,
                                ave(patient_id, patient_id, FUN=seq_along))

Then do the calculations:

tab <- with(patient_visits, table(
                                total_appointments = pmin(4,total_appointments),
                                appt_seq = pmin(4, appt_seq),
                                results = results))
results <- as.data.frame(prop.table(tab, c(1,2)), responseName = "miss_rate")
results <- results[results$results == "miss", -3]
##   total_appointments appt_seq miss_rate
##13                  2        1 0.0000000
##14                  3        1 0.2500000
##15                  4        1 0.2558140
##16                  2        2 0.0000000
##17                  3        2 0.2500000
##18                  4        2 0.1627907
##19                  2        3       NaN
##20                  3        3 0.0000000
##21                  4        3 0.4418605
##22                  2        4       NaN
##23                  3        4       NaN
##24                  4        4 0.2328042

本文标签： rCalculating percent39s for different combinations in a datasetStack Overflow