Corona Virus- Data Viz

-
(Credit to WHO)

病毒資料集:

冠狀病毒 or 新冠性病毒 or 新冠肺炎 AKA 武漢肺炎現在正在猖狂的流行，基本上全球都淪陷了，在這段期間大家要小心啊......

資料來源:
https://www.kaggle.com/sudalairajkumar/novel-corona-virus-2019-dataset

資料集是來自WHO(CHO)，而John Hopkins University 也將其應用於製作更清楚的dashboard
以利大家參考。

視覺化的表現後，可以讓病毒在全球的蹤跡一覽無遺，也能理解病毒擴散的歷史，
當然也是本篇文章的主題啦，針對武漢肺炎的視覺化練習，Start!

Data exploration

library(tidyverse)
library(highcharter)
library(lubridate)
library(GridExtra)

可樂娜資料集裡有編號 / 日期/ 行政區 / 國家/ 確診(binary)/ 死亡(binary) / 康復(binary)
corona <- read_csv("covid_19_data.csv")
head(corona)
## # A tibble: 6 x 8
##     SNo ObservationDate `Province/State` `Country/Region` `Last Update`
##   <dbl> <chr>           <chr>            <chr>            <chr>        
## 1     1 01/22/2020      Anhui            Mainland China   1/22/2020 17~
## 2     2 01/22/2020      Beijing          Mainland China   1/22/2020 17~
## 3     3 01/22/2020      Chongqing        Mainland China   1/22/2020 17~
## 4     4 01/22/2020      Fujian           Mainland China   1/22/2020 17~
## 5     5 01/22/2020      Gansu            Mainland China   1/22/2020 17~
## 6     6 01/22/2020      Guangdong        Mainland China   1/22/2020 17~
## # ... with 3 more variables: Confirmed <dbl>, Deaths <dbl>,
## #   Recovered <dbl>

為了繪圖的函數，先把國家名字改一下，Mainland China==>China /
 US ==> Unitedstates of America。

但發現Taiwan的病例竟然有1057個很不正常，仔細一看發現實際上的案例變成了
Taipei and environs......可憐哪，某國家主政者整天只會搞些小手段
corona$`Country/Region`[corona$`Country/Region`  == "Mainland China"] = "China"
corona$`Country/Region`[corona$`Country/Region`  == "US"] = "United States of America"

#political sxxt for Taipei and environ
corona %>% group_by(`Country/Region`) %>%
          summarise(Tconfirmed = sum(Confirmed)) %>%
          filter(`Country/Region` == 'Taiwan' | `Country/Region` =='Taipei and environs') ->
Taiwan

Taiwan
## # A tibble: 2 x 2
##   `Country/Region`    Tconfirmed
##   <chr>                    <dbl>
## 1 Taipei and environs         47
## 2 Taiwan                    1057

有沒有人願意說明一下1057是哪裡來的....我先把它當成China來的....
然後把Taipei and environs變成Taiwan
corona$`Country/Region`[corona$`Country/Region`  == "Taiwan"] = "China"
corona$`Country/Region`[corona$`Country/Region`  == "Taipei and environs"] = "Taiwan"

整理一下以國家為組別，並計算目前總感染情況，確診人數 / 康復人數 / 死亡人數等
#Count sum of confirmed/recover/rate of recover
corona %>% 
  janitor::clean_names() %>% 
  filter(!country_region %in% 'Others') %>% 
  group_by(country_region) %>% 
  summarise(total_confirmed = sum(confirmed),
            total_recovered = sum(recovered),
            total_death = sum(deaths)) %>% 
  filter(total_confirmed > 0) %>% 
  mutate(log_total_confirmed = log(total_confirmed)) -> countries_confirmed
head(countries_confirmed)
## # A tibble: 6 x 5
##   country_region total_confirmed total_recovered total_death
##   <chr>                    <dbl>           <dbl>       <dbl>
## 1 Afghanistan                 26               0           0
## 2 Albania                     12               0           0
## 3 Algeria                    131               0           0
## 4 Andorra                      9               0           0
## 5 Argentina                   54               0           3
## 6 Armenia                     10               0           0
## # ... with 1 more variable: log_total_confirmed <dbl>

Data Viz

#plot T-confirmed in world
highchart() %>%
  hc_add_series_map(worldgeojson, countries_confirmed, value = 'total_confirmed', joinBy = c('name','country_region'))  %>% 
  #hc_colors(c("darkorange", "darkgray")) %>% 
  hc_colorAxis(stops = color_stops()) %>% 
  hc_title(text = "Countries with nCov exposure") %>% 
  hc_subtitle(text = 'with Total Confirmed - Actual Figures')



