인공지능/프로젝트
R 개인프로젝트 - 코로나와 마스크의 상관성
정듀이
2020. 7. 14. 17:15
참고한 케글 데이터 (2020/07/05까지의 데이터로 프로젝트 구현함)
Novel Corona Virus 2019 Dataset
Day level information on covid-19 affected cases
www.kaggle.com
코로나 확진자 시각화
더보기
필요한 라이브러리 우선 설치
|
1
2
3
4
5
6
7
8
9
10
11
12
13
|
# install.packages('ggplot2')
# install.packages('maps')
# install.packages('dplyr')
# install.packages('rjson')
# install.packages('plotly')
# install.packages('data.table')
library(ggplot2)
library(maps)
library(dplyr)
library(rjson)
library(plotly)
library(data.table)
|
cs |
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
corona <- read.csv("c:/data/covid/covid_19_data.csv")
corona2 <- read.csv("c:/data/covid/time_series_covid_19_confirmed.csv")
# 나라별 코드 갖고오기
df <- read.csv("https://raw.githubusercontent.com/plotly/datasets/master/2014_world_gdp_with_codes.csv")
# 코로나 데이터에 코드 join 하기
x <- left_join(corona2,df,by=c("Country.Region"="COUNTRY"))
x[x$Country.Region=="US",]$CODE <- "USA"
# 나라, 코드, (현재까지의) 확진자 컬럼만 있는 새로운 테이블 생성
real <- data.table('country'=x$Country.Region,'code'=x$CODE,'confirmed'=x$X7.5.20)
# CODE 결측치 확인
# real[is.na(real$code)==TRUE,]
# 직접 CODE 넣어주기 위한 작업
# library(doBy)
# orderBy(~COUNTRY,df)
# real[is.na(real$code)==TRUE,]
# Congo = COG
real[real$country=='Congo (Brazzaville)',]$code <- 'COG'
real[real$country=='Congo (Kinshasa)',]$code <- 'COD'
# Diamond Princess : 크루즈
# Czech = CZE
real[real$country=='Czechia',]$code <- 'CZE'
# Gambia = GMB
real[real$country=='Gambia',]$code <- 'GMB'
# Holy See = 바티칸시티
# Macedonia = MKD
real[real$country=='North Macedonia',]$code <- 'MKD'
# Taiwan* = TWN
real[real$country=='Taiwan*',]$code <- 'TWN'
# West Bank and Gaza은 팔레스타인이지만 지도 위치상 이스라엘로 취급 = ISR
real[real$country=='West Bank and Gaza',]$code <- 'ISR'
# Eswatini는 나라이지만 위치상 남아공으로 취급 South Africa = ZAF
real[real$country=='Eswatini',]$code <- 'ZAF'
# code 별로 확진자 그룹짓기
x <- aggregate(real$confirmed,by=list(real$code),FUN=sum)
names(x) <- c("code","confirmed")
# 고른 색깔 분포를 원했는데 미국, 인도, 러시아가 너무 확진자가 많아서 이상치가 되어버려서 log함수를 새로 만듦
x$log_confirmed <- log(x$confirmed)
x$country <- left_join(x,df,by=c('code'='CODE'))$COUNTRY
x$hover <- with(x,paste(country,':',confirmed))
g <- list(
showframe = FALSE,
showcoastlines = FALSE,
projection = list(type = 'Mercator')
)
fig <- plot_geo(x)
fig <- fig %>% add_trace(
z = ~log_confirmed, color = ~log_confirmed, colors = 'Reds',
text = ~hover, locations = ~code
)
fig <- fig %>% colorbar(title = 'corona confirmed')
fig <- fig %>% layout(
title = '코로나 확진자',
geo = g
)
fig
|
cs |
코로나 완치자 시각화
더보기
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
corona <- read.csv("c:/data/covid/time_series_covid_19_recovered.csv")
corona2 <- read.csv("c:/data/covid/time_series_covid_19_confirmed.csv")
# 나라별 코드 갖고오기
df <- read.csv("https://raw.githubusercontent.com/plotly/datasets/master/2014_world_gdp_with_codes.csv")
# 코로나 데이터에 코드 join 하기
x <- left_join(corona,df,by=c("Country.Region"="COUNTRY"))
x[x$Country.Region=="US",]$CODE <- "USA"
# 나라, 코드, (현재까지의) 확진자 컬럼만 있는 새로운 테이블 생성
real <- data.table('country'=x$Country.Region,'code'=x$CODE,'recovered'=x$X7.5.20)
# CODE 결측치 확인
# real[is.na(real$code)==TRUE,]
# 직접 CODE 넣어주기 위한 작업
# library(doBy)
# orderBy(~COUNTRY,df)
# real[is.na(real$code)==TRUE,]
# Congo = COG
real[real$country=='Congo (Brazzaville)',]$code <- 'COG'
real[real$country=='Congo (Kinshasa)',]$code <- 'COD'
# Diamond Princess : 크루즈
# Czech = CZE
real[real$country=='Czechia',]$code <- 'CZE'
# Gambia = GMB
real[real$country=='Gambia',]$code <- 'GMB'
# Holy See = 바티칸시티
# Macedonia = MKD
real[real$country=='North Macedonia',]$code <- 'MKD'
# Taiwan* = TWN
real[real$country=='Taiwan*',]$code <- 'TWN'
# West Bank and Gaza은 팔레스타인이지만 지도 위치상 이스라엘로 취급 = ISR
real[real$country=='West Bank and Gaza',]$code <- 'ISR'
# Eswatini는 나라이지만 위치상 남아공으로 취급 South Africa = ZAF
real[real$country=='Eswatini',]$code <- 'ZAF'
# code 별로 확진자 그룹짓기
x <- aggregate(real$recovered,by=list(real$code),FUN=sum)
names(x) <- c("code","recovered")
# 고른 색깔 분포를 원했는데 특정 국가가 완치자 수가 많아서 log함수를 새로 만듦
x$log_recovered <- ifelse(x$recovered==0,0,log(x$recovered))
x$country <- left_join(x,df,by=c('code'='CODE'))$COUNTRY
x$hover <- with(x,paste(country,':',recovered))
g <- list(
showframe = FALSE,
showcoastlines = FALSE,
projection = list(type = 'Mercator')
)
fig <- plot_geo(x)
fig <- fig %>% add_trace(
z = ~log_recovered, color = ~log_recovered, colors = 'Blues',
text = ~hover, locations = ~code
)
fig <- fig %>% colorbar(title = 'corona confirmed')
fig <- fig %>% layout(
title = '코로나 완치자',
geo = g
)
fig
|
cs |
단순히 수치적으로는 당연하게도 인구수가 많은 미국, 브라질, 중국, 러시아 등이 진한 색으로 나타난다.
완치자와 확진자의 비율에 대한 코드를 구현하여 어떤 나라가 코로나에 대응을 잘 했는지에 대해 알아보자.
완치자/확진자 비율 시각화
더보기
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
# 나라별 코드 갖고오기
df <- read.csv("https://raw.githubusercontent.com/plotly/datasets/master/2014_world_gdp_with_codes.csv")
# 코로나 데이터에 코드 join 하기
x <- left_join(corona,df,by=c("Country.Region"="COUNTRY"))
x <- left_join(x,corona2,by=c("Country.Region" = "Country.Region"))
x[x$Country.Region=="US",]$CODE <- "USA"
# 나라, 코드, (현재까지의) 확진자 컬럼만 있는 새로운 테이블 생성
real <- data.table('country'=x$Country.Region,'code'=x$CODE,'recovered'=x$X7.5.20.x,'confimred'=x$X7.5.20.y)
# CODE 결측치 확인
# real[is.na(real$code)==TRUE,]
# 직접 CODE 넣어주기 위한 작업
# library(doBy)
# orderBy(~COUNTRY,df)
# real[is.na(real$code)==TRUE,]
# Congo = COG
real[real$country=='Congo (Brazzaville)',]$code <- 'COG'
real[real$country=='Congo (Kinshasa)',]$code <- 'COD'
# Diamond Princess : 크루즈
# Czech = CZE
real[real$country=='Czechia',]$code <- 'CZE'
# Gambia = GMB
real[real$country=='Gambia',]$code <- 'GMB'
# Holy See = 바티칸시티
# Macedonia = MKD
real[real$country=='North Macedonia',]$code <- 'MKD'
# Taiwan* = TWN
real[real$country=='Taiwan*',]$code <- 'TWN'
# West Bank and Gaza은 팔레스타인이지만 지도 위치상 이스라엘로 취급 = ISR
real[real$country=='West Bank and Gaza',]$code <- 'ISR'
# Eswatini는 나라이지만 위치상 남아공으로 취급 South Africa = ZAF
real[real$country=='Eswatini',]$code <- 'ZAF'
# 컬럼생성
a <- aggregate(real$confimred,by=list(real$code),FUN=sum)
b <- aggregate(real$recovered,by=list(real$code),FUN=sum)
x <- data.frame("code"=a$Group.1,"confirmed"=a$x,"recovered"=b$x)
# 캐나다가 이상치이므로 제대로된 값을 넣어줌
x[x$code =="CAN",]$confirmed <- 107590
x[x$code =="CAN",]$recovered <- 8783
x['vs'] <- x$recovered/x$confirmed
x$country <- left_join(x,df,by=c('code'='CODE'))$COUNTRY
x$hover <- with(x,paste(country,':',recovered))
g <- list(
showframe = FALSE,
showcoastlines = FALSE,
projection = list(type = 'Mercator')
)
fig <- plot_geo(x)
fig <- fig %>% add_trace(
z = ~vs, color = ~vs, colors = 'Greens',
text = ~hover, locations = ~code
)
fig <- fig %>% colorbar(title = 'corona confirmed')
fig <- fig %>% layout(
title = '코로나 완치자/확진자',
geo = g
)
fig
|
cs |
대체로 초창기에 난리가 났던 아시아 국가들이 확진자에 비한 완치자 비율이 높았다.
우리는 코로나 확산을 막기 위해 가장 좋은 방법이 '마스크'라는 것을 안다.
따라서 나는 이를 잘 지킨 우리나라와 세계 각국들의 마스크 사용량을 비교하여 실질적으로 얼마나 마스크가 코로나 확산 방지에 도움이 되는지에 대한 데이터를 분석하려 했다.
마스크를 실질적으로 잘 착용하는지 아닌지에 대해서는 한국 이외의 다른 나라에 대해서는 정확히 알 수가 없었다.
따라서 나는 일차적으로 우리나라 마스크 5부제에 착안하여 구글 트렌드를 활용하여 마스크 검색량이 높은 날 +7일 부터 마스크 착용의 효과가 나타난다는 가설로 마스크와 코로나 확산 방지의 관계성을 파악하고자 했다.
대한민국 국민들의 마스크 검색량과 확진자 추이
더보기
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
mask_fact <- function(name,num){
covid <- read.csv("c:/data/covid/covid_19_data.csv")
data <- covid[covid$Country.Region==name,]
data_ <- aggregate(data$Confirmed,by=list(data$ObservationDate),FUN=sum)
names(data_) <- c("date","confirmed")
fname <- file.choose()
mask_data <- read.csv(fname)
mask_data$date2 <- 1:nrow(mask_data)
data_$date2 <- as.Date(data_$date,format='%m/%d/%Y')
data <- data.table('date'=data_$date,'confirmed'=data_$confirmed)
mask_data2 <- mask_data[c(1:nrow(data)),]
mask_data2$confirmed <- data_$confirmed
# 일일확진자 컬럼 생성
mask_data2$day_confirmed <- mask_data2$confirmed - lag(mask_data2$confirmed)
mask_data2$day_confirmed[1] <- 1
mask_data2$mask_fact <- shift(mask_data2$mask,7)
mask_data2
fig <- plot_ly(mask_data2, x = ~date, y = ~day_confirmed, name = 'confirmed', type = 'scatter', mode = 'lines')
fig <- fig %>% add_trace(y = ~mask*num, name = 'mask', mode = 'lines')
fig <- fig %>% add_trace(y = ~mask_fact*num, name = 'mask_fact', mode = 'lines')
fig <- fig %>% layout(title = paste(name,"국민들의 마스크 검색량과 확진자 추이"))
fig
}
#sort(unique(corona$Country.Region)) # 나라 찾기
# 그래프의 경향성을 보기위해 최대값이 100인 마스크 검색량과 확진자를 맞추기 위해
# 임의의 숫자를 mask 검색량에 곱하여 그래프를 그림
mask_fact("South Korea",7)
|
cs |
우리나라 데이터를 통해서 구글 트렌드의 '마스크 검색량'이 어느정도 관계성을 보여준다고 생각하여, 다른 나라에 대해서도 같은 작업을 반복했다.
미국의 코로나 확진자 추이와 마스크 검색량에 대해서는 상관성이 없다는 결론이 나왔다.
하지만 의료관련 종사자들은 하나같이 '마스크'의 중요성에 대해 언급하고 있기 때문에 나는 미국인들의 마스크 검색량이 한국과 같이 마스크 착용으로 이루어지지 않았을 것이라는 추측을 하였다. 이를 증명하기 위해서는 다른 나라들에 대한 마스크 검색량과 그에 따른 코로나 확산 추이를 봐야했다.
싱가포르와 독일에 대해서 구글 트렌드와 코로나 확진자 추이를 보았으나, 오히려 미국보다 더 상관성이 없다는 것을 파악할 수 있었다. 구글 트렌드에서의 '마스크 검색량'이 실제 마스크 착용으로 이루어지는 것은 오직 우리나라 뿐이었다. 따라서 나는 다른 데이터를 구해야만 했다.
내가 찾은 데이터는 YouGov의 Wearing a face mask when in public places 부분이었다. 이에 대한 데이터를 csv 파일로 다운 받아, 마스크를 쓴다고 응답한 사람들의 퍼센트와 실질적인 확진자 감소 추이에 대해 분석하고자 했다.
마스크 착용과 코로나 확산 감소의 관계성 파악
더보기
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
|
survey_mask <- function(name,num){
covid <- read.csv("c:/data/covid/covid_19_data.csv")
data <- covid[covid$Country.Region==name,]
data_ <- aggregate(data$Confirmed,by=list(data$ObservationDate),FUN=sum)
names(data_) <- c("date","confirmed")
data_$date2 <- as.Date(data_$date,format='%m/%d/%Y')
# 일일확진자 컬럼 생성
data_['day_confirmed'] <- data_$confirmed - lag(data_$confirmed)
data_$day_confirmed[1] <- 1
# 설문조사 그래프
survey <- read.csv("c:/data/covid/yougov-chart.csv")
survey['date'] <- substr(survey$DateTime,1,10)
survey['date2'] <- as.Date(survey$date,format='%Y-%m-%d')
new <- left_join(survey,data_,by=c("date2"="date2"))
new$confirmed[is.na(new$day_confirmed)] <- 0
new['country'] <- new[name]
fig <- plot_ly(new, x = ~date2, y = ~country*num, name = name, type = 'scatter',mode = 'lines+markers',connectgaps = TRUE,text = ~country)
fig <- fig %>% add_trace(y = ~day_confirmed, name = 'day_confirmed', mode = 'lines+markers',connectgaps = TRUE)
fig <- fig %>% layout(title = paste(name,"국민들의 마스크 착용률과 확진자 감소 추이"))
fig
}
survey_mask('Germany',100)
|
cs |
독일, 베트남, 이탈리아 등 YouGov에서 받은 csv 파일에 비교적 최근까지의 응답이 있던 나라들에 대해서 마스크 착용과 코로나 확산 감소에 대한 그래프를 그렸더니 마스크 착용 응답 적었을 때보다 높아졌을 때 코로나 확진자가 감소한 것을 볼 수 있었다. 실질적으로 마스크가 코로나 확산 방지에 도움이 된다는 것을 데이터로 파악할 수 있었다.
위의 나라들과 달리 미국은 응답이 높아지면서 확진자가 감소하다가 갑작스럽게 확진자가 많아졌다.
이에 대해서는 2가지 가설을 언급할 수 있겠는데,
첫번째로는 YouGov에 응답한 미국인이 너무 적어 표본이 되지 못했다는 것과 두번째로는 허위 응답을 했다는 것이다.
하지만 위의 데이터에서 응답이 높아질수록 실제 확진자 수가 감소한 경향을 보이고, 다른 나라들이 위의 데이터에 어느정도 신빙성을 보이고 있기 때문에 나는 미국인들이 허위 응답을 했다는 결론을 내렸다. 다들 마스크를 잘 쓰고 다녔으면 좋겠다...
실제로 이 기사 내용에 따르면, 마스크 착용 이후 호흡기감염병들이 많이 줄어듦을 알 수 있다.
또한 개인 위생에 대한 중요성이 대두되면서 눈 질환에 대해서도 환자가 적어진 것으로 나타났다.
결론은 더워도 마스크 잘 쓰고 다니자는 이야기입니다.