Rの実習でのコードをまとめていく。
ここから写経して使い方をおぼえたい。
＃自分のところ
病歴の取り込み
df2 <- X20210702_IQVIA_HIS_2_病歴_2020年2月_2020年8月データ
df3 <- df2 %>% filter(df2$病名コード=="8833876" | df2$ICD10コード == "B342" | df2$病名コード == "8850104" | df2$ICD10コード == "U071" |df2$病名名称1 == "ＣＯＶＩＤ－１９" | df2$病名名称1 == "コロナウイルス感染症" | df2$病名名称2 == "ＣＯＶＩＤ－１９" | df2$病名名称2 == "コロナウイルス感染症" |df2$病名名称1 == "ＣＯＶＩＤ－１９の再燃" | df2$病名名称1 == "ＣＯＶＩＤ－１９の再発" | df2$病名名称2 == "ＣＯＶＩＤ－１９の再燃" | df2$病名名称2 == "ＣＯＶＩＤ－１９の再発", df2$疑いフラグ==0, df2$主病名フラグ==1)
病歴ファイルの取り込み
df_byoumei_group2 <- read_csv("/ext4data1/home/shared/groupwork_20220625/df_byoumei_group2.csv", col_types = cols(病名名称1 = col_character()))
df_name_covid_1st <- df_byoumei_group2 %>% group_by(患者ID) %>% summarize(最初の診断日 = min(有効開始日))
入退院
df_date <- read_csv("HIS/20210702_IQVIA HIS_6_入退院_2020年2月df~2020年8月データ.csv")
df_date_kikan <- df_date %>% filter((入院日 >= 20200401) & (入院日 <= 20200731))
df_date_kikan$入院日 <- lubridate::ymd(df_date_kikan$入院日)
df_date_kikan$退院日 <- lubridate::ymd(df_date_kikan$退院日)
df_date <- df_date_kikan %>% arrange(患者ID, 入院日)
df_date_final <- df_date %>% select(患者ID, 入院日, 退院日)
df_date_final$入院期間 <- df_date_final$退院日 - df_date_final$入院日 + 1
write.csv(df_date_final, "/home/shared/groupwork_20220625/df_date.csv")
df_byoumei_date <- left_join(df_name_covid_1st, df_date_final, by = "患者ID")
df_byoumei_date_jogai <- subset(df_byoumei_date, !(is.na(df_byoumei_date$入院日)))
df_byoumei_date_jogai$最初の診断日 <- lubridate::ymd(df_byoumei_date_jogai$最初の診断日)
df_byoumei_date_jogai$入院日ひく最初の診断日 <- df_byoumei_date_jogai$入院日 - df_byoumei_date_jogai$最初の診断日
df_byoumei_date_jogai$入院日ひく最初の診断日の絶対値 <- abs(df_byoumei_date_jogai$入院日 - df_byoumei_date_jogai$最初の診断日)
df_byoumei_date_jogai <- df_byoumei_date_jogai %>% arrange(患者ID, 入院日ひく最初の診断日の絶対値)
df_byoumei_date_final <- df_byoumei_date_jogai %>% distinct(患者ID, .keep_all=TRUE)
df_byoumei_date_final <- df_byoumei_date_final %>% filter((入院日ひく最初の診断日 >= -1) & (入院日ひく最初の診断日 <= 7))
write.csv(df_byoumei_date_final, "/home/shared/groupwork_20220625/df_byoumei_date_kubo.csv")
#CRP処理
df_ex2 <- read_csv("/ext4data1/home/shared/groupwork_20220625/df_ex2.csv", col_types = cols(`検体検査結果値（文字）` = col_character()))
df_ex3 <- df_ex2 %>% select(患者ID, 検査実施日, '検体検査結果値（文字）', '検体検査結果値（数値）')
＃最終統合
df_byoumei_date_CRP <- left_join(df_byoumei_date_final, df_ex3, by = "患者ID")
df_byoumei_date_CRP_jogai <- subset(df_byoumei_date_CRP, !(is.na(df_byoumei_date_CRP$'検体検査結果値（文字）')))
df_byoumei_date_jogai$入院日ひく検査日 <- abs(df_byoumei_date_CRP_jogai$入院日 - df_byoumei_date_CRP_jogai$検査実施日)
df_byoumei_date_CRP_jogai <- df_byoumei_date_CRP_jogai %>% arrange(患者ID, 入院日ひく検査日)
df_byoumei_date_CRP_jogai <- df_byoumei_date_CRP_jogai %>% distinct(患者ID, .keep_all=TRUE)
df_byoumei_date_CRP_final <- df_byoumei_date_CRP_jogai %>% filter(入院日ひく検査日== 0)
#必要項目の抜き出し
df_population <- df_byoumei_date_CRP_final %>% select(患者ID, 入院期間, '検体検査結果値（数値）')
#検査値NA（検出限界未満）を0に置換
df_population[is.na(df_population)] <- 0
#書き出し
write.csv(df_population, "/home/shared/groupwork_20220625/population_data_group2.csv") # グループ1のR code
#----- コロナ患者の抽出 (893 pts)
# res2 <- d2 %>%
# filter(病名コード %in% c("8833876", "8850104") & 疑いフラグ == 0) %>%
# ungroup()
res2 <- d2 %>%
filter(病名名称1 == "ＣＯＶＩＤ－１９" | 病名名称1 == "コロナウイルス感染症" |
病名名称2 == "ＣＯＶＩＤ－１９" | 病名名称2 == "ＣＯＶＩＤ－１９の再燃" |
病名名称2 == "ＣＯＶＩＤ－１９の再発" |
病名コード %in% c("8833876", "8850104") |
ICD10コード %in% c("U071", "B342"), 疑いフラグ == 0)
#----- COVID-19診断日 + 2week > 入院日
#----- 入院日 + 1week > COVID-19診断日
#----- 793 pts
diag_date <- res2 %>%
group_by(患者ID) %>%
summarise(diag_date = min(有効開始日)) %>%
distinct(患者ID, diag_date)
res6 <- left_join(x = d6, y = diag_date, by = "患者ID")
res6 <- res6 %>%
filter(is.na(diag_date) == FALSE) %>%
mutate(diag_date_conversion = lubridate::ymd(diag_date),
admission_date_conversion = lubridate::ymd(入院日),
discharge_date_conversion = lubridate::ymd(退院日),
dif_date = as.numeric(admission_date_conversion - diag_date_conversion),
admission_duration = as.numeric(discharge_date_conversion - admission_date_conversion)) %>%
filter(dif_date < 14 & dif_date >= -7) %>%
select(患者ID, 入院日, 退院日, dif_date, admission_duration)
dup_res6 <- res6 %>%
group_by(患者ID) %>%
summarise(n = n()) %>%
filter(n > 1)
chk_res6 <- res6 %>%
filter(患者ID %in% c("3088", "6514", "14917", "29378"))
res6 <- res6 %>%
group_by(患者ID) %>%
filter(入院日 == min(入院日))
#----- 患者基本にmerge
res1 <- d1 %>%
mutate(dup = if_else(患者ID %in% c(3088, 6514, 14917, 29378), "Y", ""),
covid = if_else(患者ID %in% res2$患者ID, "Y", ""))
# mutate(dup = case_when(患者ID %in% c(3088, 6514, 14917, 29378)))
res1 <- left_join(x = res1, y = diag_date, by = "患者ID")
res1 <- left_join(x = res1, y = res6, by = "患者ID")
#----- コロナ患者抽出 (789pts)
res1_1 <- res1 %>%
filter(dup == "" & covid == "Y")
#----- 診断日ある患者 (789pts)
res1_2 <- res1_1 %>%
filter(is.na(diag_date) == FALSE)
#----- 除外1: 外来患者を除外 (307pts)
res1_3 <- res1_2 %>%
filter(is.na(入院日) == FALSE)
#----- 除外2: 診断日が最終来院日より後になっている
res1_3$退院日 <- ifelse(is.na(res1_3$退院日) == TRUE, 20210630, res1_3$退院日)
res1_4 <- res1_3 %>%
mutate(diag_date_conversion = lubridate::ymd(diag_date),
discharge_date_conversion = lubridate::ymd(退院日)) %>%
filter(diag_date_conversion < discharge_date_conversion) # group4
# データフレームの読み込み
# 患者基本
df1 <- read_csv("/ext4data1/home/shared/HIS/20210702_IQVIA HIS_1_患者基本_2020年2月~2020年8月データ.csv")
# 年齢を追加
df1 <- df1 %>%
mutate(年齢 = 2020 - 生年)
# 病歴
df2 <- read_csv("/ext4data1/home/shared/HIS/20210702_IQVIA HIS_2_病歴_2020年2月~2020年8月データ.csv")
# 日付に変換
df2 <- df2 %>%
mutate(有効開始日 = lubridate::ymd(有効開始日)) %>%
mutate(有効終了日 = lubridate::ymd(有効終了日)) %>%
mutate(有効期間 = 有効終了日 - 有効開始日 + 1)
# 入退院
df6 <- read_csv("/ext4data1/home/shared/HIS/20210702_IQVIA HIS_6_入退院_2020年2月~2020年8月データ.csv")
# 日付に変換
df6 <- df6 %>%
mutate(入院日 = lubridate::ymd(入院日)) %>%
mutate(退院日 = lubridate::ymd(退院日)) %>%
mutate(入院期間 = 退院日 - 入院日 + 1)
# 患者IDの確認
# ソート
df1 <- df1 %>%
sort(患者ID)
# 各行の値の出現数をカウントして、2回以上出現したものを抽出
df1 %>%
count(患者ID) %>%
filter(n >= 2)
# 重複はないので行数を数えて記録
# ユニークな患者数:n_0
n_0 <- df1 %>% nrow
n_0
# 主病名COVID-19を抽出
#df2_covid19 <- df2 %>%
# filter((ICD10コード == 'B342' | ICD10コード == 'U071') & 主病名フラグ == 1 )
# 病名COVID-19を抽出
#df2_covid19 <- df2 %>%
#
# 主病名COVID-19を抽出
df2_covid19 <- df2 %>%
filter((ICD10コード == 'B342' | ICD10コード == 'U071') & 主病名フラグ == 1 & 疑いフラグ == 0)
# 件数の確認
df2_covid19 %>% nrow
# 複数回主病名COVID19と診断されているか確認
df2_covid19 %>%
count(患者ID) %>%
filter(n >= 2)
# 主病名COVID-19のユニークな患者数:n_1
n_1 <- df2_covid19 %>%
select(患者ID) %>%
unique() %>%
nrow
n_1
# データフレームを結合
# 患者ID、有効開始日でソート
df2 <- df2 %>% arrange(患者ID,有効開始日)
# 患者ID、入院日でソート
df6 <- df6 %>% arrange(患者ID,入院日)
# 主病名COVID19があるIDかつ入院歴があるものだけになっている
# inner_joinを使ったので、外来患者はデータフレームに含まれない
df_covid19hp <- inner_join(df2_covid19, df6, by = "患者ID")
# 複数回入院がない確認
df_covid19hp %>%
count(患者ID) %>%
filter(n >= 2)
# 主病名COVID-19&入院歴ありのユニークな患者数:n_2
n_2 <- df_covid19hp %>%
select(患者ID) %>%
unique() %>%
nrow
n_2
# 入院患者の条件設定
# 変数：診断日から入院日までの差を追加
df_covid19hp <- df_covid19hp %>%
mutate(診断入院日差 = 入院日 - 有効開始日)
# 診断入院日差で条件をつけて抽出
df_covid19hp_2 <- df_covid19hp %>%
filter(診断入院日差 >=0 & 診断入院日差 <30)
# 主病名COVID-19&入院歴あり&診断入院日差で限定のユニークな患者数:n_3
n_3 <- df_covid19hp_2 %>%
select(患者ID) %>%
unique() %>%
nrow
n_3
# 年齢20歳以上を抽出
# 年齢の情報をデータベースを結合して取得
df_covid19hp_2_age <- left_join(df_covid19hp_2, df1, by = "患者ID")
df_covid19hp_2_age <- df_covid19hp_2_age %>%
filter(年齢 >=20)
# 主病名COVID-19&入院歴あり&診断入院日差で限定のユニークな患者数&20歳以上のみ:n_4
n_4 <- df_covid19hp_2_age %>%
select(患者ID) %>%
unique() %>%
nrow
n_4
# 入院中の患者は除く：入院期間はexclusion?
df_covid19hp_2_age_ex <-df_covid19hp_2_age %>%
filter(入院期間 >= 1)
# 主病名COVID-19&入院歴あり&診断入院日差で限定のユニークな患者数&20歳以上のみ&入院中除く:n_5
n_5 <- df_covid19hp_2_age_ex %>%
select(患者ID) %>%
unique() %>%
nrow
n_5
# 複数回入院がない確認
df_covid19hp_2_age_ex %>%
count(患者ID) %>%
filter(n >= 2)
# 解析用データフレーム
# n = 154
df <- df_covid19hp_2_age_ex %>%
group_by(患者ID) %>% slice_head(n=1) %>%
ungroup()
# 表の作成
# 解析結果
df <- df %>%
mutate(性別 = factor(性別, labels =c("男性","女性"))) %>%
mutate(年齢カテゴリ =
case_when(年齢 >= 80 ~ "80-",
年齢 >= 70 & 年齢 <80 ~ "70-79",
年齢 >= 60 & 年齢 <70 ~ "60-69",
年齢 >= 50 & 年齢 <60 ~ "50-59",
年齢 >= 40 & 年齢 <50 ~ "40-49",
年齢 >= 30 & 年齢 <40 ~ "30-39",
年齢 >= 20 & 年齢 <30 ~ "20-29"))
# 全体
df %>%
select(年齢カテゴリ, 入院期間, 性別) %>%
tbl_summary(by = 年齢カテゴリ,
type=list(c(入院期間) ~ "continuous"),
statistic = list(入院期間 ~ "{mean} ± {sd}"),
digits = list(c(入院期間) ~ 1)) %>%
add_overall()
# 性別で層別化
df %>%
select(年齢カテゴリ, 入院期間, 性別) %>%
tbl_strata(
strata = 性別,
~.x %>%
tbl_summary(by = 年齢カテゴリ,
type=list(c(入院期間) ~ "continuous"),
statistic = list(入院期間 ~ "{mean} ± {sd}"),
digits = list(c(入院期間) ~ 1)) %>%
add_overall()
)rm(list=ls());gc();gc()
# setup -------------------------------------------------------------------
library(tidyverse)
library(magrittr)
source("r/my_functions.R")
setwd("/home/shared/groupwork_20220625/group5/inayoshi")
# file path ---------------------------------------------------------------
path <-
list(
kihon = "20210702_IQVIA HIS_1_患者基本_2020年2月~2020年8月データ.csv",
byoureki = "20210702_IQVIA HIS_2_病歴_2020年2月~2020年8月データ.csv",
shohou = "20210702_IQVIA HIS_3_処方_2020年2月~2020年8月データ.csv",
chuusha = "20210702_IQVIA HIS_4_注射_2020年2月~2020年8月データ.csv",
kentaikensa = "20210702_IQVIA HIS_5_検体検査_2020年2月~2020年8月データ.csv",
nyuutaiin = "20210702_IQVIA HIS_6_入退院_2020年2月~2020年8月データ.csv",
iji_NEC = "20210702_IQVIA HIS_7_医事NEC_2020年2月~2020年8月データ.csv",
iji_NEC_unpivot = "20210702_IQVIA HIS_8_医事NEC_unpivot_2020年2月~2020年8月データ.csv",
iji_fujitsu = "20210702_IQVIA HIS_9_医事Fujitsu_2020年2月~2020年8月データ.csv",
iji_fujitsu_sx = "20210702_IQVIA HIS_10_医事Fujitsu_sx_2020年2月~2020年8月データ.csv",
iji_ntt = "20210702_IQVIA HIS_11_医事NTT_2020年2月~2020年8月データ.csv"
) %>%
purrr::map(~stringr::str_c("/home/shared/HIS/", .)) %>%
print()
# kihon -------------------------------------------------------------------
kihon <- read_csv(path$kihon,col_types=cols(.default='c'))
# 生年データしかないので日付を7/1で補完しておく。
# 元データは男=1,女=2。sex列とし女を
kihon <-
kihon %>%
rename(hpcd = "施設番号",
ptid = "患者ID",
sex = "性別",
birth_year = "生年",
stature = "身長",
weight = "体重") %>%
mutate(pid = paste(trimws(hpcd),trimws(ptid),sep='_'),
sex = as.factor(if_else(sex==1,'男性','女性')) ,
birthday = lubridate::ymd(paste0(birth_year,'0101'))) %>%
select(-birth_year) %>%
print()
# byoureki ----------------------------------------------------------------
byoureki <- read_csv(path$byoureki,col_types=cols(.default='c'))
byoureki <-
byoureki %>%
rename(hpcd = '施設番号',
ptid ='患者ID',
dep ='診療科名',
sycd = '病名コード',
sy1 = '病名名称1',
sy2 = '病名名称2',
utagai_flag = '疑いフラグ',
syubyoumei_flag = '主病名フラグ',
startdate ='有効開始日',
enddate ='有効終了日',
icd ='ICD10コード') %>%
mutate(pid = paste(trimws(hpcd),trimws(ptid),sep='_')) %>%
mutate(across(c(startdate,enddate), ~as.Date(.x,format="%Y%m%d"))) %>%
mutate(across(c(utagai_flag,syubyoumei_flag), as.numeric)) %>%
print()
## ICDコード U071で絞り込み 10770人 13649レコード--------------------------
covid <-
byoureki %>%
filter(icd %in% c('U071','B342')) %>%
print()
length(unique(covid$pid))
## 確定病名に絞り込み 793人 893レコード ----------------------------------
covid <-
covid %>%
filter(utagai_flag==0) %>%
print()
length(unique(covid$pid))
## 修飾語により疑い病名の除外 484人 537レコード--------------------------
covid <-
covid %>%
filter(!str_detect(sy2,'の疑い|の治療後|疑似症|の再燃|の再発')) %>%
print()
length(unique(covid$pid))
## 初回確定日のレコードに絞り込み 484人 484レコード ---------------------
covid <-
covid %>%
arrange(pid,startdate) %>%
distinct(pid,.keep_all=T) %>%
select(hpcd, ptid, pid, icd, sy2, 'kakutei_date' = startdate) %>% # 有効開始日の列をkakutei_dayに変更
print()
# ## covid確定日の7日以内にcovid疑い病名をjoinするための処理---------------
#
# # covid疑い病名だけのリストを作成---------------------------------------
#
# covid_utagai <- byoureki %>%
# filter(pid %in% covid$pid) %>%
# filter(icd=='U071') %>%
# filter(utagai_flag == 1 | str_detect(sy2,'の疑い|の治療後|疑似症|の再燃|の再発')) %>%
# select(pid,utagai_date = startdate) %>%
# arrange(utagai_date) %>%
# print()
#
# # covid確定患者リストにcovid疑い病名のリストをleft_joinし日付の差を取る-------
# # 疑い病名が複数ある患者はレコードがふえるので、後で重複削除する
# # この時点でcovidは1患者1レコードになっているので、あとでpidで重複削除すれば問題ない
#
# covid <- covid %>%
# left_join(covid_utagai,by='pid') %>%
# mutate(diff_date = kakutei_date - utagai_date) %>%
# print()
#
# # utagai_dateがkakutei_dateより後のものはutaggai_dateをNAにする--------------
# # utagai_dateがkakutei_dateより8日以上前のものものugatai_dateをNAに
# # date型の列をNAにする方法がわからなかったのでいったん文字列に変換してから処理する
# covid <-
# covid %>%
# mutate(utagai_date = as.character(utagai_date)) %>%
# mutate(utagai_date = if_else(diff_date<=0, NA_character_,utagai_date)) %>%
# mutate(utagai_date = if_else(diff_date>=8, NA_character_,utagai_date)) %>%
# mutate(utagai_date = lubridate::ymd(utagai_date)) %>%
# mutate(diff_date = kakutei_date - utagai_date) %>%
# print()
#
# # 処理が正しいことを確認------------------------------------------------------
#
# covid %>% filter(!is.na(utagai_date))
# covid %>% filter(is.na(utagai_date))
#
# # いったん増えてしまっているレコード分重複削除を行う。----------------------
# # 7日以内の疑い病名が複数あった場合、日付が古い方を残す
# # これで確定病名が付く7日以内に疑い病名があった患者への疑い病名の日付付与完了
#
# covid <-
# covid %>%
# arrange(pid,desc(abs(diff_date))) %>%
# distinct(pid,.keep_all=T)
#
# # 患者数が変わっていないことを確認----------------------------------
#
# nrow(covid)
#
# # 確定病名がつく7日前に疑い病名がついている患者数をカウント 34件 -------
#
# sum(!is.na(covid$utagai_date))
#
# # covid_utagaiのデータフレームはもう使わないのでここで削除 -------------
# rm(covid_utagai)
#
# covidとkihonを結合 ----------------------------------------------------------
covid <-
covid %>%
left_join(kihon,by=c('pid','hpcd','ptid')) %>%
print()
# 病名確定時点での年齢を計算して確認しておく----------------------
covid <-
covid %>%
mutate(age = floor(lubridate::time_length(difftime(kakutei_date, birthday), "years"))) %>%
print()
# 年齢 -------------------------------------------------------------------
summary(covid$age)
# Min. 1st Qu. Median Mean 3rd Qu. Max.
# 0.00 29.75 47.00 48.09 65.00 89.00
covid %>% arrange(age)
# 男女比 ------------------------------------------------------
summary(covid$sex)
# 女性 男性
# 207 277
# 年齢のヒストグラム --------------------------------------------
ggplot(covid, aes(x = age))+
geom_histogram(bins=10)
# 性別別の年齢のヒストグラム -------------------------------------
ggplot(covid, aes(x = age, fill = sex))+
geom_histogram(bins=10,alpha = 0.7)+
facet_grid(sex~.)
# nyuutaiin ---------------------------------------------------------------
nyuutaiin <- read_csv(path$nyuutaiin,col_types=cols(.default='c'))
nyuutaiin <-
nyuutaiin %>%
rename(hpcd = "施設番号",
ptid = "患者ID",
dep = "診療科名",
adm_date = "入院日",
ent_date = "退院日") %>%
mutate(pid = paste(trimws(hpcd),trimws(ptid),sep='_')) %>%
mutate(across(c(adm_date,ent_date), ~as.Date(.x,format="%Y%m%d"))) %>%
print()
# nyuutaiinn に確定日をinner_joinしてCOVID確定患者に絞る -------------------
nyuutaiin <-
nyuutaiin %>%
inner_join(select(covid,pid,kakutei_date),by='pid') %>%
print()
# date_diffを追加 --------------------------------------------------------
nyuutaiin <-
nyuutaiin %>%
mutate(date_diff = kakutei_date - adm_date) %>%
print()
# 入院日基準で 確定日が-7日から+1日までの患者を抽出 ------------------------
nyuutaiin_kakutei <-
nyuutaiin %>%
filter(-7 <= date_diff , date_diff <= 1) %>%
print()
# 処理が正しいことを確認 ----------------------------------------------------
nyuutaiin_kakutei %>%
arrange(date_diff)
nyuutaiin_kakutei %>%
arrange(desc(date_diff))
# 患者の重複が発生していないことを確認。
# 上の日付を広めにとる場合、入院レコードが増える可能性があるので注意
# TODO 差分1日でもレコードが発生 !!!!!!!!!!!!!!!!!!!!!!!!!!----------------
# hpcd 00002
# ptid 6514
# 8/6 病名確定、入院
# 8/7 退院→同日再入院
# 9/5 退院
nyuutaiin_kakutei %>%
group_by(pid) %>%
filter(n()>1)
# データの扱い方としては2パターン考えられる
# A.8/6入院、9/5退院として扱う
# B.除外 簡単の為いったんこちらで進める -----------------------------------
# TODO 入院患者数報告の時除外患者として報告に入れる
# nyuutaiin_kakutei <-
# nyuutaiin_kakutei %>%
# filter(pid!='00002_6514') %>%
# filter(pid!='00010_29378') %>%
# print()
# 重複がなくなったことを確認
nyuutaiin_kakutei %>%
group_by(pid) %>%
filter(n()>1)
# 入院日が古いレコードを残して重複削除
nyuutaiin_kakutei <-
nyuutaiin_kakutei %>%
arrange(pid,adm_date) %>%
distinct(pid,.keep_all=T) %>%
print()
# これで確定患者で入院した患者のリストが完成。確定患者リストにleft_join------
covid <-
covid %>%
left_join(select(nyuutaiin_kakutei, pid,adm_date,ent_date,dep),by='pid') %>%
print()
# レコード数が変わっていないことを確認
nrow(covid)
# nyuin患者数の確認
sum(!is.na(covid$adm_date))
# nyuinのフラグを作成 -----------------------------------------
covid <-
covid %>%
mutate(nyuin = as.factor(if_else(is.na(adm_date),'外来','入院'))) %>%
print()
# 入院有無別で集計を比較
select(covid,age,sex,nyuin) %>%
group_nest(nyuin) %>%
mutate(s = map(data, ~summary(.))) %>%
pull(s,nyuin)
# 入院有無と年齢の関係を可視化-------------------
# 性別によって外来入院の割合が異なるように見える。
ggplot(covid, aes(x = age,fill=sex))+
geom_histogram(bins=10,alpha = 0.5)+
facet_grid(nyuin~sex)
# includion-exclusion ----------------------------------------------
# 入院患者に絞り込み 250人からスタート ---------------------------------
# TODO 翌日退院後、再入院の患者を上で除外しているので発表の際はそれも言及を。
#
covid_nyuin <-
covid %>%
filter(nyuin=='入院') %>%
print()
# TODO exclusion
set_age <- 20
set_start_adm_date = as.Date('2020/4/1')
set_end_adm_date = as.Date('2020/8/23')
# 年齢 # 20歳で絞り込むと236人 -------------------------------------------
covid_nyuin$age %>% table()
covid_nyuin <-
covid_nyuin %>%
filter(age >= set_age) %>%
print()
# 入院日、退院日のrangeを確認 ------------------------
covid_nyuin$adm_date %>% range()
covid_nyuin$ent_date %>% range(na.rm = T)
# 退院していない患者を確認 ----------------------------
# 2021年1月4日に確定診断で当日入院している人が退院していない。
covid_nyuin %>%
filter(is.na(ent_date))
# 月別の入院患者数、退院患者数を集計 -------------------------
covid_nyuin %>%
mutate(adm_year = lubridate::year(adm_date),
adm_month = lubridate::month(adm_date)) %>%
group_by(adm_year,adm_month) %>%
summarise(cnt = n()) %>%
arrange(adm_year,adm_month)
# データ仕様書の文言は以下の通り --------------------------------
# 対象期間:2020年4月~2020年8月
# 対象患者:対象期間内にCOVID-19の診断(確定または疑い)がついた患者
# TODO ※ 施設ごとのデータ提出状況は2020年2月~8月になっているので確認が必要
# ここまでの絞り込み----------------------------------------------------
# [COVID-19に初めて確定診断を受けた日の前後1日に入院した患者]
# 合わせて考えると、2020年9月以降に入院した患者は、8月以前に一度疑い病名がついて、
# 9月以降に確定診断となって入院した患者である。
# つまり、2020年9月にCOVID-19で入院した患者がデータに入っていないケースの方が多い。
# また、2020年3月31日以前に入院した患者も6データほど存在するが、同じことが言えるだろう。
# 結論としては対象期間(2020/4/1~2020/8/31)に入院した患者でデータを絞り込むべきと考える。
# 入院期間で絞り込み 205人------------------------------------------------
print(set_start_adm_date)
print(set_end_adm_date)
covid_nyuin <-
covid_nyuin %>%
filter(between(adm_date,set_start_adm_date,set_end_adm_date)) %>%
print()byoureki <- X20210702_IQVIA_HIS_2_病歴_2020年2月_2020年8月データ
byoureki_covid <- byoureki %>% filter( 病名名称1 =="ＣＯＶＩＤ－１９" | 病名名称1 =="コロナウイルス感染症" |病名名称2 =="ＣＯＶＩＤ－１９" | 病名名称2 =="コロナウイルス感染症" | 病名名称2 =="ＣＯＶＩＤ－１９の再燃") %>% filter(疑いフラグ =="0") %>% mutate(diag_date = lubridate::ymd(byoureki_covid$有効開始日)) %>% group_by(患者ID) %>% slice_min(diag_date)
nyuutaiin <- X20210702_IQVIA_HIS_6_入退院_2020年2月_2020年8月データ
nyuutaiin2 <- nyuutaiin %>% mutate(nyuuin = lubridate::ymd(nyuutaiin$入院日)) %>% mutate(taiin = lubridate::ymd(nyuutaiin$退院日))
a <- nyuutaiin %>% left_join(byoureki_covid,by = "患者ID")
c <- a %>% filter(退院日 != "NA") %>% filter(入院日 != "NA") %>% filter(diag_date - nyuuin > -5 & diag_date - nyuuin < 2 ) Group 1のR code（解析部分）を共有させていただきます。
########################################################
# analysis #
########################################################
#----- 施設ごとの入院期間
ana_res1 <- res1_4 %>%
group_by(施設番号) %>%
summarise(n = n(),
mean = mean(admission_duration),
sd = sd(admission_duration),
med = median(admission_duration))
ana_res1_1 <- res1_4 %>%
summarise(n = n(),
mean = mean(admission_duration),
sd = sd(admission_duration),
med = median(admission_duration))
p <- ggplot(data = res1_4, aes(x = as.factor(施設番号), y = admission_duration))
p <- p + theme_bw()
# p <- p + geom_point(size = 2.0)
p <- p + geom_hline(yintercept = 16.2, colour = "red", linetype = "dotted", size = 1.0)
p <- p + geom_jitter(size = 2.0, width = 0.1, alpha = 0.3, colour = "blue")
p <- p + xlab("施設番号")
p <- p + ylab("入院期間(day)")
# plot(p)
ggsave(file = paste0)
#----- 性別ごとの入院期間
ana_res2 <- res1_4 %>%
group_by(gender) %>%
summarise(n = n(),
mean = mean(admission_duration),
sd = sd(admission_duration),
med = median(admission_duration))
p <- ggplot(data = res1_4, aes(x = gender, y = admission_duration))
p <- p + theme_bw()
# p <- p + geom_point(size = 2.0, position = position_dodge(width = 0.5))
# p <- p + geom_violin()
p <- p + geom_jitter(size = 1.0, width = 0.1, colour = "blue", alpha = 0.3)
p <- p + xlab("Gender")
p <- p + ylab("入院期間(day)")
plot(p)
#---- 年齢区分の作成
ana_res3 <- res1_4 %>%
summarise(n = n(), mean = mean(age))
hist(res1_4$age)
res1_4 <- res1_4 %>%
mutate(age_cat1 = case_when(age < 20 ~ "< 20",
age >= 20 & age < 40 ~ "20<=, <40",
age >= 40 & age < 60 ~ "40<=, <60",
age >= 60 & age < 80 ~ "60<=, <80",
age >= 80 ~ "80<="))
#----- 年齢区分における入院期間
ana_res3 <- res1_4 %>%
group_by(age_cat1) %>%
summarise(n = n(), mean = mean(age), sd = sd(age))
ana_res3 <- res1_4 %>%
group_by(age_cat1) %>%
summarise(n = n(),
mean = mean(admission_duration),
sd = sd(admission_duration),
med = median(admission_duration))
p <- ggplot(data = res1_4, aes(x = age_cat1, y = admission_duration))
p <- p + theme_bw()
p <- p + facet_wrap( ~ gender, ncol = 2)
# p <- p + geom_point(size = 2.0, position = position_dodge(width = 0.5))
# p <- p + geom_violin()
p <- p + geom_jitter(size = 1.0, width = 0.1, colour = "blue", alpha = 0.3)
p <- p + xlab("age category")
p <- p + ylab("入院期間(day)")
plot(p)
#----- 性別/年齢区分/施設ごとの入院期間
ana_res4 <- res1_4 %>%
group_by(gender, 施設番号) %>%
summarise(n = n(),
mean = mean(admission_duration),
sd = sd(admission_duration),
med = median(admission_duration))
p <- ggplot(data = res1_4, aes(x = as.factor(施設番号), y = admission_duration))
p <- p + theme_bw()
# p <- p + facet_wrap( ~ gender, ncol = 2)
p <- p + facet_grid( gender ~ age_cat1)
# p <- p + geom_point(size = 2.0, position = position_dodge(width = 0.5))
# p <- p + geom_violin()
p <- p + geom_jitter(size = 1.0, width = 0.1, colour = "blue", alpha = 0.3)
p <- p + xlab("施設番号")
p <- p + ylab("入院期間(day)")
plot(p)#CRP分類を追加したデータフレームを作成
outcome <- df %>% mutate(CRP分類 = case_when(CRP < 1.08 ~ "Low group", CRP >= 1.08 ~ "High group"))
#入院期間を数値に変更
outcome$入院期間 <- as.numeric(outcome$入院期間)
#gtsummaryを用いて表を作成
table1 <- outcome %>% select(CRP分類, CRP, 入院期間, 年齢, 性別) %>% mutate(性別 = factor(性別, levels = c(1, 2), labels = c("男性", "女性"))) %>% tbl_summary(by = CRP分類, label = list(CRP ~ "CRP（mg/dL）", 入院期間 ~ "入院期間（日）", 年齢 ~ "年齢（歳）")) %>% add_p(all_continuous() ~ "t.test") %>% add_overall(col_label = "**Overall**<br>N = {N}") %>% modify_header(label = "**項目**", update = all_stat_cols(FALSE) ~ "**{level}**<br>N = {n}") %>% modify_spanning_header(c("stat_1", "stat_2") ~ "**CRP分類**") %>% bold_labels() %>% as_gt()
#タイトルの追加
table1 <- table1 %>% tab_header(title = "CRP値と入院期間の関係", subtitle = "CRP 1.08 mg/dLで区分")
コメント