#Top 10 country of confirmed 
countries_confirmed %>%
  group_by(country_region) %>%
  arrange(desc(total_confirmed)) %>% 
  head(10) %>%
  hchart("bar",hcaes(x = country_region,  y =total_confirmed)) %>%
  hc_add_theme(hc_theme_sandsignika())
## Warning: `parse_quosure()` is deprecated as of rlang 0.2.0.
## Please use `parse_quo()` instead.
## This warning is displayed once per session.



以日期為組別
#With Date
corona %>%
  group_by(ObservationDate) %>%
  summarise(total_confirmed = sum(Confirmed),
            total_recovered = sum(Recovered),
            total_deaths = sum(Deaths))->Date_confirmed
Date_confirmed$Date <- as.Date(Date_confirmed$ObservationDate, format = "%m/%d/%y")
head(Date_confirmed)
## # A tibble: 6 x 5
##   ObservationDate total_confirmed total_recovered total_deaths Date      
##   <chr>                     <dbl>           <dbl>        <dbl> <date>    
## 1 01/22/2020                  555              28           17 2020-01-22
## 2 01/23/2020                  653              30           18 2020-01-23
## 3 01/24/2020                  941              36           26 2020-01-24
## 4 01/25/2020                 1438              39           42 2020-01-25
## 5 01/26/2020                 2118              52           56 2020-01-26
## 6 01/27/2020                 2927              61           82 2020-01-27

直接看日期與確診/康復/死亡的歷史
#confirmed

C <- ggplot(Date_confirmed, aes(Date, total_confirmed))+
  geom_line(size = 2, alpha = 0.8,color = "#FC4E07")+
  geom_point(shape=21, color="black", fill="blue", size=6) +
  scale_x_date(date_labels = "%b %d", date_breaks = "7 days")
    
#revovered
R <- ggplot(Date_confirmed, aes(Date, total_recovered))+
  geom_line(size = 2, alpha = 0.8,color = "#FC4E07")+
  geom_point(shape=21, color="black", fill="blue", size=6) +
  scale_x_date(date_labels = "%b %d", date_breaks = "7 days")

#deaths
D <- ggplot(Date_confirmed, aes(Date, total_deaths))+
  geom_line(size = 2, alpha = 0.8,color = "#FC4E07")+
  geom_point(shape=21, color="black", fill="blue", size=6) +
  scale_x_date(date_labels = "%b %d", date_breaks = "7 days")

grid.arrange(C, R, D,ncol=1)


目前大概想得到是這些，R還有很多專為這次疫情產生的package以後可以慢慢介紹
在此願所有防疫人員平平安安並祈禱疫情趕快過去

PS: 這裡的圖可以直接顯示出每個點上的結果
https://rpubs.com/TimoBoll/583802



更新:
目前John Hopkins已將Taipei and the environ更正為Taiwan
感謝外交部

留言

張貼留言

這個網誌中的熱門文章

Word Vector & Word embedding 初探 - with n-Gram & GLOVE Model

-
圖片
       終於又有新題材可以分享了，每天在公司歷練（？），下班時常想著要爬起來自我學習，但現實總有點動力骨感，打開的不是筆電，是switch.....不過人生嘛...努力就是想到的時候再做，也是一種進步。 不胡說八道了，進入主題Word Embedding吧，繼上次分享詞頻分析之後，心中對於text mining真的是想著總有一天我還要在更加深入的學習，所以今天要努力分享嚕~ 1. 什麼是Word Embedding? 當你打開手機，輸入"一瓶"，螢幕上自動跳出 "啤酒" "汽水" 等名詞；或者郭台銘之於鴻海就像張忠謀之於台積電。 諸如此類讓文字彼此之間有所連結跟類似的邏輯，就是Word Embedding的應用。 透過分析一份完整的語料 (Corpus) 建立詞向量(Word Vector) 進而推論出詞語之間的邏輯語關係，就是Word Embedding的功能。 2. 和詞頻分析不同之處? 詞頻分析主要透過斷詞進而找出詞頻，並抓出相似的文件或者分析出文件的主題。 而詞向量主要在語料中的字詞間找出特定的邏輯和關係。 3. 貝式機率 & 馬可夫練 貝式機率一直是推論關係很好的辦法， P(w1,w2,w3,w4......,wn) = P(w1) * P(w2|w1) * P(w3|w1,w2) * .........P(wn|w1,w2,w3......,wn-1)  P(w1,w2,w3,w4......,wn) <-- w1~wn 共同出現的機率 P(w1) <-- w1 出現之機率 P(w2|w1) <-- 給了w1後，w2出現的機率；P(w3|w1,w2) 給定w1,w2後，w3出現的機率 P(wn|w1,w2,w3......,wn-1) <-- 同理類推，給定w1~wn-1後，wn出現的機率。 如此一來便能推斷字詞之間的關係，但這時發現，如果字數太多，便會很耗費計算效能。 這時便可參考馬可夫鍊的假設，目前出現的詞，僅和前幾個出現的詞語有關係。 其實很好推論，馬可夫鍊也被應用於棒球投手的配球，假設一場球賽先發投手投了120球，我們要推論投手在最後10球的配球，並不會回溯到第一球或者回溯到他生涯的第一場先發，我們會根據他在前幾球的配球做後續推論，就是這樣的道理。 ...
