코로나 바이러스 데이터 분석 (binary choice model)

 

 지난 글에 이어 코로나 바이러스 데이터 분석을 진행합니다.

 

 이항 선택 모형(binary choice model)을 이용하여 사망 요인을 찾고, 어떤 환자가 위험군에 속해있는지 살펴보도록 하겠습니다. 회귀 분석은 선형 확률 모형(LPM)으로 해석하고, 시각화는 로짓 모형(logit)을 이용하도록 하겠습니다.

library(tidyverse) patient <- readr::read_csv("patient.csv") str(patient)

 먼저 다음과 같이 사망 여부를 확인하는 decease와 나이를 의미하는 age, 확진 판정 이후 감염 기간이 얼마나 되는지 묻는 infection_period coulmn들을 만듭니다.

patient <- patient %>% mutate(decease = ifelse(is.na(deceased_date), 0, 1), age = 2020 - birth_year, today = 60 + as.numeric(format(Sys.Date(), "%d")), month = as.numeric(format(confirmed_date, format = "%m")), date = as.numeric(format(confirmed_date, format = "%d")), cured_month = as.numeric(format(released_date, format = "%m")), cured_date = as.numeric(format(released_date, format = "%d")), death_month = as.numeric(format(deceased_date, format = "%m")), death_date = as.numeric(format(deceased_date, format = "%d")), start_date = ifelse(month == 1, date, ifelse(month == 2, 31 + date, 60 + date)), finish_date = ifelse(cured_month == 1, date, ifelse(cured_month == 2, 31 + cured_date, 60 + cured_date)), decease_date = ifelse(death_month == 1, date, ifelse(death_month == 2, 31 + death_date, 60 + death_date)), infection_period = ifelse(!is.na(finish_date), finish_date - start_date, ifelse(!is.na(decease_date), decease_date - start_date, today - start_date)))

 데이터 가공을 위해 기저질환 여부를 묻는 column인 disease의 NA를 0으로 치환하고 성별, 기저질환 여부의 class를 factor로 치환합니다. 특정 집단 관련 여부를 묻는 group column의 NA값을 none으로 치환합니다.

patient$disease[is.na(patient$disease)] <- 0 patient$disease <- as.factor(patient$disease) patient$sex <- as.factor(patient$sex) patient$group[is.na(patient$group)] <- "none"

 age와 sex가 NA값이 아닌 데이터를 추출하고 nrow를 확인합니다.

pat <- patient %>% filter(!is.na(age) & !is.na(sex)) nrow(pat)

## [1] 710

 데이터를 이용하여 선형 확률 모형을 구해서 해석합니다.

bin.lp <- lm(decease ~ age + sex + disease + group + infection_period, data = pat) library(stargazer) stargazer(bin.lp, type = "text")

## ## ============================================================== ## Dependent variable: ## --------------------------- ## decease ## -------------------------------------------------------------- ## age 0.001*** ## (0.0002) ## ## sexmale -0.002 ## (0.008) ## ## disease1 0.889*** ## (0.024) ## ## groupEunpyeong St. Mary's Hospital -0.034 ## (0.047) ## ## groupnone 0.001 ## (0.037) ## ## groupPilgrimage -0.012 ## (0.055) ## ## groupShincheonji Church -0.0002 ## (0.039) ## ## infection_period -0.005*** ## (0.001) ## ## Constant 0.042 ## (0.041) ## ## -------------------------------------------------------------- ## Observations 710 ## R2 0.795 ## Adjusted R2 0.793 ## Residual Std. Error 0.100 (df = 701) ## F Statistic 340.406*** (df = 8; 701) ## ============================================================== ## Note: *p<0.1; **p<0.05; ***p<0.01

 결과를 해석하면 다음과 같습니다.

코로나 바이러스 감염자의 

1. 나이가 1살 더 많을수록 사망 확률이 0.1 % 증가한다. 
2. 기저질환 환자인 경우 사망 확률이 88.9% 증가한다. 
3. 확진 판정을 받은 이후 날짜가 하루 지날수록 사망 확률이 0.5% 하락한다.

 성별의 차이나 특정 집단에 따른 차이는 나타나지 않는 것으로 보입니다. 유의미한 결과를 보인 연령, 기저질환 여부, 감염 기간을 중심으로 결론을 내린다면 기저질환이 있는 고령의 환자를 확진 판정 초기에 집중적으로 케어해야 합니다.

 

 또한 일부 사망자의 감염 기간이 0 또는 음수로 나타나는 데이터가 있습니다. 이 경우는 사망 후에 확진 판정을 받은 경우입니다.

pat %>% filter(infection_period <= 0) %>% select(age, disease, infection_period, decease)

## # A tibble: 10 x 4 ## age disease infection_period decease ## <dbl> <fct> <dbl> <dbl> ## 1 63 1 -1 1 ## 2 55 1 -1 1 ## 3 41 1 -1 1 ## 4 36 1 0 1 ## 5 69 1 -1 1 ## 6 75 0 0 1 ## 7 58 1 0 1 ## 8 82 1 0 1 ## 9 85 0 0 1 ## 10 91 0 -2 1

 아울러 감염 기간에 따른 사망자와 격리해제환자의 분포를 살펴보면 다음과 같습니다.

pat %>% filter(state == "released" | state == "deceased") %>% ggplot(aes(x = infection_period, fill = state)) + stat_density(alpha = .5, position = "dodge") + theme_light()

 기저질환이 있거나 고령 환자의 경우 빠른 검사는 물론 확진 판정 이전에 격리 및 주의 조치가 필요하다고 생각됩니다.

 

 logit 모형을 시각화하여 위험군에 있는 환자들을 살펴보면 다음과 같습니다.

pat$decease <- as.factor(pat$decease) bin.logit <- glm(decease ~ age + sex + disease + group + infection_period, data = pat, family = "binomial") pat <- pat %>% mutate(pr.logit = predict(bin.logit, type = "response"))

• 사망 여부로 본 로짓 모형

pat %>% ggplot(aes(x = age, y = pr.logit, color = decease)) + geom_jitter(size = 5, alpha = 0.8) + geom_hline(yintercept = c(0, 1)) + theme_light()

 다음의 환자들은 코로나 바이러스 위험군으로 예상되며 집중적인 관리 감독이 필요하다고 생각합니다.

pat %>% filter(decease == 0 & pr.logit >= 0.1) %>% select(age, sex, disease, infection_period, pr.logit) %>% arrange(desc(pr.logit))

## # A tibble: 12 x 5 ## age sex disease infection_period pr.logit ## <dbl> <fct> <fct> <dbl> <dbl> ## 1 117 male 0 8 0.491 ## 2 100 female 0 4 0.450 ## 3 107 female 0 5 0.442 ## 4 91 male 0 5 0.432 ## 5 115 female 0 8 0.230 ## 6 69 male 0 4 0.222 ## 7 57 male 0 3 0.174 ## 8 79 female 0 4 0.166 ## 9 55 male 0 3 0.156 ## 10 39 male 0 1 0.147 ## 11 65 male 0 5 0.116 ## 12 65 male 0 5 0.116