Rでの分析がうまく出力されない

Question

実現したいこと

医療データを分析しています。
手術実施の患者に関して手術後60日以内に投与される薬剤を調べて、ある薬剤の組み合わせであればそれらの薬剤のdataが入力されている行のみ削除したいと思っています。（複数回手術のある患者に関して、それぞれの手術に関してうまく手術実施後の薬剤を特定できず困っています）

また試行錯誤していますが、薬剤Aと薬剤Bのみを投与された患者を定義したいのに、薬剤AとBとCを投与されている患者のA薬B薬のdataも削除されうまく出力されません。
色々調べながら実施していますが、うまく出力されません。
またデータフレーム全体を分析していますが、手術未実施の患者データが消えるケースもあり、困っております。

発生している問題・分からないこと

コードを実行してもうまく出力されない。

エラーメッセージ

エラーは出ずに出力されるのですが、うまく目的としている出力になりません。

該当のソースコード

# 必要なパッケージの読み込み
library(dplyr)
library(lubridate)

# サンプルデータフレームの作成
df <- data.frame(
  patient_id = c(1, 1, 1, 1, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 5, 5, 5),
  drugname = c("手術", "薬剤A", "薬剤B", "薬剤C", "手術", "薬剤A", "薬剤C", "手術", "薬剤A", "薬剤B", "手術", "手術", "薬剤C", "薬剤D", "手術", "薬剤A", "薬剤B"),
  actdate = as.Date(c("2025-01-01", "2025-01-15", "2025-01-20", "2025-02-01", "2025-02-01", "2025-02-10", "2025-02-20", "2025-03-01", "2025-03-10", "2025-03-15", "2025-04-01", "2025-04-01", "2025-04-05", "2025-04-10", "2025-05-01", "2025-05-10", "2025-05-15")),
  dosage = c(NA, 100, 150, 200, NA, 100, 150, NA, 100, 150, NA, NA, 200, 250, NA, 100, 150),
  Surgery_Flag = c(1, NA, NA, NA, 1, NA, NA, 1, NA, NA, 1, 1, NA, NA, 1, NA, NA)
)

# 手術日を抽出
surgery_dates <- df %>%
  filter(Surgery_Flag == 1) %>%
  select(patient_id, surgery_date = actdate)

# 手術日から2か月以内に投与された薬剤を抽出
df_within_2months <- df %>%
  filter(is.na(Surgery_Flag)) %>%  # 手術以外の行を対象
  left_join(surgery_dates, by = "patient_id") %>%
  filter(actdate > surgery_date & actdate <= surgery_date %m+% months(2))

# 削除したいレジメンを定義（例: "薬剤A" と "薬剤B" の組み合わせ）
regimen_to_remove <- c("薬剤A", "薬剤B")

# 各患者ごとに手術日から2か月以内に投与された薬剤の組み合わせ（レジメン）を特定し、特定のレジメンを含むか確認
patients_to_remove <- df_within_2months %>%
  group_by(patient_id, surgery_date) %>%
  summarise(regimen = list(sort(unique(drugname))), .groups = 'drop') %>%
  filter(all(regimen_to_remove %in% regimen)) %>%
  select(patient_id, surgery_date)

# 元のデータフレームから特定のレジメンを含む投与記録を削除
df_filtered <- df %>%
  left_join(patients_to_remove, by = c("patient_id"), relationship = "many-to-many") %>%
  filter(is.na(surgery_date) | !(actdate > surgery_date & actdate <= surgery_date %m+% months(2) & drugname %in% regimen_to_remove)) %>%
  select(-surgery_date)

# 結果の表示
print(df_filtered)

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

出力されるのですが、目的としている出力結果が得られていません。

補足

特になし

Comments

[melian]

以下の行ですが、is.na(surgery_date) | !(actdate > ... ではなく is.na(surgery_date) & !(actdate > ... ではないでしょうか。(OR ではなく AND)

> filter(is.na(surgery_date) | !(actdate > surgery_date & actdate <= surgery_date %m+% months(2) & drugname %in% regimen_to_remove)) %>%

[keikmyo]

コメントありがとうございます。A薬B薬のみ投与されているケースではうまく削除されるのですがpatient_id１AとBとCを投与された患者の薬剤Aと薬剤Bも削除されてしまっております。ABCが投与されている場合はABの行を削除せずに分析したいと思っております。
また上記に記載したデータフレームとは異なるのですが実際の分析データですと複数回手術を受けた患者の場合に2回目の手術後の薬剤がうまく削除できませんでした。
また手術未実施症例も実データには含まれているのですが、未実施データがまるまる消えてしまい困っておりました。

Answer 1

dplyr::group_by() と dplyr::group_map() を利用して、削除する投与記録の行番号を抽出します。

# 削除したいレジメンを定義（例: "薬剤A" と "薬剤B" の組み合わせ）
regimen_to_remove <- c("薬剤A", "薬剤B")

# 特定のレジメンを含む投与記録の行番号を抽出
removed_idx <- df %>%
  mutate(rownum = row_number()) %>%
  group_by(patient_id) %>%
  group_map(\(grp, ...){
    drugs = grp %>% filter(is.na(Surgery_Flag))
    grp %>%
      filter(Surgery_Flag == 1) %>%
      rowwise() %>%
      group_map(~ {
        surgery_date = .x$actdate
        drugs %>%
          filter(actdate > surgery_date & actdate <= surgery_date %m+% months(2)) %>%
          filter(setequal(drugname, regimen_to_remove)) %>%
          select(rownum)
      })
  }) %>% unlist(use.names=FALSE)

# 元のデータフレームから特定のレジメンを含む投与記録を削除
df_filtered <- df %>% slice(-removed_idx)

# 結果の表示
print(df_filtered)

#    patient_id drugname    actdate dosage Surgery_Flag
# 1           1     手術 2025-01-01     NA            1
# 2           1    薬剤A 2025-01-15    100           NA
# 3           1    薬剤B 2025-01-20    150           NA
# 4           1    薬剤C 2025-02-01    200           NA
# 5           2     手術 2025-02-01     NA            1
# 6           2    薬剤A 2025-02-10    100           NA
# 7           2    薬剤C 2025-02-20    150           NA
# 8           3     手術 2025-03-01     NA            1
# 9           3     手術 2025-04-01     NA            1
# 10          4     手術 2025-04-01     NA            1
# 11          4    薬剤C 2025-04-05    200           NA
# 12          4    薬剤D 2025-04-10    250           NA
# 13          5     手術 2025-05-01     NA            1

Comments

[keikmyo]

ありがとうございます！作成したデータフレームでは解決できました。chatgptでも何度も調べたりしましたが
何度行ってもうまくいかず困っておりました。いったん、実際のデータフレームにて実施させていただき、うまく動作するか確認させていただきます。
確認後、再度、動作しましたらベストアンサーとさせていただきます。

[keikmyo]

回答ありがとうございます。
試したところ問題が解決しました！
ベストアンサーに選ばせていただきました。