R | COVID-19 데이터로 무엇을 할 수 있을까 | 4. 확진자 증가 추세 추적 그래프

코로나19 상황에서 안정화에 진입한 국가는 어떤 국가가 있는지 알아보는 그래프를 그려보려고 합니다.

각 국가의 새로운 확진자의 수와 누적 확진자의 로그값을 이용하여 새로운 확진자가 감소하는, 즉 점차 안정화가 진행되는 국가는 어떤 국가가 있는지 알 수 있는 다음과 같은 그래프가 이번 포스팅의 목표입니다.

 

# 이번 포스팅에서 완성하고자 하는 그래프

---

# 데이터 준비

> mydata_tb %>% dim
[1] 19448    13

> mydata_tb$Country %>% 
+   unique %>% 
+   length
[1] 187

> mydata_tb$Date %>% 
+   max
[1] "2020-05-04"

지난 포스팅과 같이 데이터를 다운받습니다. 2020-05-04 기준으로 187개 국가의 데이터가 받아졌습니다.  

 

> topN <- 10

187개 국가의 모든 데이터를 사용하지는 않고, 누적확진자수 상위 10개 국가만을 이용해서 분석을 해보겠습니다.

 

> Confirmed_max <- aggregate(mydata_tb$Confirmed, by=list(mydata_tb$Country), FUN=max)
> Confirmed_max %>% head
              Group.1    x
1         Afghanistan 2894
2             Albania  803
3             Algeria 4648
4             Andorra  750
5              Angola   35
6 Antigua and Barbuda   25

 먼저 각 국가의 누적 확진자수를 정보를 얻습니다.

 

> Confirmed_order <- Confirmed_max[order(Confirmed_max$x, decreasing = T),] %>% 
+   data.frame(Confirmed.order=seq(dim(Confirmed_max)[1]))
> Confirmed_topN <- Confirmed_order[1:topN,]
> colnames(Confirmed_topN) <- c('Country', 'Confrimed.max', 'Confirmed.order')

그런 다음 누적확진자수 상위 10개 국을 추출합니다.

 

> Confirmed_topN
           Country Confrimed.max Confirmed.order
179             US       1180375               1
158          Spain        218011               2
86           Italy        211938               3
177 United Kingdom        191832               4
63          France        169583               5
67         Germany        166152               6
140         Russia        145268               7
173         Turkey        127659               8
24          Brazil        108620               9
82            Iran         98647              10

# 2020-05-04 기준 누적확진자 상위 10개국
US, Spain, Italy, United Kingdom, France, Germany, Russia, Turkey, Brazil, Iran

 

> mydata_tb_topN <- right_join(mydata_tb, Confirmed_topN, by='Country')
> mydata_tb_topN %>% head
        Date Country Confirmed Recovered Deaths Date.no Active Confirmed.new.day Recovered.new.day Deaths.new.day Confirmed.new.week Recovered.new.week Deaths.new.week Confrimed.max Confirmed.order
1 2020-01-22      US         1         0      0       1      1                 1                 0              0                  1                  0               0       1180375               1
2 2020-01-23      US         1         0      0       2      1                 0                 0              0                  1                  0               0       1180375               1
3 2020-01-24      US         2         0      0       3      2                 1                 0              0                  2                  0               0       1180375               1
4 2020-01-25      US         2         0      0       4      2                 0                 0              0                  2                  0               0       1180375               1
5 2020-01-26      US         5         0      0       5      5                 3                 0              0                  5                  0               0       1180375               1
6 2020-01-27      US         5         0      0       6      5                 0                 0              0                  5                  0               0       1180375               1

해당 10개국에 대한 데이터만 right_join을 이용해서 불러왔습니다.

---

# 에러제거

> mydata_tb_topN_rm0 <- subset(mydata_tb_topN, mydata_tb_topN$Confirmed.new.week!=0)
> mydata_tb_topN_rm0 %>% dim
[1] 813  15

데이터 수집의 문제로 새로운 확진자 수가 누락된 경우가 종종있었습니다. 그래서 그런 문제를 해결하기 위해 새로운 확진자 수를 하루 단위가 아닌 주 단위 수치를 사용할 것인데요 주단위에서도 0명이 지속되는 부분에 대해서는 제거를 해주었습니다.

---

# 그래프

> p <- ggplot(mydata_tb_topN_rm0,
+             aes(x=Confirmed, y=Confirmed.new.week, group = Country)) +
+   geom_line(colour='black', alpha=0.3, size=1) + 
+   geom_point(colour='black', size = 3)
> p

우선 ggplot에서 line, point plot을 그려줍니다. 그런데 그래프를 보면 각 나라별 누적 확진자 수 차이가 커서 비교가 어려운 모습입니다. 그래서 log scale을 적용시켜줍니다.

---

> p <- p +
+   scale_x_log10() +
+   scale_y_log10()
> p

가로축의 누적확진자수와 세로축의 한주동안의 새로운 확진자 수에 로그값이 적용되니 어떤 경향이 보입니다.

---

> p <- p +
+   geom_abline(intercept = 0, slope = 1, color="red", 
+               size=5, alpha=0.2)
> p

이 경향을 잘 확인하기위해 보조선을 그려주었습니다. 보조선을 기준으로 아래로 내려오면 확진자수가 감소하는 추세이고, 보조선과 가까운 경향을 보이면 확진자수가 줄어들지 않음을 알 수 있습니다.

---

> p <- p +
+   theme_minimal() + 
+   labs(title = sprintf('Trajectory of COVID-19 Confirmed Cases'), 
+        subtitle = sprintf('Last update : %s', Date_update),
+        caption = 'made by Chloe',
+        y = 'new Confirmed Cases (in the past week)',
+        x = 'Total Confirmed Cases') + 
+   theme(plot.title = element_text(face='bold', size=23),
+         plot.subtitle = element_text(face='bold', size=15),
+         axis.title.x = element_text(size=13),
+         axis.title.y = element_text(size=14))
> p

 

그래프 제목과 각 축의 제목, 테마를 수정하여 정리된 그래프의 모습을 얻었습니다.

---

> p <- p +
+   geom_text(aes(label = Country), hjust = 1, vjust = 0, nudge_x = -0.05,
+             angle=0,
+             fontface=2) +
+   transition_reveal(Date.no) +
+   coord_cartesian(clip = 'off')
                                                                                                    
> animate(p, fps=6, width=800, height=800,
+         end_pause = 50)

> anim_save("gganimation_trajectory_of_covid19.gif")

각 국가의 이름을 넣어주고, animate 기능을 이용해주면 시간에 따른 국가의 변화 추이를 볼 수 있는 그래프가 완성되었습니다. 

 

그래프를 봤을때 프랑스가 점차 안정화되고 있는 것 같고, 나머지 국가들은 조금더 지켜보아야할 것 같습니다.

 

 

---

---

---

누적 확진자 상위 40국가를 이용해서 그래프를 다시 그려보니, 중국과 한국이 가장 먼저 안정화에 접어드는 모습을 볼 수 있습니다. 다른 국가들도 새로운 일상으로 안전히 돌아갈 수 있길 바랍니다.

 

 

---

 

이 포스팅은 유튜브 minutephysics 채널의 다음 영상을 참고하였습니다.