閱讀完整內容

文字探勘之關鍵字萃取 : TF-IDF , text-rank , RAKE

-
圖片
Keyword Extraction 這次會將領域伸向文本分析(text mining)， 我們將試著從文字資料裡做關鍵字萃取(Keyword extraction)，主要目的就是選出可以代表文章的詞彙。 常見的應用情景如下： 1. 搜尋關鍵字萃取優化搜尋引擎(SEO) 上圖為筆者常常拜訪的部落格，右下角hot key words便是篩選出來的關鍵字應用。 2.消費者體驗優化 消費者會在評價上留下實際體驗後的意見，我們可以先針對內容抓出key words, 如此一來處理客服端便可以提前預知消費者的需求，早一步作出準備。 How to do it? (1)Word of Bag詞袋表達 怎麼去詳細計算呢? 舉簡單例子 Doc1. 我愛豬腳麵線 Doc2. 你愛麻油雞 Doc3. 我愛你，你愛我 Doc4. 你我愛麵線 我們可由上面四篇文件計算出不同的詞與對應的頻率，這樣也就達成將各詞彙量化的目的了！ Ptt Movie版實作練習 1. 讀取資料 & 整理資料(stop words / Customized words) &字頻分析 #library and reading data library(tidyverse) library(jiebaR) library(widyr) library(tidytext) library(tm) library(igraph) library(ggnetwork) library(textrank) Movie <- read_csv("movie板 電影心得.csv") head(Movie, 5) Movie$label <- ifelse(Movie$label==0,"好評","差評") Movie$label <- as.factor(Movie$label) 我們可以看到PTT上完整的文章，主要分析的內容是content，但可以看到有太多無謂的符號與各種沒有辦法幫助分析的字詞(eg: 雷文、防雷、不負責任....,等)，分析之前勢必要處理他們的。 用gsub函數代換掉多餘的符號，同時設定好stopping wo...
閱讀完整內容

多元迴歸分析- subsets and shrinkage

-
圖片
     多元迴歸分析是統計學裡舉足輕重的角色，解釋、個體與趨勢預測都是強而有力的好伙伴，但是，當我們發現變數太多，不知道挑選哪一個，或者變數間相關係數非常的高，該怎麼辦?       本篇文章將會由Subsets Methods裡的Stepwise regression 開始介紹起，再來說明Shrinkage Methods 裡 lasso and ridge兩種不同的迴歸方法。 -------------------------------------------------------- A. 前言 回歸或許是很強而有力的伙伴，但是相對的，使用條件也相對複雜得多，回歸模型往往伴隨著許多的變異，因此很輕易的將變數丟進去model裡，勢必會有很多的問題產生，例如： 1.  Predict data放了不適當的變數造成了Overfitting導致實際上的testing data預測效果太差。 2. 解釋變數彼此的相關程度很高，型成共線性的問題，反而讓coefficient被大大影響，通常判斷共線性的標準主要為： I.容忍度（ tolerance ，小於 0.1 有共線性問題） II.變異數膨脹因素（ Variance inflation factor, VIF ，大於 10 有共線性問題） III.條件指標（ Condition index, CI ，大於 30 有共線性問題） 為了解決這個方法，subsets 與 shrinkage兩種方法便孕育而生了 兩種方法代表模型如下: subsets: Stepwise            shringkage: lasso and ridge 其中lasso 跟Stepwise目前被頻繁用於變數挑選上。 B. 子集回歸(subsets regression) Forward stepwise: 在空的迴歸模型中，逐一加入變數，直到AIC值為最小  Backward stepwise: 在包含所有變數的模型中，逐一刪除變數，直到AIC值為最小  Bo...
閱讀完整內容