diff --git a/404.html b/404.html index cd26a18..24e5571 100644 --- a/404.html +++ b/404.html @@ -23,7 +23,7 @@ - + diff --git a/R23_join_twdemo_ref.md b/R23_join_twdemo_ref.md index 2750d62..0730f7c 100644 --- a/R23_join_twdemo_ref.md +++ b/R23_join_twdemo_ref.md @@ -50,12 +50,9 @@ raw %>% head ### 清理資料 {#moi_clean} -我們之前在談資料的「觀察、統計、和二維表格」三種型態時，曾經談到統計型態和二維表格型態間的差異。當時所提到的「統計型態」，也就是每個變項欄恰好是我們所認知的單一變項（如每一個變項欄恰是人口統計變項的年齡、性別、教育程度、數量），會有助於進行統計分析，也就是tidy型態的資料。相較之下，上述的表格是把資料攤成二維的型態，每一個變項是某個年齡層的某種性別的某種婚姻狀況，包含了三個人口統計變項，是方便一般大眾讀的，但不是適合進行統計的tidy型態。 -這類的資料tidyverse的相關套件把它稱為tidy form。遵守tidy -form形式的資料是，每一個欄恰好一個變項。例如在內政部開放資料「15歲以上現住人口按性別、年齡、婚姻狀況及教育程度分」中，每個變數（年齡、婚姻狀況、教育程度、人口數等等）均各自為一個欄上的變項。 +我們之前在談資料的「觀察、統計、和二維表格」三種型態時，曾經談到統計型態和二維表格型態間的差異。當時所提到的「統計型態」，也就是每個變項欄恰好是我們所認知的單一變項（如每一個變項欄恰是人口統計變項的年齡、性別、教育程度、數量），會有助於進行統計分析，也就是tidy型態的資料。相較之下，上述的表格是把資料攤成二維的型態，每一個變項是某個年齡層的某種性別的某種婚姻狀況，包含了三個人口統計變項，是方便一般大眾讀的，但不是適合進行統計的tidy型態。 這類的資料tidyverse的相關套件把它稱為tidy form。遵守tidy form形式的資料是，每一個欄恰好一個變項。例如在內政部開放資料「15歲以上現住人口按性別、年齡、婚姻狀況及教育程度分」中，每個變數（年齡、婚姻狀況、教育程度、人口數等等）均各自為一個欄上的變項。 -- [15歲以上現住人口按性別、年齡、婚姻狀況及教育程度分 \| - 政府資料開放平臺 (data.gov.tw)](https://data.gov.tw/dataset/32944) +- [15歲以上現住人口按性別、年齡、婚姻狀況及教育程度分 \| 政府資料開放平臺 (data.gov.tw)](https://data.gov.tw/dataset/32944) 接下來，我要把表格型態的資料轉為tidy型態資料。原本的資料是這樣的型態。 @@ -85,9 +82,7 @@ tidy_data <- raw %>% 之後，我使用`tidyr::separate()`函式將`key`切成四個變項，分別為`married`、`ageLower`、`ageUpper`、`gender`。 - `separate()`有一個參數是`remove=T`（預設值），意思是說，當把`key`變項切割為四個變項後，預設把key變項給丟棄；但如果未來你還會用到`key`變項的話，你可以把`remove`改為`FALSE`，代表切割完後，還保留`key`變項。 -- `tidyr::separate()`：Given either regular expression or a vector of - character positions, separate() turns a single character column into - multiple columns. +- `tidyr::separate()`：Given either regular expression or a vector of character positions, separate() turns a single character column into multiple columns. 此時我清理出來的資料大致如下： diff --git a/R25_tidy_temoral_features.md b/R25_tidy_temoral_features.md index 89fd1a4..ce7753e 100644 --- a/R25_tidy_temoral_features.md +++ b/R25_tidy_temoral_features.md @@ -62,11 +62,19 @@ class(t) ```r ?strptime t1 <- strptime(t, "%Y-%m-%dT%H:%M:%SZ") -raw %>% glimpse() +clean %>% head # %>% View ``` ```{.output} -## function (length = 0L) +## # A tibble: 6 × 7 +## plink board pcontent poster ptitle ptime ipaddr +## +## 1 https://www.ptt.cc/bb… Hate… "\n\n韓… loveb… Re: [… 2019-04-12 02:21:14 83.22… +## 2 https://www.ptt.cc/bb… Hate… "\n\n\n… ikr36… Re: [… 2019-04-12 02:13:45 114.4… +## 3 https://www.ptt.cc/bb… Hate… "\n\n正… sunye… Re: [… 2019-04-12 02:10:18 118.1… +## 4 https://www.ptt.cc/bb… Hate… "\n:\n\… rock7… Re: [… 2019-04-12 02:03:14 118.1… +## 5 https://www.ptt.cc/bb… Hate… "\n\n我… btm97… Re: [… 2019-04-12 02:01:12 101.1… +## 6 https://www.ptt.cc/bb… Hate… "\n\n\n… cblade [討論… 2019-04-12 01:55:06 180.2… ``` ### Density plot along time diff --git a/R42_read_json.md b/R42_read_json.md index 3e2e353..e79a45c 100644 --- a/R42_read_json.md +++ b/R42_read_json.md @@ -309,7 +309,7 @@ raw$retVal[["0001"]] ## Case 1: Air-Quality (well-formatted ) -前往 [https://data.gov.tw/dataset/40448](https://data.gov.tw/dataset/40448，點擊)對JSON 檔案按右鍵，然後複製連結，例如 "[https://data.epa.gov.tw/api/v2/aqx_p\_432?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=ImportDate%20desc&format=JSON"。](https://data.epa.gov.tw/api/v2/aqx_p_432?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=ImportDate%20desc&format=JSON%22。) (但是，連結地址，特別是 `api_key=9be7b239-557b-4c10-9775-78cadfc555e9`，每次都會更改。所以你必須要自己嘗試)。 +前往 [https://data.gov.tw/dataset/40448](https://data.gov.tw/dataset/40448，點擊)對JSON 檔案按右鍵，然後複製連結，例如 "[https://data.epa.gov.tw/api/v2/aqx_p_432?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=ImportDate%20desc&format=JSON"。](https://data.epa.gov.tw/api/v2/aqx_p_432?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=ImportDate%20desc&format=JSON%22。) (但是，連結地址，特別是 `api_key=9be7b239-557b-4c10-9775-78cadfc555e9`，每次都會更改。所以你必須要自己嘗試)。 ```r @@ -384,7 +384,7 @@ glimpse(df) ### Combining all - UVI Open data: -- [https://data.epa.gov.tw/api/v2/uv_s\_01?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=publishtime desc&format=JSON](https://data.epa.gov.tw/api/v2/uv_s_01?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=publishtime%20desc&format=JSON) +- [https://data.epa.gov.tw/api/v2/uv_s_01?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=publishtime desc&format=JSON](https://data.epa.gov.tw/api/v2/uv_s_01?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=publishtime%20desc&format=JSON) #### Get from web api diff --git a/V01_Learning_ggplot_files/figure-html/unnamed-chunk-25-1.png b/V01_Learning_ggplot_files/figure-html/unnamed-chunk-25-1.png index cf68327..27579e3 100644 Binary files a/V01_Learning_ggplot_files/figure-html/unnamed-chunk-25-1.png and b/V01_Learning_ggplot_files/figure-html/unnamed-chunk-25-1.png differ diff --git a/V01_Learning_ggplot_files/figure-html/unnamed-chunk-26-1.png b/V01_Learning_ggplot_files/figure-html/unnamed-chunk-26-1.png index 7b68b94..0eebf01 100644 Binary files a/V01_Learning_ggplot_files/figure-html/unnamed-chunk-26-1.png and b/V01_Learning_ggplot_files/figure-html/unnamed-chunk-26-1.png differ diff --git a/Z2_Exploring_data_Visually_files/figure-html/eda-boxplot-1.png b/Z2_Exploring_data_Visually_files/figure-html/eda-boxplot-1.png index c293a4c..dc9fd2b 100644 Binary files a/Z2_Exploring_data_Visually_files/figure-html/eda-boxplot-1.png and b/Z2_Exploring_data_Visually_files/figure-html/eda-boxplot-1.png differ diff --git a/Z2_Exploring_data_Visually_files/figure-html/eda-central-trend-1.png b/Z2_Exploring_data_Visually_files/figure-html/eda-central-trend-1.png index 4d01369..30c8790 100644 Binary files a/Z2_Exploring_data_Visually_files/figure-html/eda-central-trend-1.png and b/Z2_Exploring_data_Visually_files/figure-html/eda-central-trend-1.png differ diff --git a/amount.html b/amount.html index 2919c17..3debf27 100644 --- a/amount.html +++ b/amount.html @@ -23,7 +23,7 @@ - + diff --git a/appendix.html b/appendix.html index 351a2cc..5e54372 100644 --- a/appendix.html +++ b/appendix.html @@ -23,7 +23,7 @@ - + diff --git a/association.html b/association.html index 7488622..9712560 100644 --- a/association.html +++ b/association.html @@ -23,7 +23,7 @@ - + diff --git a/base2dplyr.html b/base2dplyr.html index 7e009a6..9d4830d 100644 --- a/base2dplyr.html +++ b/base2dplyr.html @@ -23,7 +23,7 @@ - + diff --git a/basic.html b/basic.html index 90178b7..22be156 100644 --- a/basic.html +++ b/basic.html @@ -23,7 +23,7 @@ - + diff --git a/categorical.html b/categorical.html index 30c0545..ee8f6d1 100644 --- a/categorical.html +++ b/categorical.html @@ -23,7 +23,7 @@ - + diff --git a/coordinate.html b/coordinate.html index 9c7ba10..0bef9c5 100644 --- a/coordinate.html +++ b/coordinate.html @@ -23,7 +23,7 @@ - + diff --git a/crawler-overview.html b/crawler-overview.html index c0e602b..9ca7228 100644 --- a/crawler-overview.html +++ b/crawler-overview.html @@ -23,7 +23,7 @@ - + diff --git a/crosstab.html b/crosstab.html index 2bcdf5e..ea66c78 100644 --- a/crosstab.html +++ b/crosstab.html @@ -23,7 +23,7 @@ - + diff --git a/dataframe.html b/dataframe.html index ef31a20..440c58b 100644 --- a/dataframe.html +++ b/dataframe.html @@ -23,7 +23,7 @@ - + diff --git a/distribution-histogram-density.html b/distribution-histogram-density.html index 3ae0dcd..b8639af 100644 --- a/distribution-histogram-density.html +++ b/distribution-histogram-density.html @@ -23,7 +23,7 @@ - + diff --git a/geospatial.html b/geospatial.html index 54760c1..006e56b 100644 --- a/geospatial.html +++ b/geospatial.html @@ -23,7 +23,7 @@ - + diff --git a/ggplot.html b/ggplot.html index f0b60b5..1660b3c 100644 --- a/ggplot.html +++ b/ggplot.html @@ -23,7 +23,7 @@ - + diff --git a/html-parser.html b/html-parser.html index 4cfdd3f..0ac257c 100644 --- a/html-parser.html +++ b/html-parser.html @@ -23,7 +23,7 @@ - + diff --git a/index.html b/index.html index 5eabaea..2fb6a28 100644 --- a/index.html +++ b/index.html @@ -23,7 +23,7 @@ - + @@ -784,15 +784,15 @@

About

這本書是寫給臺大新聞所「新聞資料分析與視覺化」課程使用。該課程並重三個面向的訓練：程式語言、視覺化、資料新聞。學生必須先能夠熟練地使用R語言來操作、讀取、清理、視覺化資料；然後以產製新聞為課程目標，了解資料要如何清理，以及選擇適合的視覺化的方法來強化新聞敘事，並避免視覺化方式引起讀者對新聞的理解謬誤。準此，本書分為幾個部分，包含PART I介紹程式語言基礎；PART II則以國際或國內新聞為個案，來介紹資料獲取（爬蟲）、清理、合併、篩選、轉換；PART III則著重如何用資料視覺化來強化敘事。

本書所沿用的資料分析與視覺化案例均為國內、國外的新聞案例如各國產假支薪等級、居住正義、空氣污染、人口議題、COVID-19、資源區域分佈不均、選舉與公投、運輸交通等相關議題的新聞。並大量採用紐約時報挑選作為數據理解與視覺化推廣的「What’s going on in this graph?」系列新聞，包含美國不同年代各年齡層的淨資產來做視覺化案例。在視覺化教材的設計上，本書大量參考紐時「What’s going on in this graph?」的分類與(Wilke 2019)所著「Fundamentals of Data Visualization」一書的內容安排，強調利用資料視覺化方法來呈現新聞數據中的數量、分佈、比例、趨勢等，並均換用國內或紐時的相關資料新聞案例做範例，以利中文讀者的理解。

學習路徑

-
- +
+

References

diff --git a/index.md b/index.md index 5701fc1..6215827 100644 --- a/index.md +++ b/index.md @@ -1,7 +1,7 @@ --- title: "R for Data Journalism" author: "HSIEH, JI-LUNG" -date: "2024-03-17" +date: "2024-03-24" site: bookdown::bookdown_site output: bookdown::gitbook documentclass: book @@ -22,6 +22,6 @@ description: "For my Class teaching how to make data news reports" ```{=html} -
- +
+ ``` diff --git a/inequality-net-worth-by-age-group.html b/inequality-net-worth-by-age-group.html index aef59ad..141bdaa 100644 --- a/inequality-net-worth-by-age-group.html +++ b/inequality-net-worth-by-age-group.html @@ -23,7 +23,7 @@ - + diff --git a/interactivity.html b/interactivity.html index c7b43ca..6a3f3e3 100644 --- a/interactivity.html +++ b/interactivity.html @@ -23,7 +23,7 @@ - + diff --git a/introduction.html b/introduction.html index 63623b6..55b7776 100644 --- a/introduction.html +++ b/introduction.html @@ -23,7 +23,7 @@ - + diff --git a/joindata.html b/joindata.html index bfc8bb5..97fa9c7 100644 --- a/joindata.html +++ b/joindata.html @@ -23,7 +23,7 @@ - + @@ -821,12 +821,9 @@

7.1.1 分析規劃

7.1.2 清理資料

-

我們之前在談資料的「觀察、統計、和二維表格」三種型態時，曾經談到統計型態和二維表格型態間的差異。當時所提到的「統計型態」，也就是每個變項欄恰好是我們所認知的單一變項（如每一個變項欄恰是人口統計變項的年齡、性別、教育程度、數量），會有助於進行統計分析，也就是tidy型態的資料。相較之下，上述的表格是把資料攤成二維的型態，每一個變項是某個年齡層的某種性別的某種婚姻狀況，包含了三個人口統計變項，是方便一般大眾讀的，但不是適合進行統計的tidy型態。 -這類的資料tidyverse的相關套件把它稱為tidy form。遵守tidy -form形式的資料是，每一個欄恰好一個變項。例如在內政部開放資料「15歲以上現住人口按性別、年齡、婚姻狀況及教育程度分」中，每個變數（年齡、婚姻狀況、教育程度、人口數等等）均各自為一個欄上的變項。

+

我們之前在談資料的「觀察、統計、和二維表格」三種型態時，曾經談到統計型態和二維表格型態間的差異。當時所提到的「統計型態」，也就是每個變項欄恰好是我們所認知的單一變項（如每一個變項欄恰是人口統計變項的年齡、性別、教育程度、數量），會有助於進行統計分析，也就是tidy型態的資料。相較之下，上述的表格是把資料攤成二維的型態，每一個變項是某個年齡層的某種性別的某種婚姻狀況，包含了三個人口統計變項，是方便一般大眾讀的，但不是適合進行統計的tidy型態。 這類的資料tidyverse的相關套件把它稱為tidy form。遵守tidy form形式的資料是，每一個欄恰好一個變項。例如在內政部開放資料「15歲以上現住人口按性別、年齡、婚姻狀況及教育程度分」中，每個變數（年齡、婚姻狀況、教育程度、人口數等等）均各自為一個欄上的變項。

接下來，我要把表格型態的資料轉為tidy型態資料。原本的資料是這樣的型態。

@@ -847,9 +844,7 @@

7.1.2 清理資料

diff --git a/lebron.html b/lebron.html index fa06fbc..804faaf 100644 --- a/lebron.html +++ b/lebron.html @@ -23,7 +23,7 @@ - + diff --git a/na.html b/na.html index af39d3b..cb74770 100644 --- a/na.html +++ b/na.html @@ -23,7 +23,7 @@ - + diff --git a/network-vis.html b/network-vis.html index 4f4aa5d..0746db5 100644 --- a/network-vis.html +++ b/network-vis.html @@ -23,7 +23,7 @@ - + diff --git a/optimism-survey-by-countries.html b/optimism-survey-by-countries.html index 9792d9a..fa3dab5 100644 --- a/optimism-survey-by-countries.html +++ b/optimism-survey-by-countries.html @@ -23,7 +23,7 @@ - + diff --git a/proportion.html b/proportion.html index a1a99f0..897f238 100644 --- a/proportion.html +++ b/proportion.html @@ -23,7 +23,7 @@ - + diff --git a/ptt-scrape.html b/ptt-scrape.html index 9e301c8..7e249bc 100644 --- a/ptt-scrape.html +++ b/ptt-scrape.html @@ -23,7 +23,7 @@ - + diff --git a/r-basic.html b/r-basic.html index fe36d1e..5f15002 100644 --- a/r-basic.html +++ b/r-basic.html @@ -23,7 +23,7 @@ - + diff --git a/re.html b/re.html index f42e4a3..a9a9b9e 100644 --- a/re.html +++ b/re.html @@ -23,7 +23,7 @@ - + diff --git a/read_json.html b/read_json.html index a776438..e198604 100644 --- a/read_json.html +++ b/read_json.html @@ -23,7 +23,7 @@ - + diff --git a/scraping-104.html b/scraping-104.html index a00fbb5..82f9e4f 100644 --- a/scraping-104.html +++ b/scraping-104.html @@ -23,7 +23,7 @@ - + diff --git a/search_index.json b/search_index.json index 296cfdc..49a2377 100644 --- a/search_index.json +++ b/search_index.json @@ -1 +1 @@ -[["index.html", "R for Data Journalism About", " R for Data Journalism HSIEH, JI-LUNG 2024-03-17 About 這本書是寫給臺大新聞所「新聞資料分析與視覺化」課程使用。該課程並重三個面向的訓練：程式語言、視覺化、資料新聞。學生必須先能夠熟練地使用R語言來操作、讀取、清理、視覺化資料；然後以產製新聞為課程目標，了解資料要如何清理，以及選擇適合的視覺化的方法來強化新聞敘事，並避免視覺化方式引起讀者對新聞的理解謬誤。準此，本書分為幾個部分，包含PART I介紹程式語言基礎；PART II則以國際或國內新聞為個案，來介紹資料獲取（爬蟲）、清理、合併、篩選、轉換；PART III則著重如何用資料視覺化來強化敘事。 本書所沿用的資料分析與視覺化案例均為國內、國外的新聞案例如各國產假支薪等級、居住正義、空氣污染、人口議題、COVID-19、資源區域分佈不均、選舉與公投、運輸交通等相關議題的新聞。並大量採用紐約時報挑選作為數據理解與視覺化推廣的「What’s going on in this graph?」系列新聞，包含美國不同年代各年齡層的淨資產來做視覺化案例。在視覺化教材的設計上，本書大量參考紐時「What’s going on in this graph?」的分類與(Wilke 2019)所著「Fundamentals of Data Visualization」一書的內容安排，強調利用資料視覺化方法來呈現新聞數據中的數量、分佈、比例、趨勢等，並均換用國內或紐時的相關資料新聞案例做範例，以利中文讀者的理解。 學習路徑 References "],["introduction.html", "Chapter 1 Introduction 1.1 Preloaded tool kits 1.2 Dataset used in the book 1.3 Cases in the book", " Chapter 1 Introduction 本書從基本的 base R 語法開始學習，因為 R 語言最初是為統計學研究而開發的。因此，許多統計套件和基礎操作都是使用 base R 語法編寫的，這些知識對於瞭解 R 的核心功能和基本操作是非常重要的，並能夠建立起對於數據分析和統計建模的基礎知識。不過，現在 tidyverse 風格的編寫方式越來越流行，這種方式使得程式碼撰寫效率更高且可讀性更強，對於數據科學家而言是非常有用的。因此，本書會接續使用 tidyverse 中的主要函式庫和函數，例如 dplyr、ggplot2 和 tidyr，以便讀者能夠掌握這些工具，並能夠有效地應用於實際數據分析項目中。 1.1 Preloaded tool kits 當 R 的程式開始執行時，會預載入一些基本的套件，包括 stats、graphics、grDevices、utils 和 datasets。這些套件為 R 提供了基本的數據處理、統計分析、圖形顯示和檔案處理等功能。以下是這些套件的重要函式： stats：這個套件包含了許多統計分析相關的函式，例如假設檢定、方差分析、線性迴歸和時間序列分析等。其中，比較常用的函式有 t.test()、lm()、glm()、anova()、cor() 等。 graphics：這個套件提供了用於繪製各種圖形的函式，例如散佈圖、直方圖、盒鬚圖、線圖、散點矩陣等。其中，常用的函式有 plot()、hist()、boxplot()、lines()、points() 等。 grDevices：這個套件包含了用於輸出圖形的函式，例如 pdf()、png()、jpeg() 和 tiff() 等。 utils：這個套件包含了一些實用的函式，例如 install.packages()、help()、data() 等。 datasets：這個套件包含了一些內建的數據集，可以用來進行測試和練習，例如 iris、mtcars、CO2 等。可以使用 data() 函式載入這些數據集。 1.2 Dataset used in the book 本書所採用的資料可以從台大新聞所「新聞資料分析與視覺呈現」的github repository下載。R4CSS/data。 1.3 Cases in the book WP: Paid maternity leave Taipei Residential Hot spot: Contingency table, categorical data Trump’s tweets: Line plot, Bar chart, timeline, and text processing NYT: Net worth: Line plot NYT: Carbon Proportion: Treemap NYT: Optimism by countries NYT: Population growth Annual Budget of TW government: NA Processing, Treemap Vaccinating proportion by country x year: Proportion NYT: LeBron James’s Achievement "],["basic.html", "Chapter 2 R Basic 2.1 Using RStudio 2.2 First Attempt 2.3 R Q&A", " Chapter 2 R Basic 本章介紹如何使用 RStudio 編寫和執行 R 程式語言、R語言的基本語法、以及Vector和data.frame資料型態。 2.1 Using RStudio 2.1.1 RStudio Interface RStudio的介面主要分為四大區塊： 左上的區塊是「Source」（可切換至「Visual」）是撰寫程式碼與R Markdown的區塊； 左下角「Console」的區塊，每行程式碼的執行和執行結果都會出現在此，也可觀察程式執行結果； 右上角區塊最常用的是「Environment」這個分頁，程式碼執行過程產生的變數／變項都會出現在這裡。 右下角區塊我最常用的是「Files」這個分頁，顯示的是我自己電腦本機端的檔案目錄。右下角區塊也常常用到「Packages」，可查閱現在的程式執行環境有載入哪些套件；當用help(some_function)查詢某個套件或某個函式的功能是，就會自動跳到「Help」分頁。 2.1.2 Writing R Markdown R Markdown這種格式讓程式寫作者可以將程式碼和非程式碼的內容寫在同一份文件中。例如我想要寫作一本關於程式的書，裡面有很多的程式碼，但也要有很多說明、章節與段落。此時，這些非程式碼的區塊通常被稱為「內容區塊（Text Cell）」，而程式碼的區塊就稱為「Code Cell」。尤其是資料分析師或資料科學家很愛用這種格式，因為經常要為程式的執行結果寫很多說明，甚至利用標題一、標題二來區分章節。 內容區塊使用Markdown格式撰寫，顧名思義，支援用Markdown這種標記語法來快速撰寫如標題一、標題二、點列、編號等格式化文字。詳細指令可以參考rmarkdown-cheatsheet (rstudio.com)。這種格式的靈活性和強大功能，使得 R Markdown 成為撰寫技術文檔和學術報告的理想選擇，能夠有效地將敘述性文本與程式碼結果結合，提升文檔的互動性和表達力。 程式碼區塊可以用下列鍵盤指令來新增和執行。 Cmd(Ctrl)+Option(Alt)+i 新增一個程式碼區塊 Cmd+Enter (Ctrl+Enter in Window) 執行程式碼區塊中游標所在的那一行指令。 Cmd(Ctrl)+Shift+Enter 執行游標所在的整個程式碼區塊 其他常用鍵盤指令 - 註解：用滑鼠或鍵盤圈選某幾行程式碼後，可用Cmd(Ctrl)+Shift+c來將這幾行標記為註解或將其去除註解標記。 Practice. 用鍵盤快速鍵新增一個程式碼區塊、輸入以下程式碼並嘗試用鍵盤快速鍵執行。 a <- c(1, 2, 3, 4, 5) b <- 4 a*b 2.1.3 Installing third-party packages 套件的使用分為安裝(install.packages(\"pkg_name\"))和載入（library(pkg_name)）兩個動作。通常安裝好R的時候就已經安裝好基本base套件。當執行R時便會將base套件預載入程式的執行環境中。 熱心的R使用者會編寫第三方套件，並且將這些套件開放給群眾使用。通常這些套件已經被上載到R cran提供下載。而R cran上的套件我們可以使用install.packages(\"package_name\")來自動安裝到我們的電腦中。 Practice 1. 執行以下程式碼 install.packages("tidyverse") install.packages("jsonlite") install.packages("httr") 2.1.3.1 Loading package 在安裝這些第三方套件之後，需要將它們載入到程式的運行環境中，然後才能使用。因此，需要使用 library(package_name) 命令來載入它們。 library(tidyverse) library(jsonlite) library(httr) 2.1.4 Code “Comment” 下列程式碼中開頭有#符號者為註解，程式設計師用這種註解來為程式碼做說明，便於自己日後閱讀或與他人溝通。程式在執行時會自動忽略前面有#符號的程式碼。如果要執行以下程式碼，要把前面的#記號給拿掉。在RStudio中你可以用滑鼠或鍵盤圈選下三行，然後用快速鍵command(ctrl)+shift+c就可以開關（Comment/Un-comment)這幾行程式碼。 # a <- c(1, 2, 3, 4, 5) # b <- 4 # a*b 2.2 First Attempt 2.2.1 Loading Open Data from the MOI MOS（Ministry of the Interior）: 中華民國行政院內政部 library(httr) library(jsonlite) url <- "https://www.ris.gov.tw/rs-opendata/api/v1/datastore/ODRP024/107?page=1" first_page <- fromJSON(content(GET(url), "text")) # head(first_page$responseData) head(first_page$responseData) %>% rename(戶長=headhousehold_count) ## statistic_yyy district_code site_id village edu sex 戶長 ## 1 107 65000010001 新北市板橋區 留侯里 博畢 男 3 ## 2 107 65000010001 新北市板橋區 留侯里 碩畢 男 26 ## 3 107 65000010001 新北市板橋區 留侯里 大畢 男 71 ## 4 107 65000010001 新北市板橋區 留侯里 專畢 男 52 ## 5 107 65000010001 新北市板橋區 留侯里 高中畢 男 122 ## 6 107 65000010001 新北市板橋區 留侯里 國中畢 男 40 2.2.2 Obtaining Taipei Youbike (v2) Realtime Data 觀察臺北市資料大平臺 (data.taipei)上關於Youbike的資料，你認為哪些資料是具有資料新聞價值的？ YouBike區域互補站點 YouBike站位每月熱門站點 YouBike場站建置成本 YouBike臺北市權利金與補助支出 YouBike臺北市站位每月使用量 YouBike起訖站點統計 YouBike見車率統計 YouBike潛在需求預測 YouBike2.0臺北市公共自行車即時資訊 url <- "https://tcgbusfs.blob.core.windows.net/dotapp/youbike/v2/youbike_immediate.json" ubike.df <- fromJSON(content(GET(url),"text", encoding = "utf-8")) head(ubike.df) %>% select(1:6) ## sno sna tot sbi sarea mday ## 1 500101001 YouBike2.0_捷運科技大樓站 28 9 大安區 2024-02-25 20:06:18 ## 2 500101002 YouBike2.0_復興南路二段273號前 21 7 大安區 2024-02-25 19:49:18 ## 3 500101003 YouBike2.0_國北教大實小東側門 16 10 大安區 2024-02-25 20:06:18 ## 4 500101004 YouBike2.0_和平公園東側 11 9 大安區 2024-02-25 20:06:18 ## 5 500101005 YouBike2.0_辛亥復興路口西北側 16 11 大安區 2024-02-25 20:02:04 ## 6 500101006 YouBike2.0_復興南路二段280號前 11 10 大安區 2024-02-25 20:06:14 2.2.3 Reading Taipei Residential Burglary Data 該資料網址可到臺北市資料大平臺 (data.taipei)上查詢「住宅竊盜點位資訊」後，點選「API」後複製取得。 url <- "https://data.taipei/api/v1/dataset/93d9bc2d-af08-4db7-a56b-9f0a49226fa3?scope=resourceAquire" res <- read_json(url, simplifyVector = T) df <- res$result$results head(df) dplyr::glimpse(df) 2.3 R Q&A 2.3.1 Encoding and Language Sys.setlocale(category = "LC_ALL", locale = "UTF-8") Sys.setlocale(category = "LC_ALL", locale = "cht") 如果讀取到資料有中文的話，此時，你只需要指定locale為cht，然後重開該data.frame就可以解決該問題。 Sys.setlocale(category = "LC_ALL", locale = "cht") 但你在寫程式剖析HTML時若使用了rvest這個套件，有可能在html_node()函式時會因為編碼而產生問題，此時你會需要把locale改為C。這個C指的是C語言的C。 Sys.setlocale(category = "LC_ALL", locale = "C") 參考連結：http://psmethods.postach.io/post/ru-he-geng-gai-rde-yu-she-yu-xi 參考連結：https://stat.ethz.ch/R-manual/R-devel/library/base/html/locales.html The locale describes aspects of the internationalization of a program. Initially most aspects of the locale of R are set to “C” (which is the default for the C language and reflects North-American usage) 2.3.2 RMD/R Notebook無法儲存 R Notebook 要存檔的時候檔名絕對不要有空白，若有空白就用底線_代替，否則Notebook寫到一半會無法預覽下半部的程式並出現錯誤訊息。若仍然無法儲存或出現錯誤訊息，應該只要開另外一個R Notebook檔案，複製程式碼即可。 "],["r-basic.html", "Chapter 3 R Basic 3.1 R Syntax 3.2 Vector 3.3 Calculating with vectors 3.4 Data types 3.5 Character operations", " Chapter 3 R Basic R base是R語言的基本程式庫和核心功能，提供了許多常用的指令和函數。以下是一些常見的R base指令： assignment operators（賦值運算符）：<- 或 = 用來將數值、向量、函數等資料物件賦值給變數。 arithmetic operators（算術運算符）：+、-、*、/、^、%/%和%%用於數值運算，如加、減、乘、除、指數、整除和取餘等。 relational operators（關係運算符）：==、!=、>、>=、<和<=用於比較數值或字符型資料的大小關係，返回邏輯值（TRUE或FALSE）。 logical operators（邏輯運算符）：&、|和!用於對邏輯值進行運算，如AND、OR和NOT等。 control flow statements（流程控制語句）：if、else、for、while、repeat、break和next用於控制程式的執行流程。 functions（函數）：R base提供了許多內置函數，如sum、mean、var、sd、cor、lm等，用於數值計算、統計分析、線性回歸等常見操作。 data structures（資料結構）：R base提供了多種資料結構，如向量、矩陣、數組、列表、因子等，用於存儲和處理不同類型的資料。 data input/output（資料輸入輸出）：R base提供了多種函數和工具，如read.table、write.table、read.csv、write.csv等，用於讀取和寫入資料。 3.1 R Syntax R可以做很複雜的加減乘除，例如直接在程式碼中打上(1+3)*2.01，總之，看你算式怎麼寫，他就會算出相對應的數值。但其實我們通常使用R語言是要餵給他資料，然後讓他來做運算。此時，要有一個容器來容納這些數值或資料，這個容器就是變數（Variable）。 3.1.1 Assignment <- 將右邊的算式或數值指（Assign）給左邊的變數。左側都是變數，右側則可能是數字或變數。你可以把他想像為把右側做完了以後，指（Assign）給左側的變數。 Assignment對變數型態（Variable Type）的影響：<-右側如果是numeric，那左側的變數就是numeric變數；右側如果是character，左側的變數就是character變數。 在幾乎所有程式語言中，單等號=指的是assignment，把右方的算式、值或物件指給左方的變數。而比較兩者相不相等，則用雙等號==，例如1==3-2。R當初在設計時可能是為了避免混淆，所以把assignment的符號設計為<-。 a <- 1 b <- c(1, 2, 3, 4) c <- c("1", "2", "3", "4") d <- c(b, a) e <- "abcd" 3.1.2 Comments 註解 註解：在程式碼區塊若前面有#字號後面跟著空白的話，那代表那行被標示為註解，程式執行時會自動跳過註解不執行。 快速鍵：當游標在某一行程式碼時打cmd(ctrl)-shift-c，就可以產生註解。 # df <- data.frame(a = c(1, 2, 3), b = c(3, 4, 5)) 3.2 Vector 但我如果要為所有我要運算的數字都產生一個與之對應的變數，這樣做不完。所以，我們會很常使用其他種序列或者對應的結構來儲存多筆資料。例如vector、list或Data.Frame。 在R語言中，vector是一種基本的資料類型，它是由相同類型的元素組成的序列，可以存儲數值、文字、邏輯值等不同類型的資料。例如，以下是一個由整數元素組成的vector：my_vector <- c(1, 2, 3, 4, 5)。而我如果要存取第一個數字，我便可用my_vector[1]的方式存取，分別代表my_vector中第一個位置的內容（第二個、第三個依此類推）。 在程式碼中，只要是文字必用成對的雙引號或單引號包含其中，以區隔「變數」和「數字」。例如如果看到沒有雙引號的「英文字母」必定是變數名稱，或函式名稱。如果看到有雙引號的數字，那也是文字。 以下資料來自各縣市平均每月薪資所得或各縣市人口數。 3.2.1 Creating vectors vector通常用c()函數創建，其中c表示”combine”或”concatenate”，可以將多個元素組合成一個vector。 income <- c(70100, 51300, 51100, 48400, 47600, 43000) county <- c("台北", "新北", "桃園", "高雄", "台中", "台南") population <- c(2.6, 3.9, 2.2, 2.7, 2.8, 1.8) area <- c(271.8, 2052.5, 1221, 2951.9, 2214.9, 2191.7) income ## [1] 70100 51300 51100 48400 47600 43000 county[c(5, 3, 1)] ## [1] "台中" "桃園" "台北" county <- county[c(5, 3, 1)] county ## [1] "台中" "桃園" "台北" area ## [1] 271.8 2052.5 1221.0 2951.9 2214.9 2191.7 population ## [1] 2.6 3.9 2.2 2.7 2.8 1.8 3.2.1.1 Creating a sequence a <- seq(11, 99, 11) a ## [1] 11 22 33 44 55 66 77 88 99 b <- 11:20 b ## [1] 11 12 13 14 15 16 17 18 19 20 3.2.1.2 Creating sequences by distribution x <- runif(10000000, 1, 10) # uniform dist, n=1000 plot(density(x)) x <- rnorm(1000, 1, 10) # uniform dist, n=1000 plot(density(x)) x <- rnorm(10000000, 1, 10) # normal dist, n=1000 plot(density(x)) 3.2.2 Creating a fake data with ChatGPT 你可以嘗試這麼問ChatGPT以獲得一些測試資料「可否幫我建立一個R語言的測試資料，為台北11個行政區的區名、人口數、地理面積。分別用vector來儲存，最後再把三個vector合併為一個dataframe」，觀察看看會有什麼樣的結果。 3.2.3 Viewing county ## [1] "台中" "桃園" "台北" income ## [1] 70100 51300 51100 48400 47600 43000 head(county) ## [1] "台中" "桃園" "台北" tail(county) ## [1] "台中" "桃園" "台北" length(county) ## [1] 3 mode(county) ## [1] "character" class(county) ## [1] "character" # View(county) length(county) ## [1] 3 length(income) ## [1] 6 3.2.4 Subsetting, filtering vector可以用中括號[]搭配數字來取用vector中的元素，下標從1開始。例如，要取用上述的vector中的第三個元素，可以使用my_vector[3]。 It is important to know how to neglect first n or last n elements. For example, a[1:(length(a)-2)] will neglect the last two elements. Thinking why I need parentheses for length(a)-2 here. county ## [1] "台中" "桃園" "台北" county[c(5, 3, 1)] # how about country[c(1, 3, 5)] ## [1] NA "台北" "台中" county[3:6] # is it equal to country[c(3, 4, 5, 6)] ## [1] "台北" NA NA NA a <- 11:19 a[3:length(a)] ## [1] 13 14 15 16 17 18 19 a[length(a):3] ## [1] 19 18 17 16 15 14 13 3.2.5 Deleting Without assignment, deletion won’t change original vectors b <- 11:20 b[-(3:5)] ## [1] 11 12 16 17 18 19 20 b[-c(1, 3, 5)] ## [1] 12 14 16 17 18 19 20 b ## [1] 11 12 13 14 15 16 17 18 19 20 Correct deleting operations with assignment to replace original vector b <- b[-(3:5)] b ## [1] 11 12 16 17 18 19 20 a <- seq(11, 99, 11) a <- a[-c(1, 3, 5)] a ## [1] 22 44 66 77 88 99 3.2.6 Concatenating Concatenating is quite useful for web crawling when you crawl article links page by page. You may be not sure the number of page you need to crawl. So you need to append entire new vector to old vector. It is concatenating. (“Appending” often means adding one new element at the end of data.) a <- 1:10 a <- c(a, 11) a ## [1] 1 2 3 4 5 6 7 8 9 10 11 b ## [1] 11 12 16 17 18 19 20 a <- c(a, b) a ## [1] 1 2 3 4 5 6 7 8 9 10 11 11 12 16 17 18 19 20 a <- c(a, a, b) a ## [1] 1 2 3 4 5 6 7 8 9 10 11 11 12 16 17 18 19 20 1 2 3 4 5 6 7 ## [26] 8 9 10 11 11 12 16 17 18 19 20 11 12 16 17 18 19 20 3.3 Calculating with vectors 3.3.1 Arithmetic operations a <- 11:19 a + 3 ## [1] 14 15 16 17 18 19 20 21 22 a / 2 ## [1] 5.5 6.0 6.5 7.0 7.5 8.0 8.5 9.0 9.5 a %% 2 ## [1] 1 0 1 0 1 0 1 0 1 a %/% 2 ## [1] 5 6 6 7 7 8 8 9 9 a %% 2== 0 ## [1] FALSE TRUE FALSE TRUE FALSE TRUE FALSE TRUE FALSE which(a %% 2== 0) ## [1] 2 4 6 8 a[which(a%% 2 == 0)] ## [1] 12 14 16 18 a[c(2, 4, 6, 8)] ## [1] 12 14 16 18 a %% 2 != 0 ## [1] TRUE FALSE TRUE FALSE TRUE FALSE TRUE FALSE TRUE a[a%% 2 == 0] ## [1] 12 14 16 18 a[a%%2 != 0] ## [1] 11 13 15 17 19 a <- a %% 2 # modular arithmetic, get the reminder a <- a %/% 2 # Quotient 3.3.2 Logic comparisons a %% 2 == 0 # deteting odd/even number ## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE a %% 2 != 0 ## [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE a[a%%2==0] ## [1] 0 0 0 0 0 0 0 0 0 a > b ## [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE income > mean(income) ## [1] TRUE FALSE FALSE FALSE FALSE FALSE TRUE == T # == equal to, ## [1] TRUE TRUE != F # != Not equal to ## [1] TRUE any(a>11) # is there any element larger than 1 ## [1] FALSE all(a>11) # are all elements larger than 1 ## [1] FALSE 3.3.3 Subsetting by logic comparisons two methods to filter data from vectors, by index vector or a logical vector with equal length. a <- seq(11, 55, 11) a[c(T, F, T, F, T)] ## [1] 11 33 55 a[a%%2==1] ## [1] 11 33 55 a%%2 ## [1] 1 0 1 0 1 a%%2==1 ## [1] TRUE FALSE TRUE FALSE TRUE a <- c("你好","你好棒棒","你好棒","你真的好棒") a[nchar(a)>3] ## [1] "你好棒棒" "你真的好棒" # which will return "index-of" a <- seq(11, 55, 11) a[which(a%%2==1)] ## [1] 11 33 55 which(a%%2==1) ## [1] 1 3 5 3.3.4 Sorting and ordering sort(x)的結果必須用<-覆蓋原本的x，此時的x才算被排序的結果。 order(x)函式會傳回x數值由小到大的索引。這個例子的結果是5, 4, 3, 6, 1, 2，也就是5位置的那個數最小、4那個位置的數次小、接下來3, 6, 1, 2。 x[order(x)]把order(x)結果（也就是c(5, 4, 3, 6, 1, 2)）傳給原本的x便會使得原本的x重新排序。通常order()的用途是，我們可以將兩個等長的variables例如var1和var2，依據var2來重新排序var1，例如var1[order(var2)]。 x <- c(33, 55, 22, 13, 4, 24) mode(x) ## [1] "numeric" class(x) ## [1] "numeric" sort(x) ## [1] 4 13 22 24 33 55 # x <- sort(x) # assign to replace original x order(x) ## [1] 5 4 3 6 1 2 x[order(x)] ## [1] 4 13 22 24 33 55 x[c(5, 4, 3, 6, 1, 2)] ## [1] 4 13 22 24 33 55 3.3.5 Built-in math functions a <- 11:19 min(a); max(a); mean(a); median(a); sd(a) ## [1] 11 ## [1] 19 ## [1] 15 ## [1] 15 ## [1] 2.738613 log2(a) ## [1] 3.459432 3.584963 3.700440 3.807355 3.906891 4.000000 4.087463 4.169925 ## [9] 4.247928 log1p(a) ## [1] 2.484907 2.564949 2.639057 2.708050 2.772589 2.833213 2.890372 2.944439 ## [9] 2.995732 ?log1p 3.4 Data types 3.4.1 Checking data type mode(county) # character ## [1] "character" mode(income) # numeric ## [1] "numeric" mode(income > mean(income)) # logical ## [1] "logical" testing <- c("26.142", "12.008", "7.032", "13.646", "4.589") mode(testing) # character ## [1] "character" 3.4.2 Converting data type numeric vector可以用as.character(x)轉成charcter；logical vector可以用as.numeric(x)轉為numeric。概念上可以說是character > numeric > logical。 如果硬是在logical vector後附加一個numeric element的話，那就會整個vector被轉為numeric vector；相仿地，如果numeric vector後附加一個character element的話那整個vector就會被轉為character vector。 可以用sum()函式來計算logical vector有幾個TRUE值。例如sum(a%%2==1)就是計算a中有幾個奇數。TRUE可視為1、FALSE可視為0，所以加總起來就是TRUE有幾個。 income.c <- as.character(income) population.c <- as.numeric(population) a <- seq(11, 99, 11) a <- c(a, "100") a <- seq(11, 99, 11) sum(a%%2==1) ## [1] 5 max(a) ## [1] 99 3.5 Character operations a <- seq(11, 55, 11) paste("A", a) # concatenate ## [1] "A 11" "A 22" "A 33" "A 44" "A 55" paste0("A", a) # concatenate ## [1] "A11" "A22" "A33" "A44" "A55" "],["dataframe.html", "Chapter 4 Dataframe 4.1 基本操作 4.2 簡易繪圖 4.3 延伸學習 4.4 Paid Maternity Leave", " Chapter 4 Dataframe 4.1 基本操作 4.1.1 產生新的Dataframe 4.1.1.1 建立資料並Assign給vector 用以下ChatGPT問句來產生測試資料「我現在正在準備R的教學範例， 請協助我產生台北市所有行政區的資料，包含行政區名、面積、人口數 分別指給town, area, population三個變數」。 town = c("松山區", "信義區", "大安區", "中山區", "中正區", "大同區", "萬華區", "文山區", "南港區", "內湖區", "士林區", "北投區") area = c(9.2878, 11.2077, 11.3614, 13.6821, 7.6071, 5.6815, 8.8522, 31.5090, 21.8424, 31.5787, 62.3682, 56.8216) # 單位：平方公里 population = c(206375, 225561, 309835, 203276, 159608, 132397, 194160, 275207, 122103, 287726, 288324, 255688) # 2023年的估計值 4.1.1.2 合併等長vector為dataframe df <- data.frame(town, population, area) df$density = df$population / df$area str(df) ## 'data.frame': 6 obs. of 4 variables: ## $ town : chr "中正" "大同" "中山" "松山" ... ## $ population: num 158228 126687 228075 204903 308383 ... ## $ area : num 7.61 5.68 13.68 9.29 11.36 ... ## $ density : num 20800 22298 16670 22062 27143 ... summary(df) ## town population area density ## Length:6 Min. :126687 Min. : 5.681 Min. :16670 ## Class :character 1st Qu.:165651 1st Qu.: 7.918 1st Qu.:20907 ## Mode :character Median :196412 Median : 9.070 Median :21645 ## Mean :202366 Mean : 9.412 Mean :21700 ## 3rd Qu.:222282 3rd Qu.:10.843 3rd Qu.:22239 ## Max. :308383 Max. :13.682 Max. :27143 # View(df) 4.1.1.3 存放台灣貿易各國進出口量 運用國際貿易署貿易統計系統 (trade.gov.tw)獲取臺灣進出口貿易資料。 country <- c("CN", "US", "JP", "HK", "KR", "SG", "DE", "MY", "VN", "PH", "TH", "AU", "NL", "SA", "ID", "GB", "IN", "FR", "IT", "AE") import <- c(26.142, 12.008, 7.032, 13.646, 4.589, 5.768, 2.131, 2.802, 3.428, 3.019, 1.976, 1.118, 1.624, 0.449, 0.983, 1.302, 1.027, 0.553, 0.670, 0.455) export <- c(22.987, 12.204, 11.837, 7.739, 5.381, 4.610, 2.866, 2.784, 2.414, 2.092, 1.839, 1.788, 1.665, 1.409, 1.391, 1.075, 0.974, 0.899, 0.800, 0.728) 4.1.1.4 合併vector為data.frame 當我們讀取或創建資料框架時，過去R預設會將字符串類型的變數轉換為因子（Factors），這對於統計分析而言是有益的，因為統計分析經常將文字型態的數據視為類別變數來處理。然而，隨著資料科學領域的快速發展，需要處理大量文字數據的情況日益增多，這時將文字資料預設為因子型態可能不再適合所有情境。因此，現在R的預設的處理方式已經改變，預設將文字型態的變數保持為字符型態（Character），而不是自動將其轉換為因子。這意味著，當我們使用read.csv等函數讀取數據時，除非明確指定，否則讀入的字符串不會自動轉換為Factors型態。 如果你在進行統計分析時希望將文字型態的變數作為類別變數（即因子）處理，你需要手動設定stringsAsFactors參數為TRUE。這可以在讀取數據時（如使用read.csv函數）或在數據處理過程中明確進行轉換。例如，當使用read.csv讀取CSV文件時，若想將所有的字符串變數自動轉為因子型態，可以這樣做：df <- read.csv(\"your_file.csv\", stringsAsFactors = TRUE)。若已經讀取數據且數據框架中的文字型態變數仍為Character型態，而你希望將其轉換為Factors，可以使用factor函數進行轉換：df$your_column <- factor(df$your_column)。 df <- data.frame(country, import, export, stringsAsFactors = TRUE) str(df) ## 'data.frame': 20 obs. of 3 variables: ## $ country: Factor w/ 20 levels "AE","AU","CN",..: 3 19 11 7 12 17 4 13 20 15 ... ## $ import : num 26.14 12.01 7.03 13.65 4.59 ... ## $ export : num 22.99 12.2 11.84 7.74 5.38 ... df <- data.frame(country, import, export) str(df) ## 'data.frame': 20 obs. of 3 variables: ## $ country: chr "CN" "US" "JP" "HK" ... ## $ import : num 26.14 12.01 7.03 13.65 4.59 ... ## $ export : num 22.99 12.2 11.84 7.74 5.38 ... 其他功能：建立一個新且空的data.frame。 df.test <- data.frame() 4.1.2 觀察dataframe 當我們處理數據框架（dataframe）時，有幾種常用的方法可以幫助我們更好地了解和觀察數據的結構和內容。 View(df): 使用RStudio提供的圖形使用者介面直接觀看dataframe。這個功能允許你直觀地瀏覽整個數據集，方便地查看不同行（變數）和列（觀測值）。這對於初步瞭解數據的分佈和檢查數據的格式特別有用。 head(df): 這個函數用於取出數據框架的前六筆資料（也就是前六列）。這可以讓我們快速概覽數據集的開頭部分，了解數據的基本結構和內容。如果需要查看更多或更少的列，可以向head函數傳遞一個額外的參數，如head(df, n = 10)來查看前十列。 class(df): 此函數返回該變數的類型。對於dataframe，它將返回”DataFrame”，表明該對象是一個dataframe。了解對象的類型是重要的基礎步驟，尤其是在R中，不同類型的變項能夠做的操作和應用的函數也不同。 str(df): str是結構（structure）的縮寫，這個函數提供了dataframe的詳細結構信息，包括變項的數量、變項名稱、變項數據類型以及每個變項前幾個值。這是一個非常強大的函數，用於深入了解數據集的內部結構，特別是當處理大型數據集時。 summary(df): 此函數提供了數據框架的摘要統計信息，包括數值變數的最小值、最大值、中位數、平均值、第一四分位數和第三四分位數，以及因子變數的水平計數。這對於快速獲取數據集的統計概述非常有用。 # View(df) head(df) # get first part of the data.frame ## country import export ## 1 CN 26.142 22.987 ## 2 US 12.008 12.204 ## 3 JP 7.032 11.837 ## 4 HK 13.646 7.739 ## 5 KR 4.589 5.381 ## 6 SG 5.768 4.610 class(df) ## [1] "data.frame" str(df) ## 'data.frame': 20 obs. of 3 variables: ## $ country: chr "CN" "US" "JP" "HK" ... ## $ import : num 26.14 12.01 7.03 13.65 4.59 ... ## $ export : num 22.99 12.2 11.84 7.74 5.38 ... summary(df) ## country import export ## Length:20 Min. : 0.449 Min. : 0.728 ## Class :character 1st Qu.: 1.016 1st Qu.: 1.312 ## Mode :character Median : 2.054 Median : 1.966 ## Mean : 4.536 Mean : 4.374 ## 3rd Qu.: 4.884 3rd Qu.: 4.803 ## Max. :26.142 Max. :22.987 # look up help help(summary) ?summary 4.1.2.1 觀察資料維度 dim(df) ## [1] 20 3 ncol(df) ## [1] 3 nrow(df) ## [1] 20 length(df) ## [1] 3 4.1.3 操作dataframe 4.1.3.1 取出一個變項 names(df) 列出變數名稱 df$發生.現.地點 顯示該變數內容 df$發生時段 顯示該變數內容 length(df$發生時段) 顯示該變數的長度（相當於有幾個） names(df) ## [1] "country" "import" "export" head(df$export) ## [1] 22.987 12.204 11.837 7.739 5.381 4.610 length(df$import) ## [1] 20 summary(df) ## country import export ## Length:20 Min. : 0.449 Min. : 0.728 ## Class :character 1st Qu.: 1.016 1st Qu.: 1.312 ## Mode :character Median : 2.054 Median : 1.966 ## Mean : 4.536 Mean : 4.374 ## 3rd Qu.: 4.884 3rd Qu.: 4.803 ## Max. :26.142 Max. :22.987 4.1.3.2 (mutate)透過運算產生新變數 這裡容易犯錯的是，要記得跟程式講說你要加總或四則運算的是哪個df的variable。 從下面的這個操作中，該data.frame會產生一個新的變數sub，這就相當於Excel中的某一行減去某一行，然後把資料放在新的一行。 df$sub <- df$import - df$export 4.1.3.3 (filter)篩選資料、選取變數 注意，要告訴程式import和export是哪個data.frame的。 df[,]為存取df中某個區段的數值或某個數值的方法。因此df[1, 1]會取出第一行第一列，也就是第一筆資料的第一個vector。df[2, 3]則會取出第二筆資料的第三個variable。 下面的例子nrow(df)為1894，有1894筆資料，所以自然df\\(import與df\\)export的長度都是1894。因此，比較這兩個變數的大小會得到一個長度為1894的boolean (logical) variable。因此把這個長度為1894、充滿TRUE和FALSE的logical vector丟進df的row之處，因為取自df，大小判斷式結果的長度自然和原本的df的列數相同。因此當這個TRUE/FALSE被丟在df的列之處，便會篩選出import大於p.xport的數值。 原本的df有五個variable，而上述的操作是篩選資料，所以被篩選的是列，因此行的數量、名稱都不會變。因此，我篩選完後，直接存取這個被篩選過的data.frame的country variable，自然是可以的。 df ## country import export sub ## 1 CN 26.142 22.987 3.155 ## 2 US 12.008 12.204 -0.196 ## 3 JP 7.032 11.837 -4.805 ## 4 HK 13.646 7.739 5.907 ## 5 KR 4.589 5.381 -0.792 ## 6 SG 5.768 4.610 1.158 ## 7 DE 2.131 2.866 -0.735 ## 8 MY 2.802 2.784 0.018 ## 9 VN 3.428 2.414 1.014 ## 10 PH 3.019 2.092 0.927 ## 11 TH 1.976 1.839 0.137 ## 12 AU 1.118 1.788 -0.670 ## 13 NL 1.624 1.665 -0.041 ## 14 SA 0.449 1.409 -0.960 ## 15 ID 0.983 1.391 -0.408 ## 16 GB 1.302 1.075 0.227 ## 17 IN 1.027 0.974 0.053 ## 18 FR 0.553 0.899 -0.346 ## 19 IT 0.670 0.800 -0.130 ## 20 AE 0.455 0.728 -0.273 names(df) ## [1] "country" "import" "export" "sub" nrow(df) ## [1] 20 # filter row data by column value df[df$import > df$export,] ## country import export sub ## 1 CN 26.142 22.987 3.155 ## 4 HK 13.646 7.739 5.907 ## 6 SG 5.768 4.610 1.158 ## 8 MY 2.802 2.784 0.018 ## 9 VN 3.428 2.414 1.014 ## 10 PH 3.019 2.092 0.927 ## 11 TH 1.976 1.839 0.137 ## 16 GB 1.302 1.075 0.227 ## 17 IN 1.027 0.974 0.053 df[df$import > df$export,]$country ## [1] "CN" "HK" "SG" "MY" "VN" "PH" "TH" "GB" "IN" df[df$import > df$export,1] ## [1] "CN" "HK" "SG" "MY" "VN" "PH" "TH" "GB" "IN" # 1 row == a data.frame with only one data entry class(df[df$import > df$export,1]) ## [1] "character" class(df[,1]) # character vector ## [1] "character" class(df[1,]) # data.frame ## [1] "data.frame" class(unlist(df[1, -1])) # filter the 1st row and select all columns except 1 ## [1] "numeric" 4.1.3.4 (arrange) 按某個變數排序 df.sorted <- df[order(df$import),]會使得整個df照import的大小排序重新做排列。因為order(df$import)會把資料照指定順序排列後的位置傳回來，所以把他丟給df的列的位置，便會使得df的資料照指定的順序排列。 預設是由小到大，加上decreasing = T這個參數後變成由大而小。 # sort rows by df$import column df.sorted <- df[order(df$import),] # View(df.sorted) # sort rows in decreasing order df.sorted <- df[order(df$import, decreasing = T),] # add - to column in order() can sort in decreasing order df.sorted <- df[order(-df$import),] head(df.sorted) ## country import export sub ## 1 CN 26.142 22.987 3.155 ## 4 HK 13.646 7.739 5.907 ## 2 US 12.008 12.204 -0.196 ## 3 JP 7.032 11.837 -4.805 ## 6 SG 5.768 4.610 1.158 ## 5 KR 4.589 5.381 -0.792 4.2 簡易繪圖 graphics::plot()為會預載入R的繪圖套件，如果希望繪圖的同時加上回歸線和資料點標籤的話，必須要三行一起執行。 # plot(df) # raise error, 1st column is a character vector plot(df[, 2:3]) plot(df[1:10, 2:3]) text(import, export, labels=country, cex= 0.5, pos=3) lines(1:25, 1:25, col='red') ?plot ## Help on topic 'plot' was found in the following packages: ## ## Package Library ## graphics /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library ## base /Library/Frameworks/R.framework/Resources/library ## ## ## Using the first match ... 4.3 延伸學習 4.3.1 使用dplyr library(dplyr) df <- data.frame(country, import, export, stringsAsFactors = F) df <- mutate(df, sub = import - export) filter(df, import > export) ## country import export sub ## 1 CN 26.142 22.987 3.155 ## 2 HK 13.646 7.739 5.907 ## 3 SG 5.768 4.610 1.158 ## 4 MY 2.802 2.784 0.018 ## 5 VN 3.428 2.414 1.014 ## 6 PH 3.019 2.092 0.927 ## 7 TH 1.976 1.839 0.137 ## 8 GB 1.302 1.075 0.227 ## 9 IN 1.027 0.974 0.053 select(df, c(1, 3)) ## country export ## 1 CN 22.987 ## 2 US 12.204 ## 3 JP 11.837 ## 4 HK 7.739 ## 5 KR 5.381 ## 6 SG 4.610 ## 7 DE 2.866 ## 8 MY 2.784 ## 9 VN 2.414 ## 10 PH 2.092 ## 11 TH 1.839 ## 12 AU 1.788 ## 13 NL 1.665 ## 14 SA 1.409 ## 15 ID 1.391 ## 16 GB 1.075 ## 17 IN 0.974 ## 18 FR 0.899 ## 19 IT 0.800 ## 20 AE 0.728 message(df$country) print(df$country) ## [1] "CN" "US" "JP" "HK" "KR" "SG" "DE" "MY" "VN" "PH" "TH" "AU" "NL" "SA" "ID" ## [16] "GB" "IN" "FR" "IT" "AE" 4.3.2 比較tibble, data_frame, data.frame 警告： \"data_frame()\" was deprecated in tibble 1.1.0. Please use \"tibble()\" instead. df <- data.frame(a=1:2, b=3:4, c=5:6) class(df) ## [1] "data.frame" df <- data_frame(a=1:2, b=3:4, c=5:6) class(df) ## [1] "tbl_df" "tbl" "data.frame" df <- tibble(a=1:2, b=3:4, c=5:6) class(df) ## [1] "tbl_df" "tbl" "data.frame" 4.4 Paid Maternity Leave 本案例將使用R重新製作華盛頓郵報2016年8月13日的一篇報導，該報導探討了美國婦女產假支薪情況。案例中將應用data.frame和基本的繪圖與資料摘要方法。 原始新聞來源：The world is getting better at paid maternity leave. The U.S. is not. - The Washington Post。該篇報導提及，美國因為目前的政策不保障帶薪產假，許多女性感到必須在工作和照顧家庭之間做出選擇，這種性別不平等破壞了她們在工作機會上的平等機會。同時，世界各地的婦女待遇正在逐漸改善。至少190個國家對嬰兒的母親規定了某種形式的帶薪假期，產假待遇在56個國家有所提高。專家表示，現在美國城市和州正通過不同形式的帶薪家庭假法案，這顯示美國雇主正在展示有競爭力的福利不會影響員工表現。特別是科技公司，如Twitter、Facebook和Google等，處於提供員工帶薪產假福利的前沿，美國可能有望追趕其他國家。 本案例主要呈現核心的視覺化概念，可以在Review Paid Maternity by dplyr找到更詳盡的案例說明與解析。 4.4.1 Reading .xlsx by readxl package 在進行產假支薪調查數據的分析與視覺化時，我們從該調查網站上所下載的資料是一個Excel文件。由於R語言本身不直接支援讀取Excel格式的文件，我們必須依靠外部的套件來實現這一功能，如readxl套件。它是專門設計來讀取.xls和.xlsx格式文件的強大工具。readxl套件是tidyverse套件集的一部分。tidyverse是一組旨在數據科學和數據處理領域提供便利的R套件集合，包括了ggplot2、dplyr、tidyr等多個流行的套件。如果你之前已經安裝了tidyverse，那麼readxl套件應該也已經安裝在你的系統上，無需進行重複安裝。 然而，即便readxl已經安裝，它並不會隨著tidyverse套件集的其他部分自動加載到R的執行環境中。這意味著，在你打算使用readxl套件來讀取Excel文件之前，需要先手動執行library(readxl)命令來加載它。 # Import readxl package # install.packages("tidyverse") library(readxl) 這段程式碼使用read_excel()函式從data資料夾中的WORLD-MACHE_Gender_6.8.15.xls檔案中的Sheet1工作表讀取資料。其中col_names=T為該函式的參數，表示第一列為欄位名稱。讀取後的資料會被Assign給變數df。 # Use read_excel() to convert excel sheet to data.frame df <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) 4.4.2 Previewing data by View(), class(), dim(), str(), summary() and names() # View(df) class(df) # [1] "tbl_df" "tbl" "data.frame" ## [1] "tbl_df" "tbl" "data.frame" dim(df) ## [1] 197 156 # Show names of variables (vectors, columns) by names() names(df) ## [1] "country" "iso2" "iso3" ## [4] "region" "wb_econ" "matleave_95" ## [7] "matleave_96" "matleave_97" "matleave_98" ## [10] "matleave_99" "matleave_00" "matleave_01" ## [13] "matleave_02" "matleave_03" "matleave_04" ## [16] "matleave_05" "matleave_06" "matleave_07" ## [19] "matleave_08" "matleave_09" "matleave_10" ## [22] "matleave_11" "matleave_12" "matleave_13" ## [25] "matleave_wrr_95" "matleave_wrr_96" "matleave_wrr_97" ## [28] "matleave_wrr_98" "matleave_wrr_99" "matleave_wrr_00" ## [31] "matleave_wrr_01" "matleave_wrr_02" "matleave_wrr_03" ## [34] "matleave_wrr_04" "matleave_wrr_05" "matleave_wrr_06" ## [37] "matleave_wrr_07" "matleave_wrr_08" "matleave_wrr_09" ## [40] "matleave_wrr_10" "matleave_wrr_11" "matleave_wrr_12" ## [43] "matleave_wrr_13" "bf_dur_95" "bf_dur_96" ## [46] "bf_dur_97" "bf_dur_98" "bf_dur_99" ## [49] "bf_dur_00" "bf_dur_01" "bf_dur_02" ## [52] "bf_dur_03" "bf_dur_04" "bf_dur_05" ## [55] "bf_dur_06" "bf_dur_07" "bf_dur_08" ## [58] "bf_dur_09" "bf_dur_10" "bf_dur_11" ## [61] "bf_dur_12" "bf_dur_13" "mat_bfeed_6mon_95" ## [64] "mat_bfeed_6mon_96" "mat_bfeed_6mon_97" "mat_bfeed_6mon_98" ## [67] "mat_bfeed_6mon_99" "mat_bfeed_6mon_00" "mat_bfeed_6mon_01" ## [70] "mat_bfeed_6mon_02" "mat_bfeed_6mon_03" "mat_bfeed_6mon_04" ## [73] "mat_bfeed_6mon_05" "mat_bfeed_6mon_06" "mat_bfeed_6mon_07" ## [76] "mat_bfeed_6mon_08" "mat_bfeed_6mon_09" "mat_bfeed_6mon_10" ## [79] "mat_bfeed_6mon_11" "mat_bfeed_6mon_12" "mat_bfeed_6mon_13" ## [82] "minage_fem_leg_95" "minage_fem_leg_96" "minage_fem_leg_97" ## [85] "minage_fem_leg_98" "minage_fem_leg_99" "minage_fem_leg_00" ## [88] "minage_fem_leg_01" "minage_fem_leg_02" "minage_fem_leg_03" ## [91] "minage_fem_leg_04" "minage_fem_leg_05" "minage_fem_leg_06" ## [94] "minage_fem_leg_07" "minage_fem_leg_08" "minage_fem_leg_09" ## [97] "minage_fem_leg_10" "minage_fem_leg_11" "minage_fem_leg_12" ## [100] "legal_diff_leg_95" "legal_diff_leg_96" "legal_diff_leg_97" ## [103] "legal_diff_leg_98" "legal_diff_leg_99" "legal_diff_leg_00" ## [106] "legal_diff_leg_01" "legal_diff_leg_02" "legal_diff_leg_03" ## [109] "legal_diff_leg_04" "legal_diff_leg_05" "legal_diff_leg_06" ## [112] "legal_diff_leg_07" "legal_diff_leg_08" "legal_diff_leg_09" ## [115] "legal_diff_leg_10" "legal_diff_leg_11" "legal_diff_leg_12" ## [118] "minage_fem_pc_95" "minage_fem_pc_96" "minage_fem_pc_97" ## [121] "minage_fem_pc_98" "minage_fem_pc_99" "minage_fem_pc_00" ## [124] "minage_fem_pc_01" "minage_fem_pc_02" "minage_fem_pc_03" ## [127] "minage_fem_pc_04" "minage_fem_pc_05" "minage_fem_pc_06" ## [130] "minage_fem_pc_07" "minage_fem_pc_08" "minage_fem_pc_09" ## [133] "minage_fem_pc_10" "minage_fem_pc_11" "minage_fem_pc_12" ## [136] "legal_diff_pc_95" "legal_diff_pc_96" "legal_diff_pc_97" ## [139] "legal_diff_pc_98" "legal_diff_pc_99" "legal_diff_pc_00" ## [142] "legal_diff_pc_01" "legal_diff_pc_02" "legal_diff_pc_03" ## [145] "legal_diff_pc_04" "legal_diff_pc_05" "legal_diff_pc_06" ## [148] "legal_diff_pc_07" "legal_diff_pc_08" "legal_diff_pc_09" ## [151] "legal_diff_pc_10" "legal_diff_pc_11" "legal_diff_pc_12" ## [154] "minwage_ppp_2013" "mw_overtime" "oecd" 4.4.3 Select variables 由於所需要的資料為第三欄的變數iso3（為國家代碼）和第六至24欄的matleave95~matleave13共29年的資料，所以需要在df[ , ]中選出這幾欄。只要把所要取的欄以vector的型態放在df[row,col]之col的位置，便可以選出所要的欄。 # Select the 3rd and 6th to 24th columns matleave <- df[ , c(3, 6:24)] # Use class(), dim(), and str() to inspect the data class(matleave) ## [1] "tbl_df" "tbl" "data.frame" dim(matleave) ## [1] 197 20 str(matleave) ## tibble [197 × 20] (S3: tbl_df/tbl/data.frame) ## $ iso3 : chr [1:197] "AFG" "ALB" "DZA" "AND" ... ## $ matleave_95: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_96: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_97: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_98: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_99: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_00: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_01: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_02: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_03: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_04: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_05: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_06: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_07: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_08: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_09: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_10: num [1:197] 2 5 3 3 2 2 2 5 NA 5 ... ## $ matleave_11: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_12: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_13: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... 4.4.4 Check & Replace NAs 處理開放資料常常會遇到紀錄遺漏的情形，這些遺漏的值在R語言中通常以NA（Not Available）來表示。這種情況很常見，特別是當數據來自於廣泛的來源，如網絡調查或公開資料庫時。適當處理這些NA值對於維持分析的準確性和可靠性至關重要。 為了識別和處理這些NA值，R提供了一些有用的函數和技巧。例如，is.na(v)函數可以用來檢測向量v中的NA值。如果你想選擇所有的NA紀錄，可以使用v[is.na(v)]這樣的語法。這個表達式會傳回所有在向量v中為NA的元素，這對於進一步的分析和資料清洗非常有幫助。 在某些情況下，你可能會想要以某個特定值來取代NA值，以避免在繪圖或進行其他數據分析時產生錯誤。例如，你可以選擇以0來取代所有的NA值，這可以通過v[is.na(v)] <- 0來實現。這樣，所有原本為NA的資料格都會被賦予0值。 此外，sum(is.na(v))這個表達式可以用來檢測向量v中還有多少NA值。這個函數的運作機制是計算所有is.na(v)為TRUE的情況，即所有NA值的總數。如果這個結果不是0，那麼就表示在向量或dataframe中還存在NA值。這對於確保數據清理工作已經完成，並且數據集準備好進行分析是非常有用的。 # is.na() to indicate each element is NA or NOT(TRUE/FALSE) head(is.na(matleave), n=20) ## iso3 matleave_95 matleave_96 matleave_97 matleave_98 matleave_99 ## [1,] FALSE FALSE FALSE FALSE FALSE FALSE ## [2,] FALSE FALSE FALSE FALSE FALSE FALSE ## [3,] FALSE FALSE FALSE FALSE FALSE FALSE ## [4,] FALSE FALSE FALSE FALSE FALSE FALSE ## [5,] FALSE FALSE FALSE FALSE FALSE FALSE ## [6,] FALSE FALSE FALSE FALSE FALSE FALSE ## [7,] FALSE FALSE FALSE FALSE FALSE FALSE ## [8,] FALSE FALSE FALSE FALSE FALSE FALSE ## [9,] FALSE FALSE FALSE FALSE FALSE FALSE ## [10,] FALSE FALSE FALSE FALSE FALSE FALSE ## [11,] FALSE FALSE FALSE FALSE FALSE FALSE ## [12,] FALSE FALSE FALSE FALSE FALSE FALSE ## [13,] FALSE FALSE FALSE FALSE FALSE FALSE ## [14,] FALSE FALSE FALSE FALSE FALSE FALSE ## [15,] FALSE FALSE FALSE FALSE FALSE FALSE ## [16,] FALSE FALSE FALSE FALSE FALSE FALSE ## [17,] FALSE FALSE FALSE FALSE FALSE FALSE ## [18,] FALSE FALSE FALSE FALSE FALSE FALSE ## [19,] FALSE FALSE FALSE FALSE FALSE FALSE ## [20,] FALSE FALSE FALSE FALSE FALSE FALSE ## matleave_00 matleave_01 matleave_02 matleave_03 matleave_04 matleave_05 ## [1,] FALSE FALSE FALSE FALSE FALSE FALSE ## [2,] FALSE FALSE FALSE FALSE FALSE FALSE ## [3,] FALSE FALSE FALSE FALSE FALSE FALSE ## [4,] FALSE FALSE FALSE FALSE FALSE FALSE ## [5,] FALSE FALSE FALSE FALSE FALSE FALSE ## [6,] FALSE FALSE FALSE FALSE FALSE FALSE ## [7,] FALSE FALSE FALSE FALSE FALSE FALSE ## [8,] FALSE FALSE FALSE FALSE FALSE FALSE ## [9,] FALSE FALSE FALSE FALSE FALSE FALSE ## [10,] FALSE FALSE FALSE FALSE FALSE FALSE ## [11,] FALSE FALSE FALSE FALSE FALSE FALSE ## [12,] FALSE FALSE FALSE FALSE FALSE FALSE ## [13,] FALSE FALSE FALSE FALSE FALSE FALSE ## [14,] FALSE FALSE FALSE FALSE FALSE FALSE ## [15,] FALSE FALSE FALSE FALSE FALSE FALSE ## [16,] FALSE FALSE FALSE FALSE FALSE FALSE ## [17,] FALSE FALSE FALSE FALSE FALSE FALSE ## [18,] FALSE FALSE FALSE FALSE FALSE FALSE ## [19,] FALSE FALSE FALSE FALSE FALSE FALSE ## [20,] FALSE FALSE FALSE FALSE FALSE FALSE ## matleave_06 matleave_07 matleave_08 matleave_09 matleave_10 matleave_11 ## [1,] FALSE FALSE FALSE FALSE FALSE FALSE ## [2,] FALSE FALSE FALSE FALSE FALSE FALSE ## [3,] FALSE FALSE FALSE FALSE FALSE FALSE ## [4,] FALSE FALSE FALSE FALSE FALSE FALSE ## [5,] FALSE FALSE FALSE FALSE FALSE FALSE ## [6,] FALSE FALSE FALSE FALSE FALSE FALSE ## [7,] FALSE FALSE FALSE FALSE FALSE FALSE ## [8,] FALSE FALSE FALSE FALSE FALSE FALSE ## [9,] FALSE FALSE FALSE FALSE TRUE FALSE ## [10,] FALSE FALSE FALSE FALSE FALSE FALSE ## [11,] FALSE FALSE FALSE FALSE FALSE FALSE ## [12,] FALSE FALSE FALSE FALSE FALSE FALSE ## [13,] FALSE FALSE FALSE FALSE FALSE FALSE ## [14,] FALSE FALSE FALSE FALSE FALSE FALSE ## [15,] FALSE FALSE FALSE FALSE FALSE FALSE ## [16,] FALSE FALSE FALSE FALSE FALSE FALSE ## [17,] FALSE FALSE FALSE FALSE FALSE FALSE ## [18,] FALSE FALSE FALSE FALSE FALSE FALSE ## [19,] FALSE FALSE FALSE FALSE FALSE FALSE ## [20,] FALSE TRUE TRUE FALSE FALSE FALSE ## matleave_12 matleave_13 ## [1,] FALSE FALSE ## [2,] FALSE FALSE ## [3,] FALSE FALSE ## [4,] FALSE FALSE ## [5,] FALSE FALSE ## [6,] FALSE FALSE ## [7,] FALSE FALSE ## [8,] FALSE FALSE ## [9,] FALSE FALSE ## [10,] FALSE FALSE ## [11,] FALSE FALSE ## [12,] FALSE FALSE ## [13,] FALSE FALSE ## [14,] FALSE FALSE ## [15,] FALSE FALSE ## [16,] FALSE FALSE ## [17,] FALSE FALSE ## [18,] FALSE FALSE ## [19,] FALSE FALSE ## [20,] FALSE FALSE # Assign 0 to those NA data matleave[is.na(matleave)] <- 0 # anyNA() to check if there are still NA cells. anyNA(matleave) ## [1] FALSE # sum(is.na()) to count the number of NA sum(is.na(matleave)) ## [1] 0 4.4.5 Filtering data 4.4.5.1 Filtered by the last year value matleave[matleave$'matleave_13'==5, ]中的第一個matleave表示要篩選的資料集，中括號中的matleave$'matleave_13'==5是篩選條件，表示將篩選matleave資料集中的matleave_13變數值等於5的列；中括號中的逗號後方未有欄位名稱表示將保留所有欄位（變項），僅篩選出符合條件的列，並將篩選後所產生的dataframe指給變數m5。 # Use logical comparison to see if the last year equals to 5 # Assign matching data to var m5 m5 <- matleave[matleave$'matleave_13'==5, ] # nrow() to count matching data nrow(m5) ## [1] 34 # Is it possible to use length() to check the data length? # matleave$'matleave_13' # matleave$'matleave_13'==5 # length(matleave$'matleave_13'==5) 4.4.5.2 Filtered data by the first year value 接下來我們再做一次篩選，從m5中篩選出matleave_95這個欄位為5的資料，並指給m55；同時也從m5中篩選出matleave_95這個欄位不為5的資料，並指給m05。m5、m55和m05無特殊含義，只是變數名稱而已。 # filter rows whose 'matleave_95' is 5, and assign to var m55 m55<- m5[m5$'matleave_95'==5,] # filter rows whose 'matleave_95' is not 5, and assign to var m05 m05<- m5[m5$'matleave_95'!=5,] 4.4.6 Plotting 當我們在R中進行資料視覺化時，理解資料結構對於正確使用圖形化函數是非常重要的。以matleave資料集為例，如果我們想要繪製其第二列所有行（除了第一行）的條形圖，這裡有一段示範程式碼及相關的概念解釋。 首先，為何要除去第一行？因為第一行為國家名稱。所以我們利用class(matleave[2, -1])來查看matleave資料集第二行和除了第一列外所有列的資料類型。這個操作返回的是一個data.frame的資料類型，因為即使是單一行的選取，R仍然保持了資料的data.frame結構。 然而，當我們嘗試使用barplot()函數繪製長條圖時，就不能直接把data.frame給barplot()進行繪製。。這是因為barplot()函數期望的輸入是一個vector。因此，我們使用unlist(matleave[2, -1])將單行的data.frame轉換成vector。unlist()函數的作用是將一個列表（或在這個案例中是data.frame）中的所有元素合併成一個vector，這樣就可以用於barplot()。 為了進一步理解這種差異，我們可以使用class()或str()函數來觀察未經unlist()處理的資料。這將顯示出資料仍然保留在data.frame結構中，與unlist()後轉換為vector的結構有顯著的不同。這種轉換對於使用某些特定的繪圖函數，如barplot()，是必要的，因為它們需要一個vector作為輸入來正確地繪製圖形。 4.4.6.1 Plotting one row (one country) # barplot() the second row of m55 # barplot(m55[2, ]) # raise error # barplot() the second row when neglecting the first column # barplot(m55[2, -1]) # raise error # Take a look at the data type of matleave[2, ] class(matleave[2, -1]) ## [1] "tbl_df" "tbl" "data.frame" class(unlist(matleave[2, -1])) ## [1] "numeric" # unlist() to convert a single row data.frame to a vector for barplot() barplot(unlist(m55[2, -1])) Testing # View(matleave[1]) # select the 1st variable # View(matleave[ ,1]) # select the 1st column # View(matleave[1, ]) # select the 1st row class(m55[1]) # "tbl_df" "tbl" "data.frame" ## [1] "tbl_df" "tbl" "data.frame" class(m55[ ,1]) # "tbl_df" "tbl" "data.frame" ## [1] "tbl_df" "tbl" "data.frame" class(m55[1, ]) # "tbl_df" "tbl" "data.frame" ## [1] "tbl_df" "tbl" "data.frame" class(m55$iso3) # character (vector) ## [1] "character" 4.4.6.2 More arguments (args) 接下來我們要微調一下視覺化的結果。這行程式碼使用R中的barplot函數繪製一個長條圖，其中的參數說明如下： unlist(m55[2, -1]): 將m55資料集的第2行（不包括第1欄）轉換為一個向量，並作為長條圖的高度（即每個長條的高度）。 ylim=c(0, 5): 設置y軸的範圍為0到5，即長條圖的最大高度為5。 space=0: 設置相鄰兩個長條之間的距離為0，即長條緊密相連。 border=NA: 設置長條的邊框為透明，即不顯示邊框。 xaxt=\"n\": 不顯示x軸的標籤。 yaxt=\"n\": 不顯示y軸的標籤。 # barplot() the unlisted second row (neglecting the first col) barplot(unlist(m55[2, -1])) # use ?barplot to know more argument of the function. ?barplot # Add arguments ylim, space, border, and axat/yaxt one by one to barplot() barplot(unlist(m55[2, -1]), ylim=c(0, 5)) barplot(unlist(m55[2, -1]), ylim=c(0, 5), space=0) barplot(unlist(m55[2, -1]), ylim=c(0, 5), space=0, border=NA) barplot(unlist(m55[2, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") 4.4.6.3 Plotting multiple lines 我們已經成功繪製了一個國家的資料，接下來我們要繪出所有國家的資料。以m55這個篩選後的資料為例，我分別要繪製出第1列至第6列的國家。底下可以看見每一行非常相似且一致的特徵，僅有matleave內的索引由1被列出至6。對於這種重複的程式碼，最好的方法是用迴圈（for-loop）的方式將相同的程式碼，從1~6之間做六次。 # plot the first row barplot(unlist(m55[1, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") # plot the second to 6th rows barplot(unlist(m55[2, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") barplot(unlist(m55[3, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") barplot(unlist(m55[4, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") barplot(unlist(m55[5, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") barplot(unlist(m55[6, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") 4.4.6.4 for-loop to plot multiple lines 這段R語言程式碼使用for-loop來重複執行一個指定的程式區塊，將m55資料集的前六行資料分別繪製成長條圖。在這段程式碼中，變數i控制了for-loop的迭代次數，它從1到6依次取值，然後依次執行所指定的程式區塊。 一般的for-loop的結構如下：for (variable in sequence) {# code block to be executed}。其中，變數variable是用來控制for-loop的迭代次數的，它會從序列sequence中逐一取出元素，並將其賦值給變數variable，然後執行大括號{...}中所指定的程式區塊。 # use for loop and use i as index to barplot multiple subgraphs for(i in 1:6){ barplot(unlist(m55[i, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") } 4.4.6.5 Subplots 但這樣一個國家就要畫成一個Plot，如果要將多個國家、也就是多個Plots繪製在同一張圖上的話，R也有支援Subplot的函式與設定。在R語言中，par（parameter的縮寫）是一個用於設置繪圖參數的函數，通過它可以控制繪圖的外觀、尺寸、排列等各方面，以便更好地展示數據和分析結果。par函數可以用來設置以下參數： mfrow：設置畫布的分割，即將畫布分為多少行和多少列，例如mfrow=c(3,2)代表三列二行。 mai：設置畫布的邊緣大小，包括上下左右四個邊緣的大小。 cex：設置字體大小的縮放比例。 col：設置線條、點和字體的顏色。 pch：設置散點圖中點的形狀。 lty：設置線條的類型。 在這段程式碼中，par函數被用來設置畫布的分割和邊緣大小，具體來說，par(mfrow=c(3,2), mai= c(0.2, 0.2, 0.2, 0.2))表示將畫布分為3行2列的子圖，並設置邊緣大小為0.2，包括上下左右四個邊緣。這樣可以方便地在同一張畫布上顯示多個圖形，並控制它們之間的排列和間距。 # use ?par to get more plotting parameters ?par # use par() to set-up the layout of subgraphs # use the parameter main=c(0.2, 0.2, 0.2, 0.2) to thrink the padding of figures. par(mfrow=c(3,2), mai= c(0.2, 0.2, 0.2, 0.2)) for(i in 1:6){ barplot(unlist(m55[i, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") } 接下來我們用相同的for-loop來繪製10張子圖（十個國家）看看。會發現mfrow=c(3,2)可以容納六張子圖，多餘六張子圖時，會繪製至下一張。 # plot more rows to see what happens par(mfrow=c(3,2), mai= c(0.2, 0.2, 0.2, 0.2)) for(i in 1:10){ barplot(unlist(m55[i, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") } # plot all subplots in a figure 最後，我用nrow(m55)來取得m55這個data.frame共有多少個國家，然後，我讓for-loop從1:nrow(m55)相當於繪製完所有m55中的子圖。注意我已經修改了mfrow為mfrow=c(4, 6)。 # nrow() to check number of row of m55. nrow(m55) ## [1] 18 # use par() to set-up plotting parameters. par(mfrow=c(4, 6), mai= c(0.2, 0.2, 0.2, 0.2)) # use for-loop to plot all graph as subgraph for (i in 1:nrow(m55)){ barplot(unlist(m55[i, -1]), border=NA, space=0, xaxt="n", yaxt="n", ylim = c(0,5)) } 在每個子圖上，我要加上每個國家的國別代碼iso3，也就是m55的第一行，我用同樣的i來掃過每一列，繪製完barplot()後，便用title()函式來繪製文字。結果如下。注意我的設定title(m55[i,1], line = -4, cex.main=3)。line為繪製文字的基線，而cex.main是字型大小。 par(mfrow=c(4,6), mai= c(0.2, 0.2, 0.2, 0.2)) for (i in 1:nrow(m55)){ barplot(unlist(m55[i, -1]), border=NA, space=0,xaxt="n", yaxt="n", ylim = c(0,5)) title(m55[i,1], line = -4, cex.main=3) } 4.4.7 Practice. Plotting more 請繪製m05的資料，也就是matleave_95!=5但matleave_13==5的資料。 請繪製m04的資料，也就是matleave_95!=4但matleave_13==4的資料。 請繪製m44的資料，也就是matleave_95==4但matleave_13==4的資料。 # plotting matleave_95 != 5 but matleave_13 == 5 # plotting for matleave_13 == 4 4.4.8 Practice. Selecting and filtering by dplyr I 請嘗試問問ChatGPT，如果將以下程式碼改為dplyr的寫法，要怎麼寫。 df <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) # select columns by index # matleave <- df[ , c(3, 6:24)] # select all NA cells and assign 0 to them # matleave[is.na(matleave)] <- 0 # filter rows by condition # m5 <- matleave[matleave$'matleave_13' == 5, ] # filter rows by condition # m55<- m5[m5$'matleave_95' == 5,] # plot par(mfrow=c(4,6), mai= c(0.2, 0.2, 0.2, 0.2)) for (i in c(1:nrow(m55))){ barplot(unlist(m55[i,-1]), border=NA, space=0,xaxt="n", yaxt="n", ylim = c(0,5)) title(m55[i,1], line = -4, cex.main=3) } 4.4.9 (More) Clean version # readxl::read_excel() to import the xls file df <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) # select iso3, and matleave columns by index matleave <- df[ , c(3, 6:24)] # str() to inspect the data structure of str(matleave) ## tibble [197 × 20] (S3: tbl_df/tbl/data.frame) ## $ iso3 : chr [1:197] "AFG" "ALB" "DZA" "AND" ... ## $ matleave_95: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_96: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_97: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_98: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_99: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_00: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_01: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_02: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_03: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_04: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_05: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_06: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_07: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_08: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_09: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_10: num [1:197] 2 5 3 3 2 2 2 5 NA 5 ... ## $ matleave_11: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_12: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_13: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... # select all NA cells and assign 0 to them matleave[is.na(matleave)] <- 0 # filter rows by condition m5 <- matleave[matleave$'matleave_13' == 5, ] # filter rows by condition m55<- m5[m5$'matleave_95' == 5,] # plot par(mfrow=c(4,6), mai= c(0.2, 0.2, 0.2, 0.2)) for (i in c(1:nrow(m55))){ barplot(unlist(m55[i,-1]), border=NA, space=0,xaxt="n", yaxt="n", ylim = c(0,5)) title(m55[i,1], line = -4, cex.main=3) } 4.4.10 (More) The fittest version to compute staySame # staySame version # staySame <- apply(m5[,2:20], 1, function(x) length(unique(x[!is.na(x)]))) # m55 <- m5[staySame, ] # m50 <- m5[!staySame, ] "],["crosstab.html", "Chapter 5 Counting and Cross-tabulation 5.1 Taipei Residential Burglary 5.2 Read online files 5.3 Counting Review 5.4 Pivoting long-wide tables 5.5 Residuals analysis", " Chapter 5 Counting and Cross-tabulation 交叉分析是一種對兩個或多個變數進行聯合分析的方法，通常用於研究不同類別或組別之間的關係和差異。交叉分析可以幫助我們發現變數之間的相互作用，以及不同類別或組別之間的異同點，進而進行更深入的分析和解釋。 在交叉分析中，通常會使用交叉表（cross tabulation）或稱為列聯表（contingency table）來對變數進行分析。交叉表是一種二維資料表格，其中一個變數作為行，另一個變數作為列，每個資料格中則表示兩個變數的交叉次數或百分比。交叉表可以幫助我們從不同角度瞭解變數之間的關係和差異，例如： 發現變數之間的相關性：可以通過交叉表計算兩個變數之間的相關係數或卡方檢定值，以評估它們之間的相關性程度。 比較不同類別或組別之間的差異：可以通過交叉表比較不同類別或組別之間的差異，例如不同性別、年齡、教育程度、地區等對某一變數的影響。 發現變數之間的交互作用：可以通過交叉表比較不同類別或組別之間的差異，並分析它們之間的交互作用，以進一步瞭解變數之間的關係和影響。 5.1 Taipei Residential Burglary 觀察值、點位資料：公部門所發布的開放資料通常會根據某些類別進行統計，例如年齡、性別、教育程度、地區等等，只有少部分的資料會用觀察值（Observation）的方式來記錄，也就是每一個案例紀錄一筆資料。例如疫情一開始人數還少的時候，會逐一記錄每個個案；地理資訊系統上面記錄某些機構或某些特定地點的時候也是點位資料；或在觀察輿情時，每筆發言或留言都是一筆觀察值。「臺北市住宅竊盜點位資訊」就是逐案紀錄的點位資料。而以下的例子也是點位資料，主要為主要為噪音、竊盜、交通事故等相關點位資料。 臺北市街頭隨機強盜案件點位資訊、 臺北市街頭隨機搶奪案件點位資訊、 臺北市汽車竊盜點位資訊、 臺北市機車竊盜點位資訊、 臺北市自行車竊盜點位資訊、 臺北市道路交通事故斑點圖、 臺北市娛樂營業場所噪音告發案件點位資訊、 臺北市非營業用卡拉OK噪音告發案件點位資訊、 臺北市營建工程噪音告發案件點位資訊等， 5.1.1 讀取檔案 規劃比較完善的開放資料平台會提供API給程式設計者存取，例如臺北資料大平台或內政部開放資料平台。但我們這邊用下載CSV（Common Separated Value）檔的方式來讀取這筆資料，以理解CSV這種檔案型態如何儲存資料。首先要至臺北資料大平台上查詢「住宅竊盜」，可以找到臺北市住宅竊盜點位資訊。將該CSV檔下載至個人本機端，置入data 資料夾中，便可以用read.csv()讀取該檔案。或可用tidyverse系列套件中的readr::read_csv()來直接讀取該網址所指到的檔案。 我習慣在Console視窗中用??read_csv()查詢到這些函式的用法。 read.csv() to read csv and convert it to a data.frame readr::read_csv() to read csv or read a csv by an url 如果知道這個套件是readr的話，也可以到右下方的工作區塊找到「Packages」工作視窗，裡面有列出現在載入的所有的套件，也有套件中的所有函式。偶而看一看會發現一些自己平常忽略的好用工具。 library(knitr) library(kableExtra) library(tidyverse) df <- read.csv("data/臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv") head(df) ## 編號 案類 發生日期 發生時段 發生地點 ## 1 1 住宅竊盜 1030623 08~10 臺北市中正區廈門街91~120號 ## 2 2 住宅竊盜 1040101 00~02 臺北市文山區萬美里萬寧街1~30號 ## 3 3 住宅竊盜 1040101 00~02 臺北市信義區富台里忠孝東路5段295巷6弄1~30號 ## 4 4 住宅竊盜 1040101 06~08 臺北市中山區新生北路1段91~120號 ## 5 5 住宅竊盜 1040101 10~12 臺北市文山區明興里興隆路4段1~30號 ## 6 6 住宅竊盜 1040102 00~02 臺北市士林區天福里1鄰忠誠路2段130巷1~30號 用read_csv()來讀取。除了 base套件的read.csv()外，也可使用readr套件的read_csv()函式來讀取，該套件屬於tidyverse套件系的其中一個套件，如果已經有用install.packages(\"tidyverse\")安裝過，只要用library(tidyverse)就可以使用read_csv()函式。在此鼓勵各位使用tidyverse系列套件。普遍來說，read_csv() 的功能和效果都會比read.csv()好，該函式還會自動猜測每個變數的變數型態並直接進行轉換（尤其是有時間欄位的時候，會非常方便）。 萬一遇到中文檔案會有讀檔編碼問題時，有可能該檔案是用big5來儲存的，可以在read_csv()中設定locale來指定讀取的編碼方法。如read_csv(url, locale = locale(encoding = \"Big5\")) library(readr) df <- read_csv("data/臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv") # df <- read_csv("data/臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv", locale = locale(encoding = "Big5")) head(df) ## # A tibble: 6 × 5 ## 編號 案類 發生日期 發生時段 發生地點 ## <dbl> <chr> <dbl> <chr> <chr> ## 1 1 住宅竊盜 1030623 08~10 臺北市中正區廈門街91~120號 ## 2 2 住宅竊盜 1040101 00~02 臺北市文山區萬美里萬寧街1~30號 ## 3 3 住宅竊盜 1040101 00~02 臺北市信義區富台里忠孝東路5段295巷6弄1~30號 ## 4 4 住宅竊盜 1040101 06~08 臺北市中山區新生北路1段91~120號 ## 5 5 住宅竊盜 1040101 10~12 臺北市文山區明興里興隆路4段1~30號 ## 6 6 住宅竊盜 1040102 00~02 臺北市士林區天福里1鄰忠誠路2段130巷1~30號 5.1.1.1 觀察變數 names(df) 列出所有變數名稱 df$發生地點 顯示該變數內容 df$發生時段 顯示該變數內容 length(df$發生時段) 顯示該變數的長度（相當於有幾個） 5.1.2 萃取所需新變項 該data.frame包含編號、案類、發生日期、發生時段、發生地點五個變項。其中比較有意義的應該是發生日期、發生時段和發生地點。然而，發生地點幾乎是完整地址，除非要繪製發生的地圖點位地圖，才會需要近乎完整的地址。假設我們的目標是抽取出台北市的「行政區」，發生地點的格式還蠻一致的如「臺北市中正區廈門街91~120號」。因此，我們只要抽出發生地點的第4至6個字即可。 從一個字串中抽取出第n個字到第m個字，要用substr()或stringr套件的str_sub()。可以用?substr或?str_sub查詢help中的相關用法。在此 我將中文變數現在時間的資料指給一個新的英文變項time。 從變數發生地點，用substr()取出行政區（region） 或用stringr::str_sub() ?substr查詢其用法和意義。相當於getting sub string since x to y。 # Get substring of var "發生時段" and assign to a new time var df$time <- df$發生時段 # Get substring of var "發生地點" and assign to a new region var df$region <- substr(df$發生地點, 4, 5) head(df) ## # A tibble: 6 × 7 ## 編號 案類 發生日期 發生時段 發生地點 time region ## <dbl> <chr> <dbl> <chr> <chr> <chr> <chr> ## 1 1 住宅竊盜 1030623 08~10 臺北市中正區廈門街91~120號 08~10 中正 ## 2 2 住宅竊盜 1040101 00~02 臺北市文山區萬美里萬寧街1~30號 00~02 文山 ## 3 3 住宅竊盜 1040101 00~02 臺北市信義區富台里忠孝東路5段29… 00~02 信義 ## 4 4 住宅竊盜 1040101 06~08 臺北市中山區新生北路1段91~120號 06~08 中山 ## 5 5 住宅竊盜 1040101 10~12 臺北市文山區明興里興隆路4段1~30… 10~12 文山 ## 6 6 住宅竊盜 1040102 00~02 臺北市士林區天福里1鄰忠誠路2段1… 00~02 士林 5.1.3 使用table()計數 清理完資料後，我們要回答的第一個數據問題通常是「那XXX的案例有幾個？」例如：大安區有多少竊盜案？10~12這個時段有多少案例。 table()函式可以對Vector中的值進行計數（Counting）。table(df$time) 相當於去計數不同的時間區間出現多少起案例；table(df$region) 相當於去計數不同地區各出現多少起案例。 提示：可以用class(tb_1) 觀察用table() 計數後所產生的資料型態（table）。 ## table # counting the frequency of region variable (table(df$region)) ## ## 中山 中正 信義 內湖 北投 南港 士林 大同 大安 文山 松山 萬華 ## 438 263 214 303 318 181 373 172 311 204 220 350 # counting the frequency of time variable (tb_1 <- table(df$time)) # %>% View ## ## 00~02 02~04 03~05 04~06 05~07 06~08 08~10 09~11 10~12 11~03 11~13 12~14 12~15 ## 272 214 8 156 23 191 305 6 338 1 26 338 2 ## 14~16 15~17 15~18 16~18 17~19 18~20 18~21 19~21 20~22 21~23 21~24 22~24 23~01 ## 342 3 1 246 21 314 1 4 303 5 1 206 20 class(tb_1) ## [1] "table" 5.1.4 依變數值篩選資料 該項竊盜案資料整理時經常不慎用不同的時間區間來標記，有時候也會不小心把新北市的資料給那進來，所以需要做資料篩選。從各個時間區間的竊盜案出現次數來觀察，有少數的案件出現在奇數的時間區間如09~11或12~15等等需要篩除；從各個行政區的竊盜案出現次數來觀察，確實都是台北市的竊盜案。 接下來要用base套件的R，根據某個變數值（例如上述的時間）來篩出符合條件的資料，或者篩去不符合條件的資料。其語法是要在df[ , ]逗號前加上篩選的條件，也就是對資料列進行篩選，篩出或篩除都是以整列為單位。在此的條件是df$time在00~02、02~04、…之間；或者是df$time不在03~05、05~07、…之間。表示法分別如下： df$time %in% c("00~02", "02~04", "04~6",...) !df$time %in% c("03~05", "05~07", ...) %in% 表示的是左方df$time的值是否是右方Vector中的其中一個 如果要表示不包含，就在df%time加一個NOT，也就是!。 依照各組時間的案例個數統計後，篩除資料未足100的時間區間如下，最後再用table(df$time) 計算一次，發現每個時段都兩三、百個案例，且涵蓋整日的時間。清理後沒有重疊的時間區間，做類別資料分析會比較準確。 # filter out irrelevant timestamp df <- df[!df$time %in% c("03~05", "05~07", "09~11", "11~13", "11~03", "12~15", "15~17", "15~18", "17~19", "18~21", "19~21", "21~23", "21~24", "23~01"), ] table(df$time) ## ## 00~02 02~04 04~06 06~08 08~10 10~12 12~14 14~16 16~18 18~20 20~22 22~24 ## 272 214 156 191 305 338 338 342 246 314 303 206 # filter out irrelevant region(area) # df <- df[!df$region %in% c("三重", "中和", "淡水", "板橋"), ] 5.1.5 做雙變數樞紐分析：table() 類別變項分析通常是要考驗兩個變項間的關係，從上述的計數中，我可以看見不同行政區或者不同時間的竊盜案數量，但我進一步想知道，那不同行政區的竊盜案常發生時間是否不同？這時後就要做時間和行政區的交叉分析。我們同樣可以用table()和tapply()來做兩個變項的交叉分析，寫法如下。 用table()來交叉分析的結果如下，所得到的結果之變數型態仍是table型態。 # Tabulating time and region variables (res_table <- table(df$time, df$region)) ## ## 中山 中正 信義 內湖 北投 南港 士林 大同 大安 文山 松山 萬華 ## 00~02 62 15 27 20 24 19 28 15 24 17 4 17 ## 02~04 26 22 12 15 17 12 29 10 15 14 13 29 ## 04~06 22 7 11 15 17 6 14 15 14 8 5 22 ## 06~08 20 19 13 16 24 13 17 9 19 9 11 21 ## 08~10 45 27 20 27 22 16 24 17 31 18 24 34 ## 10~12 38 20 18 33 35 19 35 12 34 18 35 41 ## 12~14 30 25 20 26 34 15 46 12 49 25 23 33 ## 14~16 43 19 18 39 32 20 40 26 32 19 22 32 ## 16~18 21 19 8 24 33 11 30 13 25 16 20 26 ## 18~20 39 42 23 22 40 18 31 13 23 23 17 23 ## 20~22 40 13 22 34 17 20 41 13 26 15 25 37 ## 22~24 33 20 16 18 15 9 23 9 12 17 14 20 # Checking it class and its content class(res_table) ## [1] "table" ## [1] "table" 5.1.6 繪圖 通常這種類別資料交叉分析最常用的圖表型態之一便是Mosaic Plot（但事實上Mosaic Plot不見能夠被一眼就了解）。我們可以把交叉分析後的變項res_table直接用MosaicPlot來繪圖。 # mosaicplot() to plot 2-dim categorical vars. mosaicplot(res_table) # Add argument main (figure title) mosaicplot(res_table, main="mosaic plot") 5.1.6.1 解決圖表無法顯示中文 大部分的視覺化套件都無法順利顯示中文，除非特別指定所要用的中文字型。這方面網路上可以找到很多的說明，但非常討厭的是，幾乎每換一套視覺化工具，換一套語言，就有不同的中文字體指定方式。例如用base的plot()來繪圖或用ggplot()的中文字型指定方法便不同，且軸上面有中文、圖標有中文、或者圖內有中文都要分開指定，非常討人厭。 Mosaic Plot屬於base R的plot()，其中文指定方法要指定在繪圖前的par()函式中（par為parameter的意思），指定方法為par(family=('Heiti TC Light'))，Heiti TC Light為字體名稱，為OSX上在用的黑體細字，STKaiti則為標楷體。然後，par()和mosaicplot()兩個函式要「同時執行」，也就是請你直接用shift-cmd(ctrl)-Enter執行整個code-cell，或者將該兩個函式選起來一次執行。 par(family=('STKaiti')) # par(family=('Heiti TC Light')) mosaicplot(res_table, main="mosaic plot", color=T) 5.1.6.2 自訂顏色 目前顏色實在過醜，你可以自訂顏色指給mosaicplot()。例如我底下便產製了12種顏色後，將其作為mosaicplot()的參數 # Set up color by yourself. colors <- c('#D0104C', '#DB4D6D', '#E83015', '#F75C2F', '#E79460', '#E98B2A', '#9B6E23', '#F7C242', '#BEC23F', '#90B44B', '#66BAB7', '#1E88A8') # par(family=('STKaiti')) par(family=('Heiti TC Light')) mosaicplot(res_table, color=colors, border=0, off = 3, main="Theft rate of Taipei city (region by hour)") 5.1.7 Practices 5.1.7.1 萃取月份作為新變項month 除了時間和地區可能會有差別外，那月份會不會竊盜案的數量也有差異呢？會不會冬天小偷也都在家休息了，夏天多呢？請嘗試從發生日期萃取出竊盜案發生的月份，並儲存為一個新的變項month。 5.1.7.2 使用count()來計數 請練習看看如果用count()來計數單一變項，如前述的region、time或前面練習中新產生的month。 5.1.7.3 分週末與週間計算 使用lubridate套件可以將文字表示的日期轉換為R的時間物件，進而可以用lubridate的wday()函式求取該日期是週幾，便可以計算，週間和週末的竊盜率有何差別。可以先計算看看，週一到週日分別有什麼差別，再去計算週間與週末的平均會有什麼差別（要注意，週末和週間天數並不同） 5.2 Read online files 方法一：直接依資料網址讀取檔案。現在的程式語言所設計的讀取檔案函式通常會允許使用者直接讀取資料所在的URL。所以，我們可以直接從網路上載入台北市竊盜案資料。首先要至臺北資料大平台上查詢「住宅竊盜」，可以找到臺北市住宅竊盜點位資訊，點選後對右上方的下載按右鍵可取得鏈結到該資料的URL（如https://data.taipei/api/getDatasetInfo/downloadResource?id=68785231-d6c5-47a1-b001-77eec70bec02&rid=93d9bc2d-af08-4db7-a56b-9f0a49226fa3）。 由於該資料網址似非永久網址，故本範例並未執行以下程式碼，僅提供範例程式碼讓個人替換網址來做測試。 方法二：用R程式將該網址的檔案抓回本機端儲存。部分Mac電腦無法使用read.csv()從網路上取得資料又轉為data.frame，一個可行的辦法是先用GET(url,write_disk(\"data/tptheft.csv\"))將其取回並命名為data/tptheft.csv，之後再用df <- read.csv(\"data/tptheft.csv\")直接讀取該檔案。 {library(httr)} GET(url, write_disk(\"data/tptheft.csv\", overwrite = TRUE)) df <- read.csv(\"data/tptheft.csv\") 5.3 Counting Review 5.3.1 tapply() 我們也可用tapply() 函式來達到一樣的目的。Apply家族的函式都是，針對某個資料，將某個函式套用到某個物件上。tapply() 即是用來做計數的，tapply(df$編號, df$time, length)有三個輸入，第一個輸入為整體物件，第二個輸入為要據以彙整的變項，在此為df$time，第三個是要用來彙整的函式，因為這裡要做計數，所以要用length函式。 註：同樣用class()來觀察彙整後的資料型態為array，和前者的table資料型態不同。 5.3.2 tapply() two variables 用tapply()來做兩個變數交叉分析的語法如下，必須要把兩個Vector包在一個list()中。其他不變。兩個變項用tapply()交叉分析後的結果，變數型態會變成matrix。前者用table()來交叉分析的仍是table型態。 res_tapply ## 中山 中正 信義 內湖 北投 南港 士林 大同 大安 文山 松山 萬華 ## 00~02 62 15 27 20 24 19 28 15 24 17 4 17 ## 02~04 26 22 12 15 17 12 29 10 15 14 13 29 ## 04~06 22 7 11 15 17 6 14 15 14 8 5 22 ## 06~08 20 19 13 16 24 13 17 9 19 9 11 21 ## 08~10 45 27 20 27 22 16 24 17 31 18 24 34 ## 10~12 38 20 18 33 35 19 35 12 34 18 35 41 ## 12~14 30 25 20 26 34 15 46 12 49 25 23 33 ## 14~16 43 19 18 39 32 20 40 26 32 19 22 32 ## 16~18 21 19 8 24 33 11 30 13 25 16 20 26 ## 18~20 39 42 23 22 40 18 31 13 23 23 17 23 ## 20~22 40 13 22 34 17 20 41 13 26 15 25 37 ## 22~24 33 20 16 18 15 9 23 9 12 17 14 20 # View(res) 5.3.3 dplyr::count() two variables 這邊多介紹一個用dplyr套件的count()函式來做交叉分析的方法（未來會常用這個方法，因為dplyr是tidyverse系列套件的核心套件。dplyr的函式第一個參數永遠是該data.frame， 例如count()；後面time與region則是這個data.frame中的兩個變項。不像tapply()或table()的結果一樣，欄與列分別為time與region，count()出來的結果會有兩個變項分別是指定要計數的time與region ，且會新增一個變項n，代表這組數據（time x region）共有幾個。這種表達型態通常稱為long-table（長表）、而tapply()或table() 的結果通常稱為wide-table（寬表）為典型的交叉分析表。 目前大部分的類別資料分析還是會採用交叉分析表的型態，但未來我們要用tidyverse系列套件做大量的數據彙整或視覺化時，都會盡可能想辦法轉為Long-table型態，讓每一欄剛好就是一個變項。只要是tidyverse系列套件所計算出來的資料型態幾乎都是類似data.frame的型態，例如觀察count的結果便是\"tbl_df\" \"tbl\" \"data.frame\"。 5.4 Pivoting long-wide tables 5.4.1 long-to-wide 那長表列可以轉為寬表嗎？可以，tidyverse系列套件中的tidyr套件有個函式spread()可以接著把某個變項展開為欄。例如原本上述的列是時間與行政區的交叉組合，但我可以把行政區展開為欄、或者把時間展開為欄 。如下例，spread(res_count, region, n, fill = 0) 有四個參數，遵循tidyverse系列套件的規則，第一個位置為data.frame，第二個參數則是要被展開至欄的變項這裡為region，第三個參數則是因應region被展開後，那中間交叉分析的數值就是n，最後一個參數是避免spread時有些交叉組是沒有資料的，因此fill=0可以指定，如果某個time x region的交叉組別是沒資料的，就填上0，也有可能是用fill=NA填上NA。以下的例子中也提供了將time 展開至欄的寫法供參考。 現在spread()函式已經被新的函式取代，為pivot_wider()。spread(res_count, region, n, fill = 0) 在此需要改寫為pivot_wider(res_count, names_from = region, values_from = n, values_fill = 0)。大致上和spread()用法是一樣的，只是要寫清楚，哪個變數要給哪一個參數。 展開後的資料型態和前者計數後的資料型態一樣，都是\"tbl_df\" \"tbl\" \"data.frame\"。這是為什麼tidyverse系列的套件逐漸變成R的顯學的原因之一。 library(tidyr) # spreading the region into columns # (res_count_spread <- spread(res_count, region, n, fill = 0)) res_count_spread <- pivot_wider(res_count, names_from = region, values_from = n, values_fill = 0) class(res_count_spread) ## [1] "tbl_df" "tbl" "data.frame" # spreading the time into columns # res_count_spread <- spread(res_count, time, n, fill = 0) res_count_spread # %>% View ## # A tibble: 12 × 13 ## time 中山 中正 信義 內湖 北投 南港 士林 大同 大安 文山 松山 萬華 ## <chr> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> ## 1 00~02 62 15 27 20 24 19 28 15 24 17 4 17 ## 2 02~04 26 22 12 15 17 12 29 10 15 14 13 29 ## 3 04~06 22 7 11 15 17 6 14 15 14 8 5 22 ## 4 06~08 20 19 13 16 24 13 17 9 19 9 11 21 ## 5 08~10 45 27 20 27 22 16 24 17 31 18 24 34 ## 6 10~12 38 20 18 33 35 19 35 12 34 18 35 41 ## 7 12~14 30 25 20 26 34 15 46 12 49 25 23 33 ## 8 14~16 43 19 18 39 32 20 40 26 32 19 22 32 ## 9 16~18 21 19 8 24 33 11 30 13 25 16 20 26 ## 10 18~20 39 42 23 22 40 18 31 13 23 23 17 23 ## 11 20~22 40 13 22 34 17 20 41 13 26 15 25 37 ## 12 22~24 33 20 16 18 15 9 23 9 12 17 14 20 # ??dplyr::count 5.4.2 Wide-to-long 寬表格亦可用tidyr的gather()函式轉回長表格型態。但gather()近期也已經被新的函式pivot_longer()取代。原先的gather(res_count_spread, region, n, -time)應取代為pivot_longer(res_count_spread, -time, names_to = \"region\", values_to = \"n\")。 # (long_table <- tidyr::gather(res_count_spread, region, n, -time)) long_table <- pivot_longer(res_count_spread, -time, names_to = "region", values_to = "n") 5.5 Residuals analysis mosaicplot()有幾個參數可以用，包含off與shade可用於呈現殘差分析。 off: vector of offsets to determine percentage spacing at each level of the mosaic (appropriate values are between 0 and 20, and the default is 20 times the number of splits for 2-dimensional tables, and 10 otherwise). Rescaled to maximally 50, and recycled if necessary. shade: a logical indicating whether to produce extended mosaic plots, or a numeric vector of at most 5 distinct positive numbers giving the absolute values of the cut points for the residuals. By default, shade is FALSE, and simple mosaics are created. Using shade = TRUE cuts absolute values at 2 and 4. # par(family=('STKaiti')) par(family=('Heiti TC Light')) mosaicplot(res_table, color=T, shade = T, border=0, off = 3, main="Theft rate of Taipei city (region by hour)") "],["base2dplyr.html", "Chapter 6 From base R to dplyr 6.1 dplyr 6.2 Taipie Theft Count (base to dplyr) 6.3 Paid Maternity Leave", " Chapter 6 From base R to dplyr From base to tidyverse style 相較於R base的較為傳統的R編程風格，tidyverse style的R programming具有以下幾個特點： 基於tidy data理念：tidyverse style的R programming基於tidy data理念，即資料應該以規律的方式組織，以方便分析和視覺化。tidyverse style的R程式庫提供了一些工具和函數，用於處理和轉換tidy data格式的資料，如dplyr、tidyr等。 使用管道操作符：tidyverse style的R programming通常使用管道操作符（%>%），將資料通過多個函數連接起來，形成一個清晰和易於理解的資料處理流程。使用管道操作符可以簡化程式碼並提高程式的可讀性。 強調函數庫的一致性：tidyverse style的R programming強調函數庫之間的一致性，即不同函數庫之間使用相似的函數名稱、參數名稱和返回值等，以方便使用者的學習和使用。 使用簡潔的命名方式：tidyverse style的R programming通常使用簡潔和易於理解的變數和函數命名方式，例如使用動詞表示操作，使用名詞表示資料，以方便使用者理解程式碼的含義。 提供高級的視覺化工具：tidyverse style的R programming提供了一些高級的視覺化工具，如ggplot2、gganimate等，可以幫助使用者更加輕鬆地進行資料視覺化和探索。 6.1 dplyr dplyr是一個tidyverse風格的R程式庫，用於對資料進行快速、一致、直觀的操作和轉換。dplyr提供了一些高效能的函數和工具，如filter、select、mutate、group_by和summarize等，用於對資料進行選擇、篩選、轉換、分組和摘要等操作。 以下是dplyr常用的函數： filter：用於選擇符合特定條件的資料列。 select：用於選擇特定的欄位。 mutate：用於新增或修改欄位。 group_by：用於按照特定欄位進行分組。 summarize：用於對分組後的資料進行摘要統計。 arrange：用於按照欄位的特定順序進行排序。 dplyr具有以下優點： 簡潔而直觀的語法：dplyr的函數名稱和語法都十分簡潔而直觀，易於使用和理解，尤其對於新手來說更加友好。 高效的運行速度：dplyr的設計考慮了資料處理的效率，使用C++實現了部分函數，因此dplyr在處理大型資料集時運行速度較快。 與tidyverse相容：dplyr與其他tidyverse程式庫，如ggplot2和tidyr，可以很好地相容，並且能夠與其他常用的R程式庫進行集成，提供更加全面和高效的資料分析和可視化工具。 6.2 Taipie Theft Count (base to dplyr) library(tidyverse) # options(stringsAsFactors = F) # default options in R ver.> 4.0 6.2.1 Reading data # Read by read_csv() # Will raise error # Error in make.names(x) : invalid multibyte string at '<bd>s<b8><b9>' # df <- read_csv("data/tp_theft.csv") # read_csv() with locale = locale(encoding = "Big5") library(readr) df <- read_csv("data/臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv") 6.2.2 Cleaning data I Renaming variables by select() Generating variable year by mutate() Generating variable month by mutate() Retrieving area by mutate() 6.2.2.1 (1) Without pipeline I df1 <- select(df, id = 編號, cat = 案類, date = `發生日期`, time = `發生時段`, location = `發生地點`) df2 <- mutate(df1, year = date %/% 10000) df3 <- mutate(df2, month = date %/% 100 %% 100) df4 <- mutate(df3, area = str_sub(location, 4, 6)) selected_df <- mutate(df4, county = str_sub(location, 1, 3)) 6.2.2.2 (2) Without pipeline II library(stringr) selected_df <- select(df, id = 編號, cat = 案類, date = `發生日期`, time = `發生時段`, location = `發生地點`) selected_df <- mutate(selected_df, year = date %/% 10000) selected_df <- mutate(selected_df, month = date %/% 100 %% 100) selected_df <- mutate(selected_df, area = str_sub(location, 4, 6)) selected_df <- mutate(selected_df, county = str_sub(location, 1, 3)) 6.2.2.3 (3) With pipeline library(stringr) selected_df <- df %>% select(id = 編號, cat = 案類, date = `發生日期`, time = `發生時段`, location = `發生地點`) %>% mutate(year = date %/% 10000) %>% mutate(month = date %/% 100 %% 100) %>% mutate(area = str_sub(location, 4, 6)) %>% mutate(county = str_sub(location, 1, 3)) 6.2.3 Cleaning data II Filtering out irrelevant data records # readr::guess_encoding("data/tp_theft.csv") filtered_df <- selected_df %>% # count(year) %>% View filter(county == "臺北市") %>% filter(year >= 104) %>% # count(time) %>% View # count(location) %>% filter(!area %in% c("中和市", "板橋市")) 6.2.4 Long to wide form count() two variables pivot_wider() spread one variable as columns to wide form # count() then pivot_wider() df.wide <- filtered_df %>% count(time, area) %>% pivot_wider(names_from = area, values_from = n, values_fill = 0) ??pivot_wider 6.2.5 Setting time as row.name for mosaicplot row.names(df.wide) <- df.wide$time df.wide$time <- NULL # Specify fonts for Chinese # par(family=('STKaiti')) par(family=('Heiti TC Light')) # for mac # Specify colors colors <- c('#D0104C', '#DB4D6D', '#E83015', '#F75C2F', '#E79460', '#E98B2A', '#9B6E23', '#F7C242', '#BEC23F', '#90B44B', '#66BAB7', '#1E88A8') # mosaicplot() mosaicplot(df.wide, color=colors, border=0, off = 3, main="Theft rate of Taipei city (region by hour)") 6.2.6 Clean version library(readr) # options(stringsAsFactors = F) df <- read_csv("data/臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv") selected_df <- df %>% select(id = 編號, cat = 案類, date = `發生日期`, time = `發生時段`, location = `發生地點`) %>% mutate(year = date %/% 10000) %>% mutate(month = date %/% 100 %% 100) %>% mutate(area = stringr::str_sub(location, 4, 6)) %>% mutate(county = stringr::str_sub(location, 1, 3)) selected_df %>% count(year) ## # A tibble: 9 × 2 ## year n ## <dbl> <int> ## 1 103 1 ## 2 104 687 ## 3 105 663 ## 4 106 560 ## 5 107 501 ## 6 108 411 ## 7 109 304 ## 8 110 189 ## 9 111 31 selected_df %>% count(time) %>% head(10) ## # A tibble: 10 × 2 ## time n ## <chr> <int> ## 1 00~02 272 ## 2 02~04 214 ## 3 03~05 8 ## 4 04~06 156 ## 5 05~07 23 ## 6 06~08 191 ## 7 08~10 305 ## 8 09~11 6 ## 9 10~12 338 ## 10 11~03 1 selected_df %>% arrange(time) %>% head(10) ## # A tibble: 10 × 9 ## id cat date time location year month area county ## <dbl> <chr> <dbl> <chr> <chr> <dbl> <dbl> <chr> <chr> ## 1 2 住宅竊盜 1040101 00~02 臺北市文山區萬美里萬寧… 104 1 文山… 臺北市 ## 2 3 住宅竊盜 1040101 00~02 臺北市信義區富台里忠孝… 104 1 信義… 臺北市 ## 3 6 住宅竊盜 1040102 00~02 臺北市士林區天福里1鄰… 104 1 士林… 臺北市 ## 4 12 住宅竊盜 1040105 00~02 臺北市中山區南京東路3… 104 1 中山… 臺北市 ## 5 33 住宅竊盜 1040115 00~02 臺北市松山區饒河街181~… 104 1 松山… 臺北市 ## 6 74 住宅竊盜 1040131 00~02 臺北市南港區重陽路57巷… 104 1 南港… 臺北市 ## 7 75 住宅竊盜 1040201 00~02 臺北市北投區中心里中和… 104 2 北投… 臺北市 ## 8 92 住宅竊盜 1040210 00~02 臺北市北投區大同路200… 104 2 北投… 臺北市 ## 9 95 住宅竊盜 1040212 00~02 臺北市萬華區萬大路493… 104 2 萬華… 臺北市 ## 10 106 住宅竊盜 1040216 00~02 臺北市信義區吳興街269… 104 2 信義… 臺北市 filtered_df <- selected_df %>% # count(year) %>% View filter(year >= 104) %>% filter(!time %in% c("03~05", "05~07", "09~11", "11~13", "15~17", "17~19", "18~21", "21~23", "23~01")) # count(time) %>% View # count(location) %>% # filter(!area %in% c("中和市", "板橋市")) df.wide <- filtered_df %>% count(time, area) %>% pivot_wider(names_from = area, values_from = n, values_fill = 0) %>% as.data.frame() row.names(df.wide) <- df.wide$time df.wide$time <- NULL par(family=('Heiti TC Light')) # for mac # Specify colors colors <- c('#D0104C', '#DB4D6D', '#E83015', '#F75C2F', '#E79460', '#E98B2A', '#9B6E23', '#F7C242', '#BEC23F', '#90B44B', '#66BAB7', '#1E88A8') # mosaicplot() mosaicplot(df.wide, color=colors, border=0, off = 3, main="Theft rate of Taipei city (region by hour)") 6.3 Paid Maternity Leave 6.3.1 Visual Strategies 這個例子之所以有趣在於記者選定了「美國沒有產假支薪」作為新聞的賣點。在呈現的時候，就必須要盡可能地凸顯這樣的情形。一般來說，會繪製世界地圖來呈現美國是目前少數沒有產假支薪的國家之一（在本資料197個國家中僅有9國目前沒有給付產假薪水。其實該筆來自Word Policy Analysis Center資料含有自1995年至2003年共19年的資料（本案例即就是下載該中心所分享的調查資料，不用申請帳號）。於是該專題的作者便構思利用過去到現在的資料來凸顯美國在這方面一直沒有改變。 但要處理197個國家的在19年間的變化相當不易。例如若為每年繪製一張世界地圖，然後以動畫或動態卷軸來凸顯這19年間美國的變化，也會因為國家數過多而難以聚焦在作者想突顯的美國。 而這便是作者在視覺化上相當具有巧思的地方。由於產假給付程度在該調查中分為五個等級，包含0週、0-14週、14-25週、26-51週、52週以上等。作者便從給付程度最高的層級開始做長條圖，共五個階層的子圖。而每個階層的子圖，作者又將該層級的圖分為「保持不變（Stay Same）」和「持續增加（Increase）」兩組。經過這樣的分組，會得到9個子圖。分別為等級5（保持不變、持續增加）、等級4（保持不變、持續增加）、…、等級1（保持不變）。讀者在看的時候，會依次看到給付程度最高到最低的國家，也可以看到哪些國家在這19年間制度有所變化（通常是增加）。但看到最後的時候，便會看到美國的情形，即是無產假給付。 6.3.2 Code by base R library(readxl) # readxl::read_excel() to import the xls file df <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) # select iso3, and matleave columns by index matleave <- df[ , c(3, 6:24)] # str() to inspect the data structure of str(matleave) ## tibble [197 × 20] (S3: tbl_df/tbl/data.frame) ## $ iso3 : chr [1:197] "AFG" "ALB" "DZA" "AND" ... ## $ matleave_95: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_96: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_97: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_98: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_99: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_00: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_01: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_02: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_03: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_04: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_05: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_06: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_07: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_08: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_09: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_10: num [1:197] 2 5 3 3 2 2 2 5 NA 5 ... ## $ matleave_11: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_12: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_13: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... # select all NA cells and assign 0 to them matleave[is.na(matleave)] <- 0 # filter rows by condition m5 <- matleave[matleave$'matleave_13' == 5, ] # filter rows by condition m55<- m5[m5$'matleave_95' == 5,] # plot par(mfrow=c(4,6), mai= c(0.2, 0.2, 0.2, 0.2)) for (i in c(1:nrow(m55))){ barplot(unlist(m55[i,-1]), border=NA, space=0,xaxt="n", yaxt="n", ylim = c(0,5)) title(m55[i,1], line = -4, cex.main=3) } 6.3.3 Code by dplyr 首先，程式碼使用 filter() 函數篩選出符合條件的列，其中 matleave_13 和 matleave_95 兩欄都必須等於 5。接著，pivot_longer() 函數將資料框轉換成長格式（long format），將從第二欄到第二十欄的資料整合到兩個欄位 year 和 degree 中。這裡 names_to 參數指定新欄位 year 的名稱，values_to 參數指定新欄位 degree 的名稱，cols 參數指定要整合的欄位範圍。 接下來，replace_na() 函數將 degree 欄位中的 NA 值替換為 0。然後，mutate() 函數使用 as.POSIXct() 函數將 year 欄位中的字串轉換為日期時間格式，再使用 year() 函數從日期時間中提取年份，最終將年份資訊存儲回 year 欄位中。其中 “matleave_%y” 是日期時間格式字串，其中 “%y” 表示兩位數的年份（例如 “13”）。這樣就將 “matleave_13”、“matleave_14” 等字串轉換成了對應的日期時間。 ggplot() 函數創建了一個空的 ggplot2 圖形物件，使用 aes() 函數定義了 x 軸 year 和 y 軸 degree 的變數名稱。geom_col() 函數指定用長條圖呈現資料，設置了顏色和填充顏色。ylim() 函數限制了 y 軸的範圍，將其設置為 0 到 5，無論y軸資料有沒有到5或者是否超過5，都會限定在0到5之間。facet_wrap() 函數則根據 iso3 欄位生成多個子圖。最後，theme_void() 函數將圖形主題設置為空白，不帶任何邊框或背景。 library(tidyverse) ## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ── ## ✔ dplyr 1.1.4 ✔ readr 2.1.5 ## ✔ forcats 1.0.0 ✔ stringr 1.5.1 ## ✔ ggplot2 3.5.0 ✔ tibble 3.2.1 ## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1 ## ✔ purrr 1.0.2 ## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ── ## ✖ dplyr::filter() masks stats::filter() ## ✖ dplyr::lag() masks stats::lag() ## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors options(scipen = 999) library(readxl) matleave <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) %>% select(iso3, 6:24) matleave %>% filter(matleave_13 == 5, matleave_95 == 5) %>% pivot_longer(names_to = "year", values_to = "degree", cols = 2:20) %>% replace_na(list(degree = 0)) %>% mutate(year = year(as.POSIXct(strptime(year, "matleave_%y")))) %>% ggplot() + aes(year, degree) + geom_col(color = "royalblue", fill = "royalblue") + ylim(0, 5) + facet_wrap(~ iso3) + theme_void() 下圖為原始資料的截圖，matleave_95代表1995年的資料，每個變數的數據1至5分別代表產假時給付薪水的月數區間共有五個區間。區間大小通常需要查看編碼簿來獲取定義。 這類資料由於採用數字（其實是Factor）來替代類別，通常隨著數據會釋出該調查的編碼簿（Code Book），這個案例的編碼（1至5）如下： 6.3.4 Generating each 在 R 中，函式是一個可重複使用的程式碼塊，可以接受輸入參數，並返回計算結果。函式可以簡化程式碼，使其更易於維護和修改。為了不要重複相同的程式碼，以下程式碼將視覺化的部分改用「函式」來進行撰寫，再輸入不同子圖所要使用的資料來進行繪圖。 在這個程式碼中，generating_plot() 是一個自定義的函式，它接受一個資料框 df 作為輸入參數。成對大括號內部為該函式所執行的步驟，包含pivot_longer()、replace_na()等。輸出則是一個 ggplot2 圖形物件，其中包含了將這些資料轉換為長條圖的視覺化表示。 在 R 中，創建一個函式需要使用 function() 關鍵字。一個最簡單的函式可能只包含一個輸入參數和一個返回值，例如：my_function <- function(x) {return(x^2)}。在這個例子中，函式名稱是 my_function，它有一個輸入參數 x，函式主體是 x^2，表示將輸入的 x 參數平方。函式主體的執行結果通過 return() 函數返回，並可以存儲到變數中，例如：result <- my_function(3)。函式的定義亦可包含多個輸入參數，可以用數字、list、或Data.Frame等當成輸入參數。 library(tidyverse) options(scipen = 999) library(readxl) matleave <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) %>% select(iso3, 6:24) generating_plot <- function(df){ df %>% pivot_longer(names_to = "year", values_to = "degree", cols = 2:20) %>% replace_na(list(degree = 0)) %>% mutate(year = year(as.POSIXct(strptime(year, "matleave_%y")))) %>% ggplot() + aes(year, degree) + geom_col(color = "royalblue", fill = "royalblue") + ylim(0, 5) + facet_wrap(~ iso3) + theme_void() + theme(strip.text = element_text(size = 14, face = "bold", vjust=0.5), strip.placement = "inside" ) } matleave %>% filter(matleave_13 == 5, matleave_95 == 5) %>% generating_plot() matleave %>% filter(matleave_13 == 5, matleave_95 != 5) %>% generating_plot() matleave %>% filter(matleave_13 == 4, matleave_95 == 4) %>% generating_plot() matleave %>% filter(matleave_13 == 4, matleave_95 != 4) %>% generating_plot() matleave %>% filter(matleave_13 == 3, matleave_95 == 3) %>% generating_plot() matleave %>% filter(matleave_13 == 3, matleave_95 != 3) %>% generating_plot() matleave %>% filter(matleave_13 == 2, matleave_95 == 2) %>% generating_plot() matleave %>% filter(matleave_13 == 2, matleave_95 != 2) %>% generating_plot() matleave %>% filter(matleave_13 == 1) %>% generating_plot() 6.3.5 Gathering subplots by cowplot 這段程式碼的作用是將多個 ggplot2 圖形物件組合成一個網格，然後將這個網格圖形儲存為一個圖像文件。首先，這段程式碼定義了多個變數，如 plot_row1、plot_row2、plot_row3 等，每個變數都是一個網格圖形。這些變數通過 plot_grid() 函數來創建，這個函數可以將多個 ggplot2 圖形物件組合成一個網格。在 plot_grid() 函數中，可以設置 labels 參數來為每個子圖添加標籤。 然後，這些變數通過 plot_grid() 函數再次組合，形成一個更大的網格圖形。這裡使用 ncol = 1 參數將多個網格排列成一列。最後，使用 ggsave() 函數將這個網格圖形儲存為一個圖像文件。在這個例子中，圖像文件的名稱是 “test.png”，大小為 10 英寸 x 30 英寸，分辨率為 300 DPI。 總的來說，這段程式碼的作用是將多個 ggplot2 圖形物件組合成一個網格，並將這個網格圖形儲存為一個圖像文件。這樣做可以方便地進行圖像導出和共享，並且可以將多個圖形合併在一起進行比較和分析。 library(cowplot) plot55 <- matleave %>% filter(matleave_13 == 5, matleave_95 == 5) %>% generating_plot() plot05 <- matleave %>% filter(matleave_13 == 5, matleave_95 != 5) %>% generating_plot() plot44 <- matleave %>% filter(matleave_13 == 4, matleave_95 == 4) %>% generating_plot() plot04 <- matleave %>% filter(matleave_13 == 4, matleave_95 != 4) %>% generating_plot() plot33 <- matleave %>% filter(matleave_13 == 3, matleave_95 == 3) %>% generating_plot() plot03 <- matleave %>% filter(matleave_13 == 3, matleave_95 != 3) %>% generating_plot() plot22 <- matleave %>% filter(matleave_13 == 2, matleave_95 == 2) %>% generating_plot() plot02 <- matleave %>% filter(matleave_13 == 2, matleave_95 != 2) %>% generating_plot() plot11 <- matleave %>% filter(matleave_13 == 1) %>% generating_plot() plot_row1 <- plot_grid(plot55, plot05, labels = c('STAY 5', 'INCREASE TO 5')) plot_row2 <- plot_grid(plot44, plot04, labels = c('STAY 4', 'INCREASE TO 4')) plot_row3 <- plot_grid(plot33, plot03, labels = c('STAY 3', 'INCREASE TO 3')) plot_row4 <- plot_grid(plot22, plot02, labels = c('STAY 2', 'INCREASE TO 2')) final_plot <- plot_grid( plot_row1, plot_row2, plot_row3, plot_row4, plot11, ncol = 1 ) ggsave("test.png", final_plot, width=10, height=30, dpi=300) "],["joindata.html", "Chapter 7 Data manipultaiton: Join data 7.1 讀取內政部人口統計資料 7.2 讀取公投資料", " Chapter 7 Data manipultaiton: Join data 7.1 讀取內政部人口統計資料 先使用slice(-1)減去第一行中文欄位名稱。再來，目前縣市鄉鎮市區（site_id）和村里（village）分別是兩個變項，由於不同的鄉鎮市可能會有相同的村里名，所以把site_id與village粘接起來成為完整的村里名vname。 這邊我多加了一行程式碼讓vname可以排到前面一點的變項欄，可以用select()達到這個目的，我之後的變項欄的還要寶劉，所以我多打一個everything()就可以把剩下的變項欄都擺放在後面。因此這個重排變項欄的完整程式碼為select(vname, everything())。 raw <- read_csv("data/opendata107Y030.csv") %>% slice(-1) %>% mutate(vname = str_c(site_id, village)) %>% select(vname, everything()) raw %>% head ## # A tibble: 6 × 157 ## vname statistic_yyy district_code site_id village single_age_15down_m ## <chr> <chr> <chr> <chr> <chr> <chr> ## 1 新北市板橋區… 107 65000010001 新北市… 留侯里 118 ## 2 新北市板橋區… 107 65000010002 新北市… 流芳里 119 ## 3 新北市板橋區… 107 65000010003 新北市… 赤松里 60 ## 4 新北市板橋區… 107 65000010004 新北市… 黃石里 113 ## 5 新北市板橋區… 107 65000010005 新北市… 挹秀里 123 ## 6 新北市板橋區… 107 65000010006 新北市… 湳興里 351 ## # ℹ 151 more variables: single_age_15_19_m <chr>, single_age_20_24_m <chr>, ## # single_age_25_29_m <chr>, single_age_30_34_m <chr>, ## # single_age_35_39_m <chr>, single_age_40_44_m <chr>, ## # single_age_45_49_m <chr>, single_age_50_54_m <chr>, ## # single_age_55_59_m <chr>, single_age_60_64_m <chr>, ## # single_age_65_69_m <chr>, single_age_70_74_m <chr>, ## # single_age_75_79_m <chr>, single_age_80_84_m <chr>, … # raw %>% glimpse() 7.1.1 分析規劃 建立各鄉鎮市區的老年人口比例 建立各鄉鎮市區的年齡中位數 讀取所有（某一）公投案的結果 視覺化年齡與公投結果間的相關性 7.1.2 清理資料 我們之前在談資料的「觀察、統計、和二維表格」三種型態時，曾經談到統計型態和二維表格型態間的差異。當時所提到的「統計型態」，也就是每個變項欄恰好是我們所認知的單一變項（如每一個變項欄恰是人口統計變項的年齡、性別、教育程度、數量），會有助於進行統計分析，也就是tidy型態的資料。相較之下，上述的表格是把資料攤成二維的型態，每一個變項是某個年齡層的某種性別的某種婚姻狀況，包含了三個人口統計變項，是方便一般大眾讀的，但不是適合進行統計的tidy型態。 這類的資料tidyverse的相關套件把它稱為tidy form。遵守tidy form形式的資料是，每一個欄恰好一個變項。例如在內政部開放資料「15歲以上現住人口按性別、年齡、婚姻狀況及教育程度分」中，每個變數（年齡、婚姻狀況、教育程度、人口數等等）均各自為一個欄上的變項。 15歲以上現住人口按性別、年齡、婚姻狀況及教育程度分 | 政府資料開放平臺 (data.gov.tw) 接下來，我要把表格型態的資料轉為tidy型態資料。原本的資料是這樣的型態。 我要將後方的數值變項欄（single_age_15down_m等）轉為單一變項key的值，再把其所對應到的資料值，也轉為單一變項value。請注意看上圖和程式碼後方結果圖的顏色區塊。南投縣中寮鄉中寮村（綠色）被複製且展開為多列。而原本多個年齡層和資料的變數項（紅色）變成一個變項欄的資料，分別對應到其原本對應的數值（藍色）。 tidy_data <- raw %>% pivot_longer(names_to = "key", values_to = "value", cols = 6:ncol(.)) 相對於pivot_wider()把變項展開成欄，pivot_longer()函式可以收合被展開的變項，在此將要收合的變數名稱統一稱為key，並將該變數所對應到的數值稱為value。並且我用6:ncol(.)來指定我要收合哪些變項欄。 ncol(.)的「.」代表從前面%>% pipe進來的那個data.frame。 pivot_longer()後資料列從7760增加至1,179,520列。（灰底部分用來觀察結果用） 由於每一列恰好是一種婚姻狀態、一個年齡層和一個性別，所以，我們可以把key中的婚姻狀態、年齡層和性別切割出來做為變數。觀察key欄位發現其格式有一些規律性，主要是婚姻狀態_年齡下界_年齡上界_性別的形式。標準的範例如married_15_10_m或widowed_25_29_f，但有一些並非這種形式，例如： single_age_15_19_m：其中single_age之間多了一個底線，所以把single_age取代為single就好。 married_15down_m：因為是15down少了一個底線，所以取代為0_14。 married_100up_f：因為100up少了一個底線，所以取代為100_105。 之後，我使用tidyr::separate()函式將key切成四個變項，分別為married、ageLower、ageUpper、gender。 separate()有一個參數是remove=T（預設值），意思是說，當把key變項切割為四個變項後，預設把key變項給丟棄；但如果未來你還會用到key變項的話，你可以把remove改為FALSE，代表切割完後，還保留key變項。 tidyr::separate()：Given either regular expression or a vector of character positions, separate() turns a single character column into multiple columns. 此時我清理出來的資料大致如下： 最後就剩零星的操作，包含轉換資料為數值型態、或者你也可以在這裡建立新的指標（例如年齡平均）。最後加上一個arrange(vname)讓他按照村里的全名排序。 tidy_data <- raw %>% pivot_longer(names_to = "key", values_to = "value", cols = 6:ncol(.)) %>% mutate(key = str_replace(key, "_age", "")) %>% mutate(key = str_replace(key, "100up", "100_110")) %>% mutate(key = str_replace(key, "15down", "0_15")) %>% separate(key, c("married", "ageLower", "ageUpper", "gender")) %>% mutate(ageLower = as.numeric(ageLower), # age = str(ageLower, ageUpper), ageUpper = as.numeric(ageUpper), value = as.numeric(value)) %>% select(-statistic_yyy) %>% arrange(vname) 7.1.3 進階：運用rowwise() raw %>% mutate_at(vars(6:157), as.numeric) %>% replace(is.na(.), 0) %>% rowwise() %>% mutate(married = sum(c_across(matches("widowed|divorced|married")), na.rm = T)) %>% mutate(lt65 = sum(c_across(matches("65|70|75|80|85|90|95|100")), na.rm = T)) %>% select(vname, married, lt65) %>% head ## # A tibble: 6 × 3 ## # Rowwise: ## vname married lt65 ## <chr> <dbl> <dbl> ## 1 新北市板橋區留侯里 920 272 ## 2 新北市板橋區流芳里 826 280 ## 3 新北市板橋區赤松里 463 149 ## 4 新北市板橋區黃石里 632 210 ## 5 新北市板橋區挹秀里 1061 365 ## 6 新北市板橋區湳興里 3157 838 7.1.4 建立鄉鎮市區與村里指標 7.1.4.1 使用group_by()建立村里指標 將資料轉換為tidy型態後，接下來要做的事情是建立村里、鄉鎮市區、縣市的分級指標。針對每個村里，我希望計算出總人口數people（原本依據年齡與性別、婚姻情形分割）、老年人總數elderSum、曾結婚人口總數marriedSum。之後再分別除以該村里的總人口數people，老年人的人口比例elderPerc以及結婚的人口比例marriedPerc。 因為一個村里的資料會根據不同性別、不同婚姻情形、不同年齡層被切割為不同的資料列，共2X4X19個資料列。因此，如果我想知道一個村里的總人口數或相關統計資料，就不需彙整這些資料列。dplyr有非常強大的group_by()可以根據群組來進行運算，我用村里代號（district_code）來做群組運算，所以是group_by(district_code)或用我們所產生的vname作為群組基準來運算group_by(vname)。 語法上，通常group_by()之後經常會跟著summarise()，跟mutate()的語法有點像，都會產生新變數，但因為這邊用group_by()針對某個或某幾個變數做彙整，相當於base套件的apply()函式，因此會根據每個不同的群組做組內的數值彙整運算。比方說，在以下的程式碼中，我用sum(num)計算了該群組內的總人數，然後同樣累計了年齡大於等於65歲的總人數，以及婚姻狀態不為single的總人數。 簡單地說，相當於按照不同的村里（district_code）各別做value的加總（該村里的總人口數）、篩選出年齡65歲以上的人口組別進行加總、篩選出不是單身者的人口組別進行加總。之後會加一個ungroup()解開群組。 最後一行left_join(raw %>% select(vname, site_id), by = \"vname\")是由於group_by()後會讓其他變數消失（例如鄉鎮市區名site_id），所以我希望將原本資料raw中的site_id給併回來。我可以抽取出raw中的vname和site_id兩個變項，然後以vname為key，用left_join()將site_id給併回來。 筆記：當group_by()、summarize()後不參與的變項會消失，但可以透過left_join()的方式將原有的變項併回來。 village_stat <- tidy_data %>% filter(ageLower >= 20) %>% group_by(vname) %>% summarise(legalPopulation = sum(value), elderSum = sum(value[ageLower >= 65]), marriedSum = sum(value[married %in% c("married", "divorced", "widowed")]), womenSum = sum(value[gender == "f"])) %>% ungroup() %>% left_join(raw %>% select(vname, site_id), by = "vname") 測試 7.1.4.2 將村里指標匯總為鄉鎮市區指標 剛剛是根據村里（village）來建立指標，現在要根據鄉鎮市區來建立指標。走過前方的邏輯後，我們只需要把原本用來做group_by()的村里變項vname改為鄉鎮市區的變項site_id，就可以完成這件事，其他都一樣，你發現沒？ 不過這邊我要多做一件事。因為三民區和鳳山區兩個區非常的大（我猜），所以內政資料中的鄉鎮市區資料有分「三民一」、「三民二」、「鳳山一」、「鳳山二」。我們只要在彙整資料前，將site_id的這四類值取代好，便可以在鄉鎮市區的指標中一併彙整。以下我一共彙整出四種資料，分別為該區人口數（legalPopulation）、老年人口數（elderSum）、曾婚人口數（marriedSum）、女性人口數（womenSum）。不難想像接下來可以計算出各鄉鎮市區的老年人口比例、曾婚比例、女性比例等。 town_stat <- village_stat %>% # mutate(site_id = str_sub(vname, 1, 6)) %>% mutate(site_id = str_replace(site_id, "三民一|三民二", "三民區")) %>% mutate(site_id = str_replace(site_id, "鳳山一|鳳山二", "鳳山區")) %>% group_by(site_id) %>% summarize(legalPopulation = sum(legalPopulation), elderSum = sum(elderSum), marriedSum = sum(marriedSum), womenSum = sum(womenSum) )%>% ungroup() 7.1.5 視覺化測試（老年人口數 x 曾婚人口數） town_stat %>% mutate(marriedPerc = marriedSum / legalPopulation) %>% mutate(womenPerc = womenSum / legalPopulation) %>% mutate(elderPerc = elderSum / legalPopulation) %>% ggplot() + aes(marriedPerc, elderPerc) + geom_point(alpha = 0.3) # geom_jitter(alpha = 0.3) 7.2 讀取公投資料 首先，先讀取資料並重新命名每個變項。由於我們要連結公投資料和前面的內政部人口統計資料，所以要注意兩筆資料間是否有共通的key（資料庫稱為鍵值）。town_stat的是以site_id鄉鎮市區名為主鍵，所以公投資料這邊也產生一個同名的鄉鎮市區變項site_id。 ref10 <- read_csv("data/ref10.csv") %>% select(county = 縣市, town = 鄉鎮市區, agree = 同意票數, disagree = 不同意票數, legalVote = 有效票數, illegalVote = 無效票數, vote = 投票數, legalPopulation = 投票權人數) %>% mutate(site_id = str_c(county, town)) %>% drop_na(site_id) names(ref10) ## [1] "county" "town" "agree" "disagree" ## [5] "legalVote" "illegalVote" "vote" "legalPopulation" ## [9] "site_id" 合併資料測試，注意，由於兩邊都有legalPopulation，所以town_stat中的legalPopulation增生為legalPopulation.x，而ref10中的legalPopulation則重新命名為legalPopulation.y。 town_stat %>% left_join(ref10, by = "site_id") ## # A tibble: 368 × 13 ## site_id legalPopulation.x elderSum marriedSum womenSum county town agree ## <chr> <dbl> <dbl> <dbl> <dbl> <chr> <chr> <dbl> ## 1 南投縣中寮… 12791 3272 9553 5824 南投縣 中寮… 5748 ## 2 南投縣仁愛… 12172 1713 9078 5899 南投縣 仁愛… 5702 ## 3 南投縣信義… 12860 1847 9050 5938 南投縣 信義… 6891 ## 4 南投縣南投… 81874 15855 57042 41343 南投縣 南投… 37547 ## 5 南投縣名間… 32388 7106 23375 15304 南投縣 名間… 14533 ## 6 南投縣國姓… 16196 3744 11826 7434 南投縣 國姓… 7089 ## 7 南投縣埔里… 66699 13411 46316 33718 南投縣 埔里… 29571 ## 8 南投縣水里… 15023 3644 10850 7106 南投縣 水里… 6392 ## 9 南投縣竹山… 45629 10154 33201 22244 南投縣 竹山… 19254 ## 10 南投縣草屯… 80426 15141 56384 40008 南投縣 草屯… 35215 ## # ℹ 358 more rows ## # ℹ 5 more variables: disagree <dbl>, legalVote <dbl>, illegalVote <dbl>, ## # vote <dbl>, legalPopulation.y <dbl> 7.2.1 合併公投資料並視覺化 由於人口統計資料中的鄉鎮市區若只有兩個字如「東區」中間有一全形空白「東 區」，但公投資料中並沒有這樣的空白，所以為了兩者要能夠正確合併，需要先做好取代。可以逐一取代，或者，直接取代掉該全形空白為空字串即可。 town_stat %>% mutate(site_id = str_replace(site_id, " ", "")) %>% # mutate(site_id = str_replace(site_id, "東 區", "東區"), # site_id = str_replace(site_id, "西 區", "西區"), # site_id = str_replace(site_id, "南 區", "南區"), # site_id = str_replace(site_id, "北 區", "北區"), # site_id = str_replace(site_id, "中 區", "中區")) %>% left_join(ref10, by = "site_id") %>% mutate(agreeRate = agree / legalVote, marriedPerc = marriedSum / legalPopulation.x) %>% # select(site_id, agree, legalVote, marriedSum, legalPopulation.x) %>% ggplot() + aes(agreeRate, marriedPerc) + geom_point(alpha = 0.5, color = "royalblue") + theme_light() "],["categorical.html", "Chapter 8 Categorical Data Analysis 8.1 Survey Analysis 8.2 The Case: Misinformation Perception 8.3 Factorizing data 8.4 Order-to-factor 8.5 Cross-tabulating", " Chapter 8 Categorical Data Analysis 8.1 Survey Analysis 國外不少媒體會用智庫或者學術單位所發佈的調查結果作為資料新聞素材，我們所曾經處理過的華盛頓郵報的產假支薪案例也是。以下為該案例資料的截圖。matleave_95代表1995年的資料，每個變數的數據1至5分別代表產假時給付薪水的月數區間共有五個區間。區間大小通常需要查看編碼簿來獲取定義。 這類資料由於採用數字（其實是Factor）來替代類別，通常隨著數據會釋出該調查的編碼簿（Code Book），這個案例的編碼（1至5）如下： 8.2 The Case: Misinformation Perception 這個範例涵括了在做問卷分析時常用的處理步驟。最核心的步驟是將文字陳述的類別資料轉換為便於後續運算的factor或數值資料。如果類別數量過多的時候，在這個過程會順便進行重新分組。例如依照年齡組把填答者分為老年、中壯年、青少年、兒童四組。 raw <- read_rds("data/tfc_survey.rds") raw ## # A tibble: 1,216 × 6 ## Q7 Q8 QAParty QASide QA3 QA4 ## <chr> <chr> <chr> <chr> <chr> <chr> ## 1 會 絕對會 民主進步黨 非常接近泛綠 25-29 研究所及以上 ## 2 會 絕對會 沒有政黨偏好 接近泛藍 35-39 研究所及以上 ## 3 不會 絕對會 沒有政黨偏好 接近泛綠 35-39 大專（專科與大學） ## 4 會 會 台灣民眾黨 接近泛綠 20-24 大專（專科與大學） ## 5 不會 不會 民主進步黨 非常接近泛綠 45-49 研究所及以上 ## 6 會 絕對會 沒有政黨偏好 非常接近泛藍 25-29 大專（專科與大學） ## 7 不會 絕對會 民主進步黨 接近泛綠 30-34 大專（專科與大學） ## 8 會 絕對會 台灣民眾黨 接近泛綠 20-24 大專（專科與大學） ## 9 會 絕對會 沒有政黨偏好 接近泛藍 20-24 大專（專科與大學） ## 10 會 會 民主進步黨 接近泛綠 55-59 高中、高職 ## # ℹ 1,206 more rows 8.3 Factorizing data 通常問卷會分為兩種類型的資料，一種是人口統計用的基本資料（如性別、年齡組、教育程度）、另一種是問卷本身要問的題項。以下是常見的問卷型態，包含把年齡從20歲開始每五年作為一組，70歲以上則歸類為一組，共會有十一組。而教育程度則常分為五至六組，但在問卷設計的時候，通常會需要增加「拒答」的選項。如果問卷中包含政黨意識形態，就必須要決定要以黨派作為類別變項，或者以意識形態做順序尺度。以下即為一個順序尺度的案例，從「非常接近泛綠」到「非常接近泛藍」共五個等第，但另增「拒答」選項。 dt <- raw %>% mutate(QA3 = ordered(QA3, levels=c("20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70及以上"))) %>% mutate(QA3_lv = ordered(QA3, levels=c("20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70及以上"), labels = c("青年", "青年", "壯年", "壯年", "壯年", "中年", "中年", "中年", "中年", "老年", "老年"))) %>% mutate(QA4 = ordered(QA4, levels=c("拒答", "國小及以下", "初中、國中", "高中、高職", "大專（專科與大學）", "研究所及以上"), labels=c("拒答", "國小以下", "國中", "高中職", "大專", "研究所以上"))) %>% mutate(QASide=ordered(QASide, exclude="拒答", levels=c("非常接近泛綠", "接近泛綠", "都不接近", "接近泛藍", "非常接近泛藍"))) 8.3.1 factor-to-order 在一開始清理資料的時候，會建議先把類別變數（通常是文字型態）轉為factor型態。常用的函式是用mutate()搭配ordered()來改變變數型態。ordered()會照類別順序來標定該factor所對應到的數字。可以用as.integer()將factor轉為整數後就可以看到各類別的順序。 mutate(QA3 = ordered(QA3, levels=c("20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70及以上"))) %>% dt$QA3[1:10] ## [1] 25-29 35-39 35-39 20-24 45-49 25-29 30-34 20-24 20-24 55-59 ## 11 Levels: 20-24 < 25-29 < 30-34 < 35-39 < 40-44 < 45-49 < 50-54 < ... < 70及以上 as.integer(dt$QA3[1:10]) ## [1] 2 4 4 1 6 2 3 1 1 8 8.3.2 Excluding 如果有某些類別變數的值（如「拒答」）不想被編入factor，可以在reorder()中加入exclude的參數指定不想被編入類別值。 mutate(QASide=ordered(QASide, exclude="拒答", levels=c("非常接近泛綠", "接近泛綠", "都不接近", "接近泛藍", "非常接近泛藍"))) dt$QASide[1:10] ## [1] 非常接近泛綠 接近泛藍 接近泛綠 接近泛綠 非常接近泛綠 ## [6] 非常接近泛藍 接近泛綠 接近泛綠 接近泛藍 接近泛綠 ## Levels: 非常接近泛綠 < 接近泛綠 < 都不接近 < 接近泛藍 < 非常接近泛藍 as.integer(dt$QASide[1:10]) ## [1] 1 4 2 2 1 5 2 2 4 2 8.3.3 Grouping-up 如果有某些類別變數的類別過多，希望再次群組化為較少的組別，如重新群組各年齡層為青年、壯年、中年與老年四個尺度。此時除了levels參數外，可以另外加入labels的參數，指定每個類別變數值所要對應到的群組。以下為群組後的結果，仔細觀察剩下多少個尺度。 mutate(QA3_lv = ordered(QA3, levels=c("20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70及以上"), labels = c("青年", "青年", "壯年", "壯年", "壯年", "中年", "中年", "中年", "中年", "老年", "老年"))) %>% dt$QA3[1:10] ## [1] 25-29 35-39 35-39 20-24 45-49 25-29 30-34 20-24 20-24 55-59 ## 11 Levels: 20-24 < 25-29 < 30-34 < 35-39 < 40-44 < 45-49 < 50-54 < ... < 70及以上 as.integer(dt$QA3[1:10]) ## [1] 2 4 4 1 6 2 3 1 1 8 dt$QA3_lv[1:10] ## [1] 青年 壯年 壯年 青年 中年 青年 壯年 青年 青年 中年 ## Levels: 青年 < 壯年 < 中年 < 老年 8.4 Order-to-factor Q7 請問您會不會受到假消息影響？ Q8 請問您認為其他人會不會受到假消息的影響？ 對於Q7、Q8的問題是詢問填答者認為自己或他人會不會受到假消息影響，並從「一點也不會」、「不會」、「會」到「絕對會」共分四個等第。Q7分別是「81, 446, 650, 39」、Q8分別是「5, 58, 803, 350」。相較於Q7，Q8的分佈略為左傾，亦即傾向於認為其他人較容易受影響。此時如果想要分析Q7和Q8間的關係，由於各有四個等第，其交叉分析表會有16個項目，相當難以分析。 dt2 <- dt %>% mutate(Q7 = ordered(Q7, levels=c("一點也不會", "不會", "會", "絕對會"))) %>% mutate(Q8 = ordered(Q8, levels=c("一點也不會", "不會", "會", "絕對會"))) %>% mutate(Q7_3rd = as.numeric(Q8)-as.numeric(Q7)) %>% mutate(Q7_3rd_lv = ifelse(Q7 %in% c("一點也不會", "不會") & Q8 %in% c("會", "絕對會"), "高", "低")) %>% mutate(Q7_3rd_lv = ordered(Q7_3rd_lv, levels=c("低", "高"))) 這時候一種策略是把這兩題視為順序尺度變數，然後把兩題的分數相減。相減後的分數從「-1, 0, 1, 2, 3」各有「12, 482, 600, 103, 19」，不難猜到會是一個較為集中的分佈，後續僅能當作順序尺度或連續變項來分析，不適合找一個閾值轉類別變項。 另一種策略是，分別先把Q7與Q8的「一點也不會」和「不會」群組為「不會」、再把「會」與「絕對會」群組為「會」，這樣Q7與Q8的交叉分析表會變成2X2的分析表，雖然群組數量比較少，但別忘記Q7的填答結果集中在會與不會、而Q8為一個較為偏右的分佈，集中在「會」和「絕對會」。Q8勢必會造成比例不均的分組。 dt2 %>% count(as.integer(Q8)-as.integer(Q7)) ## # A tibble: 5 × 2 ## `as.integer(Q8) - as.integer(Q7)` n ## <int> <int> ## 1 -1 12 ## 2 0 482 ## 3 1 600 ## 4 2 103 ## 5 3 19 最後這題所採行的策略是，做高、低第三人效果分組，也就是根據認為自己「一點也不會」、「不會」受影響，而他人「會」或「絕對會」受影響的重新群組為「高第三人效果組」，其他則為「低第三人效果組」。亦即，分組的一句是在對自己與他人的認知上，無模糊空間的分組方法（也就是認為自己至少不會，和認為別人應該會）。 dt2 %>% count(Q7_3rd_lv) ## # A tibble: 2 × 2 ## Q7_3rd_lv n ## <ord> <int> ## 1 低 746 ## 2 高 470 8.5 Cross-tabulating 在R語言中，xtabs()是一個用於建立交叉表（cross-tabulation）的函數。它可以將資料中的變數進行交叉分類，並計算每個交叉組合的頻次或其他統計量。 chisq.test(xtb)分析結果指出 X-squared（卡方值）等於10.017，df（自由度）等於3，p-value（p值）等於0.01842。 這個結果顯示在這個交叉表中，QA3_lv（年齡層）Q7_3rd_lv（第三人效應）間的分類狀態並非完全獨立，而是存在某種統計上的關聯性。 由於p值小於我們事先選定的顯著性水準（通常為0.05），我們可以拒絕虛無假設（兩個變數獨立），並認為這個關聯性是統計上顯著的。 對於vcd::assocstats(xtb)的分析結果： 這些統計量用於評估QA3_lv和Q7_3rd_lv之間的關聯性程度。 連續性係數（Contingency Coeff.）和克拉瑪爾V（Cramer’s V）的值，表示兩個變數之間的關聯性較弱，但仍存在一定程度的相關性。 (xtb <- xtabs(~QA3_lv + Q7_3rd_lv, data=dt2)) ## Q7_3rd_lv ## QA3_lv 低 高 ## 青年 178 110 ## 壯年 370 199 ## 中年 157 134 ## 老年 41 27 (chi2 <- chisq.test(xtb)) ## ## Pearson's Chi-squared test ## ## data: xtb ## X-squared = 10.017, df = 3, p-value = 0.01842 vcd::assocstats(xtb) ## X^2 df P(> X^2) ## Likelihood Ratio 9.9301 3 0.01917 ## Pearson 10.0173 3 0.01842 ## ## Phi-Coefficient : NA ## Contingency Coeff.: 0.09 ## Cramer's V : 0.091 print(round(chi2$observed, 2)) ## Q7_3rd_lv ## QA3_lv 低 高 ## 青年 178 110 ## 壯年 370 199 ## 中年 157 134 ## 老年 41 27 print(round(chi2$expected, 2)) ## Q7_3rd_lv ## QA3_lv 低 高 ## 青年 176.68 111.32 ## 壯年 349.07 219.93 ## 中年 178.52 112.48 ## 老年 41.72 26.28 print(round(chi2$residuals, 2)) ## Q7_3rd_lv ## QA3_lv 低 高 ## 青年 0.10 -0.12 ## 壯年 1.12 -1.41 ## 中年 -1.61 2.03 ## 老年 -0.11 0.14 par(family="Heiti TC Light") gplots::balloonplot(t(xtb), xlab="第三人效果", ylab="年齡組", main="", dotsize=4/max(strwidth(40),strheight(40)), text.size=1.5,label.size=2, rowmar=1, colmar=1) par(family="Heiti TC Light") corrplot::corrplot(chi2$residuals, is.corr = F) xtb %>% as_tibble() %>% group_by(QA3_lv) %>% mutate(fill = if_else(n == max(n), "orangered", "skyblue")) %>% ungroup() %>% mutate(QA3_lv = ordered(QA3_lv, levels=c("青年", "壯年", "中年", "老年"))) %>% arrange(desc(QA3_lv)) %>% ggplot() + aes(y = QA3_lv, x=Q7_3rd_lv, color = fill, size = n) + scale_size_area(max_size=70, guide = "none") + geom_point(alpha=0.7) + scale_color_manual(values = c("orangered", "skyblue"), guide = "none") + geom_text(aes( label=n, vjust=1.3, size=10 ), color="black",) + theme_minimal() + theme(text = element_text(family="Heiti TC Light"), title = element_text(family="Heiti TC Light")) "],["timeline.html", "Chapter 9 Processing Timeline 9.1 Time object 9.2 Example: Processing time object in social opinions", " Chapter 9 Processing Timeline 9.1 Time object 在當前的數位時代，網路上充斥著豐富的開放資料，許多其中包含著關鍵的時間資訊，如訂單成立的時間、氣象觀測的時刻以及股票的交易時間等。這些時間數據往往以字串形式存在，但若需進行時間計算或構建時間序列分析，在程式處理前必須將其轉化為專門的時間物件。 在R語言中，主要有兩種時間物件：POSIXct和POSIXlt，它們可通過as.POSIXct()和as.POSIXlt()函數將字串轉換成相應的時間物件形式。一旦轉換完成，各種時間相關的計算操作，如時間點之間的差異計算、時區轉換、時間序列的特定區間提取等，便可輕鬆進行。具體而言，POSIXct是以1970年1月1日00:00:00 UTC至當前的總秒數來表示時間點，適合於進行數學計算；而POSIXlt則採用結構化列表形式存儲，包括年、月、日、小時、分、秒等時間單位，更便於人工閱讀與理解。這兩種時間物件的主要差異在於，POSIXct較為適合於計算處理，POSIXlt則在時間元素的展示與處理上更為直觀。 此外，利用Sys.time()函數能夠獲取當前時刻的時間物件，這為時間數據的動態處理提供了便利。學習如何有效運用這些時間物件進行日期與時間的計算在許多領域，例如金融、氣象、交通等，都是非常關鍵的能力。 9.2 Example: Processing time object in social opinions 9.2.1 Char-to-Time 在 R 裡面，我們可以使用 strptime() 函數將字串轉換為時間物件，其中 %Y、%m、%d、%H、%M、%S 等是用來表示時間的格式碼。在這段程式碼中，我們使用 strptime() 函數將 ptime 這個字串轉換為一個時間物件，其中 %Y-%m-%dT%H:%M:%SZ 是該字串的時間格式，也就是說這個字串是以 ISO 8601 的格式表示的時間，例如 2022-03-31T14:30:00Z。tz = \"ASIA/Taipei\" 則是指定時間所在的時區，這裡指定的是台灣時間。轉換完成後，我們使用 as.POSIXct() 函數將 strptime() 轉換出來的時間物件再轉換為POSIXct時間物件，並將其存入 ptime 這個欄位中。這段程式碼的作用是將一個 ISO 8601 格式的字串轉換為 POSIXct 時間物件，並指定時區為台灣，方便之後進行時間相關的運算。 在 strptime() 函數中，可以使用不同的格式碼來指定時間的格式。以下是常用的幾種格式碼及其意義： %Y：四位數的年份，例如 2022。 %m：兩位數的月份，範圍是 01 到 12。 %d：兩位數的日期，範圍是 01 到 31。 %H：兩位數的小時，範圍是 00 到 23。 %M：兩位數的分鐘，範圍是 00 到 59。 %S：兩位數的秒數，範圍是 00 到 59。 %b：縮寫形式的月份名稱，例如 Jan。 %B：完整形式的月份名稱，例如 January。 %a：縮寫形式的星期幾名稱，例如 Mon。 %A：完整形式的星期幾名稱，例如 Monday。 %p：AM 或 PM，例如 AM。 在 strptime() 函數中，你可以使用這些格式碼來指定一個字串的時間格式，以便將其轉換為時間物件。例如，如果一個字串的格式是 2022-03-31 14:30:00，那麼可以使用 %Y-%m-%d %H:%M:%S 這個時間格式來將其轉換為一個時間物件。 # Reading from url # ptturl <- "https://github.com/P4CSS/R4CSSData/raw/main/ptt_hang_posts.csv" # raw <- read.csv(url(ptturl)) # read_csv() won't convert timestamp to POSIXct automatically # raw <- read.csv("data/ptt_hang_posts.csv") # clean <- raw %>% # mutate(ptime = as.POSIXct(strptime(ptime, "%Y-%m-%dT%H:%M:%SZ"))) # read_csv() will convert timestamp to POSIXct automatically clean <- read_csv("data/ptt_hang_posts.csv") t <- "2019-04-12T00:48:19Z" class(t) ## [1] "character" ?strptime t1 <- strptime(t, "%Y-%m-%dT%H:%M:%SZ") raw %>% glimpse() ## function (length = 0L) 9.2.2 Density plot along time 在資料分析的過程中，我們經常需要對資料進行分布分析，以了解資料的特性。ggplot2 套件提供了 geom_density() 函數，可以用來繪製密度圖（density plot）。密度圖顯示了一個連續變量的概率密度函數的近似值，可以用來了解該變量的分佈情況。密度圖與直方圖類似，但它是基於核密度估計方法繪製的，所以在某些情況下可以提供更好的分佈近似。它將一個連續變量區間劃分為若干個小區間，然後對每個小區間的密度進行估計，再將這些小區間的密度估計值連接起來，形成一條平滑曲線，用以描述變量的分佈情況。 在 ggplot2 中，使用 geom_density() 函數可以很方便地繪製密度圖。我們只需要指定變量名稱，即可繪製出該變量的密度圖。此外，我們也可以使用 stat_density() 函數來繪製密度圖，這個函數允許我們對密度圖進行更多的自定義設置，例如指定核函數、調整帶寬等。繪製密度圖可以讓我們更直觀地了解變量的分佈情況，進而對資料進行更深入的分析和探索。 clean %>% ggplot() + aes(ptime) + geom_density() 9.2.3 Freq by month 如果想要詳細觀察逐年逐月的變化，使用密度圖可能不夠直觀，此時可以考慮使用直方圖來呈現資料。直方圖可以將資料劃分為若干個等寬的區間，並計算每個區間內資料的頻率，然後將這些頻率顯示為長方形柱，以反映資料的分佈情況。對於時間序列資料，我們可以將其劃分為月、週等時間單位，然後計算每個時間單位內資料的出現次數，再使用 ggplot2 中的 geom_col() 函數繪製直方圖。 以上程式碼中，我們使用 mutate() 函數將 ptime 欄位轉換為月份 m，然後使用 count() 函數計算每個月份出現的次數。接著使用 ggplot() 函數初始化一個 ggplot 對象，指定 aes() 函數的 x 軸為月份 m，y 軸為出現次數 n，然後使用 geom_col() 函數繪製直方圖。這樣可以很直觀地看到每個月份資料的出現次數，進而觀察到逐年逐月的變化趨勢。如果需要更詳細的觀察，可以將資料劃分為更小的時間單位，例如週，然後使用類似的方法繪製直方圖。 ?lubridate clean %>% mutate(m = month(ptime)) %>% count(m) %>% ggplot() + aes(m, n) + geom_col() 9.2.4 Freq-by-date (good) 在處理時間序列資料時，我們常常需要將資料劃分為不同的時間單位，例如月、週、日等，以便進行更精細的分析和視覺化。然而，如果只是單純地提取出時間序列資料中的某一個時間單位，例如月份，就會失去時間軸在年的特性，因此需要採取一些方法來保留日期（如年）的特性。 以上程式碼中，我們使用 filter() 函數選取了時間範圍為 2019 年 3 月 18 日到 4 月 1 日的資料，然後使用 floor_date() 函數將每個時間點取整為當天的起始時間，以保留日期（如年）的特性。這樣可以確保同一天的資料都被歸到同一個時間單位中，進而保留時間軸在年的特性。接著使用 count() 函數計算每個時間單位內資料的出現次數，再使用 ggplot() 函數和 geom_col() 函數繪製直方圖，可以看到在時間軸上的年份特性被保留了下來。 總之，當我們需要從時間序列資料中提取某一個時間單位時，應該採用能夠保留日期（如年）特性的方法，例如使用 floor_date() 函數，以便進行更加精細的分析和視覺化。 clean %>% filter(ptime >= as_date("2019-03-18") & ptime < as_date("2019-04-01")) %>% mutate(m = floor_date(ptime, unit = "day")) %>% count(m) %>% ggplot() + aes(m, n) + geom_col() 9.2.5 Freq-by-hour 透過觀察資料在週末和週間的變化，可以幫助我們了解不同時間段的資料分佈情況。以下是一個範例程式碼，可以根據每天的時間點和文章數來觀察資料在週末和週間的變化。相較於將資料分為週間和週末，這個範例程式碼使用 X 軸作為 24 小時的時間點，而 Y 軸為不同日期的文章量，使用分組的方式，針對不同日期繪製折線圖，最後使用 facet_wrap() 函數將資料分成週末和週間兩個子圖來進行比較。 首先，我們使用 filter() 函數選取時間範圍為 2019 年 3 月 25 日到 4 月 1 日的資料。接著，使用 floor_date() 函數將每個時間點取整為當天的起始時間，以便進行統計。然後，使用 hour() 函數取出每個時間點的小時數，以及使用 count() 函數計算每個時間點和日期的文章數。接著，使用 wday() 函數取出每個日期的星期幾，並使用 ifelse() 函數將週末和週間的日期標記為不同的類別。最後，使用 ggplot() 函數初始化一個 ggplot 對象，指定 aes() 函數的 x 軸為小時數 h，y 軸為文章數 n，以及日期 d 的類別 color。然後，使用 geom_line() 函數繪製折線圖，並使用 facet_wrap() 函數將資料分為週末和週間兩個子圖。 透過這樣的方式，我們可以很清楚地看到週末和週間的文章量變化趨勢，從而對資料進行更深入的分析和探索。 clean %>% filter(ptime >= as_datetime("2019-03-25") & ptime < as_datetime("2019-04-01")) %>% mutate(d = floor_date(ptime, unit = "day")) %>% mutate(h = hour(ptime)) %>% count(d, h) %>% mutate(wd = wday(d, label = F, locale = Sys.getlocale("LC_TIME"))) %>% mutate(isweekend = ifelse(wd >= 6, "weekend", "weekday")) %>% ggplot() + aes(h, n, color = as.character(d)) + geom_line() + facet_wrap(~isweekend) ?ifelse "],["na.html", "Chapter 10 NA Processing 10.1 Cleaning Gov Annual Budget 10.2 Cleaning Covid Vaccinating data", " Chapter 10 NA Processing 許多統計資料都會有不同程度的NA（缺失值、遺漏值）。缺失值產生的原因不一，可能有以下原因： 資料運算的時候產生的填缺失值。例如spread()和pivot_wider()經常會產生NA，也經常會指定值（例如0）來取代可能產生的NA。 資料紀錄的時候遺漏某些時間點的資料。 開放資料在開放時已經被整理成階層化、易於展示、一般人易懂的表格型態。此時，若將其讀入也會產生非常大量的NA。例如本章節所要提到的政府各部會預算比例。 紀錄資料筆數非常龐大、來源眾多、紀錄時間不一時，雖然有很多紀錄，但這些紀錄必須要被對齊、刪減，才能夠獲得有意義的可計算資料。例如本章節會提到的世界各國疫苗注射資料。 10.1 Cleaning Gov Annual Budget 這個範例將清理中央政府111年度的歲出預算表。由於政府預算有款、科、目、節與機構，會呈現一個大部會到小布會的樹狀階層，因此非常適合用Treemap來做視覺化，預期視覺化的結果如下（視覺化的部分可參考章節26.3）： 在讀入資料後，由於資料具有階層性、從最大的科款、項、目，由於是給一般讀者所閱讀的資料，在原本的EXCEL表格中，比較大的階層可能會合併數個資料格來表示，這會使得較大的階層會有相當多的缺失值。此時，我們會需要依據其他列的值，來回填這些NA值，所用的函式為zoo::na.locf()。 raw <- readxl::read_excel("data/111B歲出政事別預算表.xls", skip=3, col_names = F) raw %>% head(10) ## # A tibble: 10 × 9 ## ...1 ...2 ...3 ...4 ...5 ...6 ...7 ...8 ...9 ## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> ## 1 科 … <NA> <NA> <NA> <NA> 本年… 上年… 前年… "本… ## 2 款 項 目 節 "名 … <NA> <NA> <NA> <NA> ## 3 <NA> <NA> <NA> <NA> "\\n… 2262… 2135… 2039… "126… ## 4 <NA> <NA> <NA> <NA> "\\n(… 2101… 2026… 1907… "750… ## 5 1 <NA> <NA> <NA> "310… 1210… 1186… 1176… "233… ## 6 <NA> 1 <NA> <NA> "310… 1004… 9789… 9973… "258… ## 7 <NA> <NA> 1 <NA> "310… 9205… 8963… 8821… "241… ## 8 <NA> <NA> 2 <NA> "310… 30000 30000 2999… "-" ## 9 <NA> <NA> 3 <NA> "310… 15760 15760 4557… "-" ## 10 <NA> <NA> 4 <NA> "310… 5332 5332 6720… "-" 10.1.1 Basic Cleaning 重新命名欄位名稱 刪去被當成表格標題的多於列（通常是前兩三列）slice(-(1:2))。 觀察資料，「款」可以說是支出大類的代號，例如總統府、行政支出、立法支出、軍事支出、教育支出等。「科」為該單位底下的部門或者項目，例如「行政支出」下有行政院、主計總處支出等。更底下的細類「目」並非本例的分析對象，所以可以刪除。所以，如果款、科均為缺失值的話，代表其為更細的「目」。因此篩去款科為缺失值的所有項目。filter(!is.na(款) | !is.na(科)) 將機構id和機構名稱切分開來，視覺化的時候只會用到機構名稱。separate(機構, c(\"oid\", \"org\"), sep=\"\\n\") names(raw) <- c("款", "科", "目", "節", "機構", "本年度預算", "上年度預算", "上年度決算", "預算差") cleaned <- raw %>% slice(-(1:2)) %>% filter(!is.na(款) | !is.na(科)) %>% select(-目, -節) %>% separate(機構, c("oid", "org"), sep="\\n") cleaned %>% head(10) ## # A tibble: 10 × 8 ## 款 科 oid org 本年度預算 上年度預算 上年度決算 預算差 ## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> ## 1 1 <NA> 3100000000 國務支出 1210301 1186955 1176955.12… 23346 ## 2 <NA> 1 3102010000 總統府 1004797 978916 997305.545… 25881 ## 3 <NA> 2 3102100000 國家安全會議 205504 208039 179649.579… -2535 ## 4 2 <NA> 3200000000 行政支出 6134276 5836481 5477154.58… 297795 ## 5 <NA> 1 3203010000 行政院 1256043 1286646 1268295.23 -30603 ## 6 <NA> 2 3203100000 主計總處 1604967 1478173 1578781.89… 126794 ## 7 <NA> 3 3203300000 人事行政總處 555363 573447 489516.177… -18084 ## 8 <NA> 4 3203340000 公務人力發展… 244346 239453 229852.261… 4893 ## 9 <NA> 5 3203420000 檔案管理局 787429 646081 443133.207… 141348 ## 10 <NA> 6 3203900000 大陸委員會 900896 900866 792491.221… 30 10.1.2 Processing NA 觀察一下現在的資料，發現，行政院、主計總處等均屬於行政支出，但行政支出卻自有一列。依照長表格的格式來說，應嘗試把「款」作為機構的變項。所以將款的數字取代為「行政支出」等支出類別的名稱。 cleaned %>% mutate(款 = ifelse(!is.na(款), org, 款)) %>% head(10) ## # A tibble: 10 × 8 ## 款 科 oid org 本年度預算 上年度預算 上年度決算 預算差 ## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> ## 1 國務支出 <NA> 3100000000 國務支出 1210301 1186955 1176955.1… 23346 ## 2 <NA> 1 3102010000 總統府 1004797 978916 997305.54… 25881 ## 3 <NA> 2 3102100000 國家安全會… 205504 208039 179649.57… -2535 ## 4 行政支出 <NA> 3200000000 行政支出 6134276 5836481 5477154.5… 297795 ## 5 <NA> 1 3203010000 行政院 1256043 1286646 1268295.23 -30603 ## 6 <NA> 2 3203100000 主計總處 1604967 1478173 1578781.8… 126794 ## 7 <NA> 3 3203300000 人事行政總… 555363 573447 489516.17… -18084 ## 8 <NA> 4 3203340000 公務人力發… 244346 239453 229852.26… 4893 ## 9 <NA> 5 3203420000 檔案管理局 787429 646081 443133.20… 141348 ## 10 <NA> 6 3203900000 大陸委員會 900896 900866 792491.22… 30 接下來，希望能夠在「款==NA」的地方填入該欄的「前一個值」例如行政支出。查詢一下（關鍵字如「Fill in NA column values with the last value that was not NA」）還真的有這樣的函式可以操作： zoo::na.locf()：zoo::na.locf() 是 R 語言中 zoo 套件提供的函式，其作用是將缺失值（NA）用最後一個非缺失值（non-missing value）填充。具體而言，na.locf() 函式將會從第一個非缺失值開始向下填充，直到下一個非缺失值出現為止。這種方法稱為 “last observation carried forward”（LOCF），意思是最後觀測值向前填充。 library(zoo) cleaned %>% mutate(款 = ifelse(!is.na(款), org, 款)) %>% mutate(款 = zoo::na.locf(款)) %>% head(10) ## # A tibble: 10 × 8 ## 款 科 oid org 本年度預算 上年度預算 上年度決算 預算差 ## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> ## 1 國務支出 <NA> 3100000000 國務支出 1210301 1186955 1176955.1… 23346 ## 2 國務支出 1 3102010000 總統府 1004797 978916 997305.54… 25881 ## 3 國務支出 2 3102100000 國家安全會… 205504 208039 179649.57… -2535 ## 4 行政支出 <NA> 3200000000 行政支出 6134276 5836481 5477154.5… 297795 ## 5 行政支出 1 3203010000 行政院 1256043 1286646 1268295.23 -30603 ## 6 行政支出 2 3203100000 主計總處 1604967 1478173 1578781.8… 126794 ## 7 行政支出 3 3203300000 人事行政總… 555363 573447 489516.17… -18084 ## 8 行政支出 4 3203340000 公務人力發… 244346 239453 229852.26… 4893 ## 9 行政支出 5 3203420000 檔案管理局 787429 646081 443133.20… 141348 ## 10 行政支出 6 3203900000 大陸委員會 900896 900866 792491.22… 30 太神奇了！看見沒！接下來只要把「科 is NA」的那些該大類支出總數的紀錄給刪除，資料就乾淨了。最後就只會剩下一些資料清理的功伕。完整程式碼可以看下一節。 10.1.3 Complete Code library(zoo) # raw <- readxl::read_excel("data/111B歲出政事別預算總表.xls") raw <- readxl::read_excel("data/111B歲出政事別預算表.xls", skip=3, col_names = F) names(raw) <- c("款", "科", "目", "節", "機構", "本年度預算", "上年度預算", "上年度決算", "預算差") # raw$款 <- na.locf(raw$款) cleaned <- raw %>% filter(!is.na(款) | !is.na(科)) %>% slice(-(1:2)) %>% select(-目, -節) %>% separate(機構, c("oid", "org"), sep="\\n") %>% mutate(款 = ifelse(!is.na(款), org, 款)) %>% mutate(款 = zoo::na.locf(款)) %>% filter(!is.na(科)) %>% select(-科) %>% type_convert() %>% mutate(上年度預算 = as.numeric(上年度預算), 上年度決算 = as.integer(上年度決算), 預算差 = as.numeric(預算差)) %>% replace_na(list(上年度預算 = 0, 上年度決算 = 0)) %>% mutate(預算差 = 本年度預算 - 上年度預算) cleaned %>% head() ## # A tibble: 6 × 7 ## 款 oid org 本年度預算 上年度預算 上年度決算 預算差 ## <chr> <dbl> <chr> <dbl> <dbl> <int> <dbl> ## 1 國務支出 3102010000 總統府 1004797 978916 997305 25881 ## 2 國務支出 3102100000 國家安全會議 205504 208039 179649 -2535 ## 3 行政支出 3203010000 行政院 1256043 1286646 1268295 -30603 ## 4 行政支出 3203100000 主計總處 1604967 1478173 1578781 126794 ## 5 行政支出 3203300000 人事行政總處 555363 573447 489516 -18084 ## 6 行政支出 3203340000 公務人力發展學院 244346 239453 229852 4893 10.2 Cleaning Covid Vaccinating data 這個案例是希望視覺化不同國家（Y）在不同時間點（X）的疫苗施打涵蓋率（將使用熱區圖，所以將用顏色來表示涵蓋率）。涵蓋率的表示法在該資料中為每百萬人施打疫苗數，但也可以轉為百分比，有多少比例的人已經施打過第一劑、第二劑或第三劑等。 資料來源為： https://ourworldindata.org/covid-vaccinations https://github.com/owid/covid-19-data/tree/master/public/data/vaccinations 預期希望看見的結果如下，如何將這份疫苗施打比例的資料做視覺化，請見視覺化的章節??： 10.2.1 觀察並評估資料概況 這是一份資料缺失相當多的資料。評估資料概況後可發現這個資料集每一列就是某一個國家某一天所上傳的紀錄。所以，一個國家會有很多列。乍聽之下不難處理，但事實上每個國家不會每天上傳、也不會固定某一天上傳、哪一週、哪一個月開始上傳也不一定，也有可能會漏掉一些月份或週次。所以，制定出一個時間單位（例如週、月）、然後延著時間軸將資料「對齊」，讓每個國家在每個時間單位都有資料。但每個國家疫情發展程度不一，所以也不可能有一個完美的對齊，所以通常會建議就所要觀察的國家進行對齊即可。至於想刪除的那些資料列，幾乎都可以當成是所謂的缺失值。 raw <- read_csv("data/vaccinations.csv") dim(raw) ## [1] 99442 16 raw %>% head(20) ## # A tibble: 20 × 16 ## location iso_code date total_vaccinations people_vaccinated ## <chr> <chr> <date> <dbl> <dbl> ## 1 Afghanistan AFG 2021-02-22 0 0 ## 2 Afghanistan AFG 2021-02-23 NA NA ## 3 Afghanistan AFG 2021-02-24 NA NA ## 4 Afghanistan AFG 2021-02-25 NA NA ## 5 Afghanistan AFG 2021-02-26 NA NA ## 6 Afghanistan AFG 2021-02-27 NA NA ## 7 Afghanistan AFG 2021-02-28 8200 8200 ## 8 Afghanistan AFG 2021-03-01 NA NA ## 9 Afghanistan AFG 2021-03-02 NA NA ## 10 Afghanistan AFG 2021-03-03 NA NA ## 11 Afghanistan AFG 2021-03-04 NA NA ## 12 Afghanistan AFG 2021-03-05 NA NA ## 13 Afghanistan AFG 2021-03-06 NA NA ## 14 Afghanistan AFG 2021-03-07 NA NA ## 15 Afghanistan AFG 2021-03-08 NA NA ## 16 Afghanistan AFG 2021-03-09 NA NA ## 17 Afghanistan AFG 2021-03-10 NA NA ## 18 Afghanistan AFG 2021-03-11 NA NA ## 19 Afghanistan AFG 2021-03-12 NA NA ## 20 Afghanistan AFG 2021-03-13 NA NA ## # ℹ 11 more variables: people_fully_vaccinated <dbl>, total_boosters <dbl>, ## # daily_vaccinations_raw <dbl>, daily_vaccinations <dbl>, ## # total_vaccinations_per_hundred <dbl>, people_vaccinated_per_hundred <dbl>, ## # people_fully_vaccinated_per_hundred <dbl>, ## # total_boosters_per_hundred <dbl>, daily_vaccinations_per_million <dbl>, ## # daily_people_vaccinated <dbl>, daily_people_vaccinated_per_hundred <dbl> 10.2.2 按月對齊資料 首先要挑選要拿來做視覺化的資料欄位。這邊所選擇的是people_fully_vaccinated_per_hundred，也就是每百人接種二劑疫苗的人數，相當於接種二劑疫苗的百分比。 接下來便是缺失值處理，如果這個欄位沒有數值的就直接用drop_na()篩除即可。 這個範例希望把該資料視覺化為Y軸為年、X軸為時間的熱區圖。但整個疫情資料橫亙二年多，如果以週為彙整單位的話，那勢必X軸會有近百個資料點。所以打算以「月」為單位來彙整這些資料，因為且資料中也有不少國家缺數週的資料，所以以月為彙整單位是一個權衡後的選擇（仍可以嘗試用週作為彙整單位試試看）。所以，運用了lubridate::floor_date()來將日期資料轉換為月，例如2022-03-12和2022-03-14都會被轉換為2022-03-01。 依照國家與時間群組彙整資料。接下來就依照各國的月份來做彙整（注意，此時會有不少資料同屬於某個月的資料）。彙整的方法是，經過對「日期」（不是對月）做排序後，僅留下第一筆資料，也就是僅留下最接近月份開頭的資料。經由這樣的操作，會使得各國在每個月剛好留下一筆資料，如下面程式的範例輸出。 library(lubridate) fullvaccinated <- raw %>% select(country = location, date, people_fully_vaccinated_per_hundred) %>% drop_na(people_fully_vaccinated_per_hundred) %>% mutate(m = floor_date(date, unit = "month")) %>% group_by(country, m) %>% arrange(date) %>% slice(1) %>% ungroup() %>% select(-date) fullvaccinated %>% head(10) ## # A tibble: 10 × 3 ## country people_fully_vaccinated_per_hundred m ## <chr> <dbl> <date> ## 1 Afghanistan 0.14 2021-05-01 ## 2 Afghanistan 0.36 2021-06-01 ## 3 Afghanistan 0.48 2021-07-01 ## 4 Afghanistan 1.08 2021-08-01 ## 5 Afghanistan 8 2021-11-01 ## 6 Afghanistan 9.42 2021-12-01 ## 7 Afghanistan 9.56 2022-01-01 ## 8 Afghanistan 9.82 2022-02-01 ## 9 Afghanistan 10.8 2022-03-01 ## 10 Afghanistan 11.4 2022-04-01 10.2.3 處理遺漏資料的月份 接下來要處理的是資料紀錄的缺漏值。每個國家登錄資料的時間是很不一致的，某些國家會缺某些月份，或者某些國家是在某年某月以後才開始登記，或者最近沒在登記。但這個範例所要視覺化的資料是接種疫苗的比例，所以即使是現在沒在登記了，但接種比例應列計最後一次資料紀錄的接種比例。 首先我要讓每個國家都有所有月份，這裡應會有某個函式可以做到這件事，但我沒查到這個函式。不過我可以很技巧性地用pivot_wider()（spread()）和pivot_longer()（gather()）來完成這件事。spread()在展開時對於缺少的資料項可以自動補NA。所以我就只要把資料的月份展開後再gather()回來後，就可以自動讓每個國家所擁有的月份資料一致。以下為spread()後的結果，可以觀察到每一列是一個國家，每一欄是個月份，如果當月都沒資料紀錄，那該月的值就會是缺失值。可以看見缺失值是相當多的，也就是在那段時間都沒有資料紀錄。 fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% head(10) ## # A tibble: 10 × 19 ## country `2020-12-01` `2021-01-01` `2021-02-01` `2021-03-01` `2021-04-01` ## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> ## 1 Afghanistan NA NA NA NA NA ## 2 Africa NA NA 0 0.02 0.3 ## 3 Albania NA NA 0 NA NA ## 4 Algeria NA NA NA NA NA ## 5 Andorra NA NA NA 1.52 5.8 ## 6 Angola NA NA NA NA NA ## 7 Anguilla NA NA NA NA 5.18 ## 8 Antigua and… NA NA NA NA NA ## 9 Argentina 0 0 0.26 0.69 1.56 ## 10 Armenia NA NA NA NA NA ## # ℹ 13 more variables: `2021-05-01` <dbl>, `2021-06-01` <dbl>, ## # `2021-07-01` <dbl>, `2021-08-01` <dbl>, `2021-09-01` <dbl>, ## # `2021-10-01` <dbl>, `2021-11-01` <dbl>, `2021-12-01` <dbl>, ## # `2022-01-01` <dbl>, `2022-02-01` <dbl>, `2022-03-01` <dbl>, ## # `2022-04-01` <dbl>, `2022-05-01` <dbl> 在以下的範例輸出可以看到gather()後的結果。注意，需要照國家和月份來排序後才便於觀察。 fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% gather(month, perc, -country) %>% arrange(country, month) %>% head(20) ## # A tibble: 20 × 3 ## country month perc ## <chr> <chr> <dbl> ## 1 Afghanistan 2020-12-01 NA ## 2 Afghanistan 2021-01-01 NA ## 3 Afghanistan 2021-02-01 NA ## 4 Afghanistan 2021-03-01 NA ## 5 Afghanistan 2021-04-01 NA ## 6 Afghanistan 2021-05-01 0.14 ## 7 Afghanistan 2021-06-01 0.36 ## 8 Afghanistan 2021-07-01 0.48 ## 9 Afghanistan 2021-08-01 1.08 ## 10 Afghanistan 2021-09-01 NA ## 11 Afghanistan 2021-10-01 NA ## 12 Afghanistan 2021-11-01 8 ## 13 Afghanistan 2021-12-01 9.42 ## 14 Afghanistan 2022-01-01 9.56 ## 15 Afghanistan 2022-02-01 9.82 ## 16 Afghanistan 2022-03-01 10.8 ## 17 Afghanistan 2022-04-01 11.4 ## 18 Afghanistan 2022-05-01 NA ## 19 Africa 2020-12-01 NA ## 20 Africa 2021-01-01 NA 接下來是最技巧性的部分。就接種比例而言是個遞增數列，所以如果這個月有紀錄，但下個月沒紀錄（NA），那下個月的資料應以這個月的資料來替代。此時可以用zoo套件的na.locf()來填NA值，其填NA值的規則是用最後一筆非NA值的資料來替代NA值。但要注意的是，因為資料紀錄可能到第六個月或第七個月才開始紀錄，但在前面的月份都沒資料紀錄，也就是說那些NA值沒有更早的資料紀錄權充填充值。原本na.locf()會把這些找不到參考對象的NA值直接刪除，但我們可以在裡面加一個參數使其不會被刪除（na.locf(perc, na.rm = F)）。 最後，就把這些沒被刪除也沒得參考的早期資料項，用replace_na()填上0即可。 fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% gather(month, perc, -country) %>% arrange(country, month) %>% group_by(country) %>% arrange(month) %>% mutate(perc = zoo::na.locf(perc, na.rm = F)) %>% ungroup() %>% arrange(country, month) %>% head(10) ## # A tibble: 10 × 3 ## country month perc ## <chr> <chr> <dbl> ## 1 Afghanistan 2020-12-01 NA ## 2 Afghanistan 2021-01-01 NA ## 3 Afghanistan 2021-02-01 NA ## 4 Afghanistan 2021-03-01 NA ## 5 Afghanistan 2021-04-01 NA ## 6 Afghanistan 2021-05-01 0.14 ## 7 Afghanistan 2021-06-01 0.36 ## 8 Afghanistan 2021-07-01 0.48 ## 9 Afghanistan 2021-08-01 1.08 ## 10 Afghanistan 2021-09-01 1.08 最後，就把這些沒被刪除也沒得參考的早期資料項，用replace_na()填上0即可。大功告成。 fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% gather(month, perc, -country) %>% arrange(country, month) %>% group_by(country) %>% arrange(month) %>% mutate(perc = zoo::na.locf(perc, na.rm = F)) %>% ungroup() %>% arrange(country, month) %>% replace_na(list(perc=0)) %>% arrange(country, month) %>% head(10) ## # A tibble: 10 × 3 ## country month perc ## <chr> <chr> <dbl> ## 1 Afghanistan 2020-12-01 0 ## 2 Afghanistan 2021-01-01 0 ## 3 Afghanistan 2021-02-01 0 ## 4 Afghanistan 2021-03-01 0 ## 5 Afghanistan 2021-04-01 0 ## 6 Afghanistan 2021-05-01 0.14 ## 7 Afghanistan 2021-06-01 0.36 ## 8 Afghanistan 2021-07-01 0.48 ## 9 Afghanistan 2021-08-01 1.08 ## 10 Afghanistan 2021-09-01 1.08 10.2.4 完整程式碼 library(lubridate) raw <- read_csv("data/vaccinations.csv") fullvaccinated <- raw %>% select(country = location, date, people_fully_vaccinated_per_hundred) %>% drop_na(people_fully_vaccinated_per_hundred) %>% mutate(m = floor_date(date, unit = "month")) %>% group_by(country, m) %>% arrange(date) %>% slice(1) %>% ungroup() %>% select(-date) vperc_by_month <- fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% gather(month, perc, -country) %>% arrange(country, month) %>% group_by(country) %>% arrange(month) %>% mutate(perc = zoo::na.locf(perc, na.rm = F)) %>% ungroup() %>% arrange(country, month) %>% replace_na(list(perc=0)) 如何將這份疫苗施打比例的資料做視覺化，請見視覺化的章節?? "],["tm.html", "Chapter 11 Text Processing", " Chapter 11 Text Processing "],["trump.html", "Chapter 12 Trump’s tweets 12.1 Loading data 12.2 Cleaning data 12.3 Visual Exploring 12.4 Keyness", " Chapter 12 Trump’s tweets 本範例取材自David Robinson的blog文章「Text analysis of Trump’s tweets confirms he writes only the (angrier) Android half」。David Robinson是「Text Mining with R」的共同作者， 可參考該書籍上的範例「7 Case study: comparing Twitter archives | Text Mining with R (tidytextmining.com)」。 這篇文章探討了美國前總統川普（Donald Trump）的推特帳號。有一個假設聲稱，當川普在推特上祝福奧運會選手好運時，他使用的是 iPhone ；當他侮辱競爭對手時，他通常是用 Android 來發推。文章作者想要透過數據分析來探討這個假設的真實性。 作者使用了文字探勘和情感分析等技術，從川普的推特內容入手，分析了不同時間和使用不同手機所發的推文。結果顯示，Android 和 iPhone 所發的推文顯然是由不同的人所發，他們在使用標籤、連結和轉推的方式上也不同。此外，Android 的推文更加憤怒和負面，而 iPhone 的推文則傾向於發佈善意的公告和圖片。整體而言，這些分析讓我們能夠區分出競選團隊所發佈的推文（iPhone）和川普自己所發佈的推文（Android）。 這個教學案例涵蓋了使用 R 語言進行社群輿論資料（tweets）的探索性分析的各種技術和工具。除了使用常見的資料處理套件 dplyr 和視覺化套件 ggplot 外，還使用了文字處理套件 stringr 和時間處理套件 lubridate，以及關鍵字分析技術 keyness。 透過這個教學案例，學習者可以掌握如何： 使用 dplyr 和 ggplot 進行資料處理和視覺化。 使用 stringr 和 extract() 進行文字處理，例如從文本中提取關鍵字。 使用 lubridate 進行時間處理，例如轉換時間格式和提取時間戳記。 學習關鍵字分析技術 keyness，以找出在不同文本之間對彼此相對突出的關鍵字。 這段程式碼是用來設計 ggplot2 的主題風格。作者首先定義了一個名為 th 的自訂主題，基於 ggplot2 的 theme_minimal() 主題，並設置了不同元素的字型、大小和樣式等屬性。接著，作者定義了一個名為 new_style() 的函數，用於更精細的主題風格設置，包括圖表標題、圖例、軸標籤和刻度標籤等。透過這些設置，可以讓 ggplot2 圖表更具有視覺吸引力，並強調重要的圖形元素，使圖表更加清晰易懂。這兩種方式都可以用來定義主題 library(tidyverse) # library(lubridate) # has been included in tidyverse options(scipen = 999) # Self-designed theme th <- theme_minimal() + theme(plot.title = element_text(size=24, face="bold"), legend.title = element_text(size=18, face="bold"), legend.text = element_text(size=18), axis.title = element_text(hjust=0.5, size=18, face="italic"), axis.text = element_text(size=18) ) # more settings new_style <- function() { font <- "Helvetica" theme( plot.title = element_text(family=font, size=28, face="bold"), plot.subtitle = element_text(family=font, size=22, margin=margin(9,0,9,0)), plot.caption = element_blank(), legend.position = "top", legend.text.align = 0, legend.background = element_blank(), # legend.title = element_blank(), legend.key = element_blank(), legend.text = element_text(family=font, size=18, color="#222222"), axis.text = element_text(family=font, size=18, color="#222222"), axis.text.x = element_text(margin=margin(5, b = 10)), axis.ticks = element_blank(), axis.line = element_blank(), panel.grid.minor = element_blank(), panel.grid.major.y = element_line(color="#cbcbcb"), panel.grid.major.x = element_blank(), panel.background = element_blank(), strip.background = element_rect(fill="white"), strip.text = element_text(size = 22, hjust = 0) ) } 12.1 Loading data load(url("http://varianceexplained.org/files/trump_tweets_df.rda")) dim(trump_tweets_df) ## [1] 1512 16 names(trump_tweets_df) ## [1] "text" "favorited" "favoriteCount" "replyToSN" ## [5] "created" "truncated" "replyToSID" "id" ## [9] "replyToUID" "statusSource" "screenName" "retweetCount" ## [13] "isRetweet" "retweeted" "longitude" "latitude" trump_tweets_df %>% select(id, text, created, favoriteCount, retweetCount, statusSource) %>% head(10) ## # A tibble: 10 × 6 ## id text created favoriteCount retweetCount statusSource ## <chr> <chr> <dttm> <dbl> <dbl> <chr> ## 1 7626698825… "My … 2016-08-08 15:20:44 9214 3107 "<a href=\\"… ## 2 7626415954… "Joi… 2016-08-08 13:28:20 6981 2390 "<a href=\\"… ## 3 7624396589… "#IC… 2016-08-08 00:05:54 15724 6691 "<a href=\\"… ## 4 7624253718… "Mic… 2016-08-07 23:09:08 19837 6402 "<a href=\\"… ## 5 7624008698… "The… 2016-08-07 21:31:46 34051 11717 "<a href=\\"… ## 6 7622845333… "I s… 2016-08-07 13:49:29 29831 9892 "<a href=\\"… ## 7 7621109187… "Tha… 2016-08-07 02:19:37 19223 5784 "<a href=\\"… ## 8 7621069044… ".@L… 2016-08-07 02:03:39 19543 7930 "<a href=\\"… ## 9 7621044117… "I a… 2016-08-07 01:53:45 75488 24663 "<a href=\\"… ## 10 7620164261… "#Cr… 2016-08-06 20:04:08 23661 7903 "<a href=\\"… 12.2 Cleaning data 這段程式碼的目的是從一個叫做trump_tweets_df的data.frame中，選擇幾個欄位並且進行過濾和轉換，最後將結果存儲在一個名為tweets的新data.frame中。 extract()函數用於從statusSource欄位中提取出一個新欄位source，該欄位包含了statusSource中的Twitter for iPhone和Twitter for Android這兩種可能的字串。這裡使用了一個正則表達式Twitter for (.*?)<，該表達式表示提取出以Twitter for開頭，且在<符號之前的任意字元序列，並將結果存儲在名為source的新欄位中。 最後，filter()函數用於過濾出source欄位中值為iPhone或Android的記錄，並將過濾結果存儲在tweets資料框中。 # tidyr::extract() # stringr::str_replace trump_tweets_df$statusSource[1] ## [1] "<a href=\\"http://twitter.com/download/android\\" rel=\\"nofollow\\">Twitter for Android</a>" tweets <- trump_tweets_df %>% select(id, statusSource, text, created) %>% # mutate(source = str_replace(statusSource, # ".*Twitter for (.*?)<.*", "\\\\1")) %>% # mutate(source = str_extract(statusSource, 'Twitter for (.*?)<')) %>% View extract(statusSource, "source", "Twitter for (.*?)<") %>% filter(source %in% c("iPhone", "Android")) # Using stringr::str_replace() to mutate a new source variable, replacing tidyr:: # str(tweets) Practice. 有時候我們會希望避免用太多種套件來寫程式，例如上面的extract()便屬於tidyr的函式。事實上我們可以用stringr::str_replace()來達到這個目的。嘗試寫寫看？或者嘗試問ChatGPT看看？ Prompt. 我如果希望用stringr::str_replace來達到extract(statusSource, \"source\", \"Twitter for (.*?)<\") %>%的功能，我該怎麼寫？ mutate(source = stringr::str_replace(statusSource, \".*Twitter for (.*?)<.*\", \"\\\\1\")) %>% 12.3 Visual Exploring 12.3.1 Productivity by time hour = hour(with_tz(created, \"EST\"))這段程式碼使用了with_tz()函數將created欄位的時區轉換為\"EST\"所對應的時區，然後使用hour()函數提取出該日期時間對應的小時數，並將結果存儲在hour變數中。該程式碼會將例如\"2023-04-12 12:30:00\"轉換為美國東部標準時間對應的小時數，即12（因為12點30分所在的小時是12點）。他所取出的並非某日的12時，他就只是取出是12時。 toplot1和toplot2的差異在於對source欄位的分組處理不同。具體來說，toplot1中沒有對source欄位進行分組，而是在後面使用mutate()函數將計數結果中的n列和sum(n)相除，得到了百分比列percent。這導致計算的是整個資料集中的hour和source的計數和百分比。相反，toplot2中使用了group_by()函數將source欄位進行分組處理，並在後面使用mutate()函數和ungroup()函數計算了每個source和hour的計數和百分比，即分別計算了iPhone和Android的計數和百分比。因此，toplot1和toplot2的計算結果是不同的，前者的計算結果中包含了整個資料集的計數和百分比，而後者的計算結果則分別對iPhone和Android進行了計數和百分比的計算。 程式碼使用了ggplot()函數創建了一個ggplot2物件，並使用aes()函數設置了hour和percent欄位作為X軸和Y軸的變數，並且設置color = source表示以source欄位的值作為不同群組（iPhone vs. Android）折線的顏色。接著，程式碼使用geom_line()函數添加折線到圖中，設置了折線的粗細為1。使用scale_color_manual()函數設置了圖例的名稱為Phone System，標籤依照分組指定為為Android和iPhone，顏色分別為royalblue和gold，並使用scale_y_continuous()函數設置了Y軸刻度標籤的格式為百分比形式，即0%到100%之間的數值。注意：percent_format()並非ggplot2既有的函式，要另外安裝並匯入library(scales)。 library(scales) # for percent_format() # lubridate::hour() # lubridate::with_tz() # scales::percent_format() toplot1 <- tweets %>% count(source, hour = hour(with_tz(created, "EST"))) %>% # group_by(source) %>% mutate(percent = n / sum(n)) # ungroup() %>% toplot2 <- tweets %>% count(source, hour = hour(with_tz(created, "EST"))) %>% group_by(source) %>% mutate(percent = n / sum(n)) %>% ungroup() p1 <- toplot1 %>% ggplot() + aes(hour, percent, color = source) + geom_line(linewidth = 1) + scale_color_manual(name = "Phone System", labels = c("Android", "iPhone"), values = c("royalblue", "gold")) + scale_y_continuous(labels = percent_format()) + labs(x = "Hour of day (EST)", y = "% of tweets", color = "") + theme_minimal() p2 <- toplot2 %>% ggplot() + aes(hour, percent, color = source) + geom_line(linewidth = 1) + scale_color_manual(name = "Phone System", labels = c("Android", "iPhone"), values = c("royalblue", "gold")) + scale_y_continuous(labels = percent_format()) + labs(x = "Hour of day (EST)", y = "% of tweets", color = "") + theme_minimal() cowplot::plot_grid( p1, NULL, p2, labels = c("(a) Normalized by all", "", "(b) Normalized in group"), nrow = 1, rel_widths = c(1, 0.1, 1) ) 12.3.2 Tweeting with figures 首先，filter()函數用於從tweets資料框中過濾出不以\"字符開頭的推文，即過濾掉引號開頭的推文。這裡使用了!str_detect(text, '^\"')表示將text欄位中以\"字符開頭的推文過濾掉，即保留那些不以引號開頭的推文。'^\"'是一個正規表示式（Regular Expression），'^'符號代表字串的開頭。 接著，mutate()函數用於在tweets資料框中添加一個新欄位picture，該欄位根據推文中是否包含t.co字串來判斷推文中是否包含圖片或者連結。具體來說，這裡使用了if_else()函數，如果text欄位中包含t.co字串，則將picture欄位設置為\"Picture/link\"，否則設置為\"No picture/link\"。 最後，使用count()函數計算tweets資料框中每個source和picture的記錄數，並將結果存儲在toplot資料框中。最終的結果是一個展示tweets資料框中source和picture的記錄數的資料框，其中picture欄位表示推文中是否包含圖片或連結。 p1和p2的主要區別在於barplot的呈現方式不同。具體來說： p1中使用了position=\"stack\"的參數，表示將不同分組的bar疊加在一起，以展示每個source的總推文數量，並且bar的寬度設置為0.5（使用width參數），使得bar之間有一定的間隔。這種方式可以方便地比較不同source的總推文數量，並且可以看到每個source中有多少推文包含圖片或連結。 p2中使用了position=\"dodge\"的參數，表示將不同分組的bar並排放置，以便比較不同source中包含或不包含圖片或連結的推文數量。這種方式可以顯示出每個source中有多少推文包含或不包含圖片或連結，並且可以清楚地比較不同source之間的差異。 toplot <- tweets %>% filter(!str_detect(text, '^"')) %>% mutate(picture = if_else(str_detect(text, "t.co"), "Picture/link", "No picture/link")) %>% count(source, picture) p1 <- toplot %>% ggplot() + aes(source, n, fill = picture) + geom_col(position="stack", width = 0.5) + scale_fill_manual(name = "With Picture/link?", labels = c("No", "Yes"), values = c("gold", "royalblue")) + labs(x = "", y = "Number of tweets", fill = "") + theme_minimal() p2 <- toplot %>% ggplot() + aes(source, n, fill = picture) + geom_col(position="dodge") + scale_fill_manual(name = "With Picture/link?", labels = c("No", "Yes"), values = c("gold", "royalblue")) + labs(x = "", y = "Number of tweets", fill = "") + theme_minimal() cowplot::plot_grid( p1, NULL, p2, labels = c("(a) Stacked", "", "(b) Dodged"), nrow = 1, rel_widths = c(1, 0.1, 1) ) 12.4 Keyness Keyness是一種文本分析方法，用於比較兩個文本集合中某些詞彙的使用頻率（例如我們要比較用iPhone和Android兩支手機所發表的內容是否有文字上的差異），以評估這些詞彙在不同文本集合中的重要性或關鍵程度。Keyness分析通常用於比較兩個文本集合，其中一個是目標文本集合，另一個是參照文本集合，並且通常會將這些文本集合中的單詞或詞彙按照出現頻率排序。 使用filter()函數過濾出不以\"字符開頭的推文，即過濾掉引號開頭的推文，將結果存儲在tweets資料框中。 使用mutate()函數將推文中的URL和&amp;字符替換為空白字符，即將推文中的網址和HTML實體轉換為正常的字符，方便後續的文本處理。 使用mutate()函數將tweets資料框中的text欄位拆分為單詞序列，存儲在word欄位中。這裡使用了str_split()函數將每個推文按照空格進行拆分，得到一個由單詞序列組成的列表，然後將這個列表存儲在word欄位中。 使用select()函數選擇需要的欄位，包括tweets資料框中的id、text和word欄位，以及tweets資料框中的所有其他欄位。 使用unnest()函數將word欄位中的單詞序列展開成一個單詞資料框，每個單詞對應一行記錄。 使用filter()函數過濾掉停用詞和非英文字符，其中停用詞（stop words）列表存儲在stop_words資料框中，通過!word %in% stop_words$word條件過濾掉停用詞，並且通過str_detect(word, \"[a-z]\")條件過濾掉不包含英文字母的單詞。最終，將結果存儲在tweets資料框中。 停用詞（stop words）指的是在文本中出現頻率非常高，但對於文本的內容和意義貢獻不大的詞彙。這些詞彙通常是一些常見的介詞、連詞、代詞、冠詞、助動詞等，例如”the”、“and”、“a”、“in”等。在文本分析中，停用詞通常被過濾掉，以便更好地捕捉文本中的主題和意義。在中文文本分析中，常見的停用詞包括一些虛詞、代詞、介詞、助詞等，例如”的”、“是”、“在”、“和”、“了”、“一”等。這些詞在中文文本中出現的頻率非常高，但對於文本的內容和意義貢獻不大，因此在文本分析中通常被過濾掉。 停用詞的列表通常是由人為構建的，根據具體的文本分析任務和文本的特徵來決定。在自然語言處理中，通常會使用預先定義好的停用詞列表，例如英文中的NLTK（Natural Language Toolkit）庫中就包含了一個預先定義好的停用詞列表。 在進行文本分析時，過濾掉停用詞可以幫助減少文本資料的雜訊和冗余訊息，提高分析的準確性和效率。但是，在某些特定的文本分析任務中，停用詞可能具有一定的重要性，例如情感分析中的否定詞（如”not”）可能對情感分析的結果產生重要的影響，因此需要特殊處理。如果進行的是網絡舆情分析，那麼一些特定的網絡用語和表情符號可能也需要被加入停用詞列表中，以避免對分析結果產生干擾。 unnest_tokens()和mutate()函數都可以用於將文本data.frame中的文本數據進行分詞處理，但它們的實現方式有所不同。mutate()函數使用str_split()函數將每個文本按照指定的分隔符（如上述程式碼即以空白\" \"做為分隔符號）進行拆分，得到一個由單詞序列組成的list。這樣做的缺點是無法同時將文本中的標點符號、空格、停用詞等過濾掉，因此在進行文本分析時需要額外進行過濾處理。 unnest_tokens()函數則使用更靈活的正則表達式（regex）來指定單詞的分割方式，可以將文本中的單詞、標點符號、空格等都分割開來，並且可以通過指定特定的正則表達式來過濾停用詞、非英文字符等。unnest_tokens()函數還可以將分割後的單詞list展開成一個單詞data.frame，每個單詞對應一行記錄，這樣更容易進行後續的文本分析和可視化。在unnest_tokens(word, text, token = \"regex\", pattern = \"[^A-Za-z\\\\d#@']\") %>%中，word表示新建的單詞欄位的名稱，text表示原始文本欄位的名稱，token表示使用的分割方式，這裡指定為正則表達式；pattern則是指定的正則表達式，其中[^A-Za-z\\\\d#@']表示匹配不屬於字母、數字、@、#、’的任意字符，即過濾掉非英文字符和一些標點符號。 library(tidytext) # unnest_tokens() library(stringr) # str_detect(), str_replace_all() # View(test) stop_words$word ## [1] "a" "a's" "able" "about" ## [5] "above" "according" "accordingly" "across" ## [9] "actually" "after" "afterwards" "again" ## [13] "against" "ain't" "all" "allow" ## [17] "allows" "almost" "alone" "along" ## [21] "already" "also" "although" "always" ## [25] "am" "among" "amongst" "an" ## [29] "and" "another" "any" "anybody" ## [33] "anyhow" "anyone" "anything" "anyway" ## [37] "anyways" "anywhere" "apart" "appear" ## [41] "appreciate" "appropriate" "are" "aren't" ## [45] "around" "as" "aside" "ask" ## [49] "asking" "associated" "at" "available" ## [53] "away" "awfully" "b" "be" ## [57] "became" "because" "become" "becomes" ## [61] "becoming" "been" "before" "beforehand" ## [65] "behind" "being" "believe" "below" ## [69] "beside" "besides" "best" "better" ## [73] "between" "beyond" "both" "brief" ## [77] "but" "by" "c" "c'mon" ## [81] "c's" "came" "can" "can't" ## [85] "cannot" "cant" "cause" "causes" ## [89] "certain" "certainly" "changes" "clearly" ## [93] "co" "com" "come" "comes" ## [97] "concerning" "consequently" "consider" "considering" ## [101] "contain" "containing" "contains" "corresponding" ## [105] "could" "couldn't" "course" "currently" ## [109] "d" "definitely" "described" "despite" ## [113] "did" "didn't" "different" "do" ## [117] "does" "doesn't" "doing" "don't" ## [121] "done" "down" "downwards" "during" ## [125] "e" "each" "edu" "eg" ## [129] "eight" "either" "else" "elsewhere" ## [133] "enough" "entirely" "especially" "et" ## [137] "etc" "even" "ever" "every" ## [141] "everybody" "everyone" "everything" "everywhere" ## [145] "ex" "exactly" "example" "except" ## [149] "f" "far" "few" "fifth" ## [153] "first" "five" "followed" "following" ## [157] "follows" "for" "former" "formerly" ## [161] "forth" "four" "from" "further" ## [165] "furthermore" "g" "get" "gets" ## [169] "getting" "given" "gives" "go" ## [173] "goes" "going" "gone" "got" ## [177] "gotten" "greetings" "h" "had" ## [181] "hadn't" "happens" "hardly" "has" ## [185] "hasn't" "have" "haven't" "having" ## [189] "he" "he's" "hello" "help" ## [193] "hence" "her" "here" "here's" ## [197] "hereafter" "hereby" "herein" "hereupon" ## [201] "hers" "herself" "hi" "him" ## [205] "himself" "his" "hither" "hopefully" ## [209] "how" "howbeit" "however" "i" ## [213] "i'd" "i'll" "i'm" "i've" ## [217] "ie" "if" "ignored" "immediate" ## [221] "in" "inasmuch" "inc" "indeed" ## [225] "indicate" "indicated" "indicates" "inner" ## [229] "insofar" "instead" "into" "inward" ## [233] "is" "isn't" "it" "it'd" ## [237] "it'll" "it's" "its" "itself" ## [241] "j" "just" "k" "keep" ## [245] "keeps" "kept" "know" "knows" ## [249] "known" "l" "last" "lately" ## [253] "later" "latter" "latterly" "least" ## [257] "less" "lest" "let" "let's" ## [261] "like" "liked" "likely" "little" ## [265] "look" "looking" "looks" "ltd" ## [269] "m" "mainly" "many" "may" ## [273] "maybe" "me" "mean" "meanwhile" ## [277] "merely" "might" "more" "moreover" ## [281] "most" "mostly" "much" "must" ## [285] "my" "myself" "n" "name" ## [289] "namely" "nd" "near" "nearly" ## [293] "necessary" "need" "needs" "neither" ## [297] "never" "nevertheless" "new" "next" ## [301] "nine" "no" "nobody" "non" ## [305] "none" "noone" "nor" "normally" ## [309] "not" "nothing" "novel" "now" ## [313] "nowhere" "o" "obviously" "of" ## [317] "off" "often" "oh" "ok" ## [321] "okay" "old" "on" "once" ## [325] "one" "ones" "only" "onto" ## [329] "or" "other" "others" "otherwise" ## [333] "ought" "our" "ours" "ourselves" ## [337] "out" "outside" "over" "overall" ## [341] "own" "p" "particular" "particularly" ## [345] "per" "perhaps" "placed" "please" ## [349] "plus" "possible" "presumably" "probably" ## [353] "provides" "q" "que" "quite" ## [357] "qv" "r" "rather" "rd" ## [361] "re" "really" "reasonably" "regarding" ## [365] "regardless" "regards" "relatively" "respectively" ## [369] "right" "s" "said" "same" ## [373] "saw" "say" "saying" "says" ## [377] "second" "secondly" "see" "seeing" ## [381] "seem" "seemed" "seeming" "seems" ## [385] "seen" "self" "selves" "sensible" ## [389] "sent" "serious" "seriously" "seven" ## [393] "several" "shall" "she" "should" ## [397] "shouldn't" "since" "six" "so" ## [401] "some" "somebody" "somehow" "someone" ## [405] "something" "sometime" "sometimes" "somewhat" ## [409] "somewhere" "soon" "sorry" "specified" ## [413] "specify" "specifying" "still" "sub" ## [417] "such" "sup" "sure" "t" ## [421] "t's" "take" "taken" "tell" ## [425] "tends" "th" "than" "thank" ## [429] "thanks" "thanx" "that" "that's" ## [433] "thats" "the" "their" "theirs" ## [437] "them" "themselves" "then" "thence" ## [441] "there" "there's" "thereafter" "thereby" ## [445] "therefore" "therein" "theres" "thereupon" ## [449] "these" "they" "they'd" "they'll" ## [453] "they're" "they've" "think" "third" ## [457] "this" "thorough" "thoroughly" "those" ## [461] "though" "three" "through" "throughout" ## [465] "thru" "thus" "to" "together" ## [469] "too" "took" "toward" "towards" ## [473] "tried" "tries" "truly" "try" ## [477] "trying" "twice" "two" "u" ## [481] "un" "under" "unfortunately" "unless" ## [485] "unlikely" "until" "unto" "up" ## [489] "upon" "us" "use" "used" ## [493] "useful" "uses" "using" "usually" ## [497] "uucp" "v" "value" "various" ## [501] "very" "via" "viz" "vs" ## [505] "w" "want" "wants" "was" ## [509] "wasn't" "way" "we" "we'd" ## [513] "we'll" "we're" "we've" "welcome" ## [517] "well" "went" "were" "weren't" ## [521] "what" "what's" "whatever" "when" ## [525] "whence" "whenever" "where" "where's" ## [529] "whereafter" "whereas" "whereby" "wherein" ## [533] "whereupon" "wherever" "whether" "which" ## [537] "while" "whither" "who" "who's" ## [541] "whoever" "whole" "whom" "whose" ## [545] "why" "will" "willing" "wish" ## [549] "with" "within" "without" "won't" ## [553] "wonder" "would" "would" "wouldn't" ## [557] "x" "y" "yes" "yet" ## [561] "you" "you'd" "you'll" "you're" ## [565] "you've" "your" "yours" "yourself" ## [569] "yourselves" "z" "zero" "i" ## [573] "me" "my" "myself" "we" ## [577] "our" "ours" "ourselves" "you" ## [581] "your" "yours" "yourself" "yourselves" ## [585] "he" "him" "his" "himself" ## [589] "she" "her" "hers" "herself" ## [593] "it" "its" "itself" "they" ## [597] "them" "their" "theirs" "themselves" ## [601] "what" "which" "who" "whom" ## [605] "this" "that" "these" "those" ## [609] "am" "is" "are" "was" ## [613] "were" "be" "been" "being" ## [617] "have" "has" "had" "having" ## [621] "do" "does" "did" "doing" ## [625] "would" "should" "could" "ought" ## [629] "i'm" "you're" "he's" "she's" ## [633] "it's" "we're" "they're" "i've" ## [637] "you've" "we've" "they've" "i'd" ## [641] "you'd" "he'd" "she'd" "we'd" ## [645] "they'd" "i'll" "you'll" "he'll" ## [649] "she'll" "we'll" "they'll" "isn't" ## [653] "aren't" "wasn't" "weren't" "hasn't" ## [657] "haven't" "hadn't" "doesn't" "don't" ## [661] "didn't" "won't" "wouldn't" "shan't" ## [665] "shouldn't" "can't" "cannot" "couldn't" ## [669] "mustn't" "let's" "that's" "who's" ## [673] "what's" "here's" "there's" "when's" ## [677] "where's" "why's" "how's" "a" ## [681] "an" "the" "and" "but" ## [685] "if" "or" "because" "as" ## [689] "until" "while" "of" "at" ## [693] "by" "for" "with" "about" ## [697] "against" "between" "into" "through" ## [701] "during" "before" "after" "above" ## [705] "below" "to" "from" "up" ## [709] "down" "in" "out" "on" ## [713] "off" "over" "under" "again" ## [717] "further" "then" "once" "here" ## [721] "there" "when" "where" "why" ## [725] "how" "all" "any" "both" ## [729] "each" "few" "more" "most" ## [733] "other" "some" "such" "no" ## [737] "nor" "not" "only" "own" ## [741] "same" "so" "than" "too" ## [745] "very" "a" "about" "above" ## [749] "across" "after" "again" "against" ## [753] "all" "almost" "alone" "along" ## [757] "already" "also" "although" "always" ## [761] "among" "an" "and" "another" ## [765] "any" "anybody" "anyone" "anything" ## [769] "anywhere" "are" "area" "areas" ## [773] "around" "as" "ask" "asked" ## [777] "asking" "asks" "at" "away" ## [781] "back" "backed" "backing" "backs" ## [785] "be" "became" "because" "become" ## [789] "becomes" "been" "before" "began" ## [793] "behind" "being" "beings" "best" ## [797] "better" "between" "big" "both" ## [801] "but" "by" "came" "can" ## [805] "cannot" "case" "cases" "certain" ## [809] "certainly" "clear" "clearly" "come" ## [813] "could" "did" "differ" "different" ## [817] "differently" "do" "does" "done" ## [821] "down" "down" "downed" "downing" ## [825] "downs" "during" "each" "early" ## [829] "either" "end" "ended" "ending" ## [833] "ends" "enough" "even" "evenly" ## [837] "ever" "every" "everybody" "everyone" ## [841] "everything" "everywhere" "face" "faces" ## [845] "fact" "facts" "far" "felt" ## [849] "few" "find" "finds" "first" ## [853] "for" "four" "from" "full" ## [857] "fully" "further" "furthered" "furthering" ## [861] "furthers" "gave" "general" "generally" ## [865] "get" "gets" "give" "given" ## [869] "gives" "go" "going" "good" ## [873] "goods" "got" "great" "greater" ## [877] "greatest" "group" "grouped" "grouping" ## [881] "groups" "had" "has" "have" ## [885] "having" "he" "her" "here" ## [889] "herself" "high" "high" "high" ## [893] "higher" "highest" "him" "himself" ## [897] "his" "how" "however" "i" ## [901] "if" "important" "in" "interest" ## [905] "interested" "interesting" "interests" "into" ## [909] "is" "it" "its" "itself" ## [913] "just" "keep" "keeps" "kind" ## [917] "knew" "know" "known" "knows" ## [921] "large" "largely" "last" "later" ## [925] "latest" "least" "less" "let" ## [929] "lets" "like" "likely" "long" ## [933] "longer" "longest" "made" "make" ## [937] "making" "man" "many" "may" ## [941] "me" "member" "members" "men" ## [945] "might" "more" "most" "mostly" ## [949] "mr" "mrs" "much" "must" ## [953] "my" "myself" "necessary" "need" ## [957] "needed" "needing" "needs" "never" ## [961] "new" "new" "newer" "newest" ## [965] "next" "no" "nobody" "non" ## [969] "noone" "not" "nothing" "now" ## [973] "nowhere" "number" "numbers" "of" ## [977] "off" "often" "old" "older" ## [981] "oldest" "on" "once" "one" ## [985] "only" "open" "opened" "opening" ## [989] "opens" "or" "order" "ordered" ## [993] "ordering" "orders" "other" "others" ## [997] "our" "out" "over" "part" ## [1001] "parted" "parting" "parts" "per" ## [1005] "perhaps" "place" "places" "point" ## [1009] "pointed" "pointing" "points" "possible" ## [1013] "present" "presented" "presenting" "presents" ## [1017] "problem" "problems" "put" "puts" ## [1021] "quite" "rather" "really" "right" ## [1025] "right" "room" "rooms" "said" ## [1029] "same" "saw" "say" "says" ## [1033] "second" "seconds" "see" "seem" ## [1037] "seemed" "seeming" "seems" "sees" ## [1041] "several" "shall" "she" "should" ## [1045] "show" "showed" "showing" "shows" ## [1049] "side" "sides" "since" "small" ## [1053] "smaller" "smallest" "some" "somebody" ## [1057] "someone" "something" "somewhere" "state" ## [1061] "states" "still" "still" "such" ## [1065] "sure" "take" "taken" "than" ## [1069] "that" "the" "their" "them" ## [1073] "then" "there" "therefore" "these" ## [1077] "they" "thing" "things" "think" ## [1081] "thinks" "this" "those" "though" ## [1085] "thought" "thoughts" "three" "through" ## [1089] "thus" "to" "today" "together" ## [1093] "too" "took" "toward" "turn" ## [1097] "turned" "turning" "turns" "two" ## [1101] "under" "until" "up" "upon" ## [1105] "us" "use" "used" "uses" ## [1109] "very" "want" "wanted" "wanting" ## [1113] "wants" "was" "way" "ways" ## [1117] "we" "well" "wells" "went" ## [1121] "were" "what" "when" "where" ## [1125] "whether" "which" "while" "who" ## [1129] "whole" "whose" "why" "will" ## [1133] "with" "within" "without" "work" ## [1137] "worked" "working" "works" "would" ## [1141] "year" "years" "yet" "you" ## [1145] "young" "younger" "youngest" "your" ## [1149] "yours" tweet_words <- tweets %>% filter(!str_detect(text, '^"')) %>% mutate(text = str_replace_all(text, "https://t.co/[A-Za-z\\\\d]+|&amp;", "")) %>% # unnest_tokens(word, text) %>% # unnest_tokens(word, text, token = "regex", pattern = "[^A-Za-z\\\\d#@']") %>% mutate(word = str_split(text, " ")) %>% select(id, text, word, everything()) %>% unnest(word) %>% filter(!word %in% stop_words$word) %>% filter(str_detect(word, "[a-z]")) # View(tweet_words) 這段程式碼用於分析文本數據中出現頻率最高的單詞（word），並使用barplot進行視覺化呈現。具體來說，這段程式碼實現了以下幾個步驟： 使用count()函數對data.frame中的單詞word進行計數，得到每個單詞出現的次數，並按照次數降序排列。 使用head()函數選擇出現次數最高的前20個單詞，並用mutate()函數將這20個單詞按照出現次數重新排序（注意reorder()的寫法）。 geom_col()函數用於繪製barplot，coord_flip()函數用於將x軸和y軸互換，以便更好地顯示barplot。 tweet_words %>% count(word, sort = TRUE) %>% head(20) %>% mutate(word = reorder(word, n)) %>% ggplot(aes(word, n)) + geom_col(fill = "royalblue") + ylab("Occurrences") + coord_flip() + theme_minimal() + theme(axis.text = element_text(size=10)) 12.4.1 Log-likelihood ratio word_by_source的程式碼用於將單詞按照來源（source）進行分類，並統計每個來源中每個單詞出現的次數： 使用count()函數對單詞資料框中的單詞按照來源進行計數，並且將計數結果按照單詞和來源兩個變數進行分組。並使用filter()函數過濾掉在所有來源中出現次數少於5次的單詞。 使用pivot_wider()函數將分組後的資料框進行重構，將每個來源的單詞出現次數作為新欄（也就是把iPhone和Android展開成為欄位名稱），以便更方便地進行後續分析和可視化。這裡的names_from參數指定重構後的欄位名稱來自原來的source欄位，values_from參數指定要重構的值來自原來的count欄位，values_fill參數指定在重構後的資料框中缺失值的填充值，這裡設置為0。 android_iphone_ratios這段程式碼用於計算每個單詞在Android和iPhone兩個來源中的keyness的log likelihood ratio。具體來說，這段程式碼實現了以下幾個步驟： 從上一步驟得到的word_by_source資料框中，選擇了Android和iPhone兩個來源的單詞出現次數資訊。 對Android和iPhone兩個來源的單詞出現次數進行標準化處理，以便進行後續的keyness計算。具體來說，這裡使用了Laplace平滑處理（add-k smoothing），將每個來源的所有單詞出現次數都增加1，然後再將這些出現次數除以各自來源的總次數加1，得到每個單詞在Android和iPhone兩個來源中的出現概率。 對Android和iPhone兩個來源中的每個單詞，分別計算其在Android和iPhone兩個來源中的keyness log ratio。這裡使用了常見的對數比值（log ratio）方法，計算Android來源中單詞出現概率和iPhone來源中單詞出現概率的比值的對數，以此來衡量單詞在Android和iPhone兩個來源中的關鍵性差異。 將計算得到的log ratio值按照降序排列，以便進一步進行分析和可視化。 test <- tweet_words %>% count(word, source) %>% filter(n >= 5) %>% pivot_wider(names_from = source, values_from = n, values_fill = 0) # View(test) word_by_source <- tweet_words %>% count(word, source) %>% filter(n >= 5) %>% pivot_wider(names_from = source, values_from = n, values_fill = 0) %>% # spread(source, n, fill = 0) %>% ungroup() sum(word_by_source$iPhone) ## [1] 1383 sum(word_by_source$Android) ## [1] 2132 android_iphone_ratios <- word_by_source %>% mutate(iPhone = (iPhone+1)/sum(iPhone+1)) %>% mutate(Android = (Android+1)/sum(Android+1)) %>% # mutate_at(.cols = vars(iPhone, Android), # .funs = funs((. + 1) / sum(. + 1))) %>% mutate(logratio = log2(Android / iPhone)) %>% arrange(desc(logratio)) 這兩行分子分母加1的處理稱為拉普拉斯平滑。mutate(iPhone = (iPhone+1)/sum(iPhone+1)) %>% 拉普拉斯平滑（add-k smoothing）是一種用於處理計數資料中零值問題的技巧，其主要目的是將出現次數為零的類別在計算機率時賦予一個非零的機率值，以避免出現無限大的情況，從而影響後續的計算結果。 在這段程式碼中，拉普拉斯平滑的目的是對每個單詞在Android和iPhone兩個來源中的出現次數進行標準化處理，以便進行後續的keyness計算。這是因為在標準化的計算中，如果某個來源中出現次數為0的單詞，則計算出來的概率值會為0，而這樣的結果可能會產生一些問題，例如無法取log或分母為零的情形。因此，為了避免這種問題，需要對每個單詞在Android和iPhone兩個來源中的出現次數進行拉普拉斯平滑處理，使得每個單詞在Android和iPhone兩個來源中的出現概率都能夠有一個非零的值，從而進行後續的計算和分析。 12.4.2 Plotting keyness 這段程式碼是用來繪製Android和iPhone兩個來源中關鍵性差異最大的單詞的keyness log ratio的條形圖。在繪製條形圖時，使用了fill = logratio < 0的參數設置，這是一個布林值，當單詞在Android和iPhone兩個來源中的log ratio小於0時，填充的顏色是gold，否則填充的顏色是royalblue。 這種設計原理的目的是將Android和iPhone兩個來源中關鍵性不同的單詞進行區分，並用不同的填充顏色來表示。當單詞在Android來源中的出現概率高於在iPhone來源中的出現概率時，其log ratio值會為正，此時填充的顏色為royalblue；反之，當單詞在Android來源中的出現概率低於在iPhone來源中的出現概率時，其log ratio值會為負，此時填充的顏色為gold。 android_iphone_ratios %>% group_by(logratio > 0) %>% top_n(15, abs(logratio)) %>% ungroup() %>% mutate(word = reorder(word, logratio)) %>% ggplot(aes(word, logratio, fill = logratio < 0)) + geom_col() + coord_flip() + ylab("Android / iPhone log ratio") + scale_fill_manual(name = "", labels = c("Android", "iPhone"), values = c("royalblue", "gold")) + theme_minimal() + theme(axis.text = element_text(size=14)) "],["re.html", "Chapter 13 Regular expression 13.1 RE applications on string operations 13.2 RE Case studies 13.3 Useful cases", " Chapter 13 Regular expression library(tidyverse) 正規表達式（Regular Expression）是一種用來描述、搜尋和操作文本的強大工具。它是由一系列字元和特殊符號所組成的模式，用於匹配和處理符合特定模式的字串。 正規表達式提供了一種靈活且強大的方式來執行字串的模式匹配。這些模式可以包含字母、數字、特殊字符和控制字符等各種元素。使用正規表達式，可以進行字串的搜尋、替換、提取、驗證和分割等操作。 Online tools for detecting regular expression (RE) https://regex101.com/ http://regexr.com/ RE Patterns 在正規表達式中，一些特殊符號和字符具有特殊的含義。例如，\\d可以匹配任何一個數字，\\w可以匹配任何一個字母或數字，.可以匹配除換行符之外的任何一個字符，+表示前面的模式可以出現一次或多次，*表示前面的模式可以出現零次或多次，?表示前面的模式可以出現零次或一次，[]用於指定一組字符中的任意一個等等。較完整的表格如下。要注意到的是，如果是\\d的話，R中要以\\\\d雙斜線來表示。 pattern <- \"\\\\b[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\\\\.[A-Za-z]{2,}\\\\b\"為一個用R來寫RE的範例：在R中，我們使用雙反斜線（\\）來表示正規表達式中的特殊字符。在這個示例中，使用的正規表達式模式包括以下幾個部分： \\\\b：匹配單詞的邊界，確保郵件地址不是部分字詞的一部分。 [A-Za-z0-9._%+-]+：匹配郵件地址的用戶名部分，它可以包含字母、數字、點（.）、下劃線（_）、百分比（%）、加號（+）和減號（-）。注意這個在中括號中的點（.）並非用來匹配任意字。後面的+號意思是代表至少要有一個字以上。 @：匹配郵件地址中的「@」符號。 [A-Za-z0-9.-]+：匹配郵件地址的域名部分，它可以包含字母、數字、點（.）和減號（-）。 \\\\.：匹配郵件地址中的點（.），需要使用反斜線進行轉義。 [A-Za-z]{2,}：匹配郵件地址的頂級域名部分，它可以是由至少兩個字母組成的字詞。 Pattern Description ^ Matches beginning of line. $ Matches end of line. . Matches any single character except newline. Using m option allows it to match newline as well. [...] Matches any single character in brackets. [^...] Matches any single character not in brackets re* Matches 0 or more occurrences of preceding expression. re+ Matches 1 or more occurrence of preceding expression. re? Matches 0 or 1 occurrence of preceding expression. *?, +?, ?? *, +和?預設是greedy的，如果要匹配’<H1>title</H1>‘時，會匹配整個句子。如果不希望它是greedy的，就要在上述符號後面加一個？。Using .*? in the previous expression will match only ’<H1>’. re{ n} Matches exactly n number of occurrences of preceding expression. re{ n,} Matches n or more occurrences of preceding expression. re{n, m} Matches at least n and at most m occurrences of preceding expression. a| b Matches either a or b. (re) 問號括住的部分就是match要留下來的部分。Groups regular expressions and remembers matched text. (?imx) Temporarily toggles on i, m, or x options within a regular expression. If in parentheses, only that area is affected. (?-imx) Temporarily toggles off i, m, or x options within a regular expression. If in parentheses, only that area is affected. (?: re) Groups regular expressions without remembering matched text. (?imx: re) Temporarily toggles on i, m, or x options within parentheses. (?-imx: re) Temporarily toggles off i, m, or x options within parentheses. (?#...) Comment. (?= re) Specifies position using a pattern. Doesn’t have a range. (?! re) Specifies position using pattern negation. Doesn’t have a range. (?> re) Matches independent pattern without backtracking. \\w Matches word characters. \\W Matches nonword characters. \\s Matches whitespace. Equivalent to [\\t\\n\\r\\f]. \\S Matches nonwhitespace. \\d Matches digits. Equivalent to [0-9]. \\D Matches nondigits. \\A Matches beginning of string. \\Z Matches end of string. If a newline exists, it matches just before newline. \\z Matches end of string. \\G Matches point where last match finished. \\b Matches word boundaries when outside brackets. Matches backspace (0x08) when inside brackets. \\B Matches nonword boundaries. \\n, \\t, etc. Matches newlines, carriage returns, tabs, etc. \\1...\\9 Matches nth grouped subexpression. \\10 Matches nth grouped subexpression if it matched already. Otherwise refers to the octal representation of a character code. 13.1 RE applications on string operations Replacing specific pattern Replacing all space or new line character to one space or empty string Deleting all number and alphabetic by empty string Deleting all HTML tags Detecting if it exists some specific pattern Fitering if one sentence starting with “. Extracting some words by specific pattern Extracting hashtags in text Extracting timestamp, email, hyperlink, or url in text Extracting number after some specific patterns Splitting Splitting string into several parts when detecting some specific pattern successfully. Replacing \\s matching any whitespace character including space, tabs, and line breaks R uses \\\\s, instead of \\s. \\\\d digit, \\\\D not digit \\\\s whitepsace, \\\\S not whitespace \\\\w word, \\\\W not word . matches any [A-Z0-9a-z] range [ABC] character set [^ABC] neglect set (Leadning ^ in [] means neglecting) s <- " 123 456 789 " str_replace_all(s, "\\\\s", "") ## [1] "123456789" 13.1.1 Extracting + means matching word occurring at least one time, matching longer is better * means matching word occurring any time, matching longer is better {1,3} means matching at least one time, but at most 3 times {3} means matching 3 times exactly. 13.1.1.1 by str_extract() 以下這個例子是在爬取PTT資料後，嘗試能夠取出每則貼文的ID與暱稱。 pname <- c("pttid111(kefan)", "pid2(hangfan)") # extracting at least one words until not word str_extract(pname, "\\\\w") ## [1] "p" "p" str_extract(pname, "\\\\w+") ## [1] "pttid111" "pid2" str_extract(pname, "[A-Za-z0-9]+") ## [1] "pttid111" "pid2" str_extract(pname, "[A-Za-z0-9]*") ## [1] "pttid111" "pid2" str_extract(pname, "[A-Za-z0-9]{8}") ## [1] "pttid111" NA str_extract(pname, "[A-Za-z0-9]{1,8}") ## [1] "pttid111" "pid2" # extracting word between () # () is controlled vocabulary in regular expression, needing \\\\( and \\\\) to specify the character themself str_extract(pname, "\\\\(\\\\w+\\\\)") %>% str_replace_all("[\\\\(\\\\)]", "") ## [1] "kefan" "hangfan" str_extract(pname, "\\\\(.+\\\\)") ## [1] "(kefan)" "(hangfan)" 13.1.1.2 by str_extract for data frame data_frame(pname) %>% mutate(nickname = str_extract(pname, "\\\\(\\\\w+\\\\)") %>% str_replace_all("[\\\\(\\\\)]", "")) %>% mutate(id = str_extract(pname, "\\\\w+")) ## Warning: `data_frame()` was deprecated in tibble 1.1.0. ## ℹ Please use `tibble()` instead. ## This warning is displayed once every 8 hours. ## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was ## generated. ## # A tibble: 2 × 3 ## pname nickname id ## <chr> <chr> <chr> ## 1 pttid111(kefan) kefan pttid111 ## 2 pid2(hangfan) hangfan pid2 13.1.1.3 by str_replace() (\\\\w+)的括號代表，我等一下要抽取出這個pattern的字 \\\\(.+\\\\)則是把剩下的pattern matching 完 \\\\1代表我要抽取前面第一組抽取出來的pattern，也就是(\\\\w+)中間的\\\\w+。 data_frame(pname) %>% mutate(id = str_replace(pname, "(\\\\w+)\\\\(.+\\\\)", "\\\\1")) ## # A tibble: 2 × 2 ## pname id ## <chr> <chr> ## 1 pttid111(kefan) pttid111 ## 2 pid2(hangfan) pid2 13.1.1.4 by tidyr::extract() for data frame data_frame(pname) %>% tidyr::extract(pname, c("id", "nickname"), "(\\\\w+)\\\\((.+)\\\\)", remove = F) ## # A tibble: 2 × 3 ## pname id nickname ## <chr> <chr> <chr> ## 1 pttid111(kefan) pttid111 kefan ## 2 pid2(hangfan) pid2 hangfan ?tidyr::extract 13.1.2 Detecting with non-greedy 這段程式碼使用R中的tidyverse套件中的extract()函數，從source向量中的每個元素中提取出「device」的資訊。假設我們希望從<p>和</p>之間提取「Twitter for iPhone」這個資訊。 此時我們會需要理解正規表示式的寫法預設是貪婪（greedy）的概念。當我們談到正規表達式的「貪婪」（greedy）和「非貪婪」（non-greedy）時，我們指的是模式匹配時的行為。 「貪婪」指的是匹配器在尋找模式時傾向於匹配盡可能多的字符。換句話說，它會儘可能地擴展匹配範圍。在正規表達式中，默認情況下，量詞（如*和+）是貪婪的。這意味著它們會匹配盡可能長的字串。 「非貪婪」（或稱「勉強」）則相反，它傾向於匹配最短的可能字串。在正規表達式中，可以在量詞後面加上「?」來表示非貪婪匹配。這樣一來，量詞就會儘可能少地匹配字符。 回到我們的例子，當使用默認的貪婪模式時，我們的正則表達式\"Twitter for (.*)<\"會從第一個<p>開始匹配，直到找到最後一個<之前的所有字符。這意味著它會將整個<p>Twitter for iphone</p><div><p>作為匹配結果，而不僅僅是<p>Twitter for iphone</p>。 但如果我們想要只匹配第一個<p>和之後的字符，而不是將整個<p>標籤內容都包括在內，我們可以使用「非貪婪」模式，將正則表達式修改為\"Twitter for (.*?)<\"，在量詞*後面加上「?」。這樣，它會匹配到第一個<之前的最短字串，即只匹配到<p>Twitter for iphone。 source <- c("<p>Twitter for iphone</p>", "<div><p>Twitter for iphone</p></div>") data_frame(source) %>% extract(source, "device", "Twitter for (.*)<") # Greedy ## # A tibble: 2 × 1 ## device ## <chr> ## 1 iphone ## 2 iphone</p> data_frame(source) %>% extract(source, "device", "Twitter for (.*?)<") # Non-Greedy ## # A tibble: 2 × 1 ## device ## <chr> ## 1 iphone ## 2 iphone 13.1.3 Detecting multiple patterns https://stackoverflow.com/questions/8020848/how-is-the-and-or-operator-represented-as-in-regular-expressions 以下練習重點是讓學生理解如何使用 str_detect() 函數和正則表達式進行模式匹配，以及如何進行邏輯操作來組合和篩選符合特定模式的句子。 str_detect(teststr, re1) & str_detect(teststr, re2) 通過 & 進行邏輯「與」操作，將兩個邏輯向量進行元素級別的「與」運算，得到一個新的邏輯向量。該向量指示哪些句子同時符合 re1 和 re2 的模式。 str_detect(teststr, re1) | str_detect(teststr, re2) 通過 | 進行邏輯「或」操作，將兩個邏輯向量進行元素級別的「或」運算，得到一個新的邏輯向量。該向量指示哪些句子符合 re1 或 re2 的模式。 teststr <- c("B和A是不是男女朋友呢", "C與B是不是在一起呢", "A就是B。") re1 <- "(.*B.*呢$)" re2 <- "(.*A.*)" str_detect(teststr, re1) ## [1] TRUE TRUE FALSE str_detect(teststr, re2) ## [1] TRUE FALSE TRUE str_detect(teststr, re1) & str_detect(teststr, re2) ## [1] TRUE FALSE FALSE str_detect(teststr, re1) | str_detect(teststr, re2) ## [1] TRUE TRUE TRUE 13.1.4 Extracting nearby words 13.1.4.1 Extracting nearby 3 English words string2 <- "..., compelled to defend as never before the hard-charging progressivism and ...." data_frame(string2) %>% mutate(string2 = str_extract(string2, "(\\\\S+\\\\s){3}before(\\\\s\\\\S+){3}")) %>% extract(string2, c("prefix","hit", "tail"), "(.+)(before)(.+)") ## # A tibble: 1 × 3 ## prefix hit tail ## <chr> <chr> <chr> ## 1 "defend as never " before " the hard-charging progressivism" 13.1.4.2 Extracting nearby 3 Chinese words string3 <- c("呵呵呵呵呵呵呵我家就住在台灣，那是個美麗的地方", "臺灣真是個美麗的地方齁齁齁", "呵呵呵呵呵呵呵我愛台灣臺灣") str_extract(string3, ".{5}台灣.{5}|.{5}臺灣.{5}") ## [1] "我家就住在台灣，那是個美" NA ## [3] NA str_extract(string3, ".{1,5}台灣.{1,5}|.{1,5}臺灣.{1,5}") ## [1] "我家就住在台灣，那是個美" NA ## [3] "呵呵呵我愛台灣臺灣" 13.1.4.3 Extracting nearby 3 Chinese words df <- data_frame(string3) df %>% extract(string3, c("pre", "hit", "tail"), "(.{0,5})(台灣|臺灣)(.{0,5})") ## # A tibble: 3 × 3 ## pre hit tail ## <chr> <chr> <chr> ## 1 "我家就住在" 台灣 ，那是個美 ## 2 "" 臺灣 真是個美麗 ## 3 "呵呵呵我愛" 台灣 臺灣 13.2 RE Case studies 13.2.1 Getting the last page of PTT HatePolitics 這段程式碼的目的是從URL中提取出頁數或特定的部分，並進行一些後續處理和轉換。這些操作可用於從URL中獲取有用的訊息，例如網頁索引、頁數等。 urls <- c("https://www.ptt.cc/bbs/HatePolitics/index4086.html", "https://www.ptt.cc/bbs/HatePolitics/index348.html") df <- tibble(urls) str_extract(urls, "index(\\\\d+)\\\\.html") ## [1] "index4086.html" "index348.html" str_replace(urls, ".*index(\\\\d+)\\\\.html", "\\\\1") %>% as.numeric() ## [1] 4086 348 data_frame(urls) %>% extract(urls, "last_page", "index(\\\\d+)\\\\.html", remove = F) ## # A tibble: 2 × 2 ## urls last_page ## <chr> <chr> ## 1 https://www.ptt.cc/bbs/HatePolitics/index4086.html 4086 ## 2 https://www.ptt.cc/bbs/HatePolitics/index348.html 348 13.2.2 Practice. Ask CHATGPT 我現在有一程式碼如下 ``` urls <- c("https://www.ptt.cc/bbs/HatePolitics/index4086.html", "https://www.ptt.cc/bbs/HatePolitics/index348.html") df <- tibble(urls) ``` 我希望來抽取出頁面的編號，新增一個page_num的變項，使得 ``` ...index4086.html: 4086 ...index348.html: 348 ``` 請以tidyverse pipeline的方式寫，並使用stringr的函式 以下為chatgpt的回答。 您可以使用tidyverse和stringr的函式來實現這個目標。以下是一個使用tidyverse pipeline和stringr的範例程式碼： library(tidyverse) urls <- c("https://www.ptt.cc/bbs/HatePolitics/index4086.html", "https://www.ptt.cc/bbs/HatePolitics/index348.html") df <- tibble(urls) %>% mutate(page_num = str_extract(urls, "(?<=index)\\\\d+(?=.html)")) PROMPT：請解釋(?<=index)\\\\d+(?=.html) (?<=index): 是一個Positive Lookbehind。它表示匹配位置之前必須出現”index”字串。在這種情況下，我們希望匹配的數字出現在”index”之後，所以使用正向肯定後願式來確定位置。 \\\\d+: 這是一個數字的匹配模式。\\\\d表示匹配一個數字字符（0-9），而+表示匹配一個或多個連續的數字字符。這樣可以確保我們匹配到的是一個或多個數字。 (?=.html): 是一個Positive Lookahead。它表示匹配位置之後必須出現”.html”字串。在這種情況下，我們希望匹配的數字出現在”.html”之前，所以使用正向肯定前願式來確定位置。 index：匹配字串中的”index”字串。 (\\\\d+)：這是一個捕獲組（Capture Group），用於捕獲一個或多個連續的數字字符。\\\\d表示匹配一個數字字符（0-9），而+表示匹配一個或多個連續的數字字符。 \\\\.html：匹配字串中的”.html”字串。由於”.”在正則表達式中具有特殊意義，所以需要使用\\\\進行轉義。 urls <- c("https://www.ptt.cc/bbs/HatePolitics/index4086.html", "https://www.ptt.cc/bbs/HatePolitics/index348.html") df <- tibble(urls) %>% mutate(page_num = str_extract(urls, "(?<=index)\\\\d+(?=.html)")) df ## # A tibble: 2 × 2 ## urls page_num ## <chr> <chr> ## 1 https://www.ptt.cc/bbs/HatePolitics/index4086.html 4086 ## 2 https://www.ptt.cc/bbs/HatePolitics/index348.html 348 13.3 Useful cases 13.3.1 Matching URL 這個正規表達式用於檢測是否符合超連結的格式。它可以匹配包含 http://、https://、ftp://、www. 或 ftp. 前綴的URL，並確保後續的部分符合網址的正確格式，例如域名、路徑和查詢參數等。 ^ 表示匹配字符串的開頭。 ((https?|ftp)://|(www|ftp)\\\\.)? 是一個可選的前綴，它匹配以 http://、https://、ftp://、www. 或 ftp. 開頭的部分。其中 ? 表示前綴部分是可選的。 [a-z0-9-]+ 匹配一個或多個小寫字母、數字或破折號字符。 (\\\\.[a-z0-9-]+)+ 是一個重複組，它匹配一個或多個點（.）後跟一個或多個小寫字母、數字或破折號字符。 ([/?].*)? 是另一個可選的後綴，它匹配以 / 或 ? 開頭的部分，並跟隨著任意字符。 $ 表示匹配字符串的結尾。 根據需求和特定的使用情境，可以有不同的寫法。以下是一些可能的替代寫法： 捕獲更多的URL前綴：當前的正規表達式只捕獲了 http://、https://、ftp://、www. 和 ftp. 這些前綴。如果需要捕獲更多的前綴，可以擴展前綴部分，例如 ((https?|ftp|file)://|(www|ftp)\\\\.)?，這樣可以捕獲 file:// 這樣的前綴。 更精確的域名部分：當前的正規表達式使用 [a-z0-9-]+(\\\\.[a-z0-9-]+)+ 匹配域名部分，這允許了字母、數字和破折號字符。如果需要更精確的域名匹配，可以使用更複雜的正規表達式，例如 (?!-)[A-Za-z0-9-]{1,63}(?<!-)\\\\.(?!-)[A-Za-z0-9-]{1,63}(?<!-)，這樣可以確保符合域名規範。 pattern <- "^((https?|ftp)://|(www|ftp)\\\\.)?[a-z0-9-]+(\\\\.[a-z0-9-]+)+([/?].*)?$" str_detect("http://www.yahoo.com.tw", pattern) ## [1] TRUE str_detect("https://m.facebook.com/story.php?story_fbid=1483357095305703&id=1435979486710131", pattern) ## [1] TRUE str_detect("https://www.facebook.com/groups/335691256571414/permalink/774316322708903/", pattern) ## [1] TRUE 13.3.2 Removing all html tags but keeping comment content ANS: \"推 ya870801: 推 218.166.12.10 10/16 15:56\" comment <- '<div class="push"><span class="hl push-tag">推 </span><span class="f3 hl push-userid">ya870801</span><span class="f3 push-content">: 推</span><span class="push-ipdatetime"> 218.166.12.10 10/16 15:56</span></div>' str_replace_all(comment, "<.+?>", "") ## [1] "推 ya870801: 推 218.166.12.10 10/16 15:56" str_replace_all(comment, "<.*?>", "") ## [1] "推 ya870801: 推 218.166.12.10 10/16 15:56" 13.3.3 Removing space # Removing space in Chinese sentence sentence <- c(' 噓 wwHui: 這批安好純 \\n 辛苦了 \\n 噓 ', '噓 wwHui: 這批安好純 ', '辛苦了 ') # Removing all space characters str_replace_all(sentence, "\\\\s", "") ## [1] "噓wwHui:這批安好純辛苦了噓" "噓wwHui:這批安好純" ## [3] "辛苦了" # Removing leading and ending space by str_replace_all() # You cannot use trimws() str_replace_all(sentence, "^\\\\s+|\\\\s+$", "") ## [1] "噓 wwHui: 這批安好純 \\n 辛苦了 \\n 噓" ## [2] "噓 wwHui: 這批安好純" ## [3] "辛苦了" 13.3.4 Testing teststr1 <- c("我最近過的挺爽", "最近我過的不是很好。", "我最近過得不太好。") re1 <- "(^我.+)" re2 <- "(.*。)" str_detect(teststr1, str_c(re1,re2, sep = "")) ## [1] FALSE FALSE TRUE str_detect(teststr1, str_c(re1,re2, sep = "|")) ## [1] TRUE TRUE TRUE "],["tmchi.html", "Chapter 14 Text processing in Chinese 14.1 Preprocessing 14.2 Tokenization 14.3 Exploring wording features 14.4 TF-IDF", " Chapter 14 Text processing in Chinese tidyverse內涵繪圖和操作資料所需要的ggplot2和dplyr stringr雖然隨著tidyverse被安裝了，但不會隨著tidyverse被載入，要另外載入。 在中文斷詞的時候要用到tidytext和jiebaR。 處理時間時要用到lubridate。 14.1 Preprocessing 14.1.1 Assigning unique id to each doc 為了便於後續建立Document-Term-Matrix，這時候若Document自身沒有編號的話，就得把整個Document內容當成該篇文章的id，但也有（極小）可能有兩篇Document內容相同，那就會被視為同一篇文章或發生錯誤。所以必須要編id。 row_number()產生每列的編號，所以這邊就直接把每列的編號視為每篇文章的id，可以保持該id的唯一性。當你在進行文本探勘或資料分析時，為每篇文章分配一個唯一的ID是非常重要的。唯一的ID確保每篇文章都有獨一無二的標識符號。這對於跟踪和識別特定文章非常重要，特別是當你處理大量的文本資料時。在進行資料合併時，唯一的ID可用於將不同來源的資料準確地匹配和合併在一起。這是非常實用的，尤其當你需要整合來自多個來源的文本資料時，例如合併多個資料集或者在不同時間點上進行的數據採集。 news.df <- readRDS("data/typhoon.rds") %>% mutate(doc_id = row_number()) %>% drop_na(title) 14.2 Tokenization 14.2.1 Initializer tokenizer cutter <- worker()這行程式碼使用worker()函式來初始化jieba分詞器，將其指派給名為cutter的變數。jieba是一個常用的中文分詞套件，用於將漢字序列分割成詞彙。初始化分詞器後，可以使用它來對中文文本進行分詞操作。 斷詞的時候不見能把我們要的字詞斷出來，比方說你可能希望台北市不會被斷開，偏偏被斷成台北+市。最簡單的辦法就是把他窮舉舉完。new_user_word(cutter, segment_not)這行程式碼使用new_user_word()函式將segment_not這個vector中的詞彙加入使用者自定義詞典。這樣做的目的是防止該詞彙被分詞器切分成不同的部分。使用者可以根據需要將自定義詞彙加入詞典，以確保這些詞彙在分詞過程中被正確處理。 載入中文停用詞：stopWords <- readRDS(\"data/stopWords.rds\") 這行程式碼載入中文停用詞（stop words）的資料，並將其讀取到名為stopWords的變數中。停用詞是在文本分析中被視為無意義或不重要的詞彙，例如連接詞、介詞、助詞等。載入停用詞列表後，可以在文本處理過程中使用它來過濾掉這些不需要的詞彙，以提高分析的效果。常見的中文停用詞包含 助詞：的、了、着、地、得、之等。 連詞：和、與、或、及、還、而等。 代詞：我、你、他、她、它、們、這、那等。 冠詞：一、個、些、這、那等。 介詞：在、從、到、以、為、因、應、對等。 虛詞：的、地、得、過、過去等。 數詞：一、二、三、十、百、千、萬等。 副詞：很、非常、太、真、已經、還、就等。 連接詞：而、並、所以、因此、然而、只是等。 感嘆詞：嗯、哦、啊、呀、吧、喔等。 # segment_not to avoid to be segmented by jeiba cutter segment_not <- c("第卅六條", "第卅八條", "蘇南成", "災前", "災後", "莫拉克", "颱風", "應變中心", "停班停課", "停課", "停班", "停駛", "路樹", "里長", "賀伯", "採收", "菜價", "蘇迪", "受災戶", "颱風警報", "韋恩", "台東縣", "馬總統", "豪大雨", "梅姬", "台東", "台北市政府", "工務段", "漂流木", "陳菊", "台南縣", "卡玫基", "魚塭", "救助金", "陳情", "全省", "強颱", "中颱", "輕颱", "小林村", "野溪", "蚵民", "農委會", "來襲", "中油公司", "蔣總統經國", "颱風天", "土石流", "蘇迪勒", "水利署", "陳說", "颱風假", "颱風地區", "台灣", "臺灣", "柯羅莎", "八八風災", "紓困","傅崑萁", "傅崐萁","台中", "文旦柚", "鄉鎮市公所", "鄉鎮市", "房屋稅", "高雄", "未達", "台灣省", "台北市") # Initialize jieba cutter cutter <- worker() # Add segment_not into user defined dictionary to avoid being cutted new_user_word(cutter, segment_not) ## [1] TRUE # loading Chinese stop words stopWords <- readRDS("data/stopWords.rds") # load("../segment_not.R") 14.2.2 Tokenization Tokenization（分詞）在文本探勘的過程中是將文本轉換為更小單位的步驟。它將連續的文本序列（例如句子或段落）分割成一系列被稱為「詞彙」或「tokens」的個別單位。在文本探勘中，進行分詞的目的是將文本轉換為可以進一步處理和分析的基本單位。每個詞彙代表著文本中的一個有意義的單詞、詞組或符號，例如一個英文單詞、一個漢字、一個數字等等。這些詞彙可以作為後續分析的基礎，用於進行文本處理、特徵提取、語義分析、情感分析等各種任務。 分詞的過程可以包括以下步驟： 斷句：如果文本是一個段落或一個文檔，首先需要將其分成句子。這可以使用標點符號（如句號、問號、驚嘆號等）作為分隔符號來實現。 分詞：將每個句子進一步分成詞彙或tokens。具體的分詞方法取決於文本的語言和特定的工具或套件。對於中文，常用的分詞工具包括jieba、SnowNLP等；而對於英文，常用的分詞方法是基於空格或標點符號進行切分。 去除停用詞：在分詞過程中，通常會過濾掉停用詞，這些詞彙被認為對文本分析沒有太大的意義。停用詞可以是常用的連接詞、介詞、助詞、冠詞等。 正規化：進行詞彙的正規化，例如將詞彙轉換成小寫，移除標點符號，處理詞彙的變體形式（如單數、複數、時態等）。 建立詞彙表：將所有詞彙收集到一個詞彙表或詞彙索引中，該詞彙表可以用於後續的文本處理和分析。 例如一個句子「今天天氣真好，我打算去公園散步。」可以被斷成「今天 天氣 真好 ， 我 打算 去 公園 散步 。」 實際上中文斷詞相當不容易，常見的問題包括： 歧義詞彙：中文中存在許多具有歧義性的詞彙，例如「打開」可以是「開啟」的意思，也可以是「打碎」的意思。在分詞時，選擇正確的分詞方式對於確定詞彙的真正含義非常重要。 新詞辨識：中文是一個活躍的語言，新詞彙的產生非常頻繁。在分詞過程中，如果遇到未在詞典中出現的新詞彙，可能會無法正確切分，導致語義的失真或信息的丟失。 縮略詞和缺詞：中文中常使用縮略詞，例如「國際象棋」可以縮寫為「國象」。在分詞時，需要考慮這些縮略詞的存在，並確保正確切分。另外，有些中文詞彙存在缺詞現象，例如「下雨了」可以簡化為「下雨」，需要根據上下文來識別和處理這些情況。 斷詞歧異：「台北市／長」或「台北／市長」 外文詞彙和混合語言：中文文本中常包含外文詞彙或混合語言的情況。在分詞時，需要考慮如何處理這些詞彙，例如是否將其當作一個整體進行切分，或者保留其原有的形式。 未知詞彙和低頻詞彙：分詞工具常基於詞典來進行切分，因此對於一些罕見或專有名詞、專術詞彙可能無法進行正確的切分。這些未知詞彙和低頻詞彙的處理需要特殊的處理策略，例如使用統計方法或自定義詞彙表。 在segment(x, cutter)後會產生一個多詞的向量。亦即每一格就是一個向量，你可以把它印出來看看。可以用unnest()將word列中的字詞向量展開，使每個單詞成為一列。這樣可以將每個單詞視為一個觀察值，方便後續的處理。 # news.df$time %>% summary tokenized.df <- news.df %>% slice(-3069) %>% mutate(timestamp=ymd(time)) %>% # filter(timestamp > as.Date("2009-01-01")) %>% select(-time) %>% select(title, text, cat, timestamp, everything()) %>% mutate(word = purrr::map(text, function(x)segment(x, cutter))) tokenized.df %>% select(title, word) %>% head() ## # A tibble: 6 × 2 ## title word ## <chr> <list> ## 1 "昨天上班的人沒加班費也不補假\\n依法 員工無權利要求•體恤 雇主可酌情嘉惠" <chr> ## 2 "走過桑梓千田\\n東台水保之旅" <chr> ## 3 "走過桑梓千田\\n東台水保之旅" <chr> ## 4 "總統祝福大家新春如意\\n期勉迎接挑戰贏得勝利" <chr> ## 5 "總統至為關切颱風災害\\n電囑儘速展開救災重建" <chr> ## 6 "總統關懷澎湖災情 俞揆冒雨巡視災區\\n指示搶修道路•優先供應水電 復建資金… <chr> # unnest() to spread character into a new word variable # filter out stop words # filter out alphabetical and numeric characters unnested.df <- tokenized.df %>% select(doc_id, text, word) %>% unnest(word) %>% filter(!(word %in% stopWords$word)) %>% filter(!str_detect(word, "[a-zA-Z0-9]+")) unnested.df %>% head ## # A tibble: 6 × 3 ## doc_id text word ## <int> <chr> <chr> ## 1 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 昨天 ## 2 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 颱風… ## 3 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 北部 ## 4 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 地區 ## 5 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 機關 ## 6 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 學校 14.3 Exploring wording features 14.3.1 Word frequency distribution 這兩個函式是用於對X軸和Y軸進行對數轉換。對數轉換可以將原始數據的數值範圍較大的部分進行壓縮，使其在視覺化時更易於比較和理解。對數尺度的使用有助於呈現數據的相對變化和細節，尤其是當數據範圍跨度較大時。 對X軸和Y軸進行對數轉換的目的是為了更好地觀察數據的分佈特徵，尤其是在存在長尾分佈（power-law distribution）或Zipf’s law的情況下。 長尾分佈（Power-law distribution）： 在長尾分佈中，少數的頻繁發生事件和大量的不太頻繁發生事件形成了一個長尾（即數量較小但頻率較高的事件非常稀有）。對於長尾分佈的數據，採取對數轉換可以將較大的數值範圍縮小，使得長尾部分的細節更容易被觀察和比較。這樣做可以更好地呈現數據的細微變化和分佈的特性。 Zipf’s law： Zipf’s law是一種描述詞彙頻率與詞彙排名之間關係的統計定律。根據Zipf’s law，詞彙的頻率與其在排序中的排名成反比。當觀察和分析詞彙頻率時，對X軸和Y軸進行對數轉換有助於更好地呈現Zipf’s law的特性。對數尺度轉換使我們能夠更清楚地觀察到詞彙頻率的排名和分佈情況。 在power-law distribution的情況下，如果對X軸和Y軸進行對數轉換，我們通常會看到以下情形： 直線關係：在對數尺度下，如果數據符合power-law distribution，我們會看到一條近似線性的直線關係。這表示在對數尺度下，數據點的分佈大致呈現線性趨勢，表示一種指數衰減或增長的規律。 長尾尾部：power-law distribution的特點是長尾尾部的存在，即少數極端值或稀有事件的出現頻率相對較高。在對數尺度下，我們能夠更清楚地看到這些極端值或稀有事件在數據分佈中的位置，因為它們在對數尺度下會呈現較為明顯的特徵。 分佈斜率：對數尺度下的power-law distribution，通常可以通過斜率來描述分佈的特性。斜率表示每個X單位變化對應的Y單位變化，或者說在對數尺度下，表示對數Y值相對於對數X值的變化率。如果數據點遵循power-law distribution，斜率會呈現相對恆定的特性。 word.count <- tokenized.df %>% unnest(word) %>% count(word, sort=T) %>% filter(!(word %in% stopWords$word)) %>% filter(nchar(word) > 1) %>% filter(!str_detect(word, "[a-zA-Z0-9]+")) %>% filter(n > 3) word.count %>% count(n, sort=T) %>% ggplot(aes(n, nn)) + geom_point(alpha=0.5, size = 1, color="#333333") word.count %>% count(n, sort=T) %>% ggplot(aes(n, nn)) + geom_point(alpha=0.5, size = 1, color="#333333") + scale_x_log10() + scale_y_log10() 14.3.2 Keyness by logratio 早、近期用字差異 cat_word.tf <- tokenized.df %>% unnest(word) %>% count(cat, word) %>% ungroup() %>% filter(!str_detect(word, "[a-zA-Z0-9]+")) %>% filter(!(word %in% stopWords$word)) %>% filter(nchar(word)>1) early_lat_ratio <- cat_word.tf %>% filter(n>1) %>% pivot_wider(names_from = cat, values_from = n, values_fill = 0) %>% # spread(cat, n, fill = 0) %>% ungroup() %>% mutate_if(is.numeric, funs((. + 1) / sum(. + 1))) %>% mutate(logratio = log2(early / lat)) %>% arrange(desc(logratio)) early_lat_ratio %>% group_by(logratio > 0) %>% top_n(20, abs(logratio)) %>% ungroup() %>% mutate(word = reorder(word, logratio)) %>% ggplot(aes(word, logratio, fill = logratio < 0)) + geom_bar(stat = "identity") + coord_flip() + ylab("early / recent log ratio") + scale_fill_manual(name = "", labels = c("early", "recent"), values = c("tomato", "lightblue")) + theme(axis.text.y=element_text(colour="black", family="Heiti TC Light")) 14.3.3 Keyness by scatter frequency <- cat_word.tf %>% filter(n>3) %>% group_by(cat) %>% mutate(proportion = n/sum(n)) %>% select(-n) %>% spread(cat, proportion) %>% na.omit() # datatable(frequency) library(scales) frequency %>% ggplot(aes(x = early, y = lat, color = abs(early - lat))) + geom_abline(color = "gray40", lty = 2) + geom_point(alpha = 0.1, size = 2.5, width = 0.3, height = 0.3) + geom_text(aes(label = word), check_overlap = TRUE, vjust = 1.5, family="Heiti TC Light", size = 3) + scale_x_log10(labels = percent_format()) + scale_y_log10(labels = percent_format()) + theme(legend.position="none") + coord_fixed(1) 14.4 TF-IDF TF-IDF (Term Frequency-Inverse Document Frequency) 是一種用於衡量一個詞彙在文本集合中重要性的統計方法。它結合了詞頻 (Term Frequency, TF) 和逆文檔頻率 (Inverse Document Frequency, IDF) 兩個指標。 詞頻 (Term Frequency, TF)：衡量一個詞彙在單篇文檔中出現的頻率。詞頻可以通過計算詞彙在文檔中出現的次數，或者使用歸一化的詞頻計算公式來得到。 逆文檔頻率 (Inverse Document Frequency, IDF)：衡量一個詞彙在整個文本集合中的普遍重要性。逆文檔頻率通過計算詞彙在文本集合中出現的文檔數量的倒數，並取對數來得到。這樣做的目的是對常見詞彙的重要性進行降低，並提高罕見詞彙的重要性。 TF-IDF 的計算公式如下：TF-IDF = TF * IDF 其中，TF表示詞頻，IDF表示逆文檔頻率。 TF-IDF 的應用主要有兩個方面： 文本檢索 (Information Retrieval)：在文本檢索中，使用TF-IDF來計算詞彙對於給定查詢的相關性。詞彙的TF-IDF值越高，表示該詞彙在文檔中的重要性越高，並且與查詢的相關性越大。 文本特徵表示 (Text Feature Representation)：在文本分析和機器學習中，使用TF-IDF來表示文本的特徵向量。將文本轉換為TF-IDF向量表示可以捕捉詞彙在文本中的重要性，並且有助於機器學習模型更好地理解和區分不同的文本。 14.4.1 Term-frequency word.tf <- tokenized.df %>% unnest(word) %>% count(cat, word, sort=T) %>% # mutate(total_words=sum(n)) %>% mutate(rank=row_number(), tf= n/sum(n)) 如果是跑histrogram因為不是常態分佈而是power-law分佈，通常會看不出什麼來 ggplot(word.tf, aes(tf, fill=cat)) + geom_histogram(show.legend = F) + xlim(NA, 0.0009) + scale_x_log10() + scale_y_log10() + facet_wrap(~cat, ncol=2, scales="free_y") 加上rank後可以看出最高rank到最後的差異，中段差不多，但是，相較於晚近的文章，早期文章用過很少次的字比較多，但用過很多次的字比較少。（是否可推論用字越來越貧乏？） word.tf %>% ggplot(aes(rank, tf, color=cat)) + geom_line(size=1.1, alpha=0.5) + scale_x_log10() + scale_y_log10() rank_subset <- word.tf %>% filter(rank < 500, rank > 10) lm_result <- lm(log10(tf) ~ log10(rank), data = rank_subset) lm_result$coefficients[[1]] ## [1] -1.739581 word.tf %>% ggplot(aes(rank, tf, color = cat)) + geom_abline(intercept = lm_result$coefficients[[1]], slope = lm_result$coefficients[[2]], color = "gray50", linetype = 2) + geom_line(size = 1.1, alpha = 0.8, show.legend = FALSE) + scale_x_log10() + scale_y_log10() 14.4.2 TF-IDF to filter significant words TF-IDF計算結果可以將原本的詞頻（TF）分布從一個長尾分佈轉變為一個呈現鐘形曲線的分佈。這種轉變使得我們能夠去除尾部，即刪除TF-IDF值很低的詞彙，從而重新優化我們要處理的詞彙集合。這樣的處理方式有兩個主要目的。 首先，透過刪除TF-IDF值很低的詞彙，我們可以去除那些在文本中出現頻率較低且普遍性較高的詞彙，這些詞彙對於區分不同文本的能力相對較低，因此可以忽略不計。 其次，我們可以僅保留大於平均值加上一個或兩個標準差的TF-IDF值較高的詞彙，這些詞彙可以作為有效辨識文章的關鍵字。這是因為這些詞彙在文本中出現的頻率較高，同時其與該文本的關聯性也相對較強。 透過這樣的過濾和選擇，我們可以得到一個更精簡且具有代表性的詞彙集合，這些詞彙能夠更好地描述和區分不同的文章。因此，使用TF-IDF計算結果進行這樣的處理，可以在文本分析和信息檢索等領域中提供更有價值的結果。 news_count <- tokenized.df %>% unnest(word) %>% count(doc_id, word) %>% bind_tf_idf(word, doc_id, n) %>% arrange(desc(tf_idf)) news_count %>% ggplot(aes(tf_idf)) + geom_histogram(bins = 100) + scale_x_log10() news_count %>% left_join(news.df, by="doc_id") %>% filter(!(word %in% c("NA"))) %>% group_by(cat) %>% arrange(desc(tf_idf)) %>% top_n(30, tf_idf) %>% ungroup() %>% mutate(word = reorder(word, tf_idf)) %>% ggplot(aes(word, tf_idf, fill = cat)) + geom_col(show.legend = FALSE) + labs(x = NULL, y = "tf-idf") + facet_wrap(~cat, ncol = 2, scales = "free") + coord_flip() + theme(axis.text.y=element_text(family="Heiti TC Light")) 14.4.3 Practice. Understanding TF-IDF TF-IDF也並非沒缺點，首先是會受到詞頻影響：TF-IDF主要依賴於詞頻作為計算的一部分，詞頻較高的詞彙往往具有較高的權重。這可能會導致在辨識關鍵字時，偏向於選擇出現頻率高的常見詞彙作為關鍵字，而忽略了一些在文本中出現頻率較低但具有重要性的詞彙。其次是長文本帶來的影響，在長文本中，由於詞彙的多樣性和詞彙數量的增加，TF-IDF計算可能導致高度稀疏的向量表示。這可能導致計算效率降低，並且在後續的處理和分析中增加了計算和存儲的負擔。 請就我們給的上述資料，選幾篇文章來觀察TF-IDF所抽出來的關鍵字，有哪一些真的是關鍵字？有哪一些不是呢？從TF和TF-IDF的數值來看，明明不是關鍵詞，但TF-IDF卻很高的誤判原因為何呢？ "],["crawler-overview.html", "Chapter 15 Introduction to Web Scraping 15.1 Using Web API 15.2 Webpage Scraping 15.3 Using Chrome DevTools", " Chapter 15 Introduction to Web Scraping 爬蟲主要分為兩大類：一類是使用網站所提供的 API，另一類則是需要寫網頁爬蟲來剖析網頁。 第一類是使用網站所提供的 API，API 是指應用程式介面，是網站提供的一種接口，用戶可以通過 API 向網站發送請求，獲取網站數據。API 可以是 RESTful API、SOAP API、XML-RPC API 等等，使用 API 的好處是可以直接獲取需要的數據，且數據格式結構化，易於處理。不過使用 API 需要瞭解 API 的參數格式，而且不是所有網站都提供 API。常見且提供API讓客戶端來取用資料的社群網站服務包含： Google Maps API：提供地圖、地理位置等相關的 API。 Twitter API：提供關於 Twitter 的相關數據，包括推文、用戶資訊等。 Facebook API：提供關於 Facebook 的相關數據，包括用戶資訊、頁面資訊等。 GitHub API：提供關於 GitHub 的相關數據，包括存儲庫資訊、用戶資訊等。 OpenWeatherMap API：提供天氣資訊的 API。 YouTube API：提供關於 YouTube 的相關數據，包括影片、頻道等。 Spotify API：提供關於音樂的相關數據，包括歌曲、歌手等。 第二類是需要寫網頁爬蟲來剖析網頁，這種方法通常使用一些開源的爬蟲框架，如 Python 的 Scrapy 和 Beautiful Soup、R 的 rvest 等等。網頁爬蟲是通過模擬瀏覽器的方式，向網站發送請求，獲取網頁的 HTML 源代碼，然後使用相應的庫對 HTML 進行解析和剖析，獲取需要的數據。網頁爬蟲需要考慮很多因素，如網站的反爬機制、網頁的動態載入、網頁的解析方式等等，需要編寫複雜的代碼來處理這些問題。例如爬取國內外報紙的搜尋結果大多需要直接剖析網頁來找到所需要的資料。 15.1 Using Web API 使用 Web API 需要瞭解 JSON 檔案格式，JSON 是一種輕量級的數據交換格式，可以被多種語言解析和生成，是目前 Web API 應用中使用最廣泛的數據格式之一。JSON 的全稱是 JavaScript Object Notation，為基於 JavaScript 語言的一種文本格式，可以被解析為不同的資料型態，如數字、布林代數、字串、數值組和物件等。JSON 與 XML 相比，具有更輕量級、更容易讀寫和解析等優勢，也因此在 Web API 中被廣泛應用。 JSON 格式的基本結構是一個鍵-值對應（Key-Value）集合，其中每個鍵都是一個字串，每個值可以是數字、布爾值、字串、數組或對象等類型。例如，以下是一個簡單的 JSON 。在 JSON 中，可以使用大括號 {} 表示鍵值對應（Key-Value），使用中括號 [] 表示序列（類似R中的List），鍵和值之間用冒號 : 分隔以對應，不同的鍵值對之間用逗號 , 分隔。JSON可以是樹狀多階層的，即一個鍵的值可以是另一個 JSON物件的鍵值對應。 在 R 語言中讀取 JSON 檔案需要先將其轉換為 R 的物件。這可以使用 R 的 jsonlite 套件中的 fromJSON() 函數來實現。jsonlite 套件是一個方便解析 JSON 的工具，它提供了從 JSON 字符串到 R 物件之間的轉換功能。 { "name": "John", "age": 30, "isMarried": false, "hobbies": ["reading", "music", "movies"], "address": { "street": "123 Main St", "city": "Anytown", "state": "CA" } } 15.2 Webpage Scraping 網頁爬蟲是一種自動化工具，可用於收集網頁上的資料。想要寫出高效能、穩定的爬蟲程式，需要掌握以下基礎知識： HTML 和 CSS：這些是用於設計和呈現網頁的標準技術。HTML 是網頁的基礎架構，而 CSS 用於設計和美化網頁的外觀。例如了解了解 HTML 標籤和屬性的基本語法和用法，以及網頁的基本結構，例如 head、body、div、span、table、a 等等。並瞭解了解 CSS 的基本語法和用法，包括如何設置元素的樣式、顏色、字體、大小、邊框等等，以及常用的選擇器和屬性。 XPath 和 CSS 選擇器：XPath 和 CSS 選擇器是用於定位 HTML 元素的語言。XPath 是 XML 語言的一部分，而 CSS 選擇器是 CSS 的一部分。Chrome 瀏覽器的 Inspector 是一個強大的工具，可以幫助我們查找 HTML 元素的 XPath 和 CSS 選擇器。 HTTP 協議：HTTP 協議是網絡通信協議，用於網頁服務器和瀏覽器之間的通信。理解 HTTP 協議可以幫助理解網頁如何工作。例如最常見的HTTP回應代碼有「401 Unauthorized：未經授權，無法訪問所需內容」以及「404 Not Found：所請求的內容不存在」。 防止反爬：由於網站經常會採取反爬蟲措施，因此開發者需要學習如何繞過這些措施，例如使用代理服務器、設置間隔時間、更換用戶代理等。 15.2.1 HTTP Status Code 回應代碼用於向客戶端通報伺服器對請求的處理狀態，以便客戶端根據不同的回應代碼進行相應的處理。例如，當客戶端發送一個請求到服務器時，如果服務器返回的回應代碼是 200 OK，這意味著該請求已經成功處理，服務器已經返回所需的內容，客戶端可以根據返回的內容進行下一步操作；如果服務器返回的是 404 Not Found，這意味著客戶端所請求的內容不存在，客戶端需要提示用戶請求的資源不存在。以下是 HTTP 協議中常見的一些代碼： 1xx（Informational）：這些代碼表示服務器已經接收到請求，但仍在處理中。 2xx（Successful）：這些代碼表示請求已經成功處理。 3xx（Redirection）：這些代碼表示客戶端需要採取進一步的操作才能完成請求。 4xx（Client Error）：這些代碼表示客戶端發生了錯誤，請求無法完成。 5xx（Server Error）：這些代碼表示服務器發生了錯誤，無法完成請求。 以下是常見的 HTTP 協議代碼： 200 OK：請求已經成功處理，並返回所需的內容。 301 Moved Permanently：請求的網頁已經永久轉移到新位置。 302 Found：請求的網頁暫時轉移到新位置。 400 Bad Request：請求的語法不正確。 401 Unauthorized：未經授權，無法訪問所需內容。 403 Forbidden：已經獲得授權，但仍無法訪問所需內容。 404 Not Found：所請求的內容不存在。 500 Internal Server Error：服務器內部錯誤，無法處理請求。 15.3 Using Chrome DevTools Chrome DevTools是一款由Google開發的網頁開發工具，可以幫助開發人員進行網頁測試、網頁性能分析、網頁設計等工作。DevTools提供了豐富的功能，包括元素查看器、Console、網絡監測器、源代碼編輯器等，可讓開發人員在開發過程中快速找到和解決問題。此外，DevTools還可以幫助開發人員模擬不同設備、網速，以及對網站進行性能分析和優化，提高網站的速度和使用體驗。 15.3.1 Observing web request 在開始網頁爬蟲之前，我們需要找到網頁中的JSON數據，以便進行後續的數據提取和處理。使用Chrome DevTools可以很容易地找到網頁背後的JSON檔案。以下是一些步驟： 打開Chrome瀏覽器，進入要爬取的網站。 按下F12鍵或右鍵點擊網頁上的任意位置並選擇「檢查」來開啟DevTools。 在DevTools中，選擇「Network」分頁。 在瀏覽器中執行您要查找JSON數據的操作，例如點擊一個按鈕或輸入一個查詢。 在DevTools的網絡監測器中，您可以看到所有網頁請求（Request）和回應（Response），包括我們感興趣的JSON檔案。如果您只想查看JSON請求，可以在過濾器中輸入「json」。 點選JSON請求，您可以查看Request和Response中的的詳細信息，包括URL、Headers、Request Payload和Response等。 在Response分頁中，您可以看到JSON數據的內容。如果JSON數據很大，您可以右鍵點擊JSON數據，然後選擇「Save Response As...」將其保存到本地檔案中。 "],["scraping-104.html", "Chapter 16 Scraping 104.com 16.1 Complete Code 16.2 Step-by-Step", " Chapter 16 Scraping 104.com 16.1 Complete Code 撰寫爬蟲時需要載入許多不同的函式庫，其中包括用於 HTTP 請求的httr，以及用於解析 JSON 數據的jsonlite。 httr：httr 庫是 R 語言中用於發送 HTTP 請求和處理 HTTP 響應的函式庫，它提供了一組簡單易用的函數，可以讓使用者方便地設置 HTTP 請求的各種參數，如 URL、HTTP 方法、HTTP 頭、HTTP 主體等，並處理 HTTP 響應的內容和狀態碼等。 jsonlite：jsonlite 庫是 R 語言中用於解析和生成 JSON 數據的函式庫，它提供了 fromJSON() 函數，可以將 JSON 字符串轉換為 R 物件，並提供 toJSON() 函數，可以將 R 物件轉換為 JSON 字符串。這個函式庫通常用於處理 API 回應數據中的 JSON 格式數據。 library(tidyverse) library(httr) library(jsonlite) # options(stringsAsFactors = F) all.df <- tibble() refer_url <- "https://www.104.com.tw" for(p in 1:10){ url <- str_c('https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E8%B3%87%E6%96%99%E7%A7%91%E5%AD%B8&order=12&asc=0&page=', p, "&mode=s&jobsource=2018indexpoc") print(p) res <- GET(url, add_headers("referer"=refer_url)) %>% content("text") %>% fromJSON() res$data$list$tags <- NULL res$data$list$link <- NULL all.df <- bind_rows(all.df, res$data$list) } all.df$jobNo %>% unique %>% length 16.2 Step-by-Step 16.2.1 Get the first pages 這段程式碼是用於爬取104人力銀行網站上與「資料科學」相關的職缺資訊，並將其存儲到名為df2的Data.Frame中。首先，我們嘗試點選104人力銀行網站上的第1頁、第2頁和第3頁的職缺搜尋結果，並將這三個網址儲存為三個URL變量，應該不難觀察到，這三個網址有何差別？僅有page=1、page=2、page=3有所差別。接下來，我們使用R語言中的httr套件中的GET()函數，將URL作為參數傳入，從網站中獲取對應的數據，並使用fromJSON()函數將該JSON格式的內容轉換為R中的Data.Frame格式。下面程式在獲取第2頁數據時，使用了add_headers()函數設置了一個HTTP header，用於識別HTTP請求的來源。 這段程式碼使用了add_headers函數添加了一個名為「Referer」的HTTP header。這個header的作用是告訴104人力銀行網站，訪問這個頁面的用戶是從哪個網頁轉跳過來的，也就是告訴網站當前HTTP請求的來源。具體來說，這裡設置的「Referer」值為https://www.104.com.tw/，代表我們偽裝這個請求是來自於104人力銀行首頁。如果沒有這個Referer，該網站會認為你是一個可疑的爬取，從沒根據和不當的頁面或用不當的方式（例如爬蟲）連過來。 對的！人家網站不歡迎你爬它，所以我們應止於測試。 url1 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=1&mode=s&jobsource=2018indexpoc" # Assigning the 2nd page data url to url2 url2 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E8%B3%87%E6%96%99%E7%A7%91%E5%AD%B8&order=14&asc=0&page=2&mode=s&jobsource=2018indexpoc" # Assigning the 3rd page data url to url3 url3 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=3&mode=s&jobsource=2018indexpoc" # Getting back the url1 data, assigning to result1 res <- GET(url2, config = add_headers("Referer" = "https://www.104.com.tw/")) res1 <- content(res, "text") %>% fromJSON() result2 <- fromJSON(content(GET(url2), "text")) # Tracing variable result2 and finding the data.frame, assigning to df2 df2 <- res1$data$list 16.2.2 Get the first page by modifying url # Guessing the 1st page data url to url1 url1 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=1&mode=s&jobsource=2018indexpoc" # Getting back the 1st page data url1 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=1&mode=s&jobsource=2018indexpoc" result1 <- fromJSON(content(GET(url1), "text")) df1 <- result1$data$list 16.2.3 Combine two data with the same variables # all.df <- bind_rows(df1, df2) # will raise error # Error in bind_rows_(x, .id) : # Argument 31 can't be a list containing data frames 16.2.4 Drop out hierarchical variables Preserving numeric or character, dropping list of data.frame by assigning NULL to the variable # Drop list and data.frame inside the data.frame df1$link <- NULL df1$tags <- NULL df2$link <- NULL df2$tags <- NULL # Re-binding two data.frame df1 and df2 all.df <- bind_rows(df1, df2) 16.2.5 Dropping hierarchical variables by dplyr way # Getting the 1st page data and dropping variable tags and link # Assigning to df1 df1 <- result1$data$list %>% select(-tags, -link) # Getting the 2nd page data and dropping variable tags and link # Assigning to df2 df2 <- result2$data$list %>% select(-tags, -link) # binding df1 and df2 all.df <- bind_rows(df1, df2) 16.2.6 Finding out the last page number # Tracing the number of pages in result1 last_page_num <- result1$data$totalPage # Checking the availability of the last page # Examining if the last page data available by re-composing URL with paste0() url.last_page <- paste0("https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=", last_page_num, "&mode=s&jobsource=2018indexpoc") # Getting back and parsing the last page data result.last_page <- fromJSON(content(GET(url.last_page), "text")) 16.2.7 Using for-loop to get all pages for(p in 1:last_page_num){ url <- paste0("https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=", p, "&mode=s&jobsource=2018indexpoc") result <- fromJSON(content(GET(url), "text")) temp.df <- select(result$data$list) print(paste(p, nrow(temp.df))) } 16.2.8 combine all data.frame # The 1st url of the query url1 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=1&mode=s&jobsource=2018indexpoc" # Getting back the 1st page data result1 <- fromJSON(content(GET(url1), "text")) # Tracing and getting total number of page last_page_num <- result1$data$totalPage # Truncating hierarchical variables: link and tags all.df <- select(result1$data$list, -link, -tags) # for-loop to getting back data and joining them for(p in 1:last_page_num){ url <- paste0("https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=", p, "&mode=s&jobsource=2018indexpoc") result <- fromJSON(content(GET(url), "text")) temp.df <- select(result$data$list) all.df <- bind_rows(all.df, temp.df) print(paste(p, nrow(all.df))) } "],["read_json.html", "Chapter 17 Read JSON 17.1 Reading JSON 17.2 Case 1: Air-Quality (well-formatted ) 17.3 Practices: traversing json data 17.4 Case 2: cnyes news (well-formatted) 17.5 Case 3: footRumor (ill-formatted) 17.6 Reviewing JSON 17.7 ", " Chapter 17 Read JSON jsonlite套件提供了處理 JSON 格式資料的功能。 # loading jsonlite package to parse a textual json file to an R object library(jsonlite) 17.1 Reading JSON 17.1.1 JSON as a string fromJSON('{\"a\":1, \"b\":2}')。 這是一個 JSON 物件，由一對大括號 {} 包圍。 該物件中有兩個鍵值對，用逗號 , 分隔。 第一個鍵值對中，鍵 a 對應的值為數字 1。 第二個鍵值對中，鍵 b 對應的值為數字 2。 fromJSON('[{\"a\":1, \"b\":2}, {\"a\":1, \"b\":3}]') 這是一個 JSON 陣列，由一對中括號 [] 包圍。 該陣列中有兩個元素，用逗號 , 分隔。 每個元素都是一個 JSON 物件，由一對大括號 {} 包圍。 第一個元素的 JSON 物件中，鍵 a 對應的值為數字 1，鍵 b 對應的值為數字 2。 第二個元素的 JSON 物件中，鍵 a 對應的值為數字 1，鍵 b 對應的值為數字 3。 library(jsonlite) lst <- fromJSON('{"a":1, "b":2}') class(lst) #list ## [1] "list" lst$a ## [1] 1 fromJSON('[{"a":1, "b":2}, {"a":1, "b":3}]') ## a b ## 1 1 2 ## 2 1 3 tbl <- fromJSON('[{"a":1, "b":2}, {"a":1, "b":3}, {"a":5, "b":7}]') class(tbl) # a data.frame ## [1] "data.frame" tbl$a[1] ## [1] 1 17.1.2 JSON as a local file 有時候JSON在編製的過程會記錄很多詮釋資料，所以不見得會把資料放在第一層，因此要嘗試去「trace」它才會知道資料在哪裡。例如以下範例是爬蟲爬回來的104職缺查詢結果，可猜想資料應放在如下結構中： { "data": { "list": [ ... ] } } library(jsonlite) raw <- read_json("data/url_104.json") raw$data$list[[1]] ## $jobType ## [1] "2" ## ## $jobNo ## [1] "10788904" ## ## $jobName ## [1] "約聘資料分析師(T45駐點食藥署)" ## ## $jobNameSnippet ## [1] "約聘<em class='b-txt--highlight'>資料分析</em>師(T45駐點食藥署)" ## ## $jobRole ## [1] "1" ## ## $jobRo ## [1] "1" ## ## $jobAddrNoDesc ## [1] "台北市南港區" ## ## $jobAddress ## [1] "" ## ## $description ## [1] "1.負責資料標準化、探勘及分析工作\\r\\n2.依客戶需求產出[[[資料分析]]]報告\\r\\n3.其他交辦工作" ## ## $optionEdu ## [1] "大學" ## ## $period ## [1] "00" ## ## $periodDesc ## [1] "經歷不拘" ## ## $applyCnt ## [1] "00005" ## ## $applyDesc ## [1] "0~5人應徵" ## ## $custNo ## [1] "97162640000" ## ## $custName ## [1] "關貿網路股份有限公司" ## ## $coIndustry ## [1] "1001001001" ## ## $coIndustryDesc ## [1] "電腦系統整合服務業" ## ## $salaryLow ## [1] "0033000" ## ## $salaryHigh ## [1] "0050000" ## ## $salaryDesc ## [1] "月薪 33,000~50,000元" ## ## $s10 ## [1] "50" ## ## $appearDate ## [1] "20191004" ## ## $appearDateDesc ## [1] "10/04" ## ## $optionZone ## [1] "9703424" ## ## $isApply ## [1] "0" ## ## $applyDate ## [1] "" ## ## $isSave ## [1] "0" ## ## $descSnippet ## [1] "1.負責資料標準化、探勘及分析工作\\r\\n2.依客戶需求產出<em class='b-txt--highlight'>資料分析</em>報告\\r\\n3.其他交辦工作" ## ## $tags ## $tags[[1]] ## [1] "上市上櫃" ## ## $tags[[2]] ## [1] "員工560人" ## ## ## $link ## $link$applyAnalyze ## [1] "//www.104.com.tw/jobs/apply/analysis?j=64404a2d3a4c445c3738406932343d208466649725c4c4627272727273e34402b826j52&channel=104rpt&jobsource=apply_analyze" ## ## $link$job ## [1] "//www.104.com.tw/job/6f8rs?jobsource=jolist_c_relevance" ## ## $link$cust ## [1] "//www.104.com.tw/company/18mw4ku8?jobsource=jolist_c_relevance" ## ## ## $jobsource ## [1] "jolist_c_relevance" ## ## $jobNameRaw ## [1] "約聘資料分析師(T45駐點食藥署)" ## ## $custNameRaw ## [1] "關貿網路股份有限公司" 17.1.3 JSON as a web file 當你使用手機上的 App 查看天氣、查詢公車路線、搜尋商品資訊時，你會注意到這些 App 看起來很不同，但它們都可以透過 Web API 來存取相同的資訊來源。簡單來說，Web API 就像是一種「資訊櫃檯」，提供存取資料的服務，它允許不同的應用程式通訊，以存取、分享、更新或刪除資料。透過 Web API，其他應用程式可以查詢、存取、下載、上傳、更新等操作資料，而不需要直接與資料庫或其他應用程式進行通訊。 舉例來說，一個網站可能有一個 Web API，它可以提供網站上所有文章的標題和內容。當其他網站或 App 需要獲取這些文章時，它們可以向該 Web API 發送請求，獲取所需資料。這樣就可以在不同的應用程式之間分享資料，提高效率和便利性。 Web API 和 JSON 之間的關係在於，Web API 通常會將回應資料以 JSON 的格式返回，以便接收方應用程式可以方便地解析和使用該資料。當一個應用程式需要從另一個應用程式獲取資料時，它可以透過 Web API 發送請求，並期望以 JSON 格式獲取回應。 如果該JSON是網頁伺服器所提供的Web API，以下程式碼示範了如何使用 R 語言中的 httr 和 jsonlite 套件，透過 HTTP GET() 請求獲取 Web API 所提供的 JSON 資料。以下是程式碼的解釋： GET(\"https://tcgbusfs.blob.core.windows.net/blobyoubike/YouBikeTP.json\") ：使用 httr 套件中的 GET 函數來發送 HTTP GET 請求，並取得 Web API 所提供的 JSON 資料。 %>% content(\"text\") ：content(\"text\") 表示將 HTTP 回應的資料轉換為純文字格式，便於後續處理。當我們把該純文字格式打開後，會發現他以JSON格式書寫。 %>% fromJSON() ：一旦確認回傳的訊息以JSON格式書寫，那麼就可以用jsonlite套件的fromJSON()將該文字字串轉為R的物件。 library(httr) library(jsonlite) raw <- GET("https://tcgbusfs.blob.core.windows.net/blobyoubike/YouBikeTP.json") %>% content("text") %>% fromJSON() write_json(raw, "data/opendata_ubike_202304261243.json") 你可以讀取本書預先爬取好的json檔來觀察前述程式所爬回的json檔轉成R物件後的結果。 raw <- fromJSON("data/opendata_ubike_202304261243.json") raw$retVal[["0001"]] ## $sno ## [1] "0001" ## ## $sna ## [1] "捷運市政府站(3號出口)" ## ## $tot ## [1] "84" ## ## $sbi ## [1] "72" ## ## $sarea ## [1] "信義區" ## ## $mday ## [1] "20221030161036" ## ## $lat ## [1] "25.0408578889" ## ## $lng ## [1] "121.567904444" ## ## $ar ## [1] "忠孝東路/松仁路(東南側)" ## ## $sareaen ## [1] "Xinyi Dist." ## ## $snaen ## [1] "MRT Taipei City Hall Stataion(Exit 3)-2" ## ## $aren ## [1] "The S.W. side of Road Zhongxiao East Road & Road Chung Yan." ## ## $bemp ## [1] "12" ## ## $act ## [1] "1" 17.1.4 Practice. Convert ubike json to data.frame 當你把ubike的資料給載回來並轉為R的物件後，你會發現該物件是一層又一層的named list，也就是每個list或每個值都有他的名字（name）。這是因為原本ubike的JSON格式是一層又一層的dict（Dictionary），全部是key-to-value的對應。這也是一種常見的Web API編法。 本練習希望你做的便是，希望你把這個好幾個階層的list，轉為一個以列（Rows）為每筆資料，欄（Columns）為變項的data.frame。 17.2 Case 1: Air-Quality (well-formatted ) 前往 https://data.gov.tw/dataset/40448對JSON 檔案按右鍵，然後複製連結，例如 “https://data.epa.gov.tw/api/v2/aqx_p_432?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=ImportDate%20desc&format=JSON”。 (但是，連結地址，特別是 api_key=9be7b239-557b-4c10-9775-78cadfc555e9，每次都會更改。所以你必須要自己嘗試)。 url <- "https://data.epa.gov.tw/api/v2/aqx_p_432?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=ImportDate%20desc&format=JSON" df <- fromJSON(content(GET(url), "text", encoding = "utf-8")) df %>% glimpse() df$records %>% head() %>% knitr::kable(format = "html") 17.2.1 Using knitr::kable() for better printing df$records %>% head() %>% knitr::kable(format = "html") 17.2.2 Step-by-step: Parse JSON format string to R objects fromJSON(content(GET(url), \"text\", encoding = \"utf-8\"))由內到外有三個函式。 * httr::GET()按照指定的url發出GET request把網頁抓回來，如果是個合乎規定存取，就會順利取回該伺服器發的response。 * hrrt::content(response, \"text\", encoding = \"utf-8\") 用?content查詢看看content(response, \"text\")的用途。其是把抓回來的檔案，轉為純文字的字串。content()是把抓回來的response解成純文字（JSON本身就是以純文字儲存，只是格式特別而已）。 jsonlite::fromJSON() 因為我們用眼睛看就知道他是個JSON格式的檔案，所以用fromJSON()這個函式，把用JSON格式編成的字串轉為R的物件，有可能是data.frame或list。fromJSON()預期會把JSON中[]的每一個項目轉為一筆筆的資料，然後把{}的pair當成column的變數名稱 17.2.2.1 Step 1. GET() 發送請求 向該URL的伺服器發送GET() request以取得該檔案。若成功取得，他會回覆一個HTML status code（你可上網查詢看看有哪些Status code）。如果成功的話就是2開頭的數字例如200 OK代表該伺服器接受該請求並開始傳回檔案。 # Getting url back by GET() response <- GET(url) # Inspecting returned data response class(response) (Tips) Using ?httr::GET to inspect the function 17.2.2.2 Step 2. httr::content() 將回應資料的轉純文字 回應的資料看他的class是一個response，但如果看Global Environment看來是個list，裡面裝載很多資料，而主要核心的內容在content這個欄位，但看來是用binary code裝起來的，而不是純文字。 因此，對於這個抓回來的檔案，我需要用httr::content()幫忙把純文字給解出來。經查詢help可得知content()後面的參數有三類，其中可以要轉為純文字的就是content(response, \"text\")。因此偵測轉出來的變數會是長度為1的character。 # Parsing to textual data by content() text <- content(response, "text", encoding = "utf-8") nchar(text) cat(text) class(text) length(text) (Tips) using ??httr::content to inspect the function 17.2.2.3 Step 3. fromJSON(): 將JSON格式文字轉為R物件 最後是將這個character轉為R的物件，也就是data.frame或list。注意，此時text是一個character，那是我們知道他是用JSON格式編寫的文字檔，就像我們知道.csv檔是用逗號分隔表示法依樣，JSON就是用層層疊疊的[]{}記號來表述資料的結構。 並要提醒初學者，.json或.csv都只是幫助程式初步篩選檔案的副檔名罷了，這兩種類型的檔案跟.txt檔一樣，都被歸屬為Win系統所謂的「純文字文件檔案」（就打開以後看得到文字的意思）。裡面的究竟是不是個完整的json檔這都要去看、去測。我自然也可以在.json的檔案裡偷偷亂用逗號分隔模式撰寫。 df <- fromJSON(text) dim(df) glimpse(df) ?fromJSON 17.2.3 Combining all UVI Open data: https://data.gov.tw/dataset/6076 https://data.epa.gov.tw/api/v2/uv_s_01?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=publishtime desc&format=JSON 17.2.3.1 Get from web api # specify data url url <- "https://data.epa.gov.tw/api/v2/uv_s_01?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=publishtime%20desc&format=JSON" # GET(), content(), then converting to R object by fromJSON() raw <- fromJSON(content(GET(url), "text", encoding = "utf-8")) 17.2.3.2 Read from pre-saved JSON 你可以讀取本書預先爬取好的json檔來觀察前述程式所爬回的json檔轉成R物件後的結果。 # You can read the pre-crawled JSON file to observe the R object. raw <- fromJSON("data/opendata_uvi_202304261215.json") raw$records %>% head %>% knitr::kable() sitename uvi publishagency county wgs84lon wgs84lat publishtime 宜蘭 0.00 中央氣象局 宜蘭縣 121,45,24 24,45,50 2023-04-26 00:00 大武 0.00 中央氣象局 臺東縣 120,54,14 22,21,20 2023-04-26 00:00 玉山 0.00 中央氣象局 南投縣 120,57,34 23,29,15 2023-04-26 00:00 臺南 0.00 中央氣象局 臺南市 120,12,17 22,59,36 2023-04-26 00:00 新竹 0.01 中央氣象局 新竹縣 121,00,51 24,49,40 2023-04-26 00:00 日月潭 0.00 中央氣象局 南投縣 120,54,29 23,52,53 2023-04-26 00:00 預期結果 sitename uvi publishagency county wgs84lon wgs84lat publishtime 宜蘭 0.00 中央氣象局 宜蘭縣 121,45,24 24,45,50 2023-04-26 00:00 大武 0.00 中央氣象局 臺東縣 120,54,14 22,21,20 2023-04-26 00:00 玉山 0.00 中央氣象局 南投縣 120,57,34 23,29,15 2023-04-26 00:00 臺南 0.00 中央氣象局 臺南市 120,12,17 22,59,36 2023-04-26 00:00 新竹 0.01 中央氣象局 新竹縣 121,00,51 24,49,40 2023-04-26 00:00 日月潭 0.00 中央氣象局 南投縣 120,54,29 23,52,53 2023-04-26 00:00 17.3 Practices: traversing json data 下列這些網路文件應該都是json檔，請在以下的練習中，一個一個把他帶入把他抓回來看看。並用str()或dplyr::glimpse()觀察資料的內容。注意，如果你用了View()會沒辦法knit成html檔。又，每個不同的Web API存放的核心資料階層都不一樣，你必須要嘗試找到該多筆資料所在的data.frame。例如url_cnyes的資料便放在raw$items$data這樣的階層底下。 如果你無法順利撈取，你可以運用本書所預備的url_cnyes.json來做觀察json結構的練習。 url_pchome <- "https://ecshweb.pchome.com.tw/search/v3.3/all/results?q=iphone&page=1&sort=rnk/dc" url_ubike <- "https://tcgbusfs.blob.core.windows.net/blobyoubike/YouBikeTP.json" url_cnyes <- "https://news.cnyes.com/api/v3/news/category/headline?startAt=1588262400&endAt=1589212799&limit=30" raw <- fromJSON(content(GET(url_cnyes), "text", encoding = "utf-8")) # raw <- fromJSON("data/url_cnyes.json") raw$items$data 17.4 Case 2: cnyes news (well-formatted) 第二類是最常會見到的例子，解出來的資料是個很多階層的list，通常一筆資料傳回來時多會附加一些metadata，比方說，一共幾筆資料、下一個資料區塊在哪裡，好讓使用者或者本地端的瀏覽器能夠繼續取得下一筆資料。因此，資料通常會在樹狀節點的某一個子節點。 url_cnyes <- "https://news.cnyes.com/api/v3/news/category/headline?startAt=1588262400&endAt=1589212799&limit=30" res <- fromJSON(content(GET(url_cnyes), "text", encoding = "utf-8")) glimpse(res) raw <- fromJSON("data/url_cnyes.json") df <- raw$items$data head(df) ## newsId title ## 1 4475846 〈財報〉疫情衝擊 Under Armour Q1營收大減23% ## 2 4475874 若一年內疫情未控制 避險基金大佬：美國將面臨第2次經濟大蕭條 ## 3 4475873 〈美股早盤〉市場憂經濟重啟條件不成熟 道瓊早盤跌逾200點 ## 4 4475465 挽救國家財政危機 沙烏地撙節支出266億美元 ## 5 4475875 長榮攜手海大開輪機工程專班 實習後正職月薪15萬元 ## 6 4475855 泰鼎-KY首季每股純益 1.5元 僅次健鼎 ## content ## 1 &lt;p&gt;美國運動用品大廠 Under Armour (UAA-US) 於週一 (11 日) 盤前公佈 2020 財年第一季財報，受到新冠肺炎 (COVID-19) 疫情影響，導致零售業者被迫關閉店面，該公司於 Q1 營收及獲利雙雙不如市場預期。&lt;/p&gt;\\n\\n&lt;p&gt;受到財報表現不佳的影響，Under Armour 股價應聲下跌，於週一 (11 日) 台北時間晚上 10 時許，該公司股價下跌 10.97%，報每股 8.85 美元。自今年以來，Under Armour 股價已下跌了 54%。&lt;/p&gt;\\n\\n\\n\\n&lt;p&gt;&lt;em&gt;基於 non GAAP 財報關鍵數據:&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;ul&gt;\\n&lt;li&gt;營收：9.302 億美元，較去年同期的 12 億美元衰退，且低於市場預估值 9.49 億美元&lt;/li&gt;\\n&lt;li&gt;稅後淨損：5.897 億美元，去年同期報稅後淨利 2250 萬美元&lt;/li&gt;\\n&lt;li&gt;每股虧損：0.34 美元，低於市場預估值每股虧損 0.19 美元，去年同期每股盈餘報 0.05 美元&lt;/li&gt;\\n&lt;/ul&gt;\\n\\n&lt;p&gt;由於疫情重創買氣，導致零售產業受到嚴重打擊，Under Armour CEO Patrik Frisk 表示，自 3 月中旬開始，疫情於北美地區快速蔓延，導致零售店面被迫關閉，並造成 Q1 營收大幅衰退 23%。&lt;/p&gt;\\n\\n&lt;p&gt;根據不同產品類別來看，Q1 服裝銷售下滑了 23%，報 5.98 億美元，鞋類銷售下滑 28%，報 2.1 億美元，配件銷售則下滑 17%，報 6800 萬美元。&lt;/p&gt;\\n\\n&lt;p&gt;根據不同銷售市場來看，Q1 北美營收下滑 28%，報 6.09 億美元，北美以外其他地區銷售則下滑 12%，報 2.87 億美元。北美地區的營收佔了 Under Armour 總營收的 65%。&lt;/p&gt;\\n\\n&lt;p&gt;此外，該公司表示，截至第一季為止，該公司帳上現金為 9.59 億美元。另外，預估今年的資本支出金額將達 1 億美元，低於較先前所預估的 1.6 億美元。&lt;/p&gt;\\n\\n&lt;p&gt;Under Armour 的營收成長，相當仰賴百貨公司等通路的銷售表現，但受到封鎖措施的影響，導致百貨公司被迫關閉。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;公司展望：&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;隨著美國宣佈實施經濟重啟計劃，包括梅西百貨 (M-US) 及 GAP(GPS-US) 皆規劃逐步重新恢復營業，但 Under Armour 卻於週一 (11 日) 表示，對於營業恢復的時程尚不確定。&lt;/p&gt;\\n\\n&lt;p&gt;此外，為了減輕疫情的衝擊，該公司計劃於 2020 年削減 3.25 億美元營運成本，包括暫時裁員部份零售店面的員工。由於疫情導致營運不確定性高，該公司已於上個月撤回了對於 2020 全年的財務預測。&lt;/p&gt;\\n ## 2 &lt;p&gt;美國知名避險基金經理人、Tudor Investment Corp. 創辦人 Paul Tudor Jones 週一 (11 日) 警告，若疫情在一年之內無法獲得控制，美國經濟將會陷入「第二次」經濟大蕭條。&lt;/p&gt;\\n\\n&lt;p&gt;Tudor Jones 表示：「若一年後我們依舊處於相同狀況，這將會形成第二次經濟大蕭條，這一切取決於封鎖措施是否解除。」&lt;/p&gt;\\n\\n&lt;p&gt;相較於中國、南韓等國在疫情控制及追蹤方面的努力，美國人對於自由的重視，正可能成為防疫過程中的一大阻礙，美國公衛專家即警告，若疫情尚未明顯趨緩即解封經濟，那麼可能帶來第二波的疫情蔓延。&lt;/p&gt;\\n\\n&lt;p&gt;Tudor Jones 說道：「與其他國家不同，我認為美國最大優勢在於個人主義，也就是對自由的熱愛，然而這在疫情之下卻是我們最大的弱點，看看在這方面取得成功的亞洲國家，他們的選擇顯示比起個人權利，他們更加重視社會價值觀。」&lt;/p&gt;\\n\\n&lt;p&gt;由於投資人認為經濟終將重啟，美股在今年 3 月創下史上最快步入熊市的紀錄後，正自低點迅速反彈，標普 500 指數已自疫情爆發後的底點反彈 30% 以上，且和紀錄高點僅相差 13.6%。&lt;/p&gt;\\n\\n\\n\\n&lt;p&gt;Tudor Jones 認為這波反彈相當容易預測，並強調未來走勢在很大程度上取決於疫情防控作業，重點將從流動性轉移到償債能力。&lt;/p&gt;\\n\\n&lt;p&gt;「若還是無法找到疫苗或治療方法，或者是更適合的大規模檢測方案，市場將會面臨更加艱難的時刻。」Tudor Jones 表示。&lt;/p&gt;\\n ## 3 &lt;p&gt;自上週以來，由於各國政府開始逐步放寬封鎖措施，並重新開放經濟活動，帶動美股呈現上揚的趨勢。但是，近日來部份國家傳出新冠疫情再度惡化的消息，除了南韓新增確診病例快速攀升之外，日本及新加坡的新增病例亦呈增加趨勢，顯示疫情的狀況仍不穩定，導致投資人不安情緒升溫，並衝擊了市場對於經濟重啟的信心。&lt;/p&gt;\\n\\n&lt;p&gt;由於擔憂若過早重啟經濟，將可能冒著第二波疫情感染的風險，美股於週一 (11 日) 開盤 4 大指數皆下跌，另外，與疫情關聯性較高的產業，包括航空、零售、郵輪及賭場等，股價亦呈現下跌的趨勢，道瓊早盤下跌超過 200 點。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;新冠肺炎疫情&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;英國首相強生 (Boris Johnson) 於上週日 (10) 宣佈了解除英國封鎖並重啟經濟的「首批謹慎步驟」，呼籲英國各地的人們重返工作崗位。強生強調，不會立即結束封鎖，但自週三 (13 日) 起，將放鬆對人們行動的限制，從戶外體育運動時間不再設限開始，例如高爾夫和網球，並允許人們開車前往公園和海灘。&lt;/p&gt;\\n\\n&lt;p&gt;新冠疫情於西歐國家呈現放緩的跡象，但於俄羅斯卻日益嚴重，不僅連續數日的單日新增確診病例皆突破 1 萬例，且累計確診病例數已突破 20 萬例，並超越德國及法國，成為全球疫情第五嚴重的國家。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;中美貿易協議&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;美國智庫戰略及國際研究中心 (CSIS) 上週五 (8 日) 發佈報告預計，新冠疫情將導致今年中國對美採購量遠低第一階段貿易協議的要求。&lt;/p&gt;\\n\\n&lt;p&gt;美中矛盾因疫情衝擊而逐漸加劇，使外界對於第一階段貿易協議的現況感到疑慮，儘管兩國最高官員上週同意持續落實貿易協議，同時保持溝通協調，美國總統川普仍在上週五 (8 日) 表示，疫情衝擊大大改變他對於協議的觀感，對於是否終止協議感到相當掙扎。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;截至台北時間週一 (11 日)22 時許：&amp;nbsp;&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;ul&gt;\\n&lt;li&gt;道瓊指數下跌 241.98 點或 -0.99%，暫報 24089.34 點&lt;/li&gt;\\n&lt;li&gt;那斯達克下跌 44.12 點或 -0.48%，暫報 9077.20 點&lt;/li&gt;\\n&lt;li&gt;標普 500 下跌 24 點或 -0.82%，暫報 2905.80 點&lt;/li&gt;\\n&lt;li&gt;費半下跌 15.59 點或 -0.88%，暫報 1760.02 點&lt;/li&gt;\\n&lt;li&gt;台積電 ADR 下跌 0.64% 至每股 52.53 美元&lt;/li&gt;\\n&lt;li&gt;十年期美債殖利率上漲至 0.686%&lt;/li&gt;\\n&lt;li&gt; 紐約輕原油上漲 0.97% 至每桶 24.98 美元&lt;/li&gt;\\n&lt;li&gt;布蘭特原油下跌 0.16% 至每桶 30.92 美元&lt;/li&gt;\\n&lt;li&gt;黃金下跌 0.41% 至每盎司 1706.85 美元&lt;/li&gt;\\n&lt;li&gt;美元指數上漲 0.31% 至 100.078 點 &amp;nbsp;&lt;/li&gt;\\n&lt;/ul&gt;\\n\\n\\n\\n&lt;p&gt;&lt;em&gt;焦點個股：&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;特斯拉 (TSLA-US)&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;特斯拉早盤下跌 3.46%，達 790.68 美元。&lt;/p&gt;\\n\\n&lt;p&gt;根據中國乘用車市場信息聯席會於週一 (11 日) 報告指出，儘管 4 月份中國整體電動車市場呈現成長的趨勢，但特斯拉平價車款 Model 3 的銷售，卻較 3 月份暴跌了 64%，由 10160 輛減少至 3635 輛。此外，特斯拉在今年 1 月至 4 月，於中國的 Model 3 車款累計銷售量則達 19705 輛。&lt;/p&gt;\\n\\n&lt;p&gt;特斯拉執行長馬斯克 (Elon Musk) 於日前表示，為了使中國消費者能夠獲得電動車補貼的資格，已調降了 Model 3 於中國的銷售價格。此外，特斯拉亦致力於降低生產成本，因此，即使調降了銷售價格，該公司仍舊可以維持穩定的毛利率。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;蘋果 (AAPL-US)&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;蘋果早盤下跌 0.80%，達 307.61 美元。&amp;nbsp;&lt;/p&gt;\\n\\n&lt;p&gt;據報導指出，蘋果正計劃將該公司近五分之一的產能從中國轉移到印度，並通過富士康和緯創資通等合作製造商，擴大印度當地的生產業務，未來五年內投資規模可能升至 400 億美元，也可能使印度成為蘋果商品最大出口國。&lt;/p&gt;\\n\\n&lt;p&gt;數據顯示，蘋果的產品中有 90% 以上的產能來自中國。其中，iPhone 的代工生產很大一部分來自富士康與和碩。在 2015 年時，蘋果代工廠富士康就曾與印度達成備忘錄，同意加大對印度製造業的投資，並有計劃於 2020 年在印度建立 10 至 12 家製造消費電子產品的工廠。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;Under Armour (UAA-US)&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;Under Armour 早盤下跌 7.95%，達 9.15 美元。&lt;/p&gt;\\n\\n&lt;p&gt;美國運動用品大廠 Under Armour 於週一 (11 日) 盤前公佈 2020 財年第一季財報，受到疫情影響，導致零售業者被迫關閉店面，該公司於 Q1 營收衰退 23% 至 9.3 億美元。其中，服裝銷售下跌了 23%，鞋類銷售下滑 28%，配件銷售則下滑 17%。&lt;/p&gt;\\n\\n&lt;p&gt;此外，疫情亦造成 Under Armour 獲利能力大幅下降，Q1 稅後淨損報 5.89 億美元，每股損失 0.34 美元。去年同期稅後淨利則為 2250 萬美元，每股盈餘為 0.05 美元。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;今日關鍵經濟數據：&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;無&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;華爾街分析：&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;Vital Knowledge 創辦人 Adam Crisafulli 表示，全球經濟呈現逐步重啟的態勢，預期在接下來幾週，開放的速度將會加速，但儘管如此，目前 S&amp;amp;P 500 的估值仍屬被高估的狀態。&lt;/p&gt;\\n\\n&lt;p&gt;Principal Global Investors 經濟學家 Bob Baur 亦表示，全球疫情逐漸好轉的消息、以及對於經濟成長的預期，目前皆已被反映在股價的估值上。&lt;/p&gt;\\n\\n&lt;p&gt;穆迪首席經濟學家 Mark Zandi 警告，各州過早重新開放企業是一次豪賭，如果因此出現第二波感染潮，將引發經濟蕭條。Zandi 表示，市場認為 V 型復甦的可能性很高，而隨著美國企業重新開放，就業有望從 5 月最後一週開始反彈，如果不出現第二波感染，就業增長將從夏季持續至秋季初。&lt;/p&gt;\\n ## 4 &lt;p&gt;為挽救低油價及疫情帶來的國家財政危機，沙烏地阿拉伯週一 (11 日) 宣布自 6 月起停發生活津貼，同時將加值稅上調三倍，撙節支出總計 266 億美元。&lt;/p&gt;\\n\\n&lt;p&gt;受外在因素衝擊，財政部長賈丹 (Mohammed Al-Jadaan) 認為沙國正處於財政危機邊緣，宣布縮減「願景 2030」(Vision 2030) 經濟改革計劃內的部分措施，國家將自 6 月 1 日起停發生活津貼，並自 7 月 1 日起將加值稅上調三倍至 15％，總計削減規模達 266 億美元。&lt;/p&gt;\\n\\n&lt;p&gt;賈丹稱道：「肺炎疫情導致政府收入下滑，對公共財政形成的壓力來到難以應付的水平，將衝擊國家中長期宏觀經濟及公共財政，因此我們必須削減開支，並採取相關措施來支撐非石油收入的穩定。」&lt;/p&gt;\\n\\n&lt;p&gt;賈丹上週警告，沙國已數十年沒有經歷這種嚴重危機，強調該國必須大幅削減支出。根據統計，今年第一季沙國預算赤字約達 91 億美元，光是石油收入就減少 350 億美元，非石油收入則減少 170 億美元。&lt;/p&gt;\\n\\n&lt;p&gt;由於各國政府相繼頒布旅遊及封鎖禁令，沙國已受到油價暴跌和原油減產的深刻影響。今年 3 月，國際原油基準布蘭特原油暴跌逾 50%，導致沙國央行的淨海外資產每月損失 270 億美元，創下歷史紀錄，3 月外匯存底以 20 年幾年來最快速度下滑。&lt;/p&gt;\\n\\n\\n\\n&lt;p&gt;儘管高盛預計第二季石油收入將持續下滑，高盛經濟學家 Farouk Soussa 仍表示，預計沙國外匯存底損耗速度將逐漸放緩。&lt;/p&gt;\\n ## 5 &lt;p&gt;為擴大培育國籍海事專業人才，長榮海運 (2603-TW) 今 (11) 日宣布，與國立台灣海洋大學再度合作開辦學士後多元專長培力方案(輪機工程學系專班)，希望透過產業與學術密切合作，培養有志投身海勤工作的學員，並可在畢業後隨即就業，長榮指出，一旦正式成為長榮的海勤人員，月薪約 15 萬元。&lt;/p&gt;\\n\\n&lt;p&gt;長榮說明，此專班的招生對象為非輪機科系畢業的學員，只要具備學士資格，役畢或免服兵役者皆可報考，通過遴選後開始就讀，修業時間為三學期，長榮海運將全額補助學雜費和部分住宿費用，自 5 月 12 日起開放報名，預計 9 月正式開學。&lt;/p&gt;\\n\\n&lt;p&gt;而此方案是為配合長榮永續發展的專業人才需求，透過不同的管道來擴大培育優秀的國籍海事尖兵，並不影響海事科系學生到長榮實習和工作的機會。&lt;/p&gt;\\n\\n&lt;p&gt;長榮於 2017 年開始與海洋大學開辦第一期學士後輪機技術人才專班，該期學員已於去年畢業，並有超過 90% 的學員通過交通部的航海人員一等管輪測驗，陸續上船實習；部分學員已依規定累積一年的實習資歷，取得管輪適任證書，正式成為長榮的海勤人員，月薪約 15 萬元，未來隨著海勤年資與經驗增加，並通過相關測驗，可逐級晉升為輪機長，月薪將達 28-30 萬元的水準。&lt;/p&gt;\\n\\n&lt;p&gt;除了優渥的薪資外，長榮強調，貨櫃船隊提供舒適的住艙環境，並有圖書室、健身房、三溫暖及影音娛樂等設施，以及無線網路。&lt;/p&gt;\\n ## 6 &lt;p&gt;PCB 廠泰鼎 - KY(4927-TW) 今 (11) 日公布日首季稅後純益達 2.85 億元，每股純益為 1.5 元，在已公布 2020 年第一季財報的 PCB 廠中，僅次健鼎 (3044-TW) 的每股純益 1.86 元，第三名則是臻鼎 (4958-TW) 的 0.97 元。&lt;/p&gt;\\n\\n&lt;p&gt;泰鼎 2020 年首季營收 26.05 億元，毛利率 21%，季增 6 個百分點，年增 2 個百分點，稅後純益 2.85 億元，季增 5.06 倍、年增 11.8%，為單季次高，每股純益&amp;nbsp;1.5 元，也優於去年同期&amp;nbsp;1.43 元。&lt;/p&gt;\\n\\n&lt;p&gt;泰鼎 4 月營收 10.14 億元，月增 23.2%、年增 28.4%，為 9 個月新高，也創單月歷年同期新高; 累計今年前 4 月營收 36.19 億元，年減 0.5%。&lt;/p&gt;\\n\\n&lt;p&gt;展望第二季，泰鼎在 PC、家電、汽車、通訊四大區塊接單順利，預估營收相對第一季 26.05 億元，將雙位數成長。&lt;/p&gt;\\n\\n&lt;p&gt;泰鼎目前在泰國擁有每月 500 萬平方呎 PCB 產能，第 3 廠已經動工，全部完工後每月將再增加 180 萬平方呎新產能。&lt;/p&gt;\\n ## hasCoverPhoto isIndex ## 1 0 1 ## 2 0 1 ## 3 0 1 ## 4 0 1 ## 5 1 1 ## 6 1 1 ## summary ## 1 Under Armour (UAA-US) 於週一 (11 日) 盤前公佈 2020 財年第一季財報，受到新冠肺炎 (COVID-19) 疫情影響，導致零售業者被迫關閉店面，該公司於 Q1 營收及獲利雙雙不如市場預期。 ## 2 美國知名避險基金經理人、Tudor Investment Corp. 創辦人 Paul Tudor Jones 週一 (11 日) 警告，若疫情在一年之內無法獲得控制，美國經濟將陷入「第二次」經濟大蕭條。 ## 3 由於擔憂若過早重啟經濟，將可能冒著第二波感染的風險，美股於週一 (11 日) 開盤 4 大指數皆下跌，另外，與疫情關聯性較高的產業，包括航空、零售、郵輪及賭場等，股價亦呈現下跌的趨勢。道瓊指數下跌超過 200 點。 ## 4 為挽救低油價及疫情帶來的國家財政危機，沙烏地阿拉伯週一 (11 日) 宣布自 6 月起停發生活津貼，同時將加值稅上調三倍，撙節支出總計 266 億美元。 ## 5 長榮攜手海大開輪機工程專班 實習後正職月薪 15 萬元 ## 6 PCB 廠泰鼎 - KY(4927-TW) 今 (11) 日公布日首季稅後純益達 2.85 億元，每股純益為 1.5 元，在已公布 2020 年第一季財報的 PCB 廠中，僅次於健鼎 (3044-TW) 的每股純益 1.86 元，而第三為臻鼎。 ## isCategoryHeadline video payment ## 1 1 0 ## 2 1 0 ## 3 1 0 ## 4 1 0 ## 5 1 0 ## 6 1 0 ## otherProduct ## 1 USS:UAA:STOCK:COMMON, USS:M:STOCK:COMMON, USS:GPS:STOCK:COMMON ## 2 ## 3 TWS:2330:STOCK:COMMON, USS:TSLA:STOCK:COMMON, USS:AAPL:STOCK:COMMON, USS:UAA:STOCK:COMMON, USS:TSM:STOCK:COMMON ## 4 ## 5 TWS:2603:STOCK:COMMON ## 6 TWS:4927:STOCK:COMMON, TWS:3044:STOCK:COMMON, TWS:4958:STOCK:COMMON ## isOutsource publishAt ## 1 0 1589211902 ## 2 0 1589209204 ## 3 0 1589205268 ## 4 0 1589204403 ## 5 0 1589203838 ## 6 0 1589203802 ## coverSrc.xs.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/xs/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/xs/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.xs.width coverSrc.xs.height ## 1 NA NA ## 2 NA NA ## 3 NA NA ## 4 NA NA ## 5 100 56 ## 6 100 56 ## coverSrc.s.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/s/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/s/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.s.width coverSrc.s.height ## 1 NA NA ## 2 NA NA ## 3 NA NA ## 4 NA NA ## 5 180 101 ## 6 180 101 ## coverSrc.m.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/m/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/m/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.m.width coverSrc.m.height ## 1 NA NA ## 2 NA NA ## 3 NA NA ## 4 NA NA ## 5 380 214 ## 6 380 214 ## coverSrc.l.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/l/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/l/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.l.width coverSrc.l.height ## 1 NA NA ## 2 NA NA ## 3 NA NA ## 4 NA NA ## 5 640 360 ## 6 640 360 ## coverSrc.xl.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/xl/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/xl/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.xl.width coverSrc.xl.height ## 1 NA NA ## 2 NA NA ## 3 NA NA ## 4 NA NA ## 5 960 539 ## 6 960 540 ## coverSrc.xxl.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/xxl/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/xl/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.xxl.width coverSrc.xxl.height categoryId fundCategoryAbbr etf ## 1 NA NA 831 NULL NULL ## 2 NA NA 831 NULL NULL ## 3 NA NA 831 NULL NULL ## 4 NA NA 833 NULL NULL ## 5 1080 607 827 NULL NULL ## 6 960 540 827 NULL NULL ## fbShare fbComment fbCommentPluginCount ## 1 0 0 0 ## 2 0 0 0 ## 3 0 0 0 ## 4 0 0 0 ## 5 0 0 0 ## 6 0 0 0 ## market ## 1 NULL ## 2 NULL ## 3 2330, 台積電, TWS:2330:STOCK ## 4 NULL ## 5 2603, 長榮, TWS:2603:STOCK ## 6 4927, 3044, 4958, 泰鼎-KY, 健鼎, 臻鼎-KY, TWS:4927:STOCK, TWS:3044:STOCK, TWS:4958:STOCK ## source ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 ## 6 17.4.1 (option) 取回資料並寫在硬碟 有時候寫爬蟲尤其是在爬會即時更新的資料時，會需要反覆定時地抓資料，這時候通常會先通通抓回來再慢慢合併整理。此時要特別注意如何保持每次抓回來的資料都是獨特的一個資料。以下面的例子來講，因為每次檔名都是一樣的，他會一直覆蓋過去，所以再怎麼抓，都不會是歷時性資料。通常會自動讀取當下時間當成檔名的一部分，這樣就不會重複了。這將在日後youbike的例子中用到。 response <- GET(url_cnyes, write_disk("data/url_cnyes.json", overwrite=TRUE)) 17.5 Case 3: footRumor (ill-formatted) 食品闢謠的例子可能是個沒好好編過JSON的單位所編出來的案子，資料很簡單，但卻是一個list裡面有329個data.frame，且每個data.frame只有對腳現有資料，然後每一筆資料就一個data.frame。 url <- 'http://data.fda.gov.tw/cacheData/159_3.json' safefood <- fromJSON(content(GET(url),'text')) # write_json(safefood, "data/opendata_safefood_202304261256.json") 為了避免產製本書時出錯，本程式採用預備好的資料來練習。但仍建議你用前述方式自網路上爬取資料下來練習。 safefood <- fromJSON("data/opendata_safefood_202304261256.json") # str(safefood) class(safefood) ## [1] "list" class(safefood[[1]]) ## [1] "data.frame" dim(safefood[[1]]) ## [1] 5 5 # View(safefood[[1]]) # View(safefood) # print(content(GET(url), "text")) 17.5.1 處理非典型的JSON檔 但這時候也不難觀察到其規律性。既然每個data.frame是一筆資料，且資料都是照順序出現在對角線，那我就把data.frame給unlist()拆成vector後，把NA給移除了，那剩下的就是我們要的資料了。 但，由於對整筆資料unlist()，那整筆資料會變成一個很長的vector，不過我們知道每五個元素就是一筆資料。所以我可以嘗試用matrix()的指令，讓資料每五個就折成一筆資料。 程序大致上是 safefood.v <- unlist(safefood) 把資料unlist()。 safefood.v <- safefood.v[!is.na(safefood.v)]剔除NA值 safefood.m <- matrix(safefood.v, byrow = T, ncol = 5)照列來折，因為每五個就一筆資料，所以是照列折，然後用ncol = 5來指定五個一折。 # unlist data structure to a list safefood.v <- unlist(safefood) head(safefood.v) ## 分類1 分類2 分類3 分類4 分類5 標題1 ## "" NA NA NA NA NA # anyNA() to check if NAs still exist anyNA(safefood.v) ## [1] TRUE # (option) check if NAs exist sum(is.na(safefood.v)) ## [1] 10720 # remove NAs safefood.v <- safefood.v[!is.na(safefood.v)] # length(safefood.v) # double-check NAs anyNA(safefood.v) ## [1] FALSE # head(safefood.v) # convert vector to matrix safefood.m <- matrix(safefood.v, byrow = T, ncol = 5) # ?matrix # convert matrix to dataframe safefood.df <- as.data.frame(safefood.m) # delete the 4th column safefood.df <- safefood.df[-4] # naming the data.frame names(safefood.df) <- c('category', 'question', 'answer', 'timestamp') head(safefood.df) ## category question ## 1 使用含有acetaminophen成分藥品會傷腎，是真的嗎？ ## 2 使用退燒藥會延誤治療，是真的嗎？ ## 3 美國全面禁止2歲以下幼兒使用感冒藥及退燒藥嗎？ ## 4 凡士林(Petrolatum)會致癌，請問是真的嗎？ ## 5 市售護唇膏多含石蠟，長期使用可能致癌，是真的嗎？ ## 6 含藥化粧品比一般化粧品效果更好嗎？ ## answer ## 1 解答： Acetaminophen 是一種中樞作用型解熱鎮痛藥品，在正常健康狀況下，使用正常的建議劑量（成人每日不超過4000 毫克，兒童每日每公斤不超過50 毫克，分多次服用，每次至少間隔4 小時），並不會引起腎毒性。有少數報告顯示當急性過量使用時，會導致腎功能不良，但多為可逆性，如果慢性大量使用，才有嚴重腎臟傷害的可能性。 根據國外報告，成人長期持續使用1 年以上，而且累積劑量超過1 公斤（以一般每顆500 毫克的成人劑型而言，相當於2000 顆）時，可能導致嚴重腎臟傷害。此外，過量使用acetaminophen 或併服酒精性飲料時，具有肝臟損傷之風險。因此使用該成分藥品，應依照仿單或醫師指示使用，且避免長期持續使用或同時飲用酒精。 本文案為食藥署與臺灣兒科醫學會共同撰文 ## 2 解答： (1)發燒為一種症狀，並非病因，瞭解引起發燒之原因遠比退燒重要。因此，出現發燒症狀時，應立即就醫治療，以瞭解導致發燒的原因，切勿自行購買退燒藥使用，以免延誤疾病之治療。 (2)退燒藥之使用，主要目的是減緩因發燒出現之不適感。當發燒超過38.5° C且有不舒服的感覺，可適當給予退燒藥，但不一定要讓體溫降到正常範圍。 本文案為食藥署與臺灣兒科醫學會共同撰文 ## 3 解答： 美國食品藥物管理局並未完全禁止2 歲以下幼兒使用退燒藥或感冒藥，而是強調應在醫師指示下使用。美國分析兒童使用感冒藥產生的嚴重不良反應，主要是因為美國民眾可於藥局自行購買成藥，家長因為沒有劑量觀念，可能導致藥物過量而使幼兒發生危險。我國對於該類藥品之使用建議與國外一致，且中文仿單已註明「幼兒應洽醫師診治，不宜自行使用」，強調感冒藥必須經由專業醫師診治後，方能用於2 歲以下幼兒。 幼兒的生理發展尚未健全，必須特別注意藥物劑量。因此，無論中藥或西藥，幼兒使用藥品一定要經熟悉兒科專業的醫師評估其臨床效益及風險，並依幼兒之體重年齡處方適當劑量。家長依循專業醫師處方使用藥物，比較不會發生腎毒性等不良反應。 本文案為食藥署與臺灣兒科醫學會共同撰文 ## 4 解答： 凡士林(Petrolatum) 成分常被用於髮蠟、髮乳、潤膚霜、冷霜、唇膏、乳液等化粧品中，該成分安定性佳且歐盟、美國、日本等國的化粧品均未禁止使用凡士林成分，更可用於食品及口服藥品中，做為油性鎖水保濕劑使用。 提醒大家不要被謠言所誤導，選擇適合自己的產品，瞭解成分的用途與使用方式，才是保養身體的關鍵。 ## 5 解答： 石蠟是護唇膏、各種保濕保養化粧品的常見的成分，目前國際間均允許該成分可添加於化粧品中。化粧品中使用之石蠟已經精製，而精製過後的石蠟安定性佳，更可用於食品及口服藥品中。 食藥署提醒大家，不要被謠言所誤導，選擇標示完整及適合自己的產品，瞭解成分的用途與使用方式，才是保障自身權益的關鍵。 ## 6 解答： (1)我國所謂的「含藥化粧品」，實際上為含有衛生福利部公告的「化粧品含有醫療或毒劇藥品基準」成分之化粧品，主要針對添加前述基準成分之染髮劑、燙髮劑、止汗制臭劑等產品加強安全性管理，與化粧品的效果無關。 (2)目前含藥化粧品依規定需於進口或上市前辦理查驗登記，取得許可證後始得輸入、製造及販售。 (3)民眾在選購含藥化粧品前，可先上食藥署首頁>業務專區>化粧品>含藥化粧品許可證查詢作業，查詢該含藥化粧品是否已取得許可證，才可安心購買。 相關連結： 西藥、醫療器材、含藥化粧品許可證查詢作業http://www.fda.gov.tw/mlms/H0001.aspx (另開視窗) ## timestamp ## 1 06 25 2015 12:00AM ## 2 06 25 2015 12:00AM ## 3 06 25 2015 12:00AM ## 4 06 25 2015 12:00AM ## 5 06 25 2015 12:00AM ## 6 06 25 2015 12:00AM 17.6 Reviewing JSON 17.6.1 Type I: Well-formatted JSON: UVI, AQI, Hospital_revisits 這類的資料以典型的[{}, {}, {}]形式儲存，以以下方式就可直接轉為data.frame df <- fromJSON(content(GET(url), \"text\")) 17.6.2 Type II: hierarchical JSON: rent591, facebook graph api, google map 這類的json資料為well-formatted，但要的資料儲存在比較深的階層中，代表其並非簡單地二維表格，還有其他更多的詮釋資料被擺在同一個JSON檔案中。解決策略：通常fromJSON()轉完後為list，逐一就variable names查看資料在哪裡。View(res$data$data) 17.6.3 Type III: Ill-formatted JSON: food_rumors, ubike 這類的資料並非以典型的[{}, {}, {}]形式儲存，但仍是有序的二維數據。可將資料unlist()攤開，然後去除不必要的NA後，按欄位數目重建Matrix再轉回data.frame 解決策略：用as.data.frame()或unlist()硬轉成data.frame或vector來看資料的出現是否有所規律。 17.7 "],["html-parser.html", "Chapter 18 HTML Parser 18.1 HTML 18.2 Detecting Element Path", " Chapter 18 HTML Parser 本章已經介紹了如何讀取XLSX、CSV、JSON檔等常見的開放資料，也可以讀取來自各種網站的資料，例如104、信義房屋、Dcard、facebook、Google Map API、Flickr API、Twitter Rest API等等。但是有些網站不是以資料檔案的方式提供資料，而是直接由伺服器端傳回整個網頁，例如PTT網頁版、不動產實價登錄網站、政府標案決標資訊等等。對於這些網頁，我們需要使用HTML剖析器來解析網頁並獲取其中的資料。 大多數網頁都是由多個<div>、<table>或<li>等標籤層層巢套組成，包括導覽元件、廣告、標題、分類等等各種資訊，而我們需要的資料僅佔其中的一小部分，因此必須要撰寫HTML剖析器，找到目標的HTML標籤，將其獲取回來。 這些網站的HTML標籤通常會巢套很多層，甚至會動態更改巢套的階層以防止被爬取。但是如果仔細觀察，就會發現其中有一些規律性，例如新聞搜尋結果通常包括標題、簡要內文、時間和圖片等元素。瀏覽器發出搜尋請求後，伺服器會傳回一個HTML檔案，並且會傳回一些CSS或JavaScript來指示瀏覽器如何視覺化這個HTML檔案。因此，這個HTML和CSS是在傳回你的瀏覽器後視覺化成網頁的模樣，如果看起來有規律性，那就意味著有一套規律性是設計來讓程式知道如何視覺化這些標題或內容，以便使它們看起來具有一定的規則性。這套規則主要由HTML標籤和屬性組成，使我們可以使用CSS選取相同規則的元件，將之視覺化為相同的樣子。 因此，在進行網頁爬蟲時，我們需要了解HTML和CSS，並學習如何使用CSS Selector和XPath這兩種方法選取HTML元素。CSS Selector和XPath是兩種定義路徑的方法，它們可以通過選擇器（selector）定位HTML元素，以便選取一個或多個條件相同的元素。 CSS Selector是CSS中的一個語法，可以根據HTML元素的標籤名稱、屬性、類別、ID等條件選取對應的元素。舉例來說，可以使用以下CSS Selector選取所有標籤名稱為div的元素：div，或選取所有class屬性為test的元素： .test。 XPath則是XML Path Language的縮寫，是一種用於選擇XML文件中元素的語言，同樣可以用於HTML文件的選擇。XPath使用路徑表達式來定位元素，可以根據標籤名稱、屬性、位置等多種條件進行選擇。例如，以下XPath可以選擇所有標籤名稱為div的元素：//div，或選取所有class屬性為test的元素：//*[@class='test']。 掌握CSS Selector和XPath的使用，可以讓我們更加靈活地獲取網頁上的元素，並且能夠解析複雜的HTML結構，提取出需要的資料。 18.1 HTML HTML檔案的結構大致如下： 首先會有一個檔案類別的宣告<!DOCTYPE html>，用以告訴第三方瀏覽器或應用程式說這是一個HTML5檔案； 再來是成對標籤所組成的巢套結構，下例即有一對<html></html>包著一對<head></head>和一對<body></body>。 另外<!---->包著的內容為註解，瀏覽器或程式遇到該區段的內容會略過不處理。 下圖可用以說明HTML檔案的巢套（一層包一層）結構（圖片來源https://www.w3schools.com/html/html_intro.asp）。 18.2 Detecting Element Path Chrome DevTools的使用如下： 打開Chrome瀏覽器，進入要爬取的網站。 按下F12鍵或「右鍵」點擊網頁上的任意你感興趣的內容並選擇「檢查（Inspector）」來開啟DevTools。 在DevTools中，選擇「Elements」分頁。Elements分頁用於查看和修改網頁的HTML和CSS，以及網頁中的DOM元素。在Elements分頁中可以看到網頁中所有的HTML標籤和屬性，以及網頁中的DOM樹狀結構。程式寫作者可使用此功能來檢查和修改網頁元素，例如更改元素的文本、樣式或屬性，或者添加、刪除或重新排列元素。Elements分頁還提供了選擇元素和檢查元素屬性的工具，便於快速找到和解決網頁問題。此外，Elements分頁還具有許多有用的功能，例如網頁渲染性能分析、Box-Model、色彩選擇器等，可幫助使用者更好地理解和設計網頁。 在「Elements」分頁中找到你要查找的元素，例如一個按鈕或一個超連結。你可以輕點一下Elements中的任意元素，然後按「Ctrl/Cmd+F」就可以搜尋在Elements分頁中的內容。例如你感興趣的是網頁上的「下一頁」三個字，那你搜尋「下一頁」就可以找到相對應的元素。或者，你可以在「Elements」分頁開啟的狀況下，用右鍵輕點左側原始網頁中你感興趣的內容或元素，然後再次選擇「檢查（Inspector）」，此時「Elements」分頁就會自動跳到你感興趣的內容或元素。 在DevTools的選擇元素面板中，右鍵點擊選擇的元素，然後選擇「Copy」>「Copy XPath」或「Copy」>「Copy selector」。 將複製的XPath或CSS Selector粘貼到您的爬蟲程式中，以查找和提取相應的數據。 18.2.1 XPath XPath是一種用於定位和選擇XML文檔中元素的語言，也可以應用於HTML文檔。XPath使用路徑表達式來選擇文檔中的節點或節點集，這些路徑表達式可以是絕對的或相對的，可以根據元素名、屬性、節點位置等進行篩選。XPath提供了一種簡單而強大的方式來編寫網頁爬蟲，使得開發者能夠精確地定位需要提取的數據，進而進行數據清洗和分析。 以下是一個XPath的例子：考慮一個HTML文檔，其中有一個表格，表格中包含多個行和列，每一個單元格包含一些數據。如果我們想要提取表格中第一行第一列的數據，可使用//table/tr[1]/td[1]。這個XPath表達式由以下幾個部分組成： //table: 選擇文檔中的所有表格元素。 /tr[1]: 選擇表格中的第一行。 /td[1]: 選擇第一行中的第一列。 18.2.2 CSS Selector CSS Selector是一種用於定位和選擇HTML元素的語言，它可以根據元素的屬性、標籤名稱、類名稱等進行篩選和定位。CSS Selector同樣也是網頁爬蟲中經常使用的一種定位方式。和XPath相比，CSS Selector的寫法更加簡潔和直觀，因此在一些簡單的定位場景中，使用CSS Selector可以更加方便和快捷。但是，在一些複雜的定位場景中，XPath可能更加適合，因為它可以根據節點的位置等進行更加精確的篩選。 用CSS Selector如前面XPath的例子來選擇表格中第一行第一列：table tr:first-child td:first-child。這個CSS Selector由以下幾個部分組成： table: 選擇文檔中的所有表格元素。 tr:first-child: 選擇表格中的第一行。 td:first-child: 選擇第一行中的第一列。 "],["ptt-scrape.html", "Chapter 19 Scraping PTT 19.1 Step 1. 載入所需套件 19.2 Step 2. 取回並剖析HTML檔案 19.3 Step 3. 用for迴圈打撈多頁的連結 19.4 Step 4. 根據連結取回所有貼文 19.5 補充(1) 較好的寫法 19.6 補充(2) 最佳的寫法", " Chapter 19 Scraping PTT 在爬取HTML之前，你要先知道的是，資料如何被放在巢套元素的HTML檔案中，而Attribute（尤其是id和class和<a>的href）又如何提供線索給CSS Selector或XPath來選取我們所要的元素，最後要知道XPath和CSS Selector的用途是用來選取你所需要的HTML中的資料。 以下以ptt boy-girl版為例，展示如何以爬蟲擷取網頁上的資料，並整理成DataFrame。PTT的網頁分為兩種主要類型， 其一稱為鏈結頁或索引頁，為文章的超鏈結，例如https://www.ptt.cc/bbs/Boy-Girl/index.html。 其二為每一篇文章的內容頁https://www.ptt.cc/bbs/Boy-Girl/M.1523994970.A.71C.html。 對於這種網頁，要設計兩階段的爬蟲，第一階段是把所有所需鏈結撈回來，第二階段是根據撈回來的鏈結去打撈文章，並把裡面的內文整理出來。對於第一階段而言，概念大概如下面的示意圖，其實爬取HTML的概念都差不多是這樣，但以下示意圖說明了用XPath或CSS Selector「分別」選取出整個頁面中的標題、超鏈結、時間、和作者，然後用data.frame()組合成一個DataFrame；Page 2也如此炮製，然後把Page 2的DataFrame用bind_rows()附加在Page 1的DataFrame後面。 19.1 Step 1. 載入所需套件 在這個例子中，不僅要用httr來取得網頁頁面，還要用rvest套件（其實是呼叫xml2）來剖析網頁。網頁內容並不像json一樣可以直接轉為DataFrame或list。網頁內容可以是資料、視覺化元素、也可以是架構元素，相對於json而言複雜也冗贅許多。因此需要一個套件能夠剖析HTML標籤例如xml2，而rvest內則應用了xml2套件的內容來剖析網頁，另外，我會用bind_rows()將過程中所抓取的資料進行合併。 library(tidyverse) library(rvest) library(httr) 19.2 Step 2. 取回並剖析HTML檔案 在從HTML檔案中打撈出我們所要的資料有三個重要的rvest函式（步驟），分別為： read_html()依照網址將網頁取回並轉為xml_document。 html_nodes() 用CSS Selector或XPath選擇所需的資料節點，另外html_node()是只取滿足條件的第一個節點。 html_text()或html_attr()或html_table()、html_tags()取出所要抓的節點的目標資料，可能是一個表格、一個標籤內容、或者是一個屬性值。 19.2.1 Step 2-1. read_html() 將網頁取回並轉為xml_document read_html()內部包含了GET()與content()等的實作，其主要的功能是將取回來的回應（response）轉為xml_document。若以class(doc)觀察其型態，會是xml_document xml_node。 使用browseURL(url)可以用瀏覽器打開該網址並瀏覽。 url <- "https://www.ptt.cc/bbs/Boy-Girl/index.html" doc <- read_html(url) class(doc) ## [1] "xml_document" "xml_node" browseURL(url) 19.2.2 Step 2-2 以html_nodes() 以選擇所需的資料節點 html的檔案還包含了相當多其他視覺、互動、排版的標籤，因此通常只有少部分是資料，且存在層層的html元素中。因此，獲取到該網頁並轉為xml_document後，便要用html_nodes()或html_node()根據所給的CSS Selector或XPath來選擇所要取出的節點中的資料。要獲取該元素的CSS Selector可以利用Chrome DevTool或者是Firefox。用法是對著該網頁空白處按右鍵選擇檢查（insepect）。 以下用CSS Selector抽取： #指的是id、.指的是class。 #main-container意思是，某個id為main-container的元素。 .title指的是某個class為title的元素。 div.title指的是class為title的div（排版元素）。 Div.r-list-container.action-bar-margin.bbs-screen指的是同時具有r-list-container、action-bar-margin、bbs-scree三個class的div元素。 css <- "#main-container > div.r-list-container.action-bar-margin.bbs-screen > div > div.title > a" node.a <- html_nodes(doc, css) class(node.a) # "xml_nodeset" length(node.a) 用XPath抽取： path <- '//*[@id="main-container"]/div[2]//div/div[3]/a' node.a <- html_nodes(doc, xpath = path) links <- html_attr(node.a, "href") 19.2.3 Step 2-2 補充說明與XPath、CSS Selector的最佳化 用CSS Selector和XPath抽取有一些經驗法則，以PTT為案例來說的話，原本複製得來的CSS Selector和XPath分別為 CSS Selector：#main-container > div.r-list-container.action-bar-margin.bbs-screen > div:nth-child(3) > div.title > a XPath：//*[@id=\"main-container\"]/div[2]/div[3]/div[2]/a PTT貼文目錄頁面的HTML結構。 到html之間，有一個id為#main-container的div。所以從div#main-container開始取即可。通常確定有id後，我就會開始找重複項，這邊的重複項是class為r-ent的div，找到重複項後，我就會去找重複項後面到我要的資料的路徑，而我們要的<a>就在class為title的div中。所以一個簡化的路徑是div#main-container div.r-ent div.title a。 但在這邊，既然有id，就不在乎是什麼元素會有id，所以可以只寫#main-container，而也只有資料在的div才有.r-ent的class，所以也不用強調前面的div，至於.title前面一定是搭div的元素，所以我可以簡化到寫為#main-container .r-ent .title a。甚至，由於.r-ent一定在#main-container裡面，所以連前面的id我都可以省略掉。 如果用XPath來寫的話，照上面的邏輯應該要寫成//*[@id=\"main-container\"]//div[@class=\"r-ent\"]/div[@class=\"title\"]/a。注意到第二個div前有兩個斜線//，原因是#main-container和.r-ent之間還有一層div，兩個斜線代表前後兩者間還有其他層，如果沒有兩個斜線而只有一個斜線的話，那就是代表#main-container下面一層馬上就要是.r-ent，若你把它改成單斜線的話，就會發現取不到資料。 以政府招標為範例來解釋 最終要抓的資料節點為何？主要為<a href=\"...\">的href屬性值和<a>底下<div>中的內容。 觀察資料在哪個節點「逐筆」出現?這邊是<tr>（table row），<td>則是資料欄位 利用id和class來辨識：遇到有id就從id開始取就好，例如#searchResult。 中間的節點多可以忽略：例如這個CSS selector可省略寫為#searchResult tr a 政府招標網站的HTML結構 19.2.4 Step 2-3 html_text()或html_attr()轉出所要的資料 我們所要的資料為<a href=\"/bbs/Boy-Girl/M.1523983903.A.71E.html\">[心情] 看到自己喜歡女生跟別的男生走很近好難過</a>中的超鏈結和標題文字。 html_text(): 在<a>與</a>之間的[心情] 看到自己喜歡女生跟別的男生走很近好難過稱為<a>的元素內容，要用html_text(node.a)來抽取。 html_attr(): 在<a>內的href=\"/bbs/Boy-Girl/M.1523983903.A.71E.html\"稱為<a>的屬性，該屬性名稱為href(Hyper Reference的意思)，屬性值為/bbs/Boy-Girl/M.1523983903.A.71E.html。要用html_attr(node.a, \"href\")來抽取（相當於指定某個元素的href屬性的內容）。 取出元素節點的內容，相當於取出<a></a>間所夾的內容。 texts <- html_text(node.a) length(texts) 取出元素節點某個屬性的值，這邊是取出href這個屬性的值，也就是超鏈結。 links <- html_attr(node.a, "href") class(links) # character links[1] # "/bbs/Boy-Girl/M.1555188846.A.D5F.html" 但這些超鏈結只有後半段，點開一篇文章觀察其網址，發現我們所抓到的網址少了前面那一段，因此用paste0()黏上前綴的網址前段，便可得到完整網址，可用browseURL(links[1])觀察。 pre <- "https://www.ptt.cc" links <- paste0(pre, links) links[1] # [1] "https://www.ptt.cc/bbs/Boy-Girl/M.1555188846.A.D5F.html" 重組上列程式碼如下： pre <- "https://www.ptt.cc" url <- "https://www.ptt.cc/bbs/Boy-Girl/index.html" doc <- read_html(url) css <- "#main-container div.r-ent div.title a" node.a <- html_nodes(doc, css) 題外話，因為rvest與httr均支援tidyverse的程式寫作，因此可改為以下pipeline的形式。但我不見得會這麼寫，比如說<a>這個元素我可能不僅會取出其超鏈結，還打算取出標題文字，為了避免重複操作，我不見得會用tidyverse來寫。 pre <- "https://www.ptt.cc" url <- "https://www.ptt.cc/bbs/Boy-Girl/index.html" links <- url %>% read_html %>% html_nodes("#main-container div.r-ent div.title a") %>% html_attr("href") %>% paste0(pre, .) 19.3 Step 3. 用for迴圈打撈多頁的連結 我們可以觀察到PTT該版的鏈結頁的網址規則如下 最新頁：https://www.ptt.cc/bbs/Boy-Girl/index.html 倒數第二頁：https://www.ptt.cc/bbs/Boy-Girl/index3902.html 倒數第三頁：https://www.ptt.cc/bbs/Boy-Girl/index3901.html 倒數第四頁：https://www.ptt.cc/bbs/Boy-Girl/index3900.html 最新一頁因此可類推出為https://www.ptt.cc/bbs/Boy-Girl/index3903.html 因此，我打算寫一個for迴圈，讓他幫我（先）抓最後10頁，那就是3894到3903頁。並且，把頁數當成網址的參數，用sprintf()或paste0()組合出網址，以下分別提供兩種版本。你可以把它印出來且點選看看是否是你所要的網頁。 for(p in 3894:3903){ url <- sprintf("https://www.ptt.cc/bbs/Boy-Girl/index%s.html", p) # url <- paste0("https://www.ptt.cc/bbs/Boy-Girl/index", p, ".html") } 接下來，我要用一個all_links變數來存放所有的網址，並且把每一個頁面抓到的網址們都用vector的concatenation，也就是c()黏在一起 all_links <- c(all_links, links)。 all_links <- c() for(p in 3894:3903){ url <- sprintf("https://www.ptt.cc/bbs/Boy-Girl/index%s.html", p) all_links <- c(all_links, links) } 最後，我就將上述抓到網址的方法填入這個for迴圈中，並把抓到的網址存為links，就會隨著每回合的for迴圈逐漸把抓到的網址整理在一起。 pre <- "https://www.ptt.cc" all_links <- c() for(p in 3894:3903){ url <- sprintf("https://www.ptt.cc/bbs/Boy-Girl/index%s.html", p) print(url) doc <- read_html(url) # Get and parse the url css <- "#main-container div.r-ent div.title a" node.a <- html_nodes(doc, css) links <- html_attr(node.a, "href") links <- paste0(pre, links) # Recover links all_links <- c(all_links, links) } length(all_links) 19.4 Step 4. 根據連結取回所有貼文 前面是針對每一個頁面的網址取回該頁面中所有的貼文鏈結，所以我現在all_links中是所有的貼文鏈結。我可以仿照前面的做法，就每一個貼文鏈結，取回貼文內容，貼文內容可能包含作者、時間、標題、版別、內文等資料欄位 不失一般性地，用第一篇貼文的鏈結來做資料抓取實驗，之後再抓第二篇、第三篇即可。 首先，對於這每篇文章，我要爬取作者（author）、標題（title）、時間（time）、看板（board）和內容（content）五個欄位，包含原本文章的連結url一共六個欄位。 從以下的圖發現，每篇文章的內容放置在div#main-content中，之後一連跟著四個div.article-metaline，裡面分別有作者、看板、標題與時間，但從class名稱看不出來哪個，但我們要的值會是在span.article-meta-value中。所以我的規劃是，一次把所有的.article-meta-value給抓回來，然後再去分別指定哪個是作者、看板、標題或時間。所以我用 link <- all_links[1] doc <- read_html(link) meta.css <- "#main-content div.article-metaline span.article-meta-value" metadata <- html_text(html_nodes(doc, meta.css)) PTT貼文的HTML結構 另外，從上面的文字中可發現，主文的部分被包含在div#main-content中，但在上述的作者、標題等後面，若這時候我們用CSS Selector搭配html_node()和html_text()把div#main-content的內容都給取出來，會連上述的作者、標題等都一起取出來。最好的方法是用XPath的text()來只取出文字的部分，而不取出有tag的部分。 而且這樣取出來會是每個paragraph都是一個character vector中的值，所以要把他們合併成一篇文章，此時要用paste()指令，paste()指令可以指定把一個character vector給串接成一個string，輸入的變數是一個character vector，然後設定參數collapse = ““，代表串接起這些character時中間不要有空白。 post.xpath <- '//*[@id="main-content"]/text()' post.paragraph <- html_text(html_nodes(doc, xpath = post.xpath)) post <- paste(post.paragraph, collapse = "") 最後，我們知道metadata變數的第一個是作者、第二個是標題、第三個是時間、便依序指派給個別的變數後，組成DataFrame如下，這樣所組成的DataFrame是為只有一筆資料的DataFrame，但有五個變項。 link <- all_links[1] doc <- read_html(link) meta.css <- "#main-content div.article-metaline span.article-meta-value" metadata <- html_text(html_nodes(doc, meta.css)) post.xpath <- '//*[@id="main-content"]/text()' post.paragraph <- html_text(html_nodes(doc, xpath = post.xpath)) post <- paste(post.paragraph, collapse = "") post.df <- data.frame(post, uid = metadata[1], title = metadata[2], timestamp = metadata[3], url = link ) 這樣我們取得的第一篇文章存放在post.df中，之後，我稍微修改一下上述的程式，就可以用for迴圈抓取第2至n篇文章，每一篇都存在名為temp.df的DataFrame中，然後用bind_rows()依序和post.df銜接在一起，除了黃色的部分是新增的之外，都跟前面的程式幾乎一模一樣。 for(link in all_links[2:10]){ doc <- read_html(link) meta.css <- "#main-content .article-metaline .article-meta-value" metadata <- html_text(html_nodes(doc, meta.css)) post.xpath <- '//*[@id="main-content"]/text()' post.paragraph <- html_text(html_nodes(doc, xpath = post.xpath)) post <- paste(post.paragraph, collapse = "") temp.df <- data.frame(post, uid = metadata[1], title = metadata[2], timestamp = metadata[3], url = link ) post.df <- bind_rows(post.df, temp.df) } 打撈回來的HTTP資料 19.5 補充(1) 較好的寫法 一個比較好的寫法是，不用先讀第一篇文章，而是用data.frame()初始化一個空的DataFrame，之後可以利用bind_rows()可自動增添缺少的變數的特性，自然就會補上所需要的變數。因此，只要改寫黃色的部分。 但這樣的寫法仍會有一個缺點，也就是當文章數越來越多時會越跑越慢。原因是，假設現在你已經抓了9999篇文章，你這次的for迴圈要抓第10000篇，然後用bind_rows()合併第10000篇，此時，post.df已經有9999篇非常肥大，等號右邊的bind_rows()跑完後會變成10000篇，此時又要把原本很肥大的post.df覆蓋掉，所以會非常費時。 post.df <- data.frame() for(link in all_links[1:10]){ doc <- read_html(link) meta.css <- "#main-content .article-metaline .article-meta-value" metadata <- html_text(html_nodes(doc, meta.css)) post.xpath <- '//*[@id="main-content"]/text()' post.paragraph <- html_text(html_nodes(doc, xpath = post.xpath)) post <- paste(post.paragraph, collapse = "") temp.df <- data.frame(post, uid = metadata[1], title = metadata[2], timestamp = metadata[3], url = link ) post.df <- bind_rows(post.df, temp.df) } 19.6 補充(2) 最佳的寫法 採用list先將每一個DataFrame存放起來，然後跑完所有的for迴圈後才用bind_rows()將所有資料合併為DataFrame。此時，p指的是第幾個連結，而前例的link就相當於下方的all_link[p]。 post.list <- list() for(p in 1:length(all_links)){ doc <- read_html(all_links[p]) meta.css <- "#main-content .article-metaline .article-meta-value" metadata <- html_text(html_nodes(doc, meta.css)) post.xpath <- '//*[@id="main-content"]/text()' post.paragraph <- html_text(html_nodes(doc, xpath = post.xpath)) post <- paste(post.paragraph, collapse = "") post.list[[p]] <- data.frame(post, uid = metadata[1], title = metadata[2], timestamp = metadata[3], url = all_links[p] ) } post.df <- bind_rows(post.list) "],["lebron.html", "Chapter 20 NYT: LeBron James Achievement 20.1 Get top250 players 20.2 Scraping live scores 20.3 Cleaning data 20.4 Visualization 20.5 Scraping and cleaning 20.6 (More) Scraping all players", " Chapter 20 NYT: LeBron James Achievement 這個案例的靈感來自於紐約時報於2023年2月7日所發布的一篇新聞「How LeBron James Outscored Kareem Abdul-Jabbar and All the N.B.A. Greats」。該篇新聞的破題點在於LeBron James 打破 Kareem Abdul-Jabbar 的紀錄，成為 NBA 歷史上得分王，這是許多人認為無法達成的成就。今年 38 歲的 James，本季平均每場比賽可以攻下 30.2 分，以 38,390 分超越了 Abdul-Jabbar 的 38,387 分。Abdul-Jabbar 以 sky hook 聞名，而 James 則透過多種得分方式積累分數，包括近年來在聯盟中日益盛行的三分球。James 的長壽、創意、天賦和能力讓他達成了這個成就。但實際上，這篇新聞同時也凸顯了 NBA 在過去50年的演變。 這篇新聞中運用了NBA球員與球賽資料庫中250名頂尖球員的資料來繪製視覺圖表，頂尖球員援引該網站的定義，為歷年的每場平均得分（PTS）。其用了折線圖、長條圖、散佈圖等多種視覺呈現方法，並採用了多項指標來凸顯LeBron James的成就，包含年齡、累積得分數、場均得分數、三分球與二分球的比例等。 除了資料視覺化外，這個案例也是相當好的爬蟲練習，可用R語言的rvest套件來爬取https://www.basketball-reference.com/網站的球員資料，包含每個球季的比分，甚至著名球員每場的得分和進球數等等。該網站的網頁多為具有id的HTML表格，相對來說爬取難度較低，但如果要仿照該篇新聞來製作視覺圖表，需要爬取多個頁面的資料，反而是訓練學生從篩檢資料到產生新聞的一個好範例。 20.1 Get top250 players 事實上我是知道有NBA球員比分網站的，看到這則新聞時我就去線上查找了相關的網站https://www.basketball-reference.com。而且該網站的球員資料是表格形式，代表我們可以用一些比較方便的函式（html_table()）直接將該表格的內容轉為data.frame。 但目前（2023/04/01）的球員數共有五千多人，我們不可能將所有的球員通通繪製在圖上，反而會影響我們看到重要的訊息，因此要有效且有意義地減少要視覺化的資料量。這有幾種策略，一種是根據目的取出想要比較的球員、一種是直接設一個閥值（例如職涯超過15年的約90人），一種是看看該資料網站上有沒有列出一些頂尖球員名單。（猜想）紐約時報用的是該網站上的Top 250，因此第一個步驟要做的就是先把要分析的這250名球員的名冊爬取下來，之後再逐一爬取每個球員的資料紀錄。 這段程式碼的目的是從網站 “https://www.basketball-reference.com%22 中提取出排名前幾位的籃球員生涯表現數據，以及每個球員的個人資料頁面連結。Top 250球員的頁面網址為https://www.basketball-reference.com/leaders/per_career.html。 現在，我們可以使用rvest套件中的read_html()函數讀取網頁的 HTML 內容，該。接著傳遞給下一個函數html_node()，並指定要選取的 HTML 元素 ID 為nba。這個 ID 代表了包含球員表現數據的表格。最後，使用html_table() 函數提取表格資料並將結果存入top_players變數中。 read_html(url) 函數是 rvest 套件中的一個函數，它可讀取指定網址的 HTML 內容，以轉換為R的物件。 html_node() 函數則可用於選擇 HTML 內容中的指定元素。指定元素的方法是使用XPath或CSS Selector，本範例採用的是CSS Selector。若所要選取的同類型元素大於一個，那就要使用html_nodes()，所取得的結果會存入一個由1開始編號的List。 如果前一個步驟所指定的元素恰巧是一個表格的話，那我們就可以使用html_table()直接將表格轉換為一個R的data.frame，但如果不是表格的話，就必須要搭配使用html_text()或html_attr()來取出指定元素中的所需內容。 做完html_table()後的dataframe存於top_players，該dataframe共有三個變項：Rk（Rank）、PER（每場平均得分）、Player（球員名）。但該dataframe中缺少球員資料頁面的連結，所以需要另外再爬取一次球員名中的連結。取得的方式還是那三個步驟 read_html()：取得該url的網頁內容並轉為R的物件。 html_node()/html_nodes()：選取所需的HTML元素。此時我們要娶的是#nba這個表格中每一列<tr>的第二欄<td>中的超鏈結<a>。 html_text()/html_attr()/html_table()：抽取所選取的HTML元素內容。此時要抽取的是<a>中的超鏈結，也就是<a>的href屬性（Attribute），所以要用html_attr(\"href\")。 抽取出來的連結往往是相對於主要連結的後半段，因此，最後要將所取得的連結黏接在主頁連結的後方，如str_c(url.base, .)。 url.base <- "https://www.basketball-reference.com" url <- "https://www.basketball-reference.com/leaders/per_career.html" top_players <- read_html(url) %>% html_node("#nba") %>% html_table() top_players$plink <- read_html(url) %>% html_node("#nba") %>% html_nodes("tr td:nth-child(2) a") %>% html_attr("href") %>% str_c(url.base, .) top_players 20.2 Scraping live scores https://www.basketball-reference.com/players/c/chambto01.html 20.2.1 Testing: Scrape one url <- "https://www.basketball-reference.com/players/c/chambto01.html" table2 <- read_html(url) %>% html_node("#per_game") %>% html_table(convert=T) 20.2.2 Scrape life time scores of all top-250 players # pinks <- long_players$plink plinks <- top_players$plink totals <- tibble() for(i in 1:length(plinks)){ plink <- plinks[i] message(sprintf("[%s] ", i), plink) table <- read_html(plink) %>% html_node("#totals") %>% html_table() table$plink <- plink totals <- bind_rows(totals, table) Sys.sleep(sample(1:2, 1)) } 20.3 Cleaning data top250 <- totals %>% filter(str_detect(Season, "\\\\d{4}-\\\\d{2}")) %>% left_join(top_players, by="plink") %>% select(-(34:53)) %>% select(-31) %>% mutate(year = year(paste0(str_sub(Season, 1, 4), "-01-01"))) %>% mutate(PERyear = PTS/G) %>% group_by(plink) %>% arrange(Age) %>% mutate(cumPTS = cumsum(PTS)) %>% ungroup() 20.4 Visualization Load pre-save data load("data/nba_players.rda") 20.4.1 Line: Age x cumPTS library(gghighlight) selected_players <- c("Michael Jordan*", "LeBron James", "Kobe Bryant*", "Wilt Chamberlain*", "Kareem Abdul-Jabbar*", "Stephen Curry") top250 %>% ggplot() + aes(Age, cumPTS, group=Player) + geom_line() + gghighlight(Player %in% selected_players) + theme_bw() + theme(legend.position = "none") 20.4.2 Line: year x cumPTS top250 %>% ggplot() + aes(year, cumPTS, group=Player) + geom_line() + gghighlight(Player %in% selected_players) + theme_bw() + theme(legend.position = "none") 20.4.3 Line: Age x PER_by_year top250 %>% ggplot() + aes(Age, PERyear, group=Player) + geom_line() + gghighlight(Player %in% selected_players) + theme_bw() + theme(legend.position = "none") 20.4.4 Comparing LeBron James and Jabbar 20.5 Scraping and cleaning # plink <- "https://www.basketball-reference.com/players/j/jamesle01.html" plink <- "https://www.basketball-reference.com/players/a/abdulka01.html" loglinks <- read_html(plink) %>% html_node("#totals") %>% html_nodes("tr th a") %>% html_attr("href") %>% paste0(url.base, .) logtable <- tibble() for(link in loglinks){ table <- read_html(link) %>% html_node("#pgl_basic") %>% html_table() logtable <- bind_rows(logtable, table) message(nrow(logtable), link) } jabbar.log <- logtable %>% select(Rk, G, Date, FG, `3P`, FT, PTS) %>% mutate(Rk = as.numeric(Rk), FG = as.numeric(FG), `3P` = as.numeric(`3P`), FT = as.numeric(FT), PTS = as.numeric(PTS)) %>% filter(!is.na(PTS)) %>% replace(is.na(.), 0) %>% mutate(try = FG + `3P` + FT) %>% mutate(FGperc = FG/try, P3perc = `3P`/try, FTperc = FT/try) %>% mutate(gid = row_number()) 20.5.1 VIS LJames and jabbar james.log %>% pivot_longer(names_to = "type", cols = c("FGperc", "P3perc", "FTperc"), values_to = "perc") %>% ggplot() + aes(gid, perc, fill = type) + geom_area() + theme_bw() jabbar.log %>% pivot_longer(names_to = "type", cols = c("FGperc", "P3perc", "FTperc"), values_to = "perc") %>% ggplot() + aes(gid, perc, fill = type) + geom_area() + theme_bw() top250 %>% group_by(Player) %>% summarize(FGsum = sum(FG), FTsum = sum(FT), P3sum = sum(`3P`)) %>% ungroup() %>% replace(is.na(.), 0) %>% mutate(trials = FGsum + FTsum + P3sum) %>% mutate(FGperc = FGsum/trials, FTperc = FTsum/trials, P3perc = P3sum/trials) %>% ggplot() + aes(FGperc, P3perc) + geom_point() + geom_text(aes(label = Player), hjust = -0.1) + gghighlight(Player %in% selected_players) + theme_bw() + theme(aspect.ratio = 2/3) save(jabbar.log, james.log, top_players, top250, totals, file="../data/nba_players.rda") 20.6 (More) Scraping all players 20.6.1 Testing url <- "https://www.basketball-reference.com/players/x/" table.path <- read_html(url) %>% html_node("#players") table <- table.path %>% html_table() table$pid <- table.path %>% html_nodes("tbody th") %>% html_attr("data-append-csv") table$plink <- table.path %>% html_nodes("tbody th a") %>% html_attr("href") %>% str_c("https://www.basketball-reference.com",.) 20.6.2 Scrape from a-z except x(no x) # letters[c(1:23, 25:26)] players <- tibble() for(letter in letters[c(1:23, 25:26)]){ url <- str_c("https://www.basketball-reference.com/players/", letter, "/") print(url) table.path <- read_html(url) %>% html_node("#players") table <- table.path %>% html_table() table$pid <- table.path %>% html_nodes("tbody th") %>% html_attr("data-append-csv") table$plink <- table.path %>% html_nodes("tbody th a") %>% html_attr("href") %>% str_c("https://www.basketball-reference.com",.) players <- bind_rows(players, table) } "],["visualization-1.html", "Chapter 21 Visualization 21.1 ggplot2 21.2 VIS packages 21.3 Case Gallery", " Chapter 21 Visualization 21.1 ggplot2 ggplot2和Python的matplotlib都是常用的視覺化套件，但在設計上有一些主要的差異。首先，ggplot2是基於grammar of graphics的設計原則，而matplotlib則是基於pyplot-style的設計風格。這意味著ggplot2更加著重於資料和視覺化之間的關係，並且提供了一個統一的語法來描述這些關係，而matplotlib則更加注重對於底層圖形物件的控制。其次，ggplot2支持更多的圖形屬性，例如數值變數、類別變數、時間序列等等，並且可以輕鬆地進行層疊圖、面積圖等高級視覺化技巧，而matplotlib則需要手動設置較多的屬性來達到類似的效果。此外，ggplot2在設計上更加注重美學和可讀性，因此預設的圖形風格更加美觀且易於閱讀，而matplotlib的預設風格則比較簡單，需要進行額外的設置才能達到類似的效果。 21.2 VIS packages 除了ggplot2本身之外，尚有相當多基於ggplot或tidyverse風格的視覺化套件，如： ggraph：ggraph是一個基於ggplot2的視覺化套件，專門用於網絡和關係圖的繪製，提供了多種佈局和美學風格的選擇。 ggmap：ggmap是一個基於ggplot2的地圖繪製套件，可以將Google Maps、OpenStreetMap等地圖數據與ggplot2圖形整合起來，方便進行地理位置相關的資料視覺化。 ggridge：ggridge是一個基於ggplot2的視覺化套件，專門用於繪製ridge plots，也就是密度圖的一種變形。它可以幫助使用者更好地展示數據的分佈和趨勢。Introduction to ggridges (r-project.org) ggthemes：ggthemes是一個基於ggplot2的視覺化套件，提供了多種高質量的主題風格和顏色調色板，可以讓使用者快速改善圖表的外觀和可讀性。 ggnatimate：ggnatimate用於將ggplot所產製的圖表多增加一個變量以轉製為動態圖表，支持多種動畫效果。 ggally：ggally是一個基於ggplot2的視覺化套件，提供了多種高級散點圖和數據矩陣的繪製方式，方便使用者進行多變量分析和資料探索。 ggrepel：ggrepel是一個基於ggplot2的視覺化套件，用於解決文字標籤重疊的問題，可以自動調整文字標籤的位置，使其更加易讀和美觀。 21.3 Case Gallery 21.3.1 WP: Paid Maternity Leave (產假支薪): barplot 原始新聞來源：The world is getting better at paid maternity leave. The U.S. is not. - The Washington Post。該篇報導提及，美國因為目前的政策不保障帶薪產假，許多女性感到必須在工作和照顧家庭之間做出選擇，這種性別不平等破壞了她們在工作機會上的平等機會。同時，世界各地的婦女待遇正在逐漸改善。至少190個國家對嬰兒的母親規定了某種形式的帶薪假期，產假待遇在56個國家有所提高。專家表示，現在美國城市和州正通過不同形式的帶薪家庭假法案，這顯示美國雇主正在展示有競爭力的福利不會影響員工表現。特別是科技公司，如Twitter、Facebook和Google等，處於提供員工帶薪產假福利的前沿，美國可能有望追趕其他國家。 21.3.2 NYT: Population Changes Over More Than 20,000 Years: Coordinate, lineplot 紐時這篇報導「When Did the Anthropocene Start? Scientists Closer to Saying When. - The New York Times (nytimes.com)」討論了人類活動對地球所產生的深遠影響，並探討人類是否已經進入了一個新的地質時期，被稱為「人新世」。報導指出，人類的經濟活動、能源消耗和人口增長是人新世的主要因素，並且這些因素已經在地球上留下了不可磨滅的痕跡。報導也提到，地質學家已經發現了人新世的證據，包括核爆炸中的鈽同位素、肥料中的氮和發電廠的灰燼等。然而，報導也問道，人新世是否真的已經開始，以及它的開始點是否應該是農業革命、工業革命、核彈（77年前）或其他發展。 21.3.3 NYT: LeBron James’ Achievement: Coordinate, lineplot 這個案例的靈感來自於紐約時報於2023年2月7日所發布的一篇新聞「How LeBron James Outscored Kareem Abdul-Jabbar and All the N.B.A. Greats」。該篇新聞的破題點在於LeBron James 打破 Kareem Abdul-Jabbar 的紀錄，成為 NBA 歷史上得分王，這是許多人認為無法達成的成就。今年 38 歲的 James，本季平均每場比賽可以攻下 30.2 分，以 38,390 分超越了 Abdul-Jabbar 的 38,387 分。Abdul-Jabbar 以 sky hook 聞名，而 James 則透過多種得分方式積累分數，包括近年來在聯盟中日益盛行的三分球。James 的長壽、創意、天賦和能力讓他達成了這個成就。但實際上，這篇新聞同時也凸顯了 NBA 在過去50年的演變。 21.3.4 Taiwan Village Population Distribution: Coordinate, lineplot 以下我打算繪製出每個村里在15歲以上的人口數，來呈現台灣有些村里人口相當稀少，尤其是花蓮縣、澎湖縣、南投縣和宜蘭縣的幾個聚落。並標記出幾個人口數最高的里。如果我的目的是呈現村里人口數的統計分佈，我會用geom_density()來繪圖（如下），但實際上沒辦法從這樣的密度函式圖來說故事，指出那些人口數過高或過低的村里。 21.3.5 NYT: Net Worth by Age Group: Coordinate, barplot 這個教學案例來自紐約時報的「What’s going on in this gragh」系列資料視覺化教學之Teach About Inequality With These 28 New York Times Graphs - The New York Times (nytimes.com) 。該圖表呈現在不同年代、不同年齡層的人所擁有的淨資產（包含土地、存款、投資等減去債務）。該圖表的結果指出，在不同年代的老年人是越來越有錢，但年輕人卻越來越窮 21.3.6 NYT: Optimistic of different generation: Association, scatter 這個練習為紐約時報的一則報導「Where Are Young People Most Optimistic? In Poorer Nations. - The New York Times (nytimes.com)」。該報導乃根據一項涵蓋 21 個國家的大型調查，這項調查比較了不同國家和年齡層（年輕人對成年人）對於下一代的生活是否會比現在更好的看法。該調查還比較了不同國家（富裕與貧窮）和年齡層（年輕人對成年人）對於當今兒童在基本方面的狀況，以及對於社會和環境問題的看法。此外，調查還比較了不同國家和年齡層對於現代科技對年輕人生活的影響看法，以及對於焦慮和壓力等方面的看法。 21.3.7 Vaccinating Proportion by countries: Amount, heatmap 這個例子參考(Wilke 2019)在視覺化數量（Amount）時的熱圖範例（Heatmap），但改用為視覺化各國每百人完整注射COVID-19疫苗人數歷時資料。 21.3.8 Taiwan salary distribution: Distribution, boxmap 箱形圖（Box plot）是一種用於展示數據分佈情況的統計圖表。它通常顯示數據的中位數、四分位數、極值和異常值等統計量。箱形圖的中間線表示數據的中位數，箱子的上下邊界則分別表示數據的上四分位數和下四分位數。箱子的高度表示數據的變異程度，而箱子外的線段則表示數據的最大值和最小值。如果數據中存在異常值，則通常使用圓圈或星號等符號來標記。箱形圖可以用來比較不同數據集之間的分佈情況，以及檢查數據是否存在異常值。 Inspired by Six Myths About Choosing a College Major - The New York Times (nytimes.com) and What’s Going On in This Graph? | Jan. 9, 2018 - The New York Times (nytimes.com) 21.3.9 Taiwan income distribution by each town: Distribution, boxmap 本案例用BoxPlot來呈現某個行政區（鄉鎮市區）各村里的所得中位數、平均數、四分位數的分佈。如果在箱型圖中，平均數高於第三分位數，這代表數據集呈現右偏分佈。也就是說，數據中的大部分觀測值都分佈在第一、二分位數之間，但存在一些較大的極端值，使平均值被往右偏移。從這樣的分佈中可以察覺某些里因為有少數極端高收入住戶，而使得平均高於四分位數。 21.3.10 NYT: Carbon by countries: Proportion, Treemap 本案例取自紐時所報導之Who Has The Most Historical Responsibility for Climate Change? - The New York Times (nytimes.com)。該新聞報導了聯合國氣候峰會在格拉斯哥舉行期間的一個重要議題：世界上最富裕的國家，即那些對全球暖化負責任的不成比例的國家，應如何賠償因全球氣溫上升所造成的貧困國家的損失。報導指出，現今全球人口中，包括美國、加拿大、日本以及西歐大部分國家在內的富裕國家僅佔12％，但是在過去的170年中，這些國家卻負責了50％的溫室氣體排放。 21.3.11 Taiwan Annual Expenditure: Proportion, Treemap 本案例將就台灣中央預算的資料，以TreeMap階層化地顯示不同機構層級（大類、一級部會）等的預算佔比。例如衛福部、財政部與勞動部的預算均屬於社會福利支出。 References "],["ggplot.html", "Chapter 22 ggplot 22.1 Essentials of ggplot 22.2 NYT: Inequality 22.3 Adjusting Chart 22.4 Highlighting & Storytelling", " Chapter 22 ggplot 本節著重在介紹ggplot的基本概念與設定。 小訣竅：可在一開始便透過knitr::opts_chunk$set(echo = TRUE, fig.width = 2, fig.asp = 0.4)來一次設定所有圖片。fig.width = 8與fig.height = 6 是以英吋（inches）為單位，或用fig.dim = c(8, 6)一次設定長寬1。echo = TRUE是設定knit出輸出格式（如html）時，也要包含程式碼。如果echo = FALSE的話，就只會輸出文字和圖形。 22.1 Essentials of ggplot 用ggplot來繪製圖形有三個基本函式ggplot() + aes() + geom_圖表類型。 指定要進行繪圖ggplot()：用%>%將資料（dataframe）pipe給ggplot()後，底下各增添的繪圖選項都用+的符號，類似不斷修正繪圖結果的意思。 指定X／Y軸與群組因子aes()：指定圖表的X/Y軸分別是什麼變數，有些圖表只需要單一個變數（例如Density-chart和Histogram），有些需要X/Y兩個變數（例如Scatter-chart）什麼的變數要做視覺化，Boxplot甚至可以直接指定最大、最小、Q1、Q3和Median等多個變數。 指定要繪製的圖表類型。例如Line-chart為geom_line()、Scatter-chart為geom_point()、Bar-chart為geom_col()或geom_bar()。查閱ggplot cheat sheet可以快速翻閱有哪些圖表類型（如截圖）。 ggplot-cheat-sheet 22.1.1 (1) ggplot() 秀出預備要繪製的繪圖區 tibble(a=1:5, b=5:1) %>% ggplot() 22.1.2 (2) aes() 指定X／Y軸與群組因子 aes()會在繪圖區上繪製X與Y軸 tibble(a=1:5, b=5:1) %>% ggplot() + aes(x=a, y=b) 22.1.3 (3) geom_???() 指定要繪製的圖表類型。 例如折線圖為為geom_line()、X/Y散佈圖為geom_point()、長條圖我多會使用geom_col()。ggplot繪圖種類除了可以參照前面的ggplot cheat sheet之外，可以詢問ChatGPT有哪些常見的類別，甚至可以請他舉例給你測試該繪圖方法。 tibble(a=1:5, b=5:1) %>% ggplot() + aes(x=a, y=b) + geom_line() 亦可同時繪製兩種類型的圖表於同一張圖上。例如以下同時繪製了geom_line()與geom_plot()。 tibble(a=1:5, b=5:1) %>% ggplot() + aes(x=a, y=b) + geom_line() + geom_point() 注意：ggplot是以變數為基礎的視覺化套件，也就是說，當準備好dataframe後，就可以在ggplot中指定要用哪些變數來繪圖。也因此，務必把dataframe整理為tidy型態，也就是長表格（long-form）的型態。整理完資料後，我會習慣地用names(plot)或glimpse(plot)來看一下該資料所有的變項，好可以在下一階段的繪圖做參考。 22.2 NYT: Inequality 以下將以紐時的這個Teach About Inequality With These 28 New York Times Graphs 案例來做繪圖教學。該教學引用了Opinion | America Will Struggle After Coronavirus. These Charts Show Why.這篇新聞中的圖表，我們拿來做範例的這張圖，主要是在說財富趨勢對年輕人而言尤其艱難。35歲以下美國人的凈資產中位數 - 他們平均比年長的美國人差得多 - 比2004年35歲以下美國人的凈資產低40%。相比之下，65歲以上美國人的凈資產在同一時期增長了9%。簡而言之，嬰兒潮一代比他們的前輩更富有，而千禧一代和X世代比他們的前輩更窮；或者說，年輕人拿自己和10年前的年輕人相比，現在的年輕人更窮；而現在的老年人拿自己和10年前的老年人比，現在的老年人更富有。 22.2.1 (1) Loading data 仔細觀察一下資料，你會怎樣描述這個資料？ 這個Dataframe包含三個變數（Category, year, Net_Worth），共66個觀測值。變數「Category」描述的是年齡範圍，包含六個類別（Level）。變數「year」代表年份，從1989年到2019年，以三年為一個週期觀察，共有11個Levels。變數「Net_Worth」則表示在該年齡範圍內的淨資產。從資料可以觀察到，在不同的時間點，不同年齡範圍的人群的財富狀況看似有明顯差異。例如，比較1989年和2019年，45-54歲的年齡組在這段期間內的淨值似乎較35-44歲組要高，這可能反映了隨著年齡增長，個人或家庭的財富累積增加的趨勢。 NW <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(Category, year, Net_Worth) %>% group_by(Category) %>% arrange(year) %>% ungroup() ## Rows: 66 Columns: 37 ## ── Column specification ──────────────────────────────────────────────────────── ## Delimiter: "," ## chr (1): Category ## dbl (36): year, Before_Tax_Income, Net_Worth, Assets, Financial_Assets, Tran... ## ## ℹ Use `spec()` to retrieve the full column specification for this data. ## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message. NW %>% head(12) ## # A tibble: 12 × 3 ## Category year Net_Worth ## <chr> <dbl> <dbl> ## 1 Less than 35 1989 16.2 ## 2 35-44 1989 112. ## 3 45-54 1989 195. ## 4 55-64 1989 195. ## 5 65-74 1989 154. ## 6 75 or older 1989 144. ## 7 Less than 35 1992 16.6 ## 8 35-44 1992 79.9 ## 9 45-54 1992 140. ## 10 55-64 1992 203. ## 11 65-74 1992 176. ## 12 75 or older 1992 155. 22.2.1.1 (1.1) group_by()的概念 在提供的程式碼中，group_by(Category)是一個關鍵步驟，它影響了數據處理的方式，尤其是在隨後的操作中。以下是有和沒有group_by(Category)時的主要差異： 有group_by(Category)：當在程式碼中使用group_by(Category)時，這意味著接下來的操作將在每個Category類別的子集上單獨進行。這對於需要按類別分析或操作數據時非常有用。在此程式碼中，arrange(year)將會在每個Category內部對year進行排序。這意味著每個類別內的年份會從最小到最大排序，但這種排序是獨立於其他類別的。 沒有group_by(Category)：如果省略group_by(Category)，則後續的操作將考慮所有的數據作為一個整體來進行。 省略group_by(Category)後，arrange(year)會對整個數據集按year進行全局排序，而不會考慮Category的界限。由於year是一個類別變項，出現在多個Category組中，因此，會有多個相同year的列排在一起。 22.2.2 (2) Visualizing 這是預期視覺化的結果。 22.2.2.1 (2.1) Plot without group 先將year和Net_worth分別繪製在X與Y軸上，並用geom_line()繪製為折線圖。結果圖表中呈現鋸齒狀的折線，看似有問題，但其實是合理的。因為year是一個離散變數，而我們希望每個年齡層一條線的話，那就要照年齡層來分組。也因此，每一年都有有每個年齡層的資料，當我們把「年」作為X軸時，自然同一年就會有數筆不同年齡層的資料，因此才會是鋸齒狀的。 NW %>% ggplot() + aes(x=year, y=Net_Worth) + geom_line() 不同的圖表類型是可以疊加在同一張圖上的。我們也可以把geom_point() 另一種圖表型態加入，也是可以的，兩者的X與Y不相衝突。geom_line()、geom_point()、geom_text()三者會經常伴隨出現。 NW %>% ggplot() + aes(x=year, y=Net_Worth) + geom_line() + geom_point() 22.2.2.2 (2.2) Grouping 上圖是我們把多個年齡層的逐年資料畫在同一條折線上，所以會呈現鋸齒狀折現的狀況。但這些年齡層並非在同一條線上呀？因此，我們要根據Category這個變數來做分組。 NW %>% ggplot() + aes(x=year, y=Net_Worth, group=Category) + geom_line() + geom_point(stat="identity") 如希望不同線條上不一樣的色彩，應指定color=Category。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() 用color、fill或group來做分組？ 在使用geom_line()函數時，顏色的設定是針對線條本身，而非填充面積。當我們希望指定點（透過geom_point()）或線條（使用geom_line()）的顏色時，我們會使用color參數來定義顏色。 相對地，當使用`geom_area()`函數進行視覺化時，由於它涉及的是面積的填充，因此我們應該使用`fill`參數來指定填充色。在某些情況下，我們可能會同時使用`color=Category`和`fill=Category`來對`geom_area()`進行設定，這樣做能夠同時定義邊線顏色和填充顏色。然而，當利用`geom_area()`來展示折線圖時，建議限制使用的顏色種類不超過兩種，以避免顏色層疊導致的視覺混淆，即便是設定了`alpha=0.2`以降低透明度。 `geom_area()`函數默認展示的是累積分佈圖，即不同群組的數值會在Y軸方向上疊加。若目的是比較兩個群組之間的差異，而非觀察整體趨勢，則可以通過添加`position="dodge"`參數來調整分佈方式，並將`alpha`設定為小於1的值以增加圖形的透明度，從而更清晰地分辨不同群組之間的差異。 NW %>% ggplot() + aes(year, Net_Worth, color=Category, fill=Category) + geom_area(position="dodge", alpha=0.2) 22.3 Adjusting Chart 22.3.1 Type of Points and Lines 下面的例子同時用了geom_line()和geom_point()，且分別設定了線寬（size=1）、點的大小(size=2)，折線型態（linetype=\"dashed\"）、半透明程度（alpha）。 ggplot2 line types : How to change line types of a graph in R software? - Easy Guides - Wiki - STHDA NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line(size=1, linetype = "dashed", alpha=0.5) + geom_point(size=2, color="dimgrey", alpha=0.5) ## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0. ## ℹ Please use `linewidth` instead. ## This warning is displayed once every 8 hours. ## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was ## generated. 22.3.2 Line Types See more from ggthemes https://github.com/BTJ01/ggthemes/tree/master/inst/examples library(ggthemes) rescale01 <- function(x) { (x - min(x)) / diff(range(x)) } gather(economics, variable, value, -date) %>% group_by(variable) %>% mutate(value = rescale01(value)) %>% ggplot(aes(x = date, y = value, linetype = variable)) + geom_line() + scale_linetype_stata() + theme_minimal() 22.3.3 Title, Labels and Legends Titles, labels, and legend 設定標題與X／Y軸標題（法一）：以下設定了圖表的圖表標題、和X軸與Y軸的軸標題（xlab與ylab）。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + xlab("Year") + ylab("Net Worth") + ggtitle("Net Worth by year grouped by age groups") 設定標題與X／Y軸標題（法二）：這是一次設定圖表標題（title）、次標題（suttitle）、X軸與Y軸標題的方法。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", subtitle = "Source from: ...", x = "Year", y = "Net Worth") 調整X軸與Y軸標題位置的：必須要透過theme()來設定axis.title.x = element_text(hjust=1)。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", x = "Year", y = "Net Worth") + theme(axis.title.x = element_text(hjust=1), axis.title.y = element_text(hjust=1)) 去除X／Y軸標題（不佳）：直接將空字串Assign給title、x、與y即可。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + labs(title = "", x = "", y = "") 去除X／Y軸標題（較佳）：透過設定theme()來調整。可發現透過這種設定方法，原本標題和X／Y軸標題的邊界空間就會被釋放出來。 # No extra space for xlab, ylab and title NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line(show.legend = F) + theme_minimal() + theme(plot.title = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank()) 22.3.4 Font 調整字型會建議都從theme()來做調整，所有圖面上看得到的字都有相對應的變數可以調整字型。例如以下的例子中，把標題的字型大小調整為14粗體、X與Y軸的字型則調整了向右對齊、10粗斜體、顏色為dimgrey。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", x = "Year", y = "Net Worth") + theme(plot.title = element_text(size=14, face="bold"), axis.title.x = element_text(hjust=1, size=10, color="dimgrey", face="bold.italic"), axis.title.y = element_text(hjust=1, size=10, color="dimgrey", face="bold.italic") ) 22.3.5 Color Themes ggplot也有其圖表主題色調。之前範例的灰色圖表背景就是預設的主題，ggplot中還有好幾個預設圖表主題可以選，例如theme_minimal()或theme_tw()等等。 Modify components of a theme — theme • ggplot2 (tidyverse.org) bbplot/bbc_style.R at master · bbc/bbplot (github.com) NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() 22.3.6 Set-up Default Theme 如果希望所有的圖表都有一致的顏色和排版的調性，可以在一開始編輯Rmd的時候就設計好一套theme()並指給一個變數（例如以下的th）。 th <- theme(plot.title = element_text(size=14, face="bold"), axis.title.x = element_text(hjust=1, size=10, color="dimgrey", face="bold.italic"), axis.title.y = element_text(hjust=1, size=10, color="dimgrey", face="bold.italic") ) NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line(linetype = "dashed", alpha=0.5) + geom_point(size=2, color="dimgrey", alpha=0.5) + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", x = "Year", y = "Net Worth") + th 22.3.7 Show Chinese Text Python和R這些程式語言的預設視覺化套件都沒辦法顯示中文，所以如果要顯示中文的話，就要指定圖表標題、X、Y軸標籤、圖說和各個部件的字型。因為我在Mac上繪圖，所以我將字型指定為Heiti TC Light。如果想知道自己的電腦上有什麼可以用，可以到電腦的字體簿上查找中文字體名稱，或者上網google「ggplot 中文字型選擇」。 county <- read_csv("data/tw_population_opendata110N010.csv") %>% slice(-1, -(370:375)) %>% type_convert() %>% mutate(county = str_sub(site_id, 1, 3)) %>% group_by(county) %>% summarize( area = sum(area), people_total = sum(people_total) ) %>% ungroup() ## Rows: 375 Columns: 5 ## ── Column specification ──────────────────────────────────────────────────────── ## Delimiter: "," ## chr (5): statistic_yyy, site_id, people_total, area, population_density ## ## ℹ Use `spec()` to retrieve the full column specification for this data. ## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message. ## ## ── Column specification ──────────────────────────────────────────────────────── ## cols( ## statistic_yyy = col_double(), ## site_id = col_character(), ## people_total = col_double(), ## area = col_double(), ## population_density = col_double() ## ) 下面這是一個長條圖的範例（barplot，不是histogram）。Barplot可以直接指定X軸為縣市（county）和Y軸為總人口數（people_total），但是要用geom_col()而非geom_bar()。除此之外，Bar的顏色有「面」的特徵，所以若要自訂整條bar的顏色，要用fill而非color，color只會是每條Bar的外框。 county %>% arrange(desc(people_total)) %>% ggplot() + aes(county, people_total) %>% geom_col(fill="lightgrey", color="black") + theme_minimal() + theme(axis.text.x = element_text(family="Heiti TC Light")) 舉例來說，中文字型可以是標楷體（BiauKai）、宋體（Songti TC）、黑體（Heiti TC Light）、蘋方（PingFang TC）、Noto（Noto Sans CJK TC） th <- theme(title = element_text(family="Heiti TC Light"), text = element_text(family="Heiti TC Light"), axis.text.y = element_text(family="PingFang TC"), axis.text.x = element_text(family="Heiti TC Light"), legend.text = element_text(family="Heiti TC Light"), plot.title = element_text(family="Heiti TC Light") ) county %>% ggplot() + aes(county, people_total) %>% geom_col(fill="skyblue") + theme_minimal() + th + theme(axis.text.x = element_text(angle = 45)) 22.3.8 X/Y axis 調整圖表方向 county %>% ggplot() + aes(county, people_total) %>% geom_col(fill="skyblue") + coord_flip() + theme_minimal() + th + theme(axis.text.x = element_text(angle = 45)) 通常coord_flip()後往往會希望這些bar會是由上而下排序好的，但用arrange(desc(people_total)是無法解決問題的，因為Y軸原本會是照Y軸的刻度排列，而不是Y軸的數值。所以，要被排序的應該是Y軸的「文字」也就是那些縣市。因此，我們需要將該縣市轉為factor（1~n），並且讓這些縣市被安排的factor數值照people_total排列，因此要用mutate(county = reorder(county, people_total))。reorder()是一個將文字轉factor的函式，但在此特別指定照people_total的編排。 county %>% # arrange(desc(people_total) %>% mutate(county = reorder(county, people_total)) %>% ggplot() + aes(county, people_total) %>% geom_col(fill="skyblue") + coord_flip() + theme_minimal() + th 22.4 Highlighting & Storytelling 「說故事」才是整則資料新聞的核心，在運用圖表來輔助敘事時，應搭配說理說服的內容來突顯（highlight）圖面上的特徵，而不是留待讀者自己觀察。以下有三種highlight圖表部分資料的方法。第一個方法是在繪圖時用+ scale_color_manual()或+ scale_fill_manual()指定顏色給不同群組；方法二是利用gghighlight這個套件來指定要上色的群組，而且gghighlight可以和fill與color相互搭配，仍然可以用scale_fill_manual和scale_color_manual來指定顏色。但會有個狀況是，如果原本沒群組那怎麼辦？就自己用mutate()打造群組就好。方法各有利弊與使用時機。 22.4.1 依群組指定顏色 scale_color_manual() 與scale_fill_manual() NW %>% ggplot() + aes(year, Net_Worth, color = Category) + geom_line() + scale_color_manual( limits=c("65-74", "35-44"), # original chart group values=c("gold", "skyblue"), # map to color name="Age group", # legend title breaks=c("65-74", "35-44"), # original legend group labels labels=c("elder(65-74)","younger(35-44)"), # map to new labels na.value = "lightgrey" # color for other groups ) + theme_minimal() 22.4.2 使用gghighlight套件 library(gghighlight) NW %>% ggplot() + aes(year, Net_Worth, color = Category) + geom_line() + gghighlight(Category %in% c("65-74", "35-44")) + theme_minimal() + scale_x_continuous(breaks = NULL) + theme(panel.background = element_rect(fill = "whitesmoke", colour = "whitesmoke", size = 0.5, linetype = "solid")) 使用gghighlight仍能自己使用scale_color_manual()來指定顏色 NW %>% ggplot() + aes(year, Net_Worth, color = Category) + geom_line() + gghighlight(Category %in% c("65-74", "35-44")) + scale_color_manual( limits=c("65-74", "35-44"), # original chart group values=c("gold", "skyblue")) + # map to color theme_minimal() ## Warning: Tried to calculate with group_by(), but the calculation failed. ## Falling back to ungrouped filter operation... ## label_key: Category 22.4.3 為視覺化建立群組 這個方法是在原本的資料並沒有可以作為color或fill的因子，所以自行創建一個要突顯的群組。 county %>% mutate(group = if_else(county %in% c("新竹縣", "新竹市"), "highlight", "other")) %>% mutate(county = reorder(county, people_total)) %>% ggplot() + aes(county, people_total, fill=group) %>% geom_col() + scale_fill_manual(values=c("highlight"="Khaki", "other"="lightgrey")) + guides(fill="none") + coord_flip() + theme_minimal() + th 但事實上也可以用gghighlight直接達成 county %>% mutate(county = reorder(county, people_total)) %>% ggplot() + aes(county, people_total) %>% geom_col(fill="deeppink") + gghighlight(county %in% c("新竹縣", "新竹市")) + guides(fill="none") + coord_flip() + theme_minimal() + th 參考資料：5.4 Control the size of plots/images | R Markdown Cookbook (bookdown.org)↩︎ "],["coordinate.html", "Chapter 23 Coordinate 23.1 NYT: Population Growth 23.2 Order as axis 23.3 Log-scale 23.4 23.5 Square-root scale 23.6 Increasing percentage as Y 23.7 X/Y aspect ratio", " Chapter 23 Coordinate 本章節談論的是視覺化圖表的座標軸，本章節所涵蓋的概念可參考Claus O. Wilke所著之Fundamentals of Data Visualization的Chap3 Coordination & Axis與Chapter 8 Visualizing distributions: Empirical cumulative distribution functions and q-q plots。 23.1 NYT: Population Growth 紐時這篇報導「When Did the Anthropocene Start? Scientists Closer to Saying When. - The New York Times (nytimes.com)」討論了人類活動對地球所產生的深遠影響，並探討人類是否已經進入了一個新的地質時期，被稱為「人新世」。報導指出，人類的經濟活動、能源消耗和人口增長是人新世的主要因素，並且這些因素已經在地球上留下了不可磨滅的痕跡。報導也提到，地質學家已經發現了人新世的證據，包括核爆炸中的鈽同位素、肥料中的氮和發電廠的灰燼等。然而，報導也問道，人新世是否真的已經開始，以及它的開始點是否應該是農業革命、工業革命、核彈（77年前）或其他發展。 23.1.1 Parsing table from pdf 至R4CSS/data可以下載到本範例所用的資料（是一個pdf檔案）https://github.com/p4css/R4CSS/raw/master/data/world_population_change.pdf。 我們可使用tabulizer這個套件來萃取PDF文件中的表格，官方雖然提供cran可以直接安裝，但有可能會遇到R的版本不符要求而安裝不起來的情形。此時可用第二種方法，直接從github上安裝該套件。 程式碼使用 extract_tables() 函數從指定的PDF文件中提取表格數據，並將其存儲在 tables 變量中。在這個函數中，我們指定了要從第1頁中提取表格數據。 # Method 1 # install.packages("tabulizer") # Method 2 # if (!require("remotes")) { # install.packages("remotes") # } # remotes::install_github(c("ropensci/tabulizerjars", "ropensci/tabulizer")) library(tidyverse) library(tabulizer) # Extract the table tables <- extract_tables('data/world_population_change.pdf', pages = 1) # Extract the first element of the variable raw <- as.data.frame(tables[[1]]) population_by_year <- raw %>% select(1, 2) %>% slice(-c(1:4)) %>% rename(years_to_2020 = V1, population = V2) # select(years_to_2020 = v1, population = v2) # mutate(years_to_2020 = v1, population = v2) 23.1.2 X and Y with log-scale 通常情況下，當數據範圍很大，且存在極端值或者偏離值時，使用對數轉換可以更好地展示數據的分佈情況。在這種情況下，你可以使用 scale_x_log10() 或 scale_y_log10() 函數將 x 軸或 y 軸轉換為對數刻度。 例如，如果你有一個數據集，其中一個變量的數值範圍從1到100000，且大多數數據會集中在較小的值上，那麼使用線性刻度將導致數據在圖形中的分佈不平衡，而較大的值會集中在圖形的邊緣或者消失在圖形之外。在這種情況下，使用對數刻度可以更好地展示數據的分佈情況，並且可以更好地顯示較大值之間的差異。而上述資料便有這樣的特色，尤其是在Y軸方向，一開始人口增加量不多，後來指數成長，此時若使用線性尺度，會看不清楚一開始的人口增加量。 library(cowplot) load("data/world_population_change.rda") population_by_year ## years_to_2020 population ## 1 11,720 4 ## 2 10,020 5 ## 3 8220 8 ## 4 7020 11 ## 5 6020 7 ## 6 5020 14 ## 7 4220 27 ## 8 3020 50 ## 9 2520 100 ## 10 2020 268 ## 11 1020 289 ## 12 720 397 ## 13 520 471 ## 14 420 561 ## 15 320 629 ## 16 270 772 ## 17 220 951 ## 18 170 1247 ## 19 120 1643 ## 20 70 2499 ## 21 65 2769 ## 22 60 3042 ## 23 55 3333 ## 24 50 3691 ## 25 45 4071 ## 26 40 4440 ## 27 35 4838 ## 28 30 5269 ## 29 25 5735 ## 30 20 6076 ## 31 15 6463 ## 32 10 6930 ## 33 5 7349 ## 34 0 7717 toplot <- population_by_year %>% mutate(years_to_2020 = map(years_to_2020, ~(str_remove(., ",")))) %>% mutate(years_to_2020 = as.numeric(years_to_2020), population = as.numeric(population)) toplot %>% head ## years_to_2020 population ## 1 11720 4 ## 2 10020 5 ## 3 8220 8 ## 4 7020 11 ## 5 6020 7 ## 6 5020 14 p1 <- toplot %>% ggplot() + aes(x=years_to_2020, y=population) + geom_point() + theme_bw() p2 <- toplot %>% ggplot() + aes(x=years_to_2020, y=population) + geom_point() + scale_x_log10() + scale_y_log10() + scale_x_reverse() + theme_bw() cowplot::plot_grid( p1, NULL, p2, labels = c("(a) Original Scale", "", "(b) Low-Scale"), nrow = 1, rel_widths = c(1, 0.1, 1) ) 23.2 Order as axis 學術論文若要呈現一群數據的分佈時，最常用的是密度（分佈）函數、累積分佈函數，最常視覺化的方法是密度分佈圖（geom_density()）或直方圖（geom_histogram())。然而，對新聞等強調「說故事」的文體而言，說故事的技巧往往不是「那一群資源多或資源少的對象」，而經常要直指「那個對象」，要能夠看得見所敘述的對象在圖中的位置。此時，用密度分佈來呈現的話，只能看出，該對象在分佈的某個位置；但可以改用將資料對象根據某個數據來排序後，繪製折現圖的方式來表現。例如，若要繪製一個班級的成績分佈，通常X軸是分數（組），Y軸是獲得該分數（組）的人數；但其實可以將個體依照分數來做排序，Y軸不是某個分數（組）的個數，而是每個排序後的個體，而且以排序後的序號（Ranking）來表示。用折線圖繪製後，一樣可以看出分數的分佈，但卻能夠直接標記敘事中的某個對象是Y軸中得哪個點。 Figure 3.5: Population numbers of Texas counties relative to their median value. Select counties are highlighted by name. The dashed line indicates a ratio of 1, corresponding to a county with median population number. The most populous counties have approximately 100 times more inhabitants than the median county, and the least populous counties have approximately 100 times fewer inhabitants than the median county. Data source: 2010 Decennial U.S. Census. See What’s Going On in This Graph? | Vaccination by Country fromWhat Data Shows About Vaccine Supply and Demand in the Most Vulnerable Places - The New York Times (nytimes.com) The original chart is animated along the timeline.What Data Shows About Vaccine Supply and Demand in the Most Vulnerable Places - The New York Times (nytimes.com) 23.3 Log-scale 以下我打算繪製出每個村里在15歲以上的人口數，來呈現台灣有些村里人口相當稀少，尤其是花蓮縣、澎湖縣、南投縣和宜蘭縣的幾個聚落。並標記出幾個人口數最高的里。如果我的目的是呈現村里人口數的統計分佈，我會用geom_density()來繪圖（如下），但實際上沒辦法從這樣的密度函式圖來說故事，指出那些人口數過高或過低的村里。 raw <- read_csv("data/opendata107Y020.csv", show_col_types = FALSE) %>% slice(-1) %>% type_convert() raw %>% ggplot() + aes(edu_age_15up_total) + geom_density() 因此，一個比較好的策略是，把各村里的人口數由小到大或由大到小排序好，編好Rank比序的代號，然後讓X軸做為比序，逐一在Y軸打出每一個村里的數據。 但這邊值得注意的是，如果沒有放大尾端（也就是村里人口數最少的那部分），實際上也很難繪圖。所以對Y軸取log，就可以看清楚Y軸的資料點。 toplot <- raw %>% select(site_id, village, edu_age_15up_total) %>% arrange(desc(edu_age_15up_total)) %>% mutate(index = row_number()) %>% mutate(label = ifelse(index <= 5 | index > n()-5, paste0(site_id, village), "")) library(ggrepel) p2 <- toplot %>% ggplot() + aes(index, edu_age_15up_total) + geom_point(alpha=0.5, color="royalblue") + geom_text_repel(aes(label = label), point.padding = .4, color = "black", min.segment.length = 0, family = "Heiti TC Light") + theme(axis.text.x=element_blank()) + scale_y_log10(breaks = c(0, 1, 10, 100, 1000, 10000)) + theme_minimal() p1 <- toplot %>% ggplot() + aes(index, edu_age_15up_total) + geom_point(alpha=0.5, color="royalblue") + theme(axis.text.x=element_blank()) + theme_minimal() cowplot::plot_grid( p2, NULL, p1, labels = c("a", "", "b"), nrow = 1, rel_widths = c(1, 0.1, 1) ) library(tidyverse) library(gghighlight) 23.4 23.5 Square-root scale Chap3 Coordination & Axis Fundamentals of Data Visualization (clauswilke.com) Figure 3.8: Areas of Northeastern U.S. states. (a) Areas shown on a linear scale. (b) Areas shown on a square-root scale. Data source: Google. 前面是視覺化了各村里大於十五歲以上人口的人口數分佈，採用對數尺度（log-scale）可以觀察到比較小的村里。那有什麼是適合用平方根尺度（sqrt-scale）的呢？是土地嗎？密度嗎？還是人口數？是村里等級嗎？鄉鎮市區等級嗎？還是縣市等級？ town <- read_csv("data/tw_population_opendata110N010.csv") %>% slice(-1, -(370:375)) %>% type_convert() town %>% arrange(desc(area)) %>% mutate(index = row_number()) %>% ggplot() + aes(index, area) %>% geom_col(fill="skyblue") + scale_y_sqrt() + theme_minimal() Figure 23.1: (ref:population-area) county <- town %>% mutate(county = str_sub(site_id, 1, 3)) %>% group_by(county) %>% summarize( area = sum(area), people_total = sum(people_total) ) %>% ungroup() p1 <- county %>% arrange(desc(people_total)) %>% mutate(index = row_number()) %>% ggplot() + aes(index, people_total) %>% geom_col(fill="lightgrey") + # scale_y_sqrt() + theme_minimal() p2 <- county %>% arrange(desc(people_total)) %>% mutate(index = row_number()) %>% ggplot() + aes(index, people_total) %>% geom_col(fill="khaki") + scale_y_sqrt(breaks=c(0, 250000, 500000, 1000000, 2000000, 4000000)) + theme_minimal() cowplot::plot_grid( p1, p2, labels = c("a", "b"), nrow = 1 ) Figure 23.2: (ref:population-area) 23.6 Increasing percentage as Y 23.6.1 NYT: Net Worth by Age Group LEARNING NOTES Median for Inequality 這個教學案例來自紐約時報的「What’s going on in this gragh」系列資料視覺化教學之Teach About Inequality With These 28 New York Times Graphs - The New York Times (nytimes.com) 。該圖表呈現在不同年代、不同年齡層的人所擁有的淨資產（包含土地、存款、投資等減去債務）。該圖表的結果指出，在不同年代的老年人是越來越有錢，但年輕人卻越來越窮（該曲線為減去1989年 23.6.2 Read and sort data Sorted by arrange() function. p1 <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(year, Category, Net_Worth) %>% group_by(Category) %>% arrange(year) %>% ungroup() p1 %>% filter(year <= 1992) %>% knitr::kable() year Category Net_Worth 1989 Less than 35 16.17019 1989 35-44 112.47530 1989 45-54 195.11630 1989 55-64 195.25554 1989 65-74 154.34277 1989 75 or older 144.29855 1992 Less than 35 16.60780 1992 35-44 79.91050 1992 45-54 139.97745 1992 55-64 203.44104 1992 65-74 176.44667 1992 75 or older 155.35173 library(gghighlight) p1 %>% ggplot() + aes(year, Net_Worth, color = Category) + geom_line() + geom_point() + gghighlight(Category %in% c("65-74", "35-44")) + theme_minimal() + scale_x_continuous(breaks = NULL) + theme(panel.background = element_rect(fill = "white", colour = "white", size = 0.5, linetype = "solid")) p2 <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(year, Category, NW = Net_Worth) %>% group_by(Category) %>% arrange(year) %>% mutate(increase = (NW-first(NW))/first(NW)) %>% ungroup() p2 %>% filter(year <= 1992) %>% knitr::kable() year Category NW increase 1989 Less than 35 16.17019 0.0000000 1989 35-44 112.47530 0.0000000 1989 45-54 195.11630 0.0000000 1989 55-64 195.25554 0.0000000 1989 65-74 154.34277 0.0000000 1989 75 or older 144.29855 0.0000000 1992 Less than 35 16.60780 0.0270627 1992 35-44 79.91050 -0.2895285 1992 45-54 139.97745 -0.2825948 1992 55-64 203.44104 0.0419220 1992 65-74 176.44667 0.1432131 1992 75 or older 155.35173 0.0765994 美國35歲以下的年輕人的中位淨資產比起年長的美國人來說，一開始平均貧窮得多。從「Less than 35」這條線看來，現在的年輕世代比起2004年的年輕世代所擁有的淨資產低了40%。相比之下，65歲以上的美國人現在的淨資產，相較於2004年增加了9%。隨著時代變化，可想像會有一群人的淨資產越來越多，只是現在從這個圖表看來，年輕人所擁有的淨資產相較於過去是越來越低的，多半流入了成年人和老年人手中。 p2 %>% ggplot() + aes(year, increase, color = Category) + geom_line() + geom_point() + gghighlight(Category %in% c("65-74", "Less than 35")) + theme_minimal() + scale_y_continuous(labels=scales::parse_format()) + scale_x_continuous(breaks = NULL) + theme(panel.background = element_rect(fill = "white", colour = "white", size = 0.5, linetype = "solid")) 23.7 X/Y aspect ratio 23.7.1 UNICEF-Optimistic (WGOITH) https://www.nytimes.com/2021/11/17/upshot/global-survey-optimism.html https://changingchildhood.unicef.org/about plot.opt <- read_csv("data/unicef-changing-childhood-data.csv") %>% select(country = WP5, age = WP22140, bw = WP22092) %>% mutate(country = ordered(country, levels=c(1, 3, 4, 10, 11, 12, 13, 14, 17, 29, 31, 33, 35, 36, 60, 61, 77, 79, 81, 87, 165), labels=c("USA", "Morocco", "Lebanon", "Indonesia", "Bangladesh", "UK", "France", "Germany", "Spain", "Japan", "India", "Brazil", "Nigeria", "Kenya", "Ethiopia", "Mali", "Ukraine", "Cameroon", "Zimbabwe", "Argentina", "Peru"))) %>% count(country, age, bw) %>% group_by(country, age) %>% mutate(perc = n/sum(n)) %>% ungroup() %>% filter(bw == 1) %>% select(country, age, perc) %>% spread(age, perc) %>% rename(`15-24y` = `1`, `40+y` = `2`) plot.opt %>% head(10) %>% knitr::kable() country 15-24y 40+y USA 0.6679842 0.4611465 Morocco 0.4365079 0.4735812 Lebanon 0.5467197 0.4435798 Indonesia 0.7920605 0.8027344 Bangladesh 0.4624506 0.4319527 UK 0.5040000 0.4140000 France 0.3900000 0.2640000 Germany 0.5900000 0.3860000 Spain 0.5160000 0.3340000 Japan 0.6367265 0.2586873 plot.opt %>% ggplot() + aes(`40+y`, `15-24y`, label = country) + geom_point(color = "skyblue", size = 2) + xlim(0, 1) + ylim(0,1) + geom_text(hjust = -0.1, vjust = -0.5) + geom_abline(intercept = 0, slop = 1, color="lightgrey", alpha=0.5, linetype="dashed") + theme_minimal() + theme(aspect.ratio=1) "],["amount.html", "Chapter 24 AMOUNT 24.1 Bar chart 24.2 Heatmap: Vaccination", " Chapter 24 AMOUNT 24.1 Bar chart 24.2 Heatmap: Vaccination 這個例子參考(Wilke 2019)在視覺化數量（Amount）時的熱圖範例（Heatmap），但改用為視覺化各國每百人完整注射COVID-19疫苗人數歷時資料。 - https://ourworldindata.org/covid-vaccinations - https://github.com/owid/covid-19-data/tree/master/public/data/vaccinations 在R語言中，我們可以使用ggplot2套件來創建熱圖。熱圖通常使用顏色來表示數據的強度或值，通常是從淺色到深色或從冷色到暖色的漸變。ggplot2套件提供了geom_tile()函數來繪製熱圖。熱圖主要有以下幾個作用： 顯示數據的分布情況：熱圖可以將數據的分布情況一目了然地呈現出來，讓觀察者可以快速了解數據的分布情況。 發現數據之間的相關性：熱圖可以將數據之間的相關性直觀地呈現出來，這對於探索數據之間的關係非常有用。 篩選數據：熱圖可以幫助我們快速地篩選出數據中的關鍵部分，從而更好地理解數據。 使用ggplot2繪製熱圖的過程中，我們可以使用scale_fill_gradient()函數設置顏色的漸變方式和範圍，使用coord_equal()函數使x和y軸的尺度相同，從而保持正方形。 24.2.1 The case: Vaccinating coverage by month 本例子的資料前處理難度較高（OS：惡魔級）。困難來自於每個國家登記資料的時間不同，因此會產生大量NA值。但在這樣的狀況下，又要找到以月為時間單位的共同數值，就會更挑戰程式編寫者的資料清理技術。除此之外，如何偵測「每個國家超過每百人有二十人完整注射疫苗的時間點」，更是技巧中的技巧。是個磨練NA值處理和高難度資料前處理的好例子。這個例子同時也是大量在長表格、寬表格間轉換，多次運用spread()/pivot_wider()與gather()/pivot_longer()，搭配group_by()來達到資料整理目的的困難例子。 24.2.2 Data cleaning library(lubridate) raw <- read_csv("data/vaccinations.csv") fullvaccinated <- raw %>% select(country = location, date, people_fully_vaccinated_per_hundred) %>% drop_na(people_fully_vaccinated_per_hundred) %>% mutate(m = floor_date(date, unit = "month")) %>% group_by(country, m) %>% arrange(date) %>% slice(1) %>% ungroup() %>% select(-date) vperc_by_month <- fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% gather(month, perc, -country) %>% arrange(country, month) %>% group_by(country) %>% arrange(month) %>% mutate(perc = zoo::na.locf(perc, na.rm = F)) %>% ungroup() %>% arrange(country, month) %>% replace_na(list(perc=0)) 24.2.3 Visualization https://clauswilke.com/dataviz/visualizing-amounts.html 這個案例使用了三個維度的資料，分別為X軸的時間（月）、Y軸的國家、以及用顏色來呈現各國疫苗注射量（每百人）。並使用geom_tile()來製作熱圖。然而，Y軸的排序卻會影響讀圖。例如，在第一個例子中，Y軸的順序是用最後一個時間點的疫苗注射比例來排序。但每個國家政策和疫苗可獲量均不同，故開始注射和覆蓋速度也差很多，最終覆蓋量也會差很多。所以如果以最終覆蓋量來排序的話，反而不易觀察過程的變化，且「顏色」並不容易用來比較最終覆蓋量的大小，因而會產生很多讀圖上的困擾。 另一種繪圖策略是該書上的做法，其Y軸的排序是依照疫苗覆蓋率達到某個數值（例如每百人中有20人完整注射二劑疫苗）的時間早晚來排序。有此作為基準，每個國家在後續時間點的覆蓋速度的比較便比較容易。 另外需要注意到，顏色的取捨、以及相對於尺度的漸層設計也會影響讀圖。 24.2.3.1 Heatmap 01: Sorted by coverage of the last month watched <- c("United Arab Emirates", "Japan", "Singapore", "South Korea", "Taiwan", "Malaysia", "Hong Kong", "New Zealand", "Thailand", "Netherlands", "United States", "Israel", "United Kingdom", "Indonesia", "Thailand", "Philippines") vperc_by_month %>% spread(month, perc) %>% filter(country %in% watched) %>% mutate(country = reorder(country, -`2022-05-01`)) %>% gather(month, perc, -country) %>% ggplot() + aes(month, country, fill=perc) + geom_tile() + theme_minimal() + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) 24.2.3.2 Heatmap 02: Sorted by the time of specific coverage rate Sort by the time when the vaccine coverage rate exceeds 20% for all countries on the Y-axis. https://clauswilke.com/dataviz/visualizing-amounts.html vperc_by_month %>% filter(country %in% watched) %>% mutate(month = lubridate::as_date(month)) %>% group_by(country) %>% mutate(month1 = min((month[perc > 20]))) %>% ungroup() %>% spread(month, perc) %>% mutate(country = reorder(country, -as.numeric(month1))) %>% select(-month1) %>% gather(month, perc, -country) %>% ggplot() + aes(month, country, fill=perc) + geom_tile() + theme_minimal() + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) References "],["distribution-histogram-density.html", "Chapter 25 DISTRIBUTION: Histogram & Density 25.1 Density plot 25.2 Histogram 25.3 Pyramid Plot 25.4 Box plot: Muitiple Distrubution 25.5 Likert plot", " Chapter 25 DISTRIBUTION: Histogram & Density 本章節將介紹與資料分布相關的視覺化方法。資料分布是指數據中每個值出現的頻率或概率。在統計學中，了解資料分布是非常重要的，因為它可以幫助我們判斷數據是否為正態分佈，或者是否存在異常值或極端值。本章節將涵蓋常見的資料分布視覺化方法，包括直方圖、密度圖、箱形圖和金字塔圖等。 以下是R語言ggplot2套件中，用於資料分布視覺化的一些常用函式： geom_histogram()：用於創建直方圖。 geom_density()：用於創建密度圖。 geom_boxplot()：用於創建箱形圖。 geom_bar()：用於創建柱狀圖。 geom_freqpoly()：用於創建頻率多邊形圖。 註：本節的設計概念不少是參考 Claus O. Wilke 所著的「Foundations of Data Visualization」一書的章節，同時也參考臺灣和資料新聞的案例進行了改編。 接下來我們將使用Histogram和Density Plot這兩種資料視覺化方法來探索台灣村里長的年齡和性別分布情況。我們所使用的資料來源包括內政部和中選會的投票資料，這些資料能夠提供具有代表性的統計樣本，幫助我們更好地了解村里長的整體特徵。在進行資料視覺化的過程中，我們將會運用R語言中的ggplot2套件，並根據不同的視覺化需求進行相應的設置和調整。 https://www.moi.gov.tw/LocalOfficial.aspx?n=577&TYP=KND0007。 vilmaster <- readr::read_csv("data/tw_vil2018_elccand.csv") %>% drop_na(當選註記) 25.1 Density plot 密度圖（Density Plot)是一種展示數據集分佈情況的圖表，它可以幫助我們更好地理解數據集中數值出現的概率。圖表的 X 軸代表數據集的數值範圍，Y 軸則代表每個數值的出現概率。與直方圖不同，密度圖的曲線是光滑的，因為它是通過連續的數值範圍估算出的概率密度函數。通過比較不同數據集的密度圖，我們可以更好地了解它們之間的差異。在ggplot2中，可以用geom_density()函數來創建密度圖。 p1 <- vilmaster %>% ggplot() + aes(年齡) + geom_density() + th p2 <- vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_density(alpha=0.5) + th + scale_fill_manual( limits=c('1', '2'), # original chart group values=c("gold", "skyblue"), # map to color name="性別", # legend title breaks=c(1, 2), # original legend group labels labels=c("Male","Female"), # map to new labels na.value = "lightgrey" # color for other groups ) cowplot::plot_grid( p1, p2, labels = c("(a) Overall", "(b) Group by gender"), nrow = 1, rel_widths = c(1, 1) ) 25.1.1 Density with different bandwidth 參數bw指的是bnadwidth，為繪製histogram時的bar所涵蓋的資料寬度。以step-plot來說，bw越大，則梯距越寬；以density-plot來說，若bw越大則越是平滑。 library(ggridges) # for geom_density_line() p.b05 <- vilmaster %>% ggplot() + aes(年齡) + geom_density_line(fill='gold', bw=0.5, kernel='gaussian') + th p.b1 <- vilmaster %>% ggplot() + aes(年齡) + geom_density_line(fill='gold', bw=1, kernel='gaussian') + th p.b5 <- vilmaster %>% ggplot() + aes(年齡) + geom_density_line(fill='gold', bw=5, kernel='gaussian') + th p.rect <- vilmaster %>% ggplot() + aes(年齡) + geom_density_line(fill='gold', bw=10, kernel='rectangular') + th cowplot::plot_grid( p.b05, p.b1, p.b5, p.rect, labels = c("(a) bw=.5", "(b) bw=1", "(c) bw=2", "(b) rect"), nrow = 2, rel_widths = c(1, 1) ) 25.2 Histogram 直方圖（Histogram）是一種用於展示數據集分佈的圖表。它通過將數據範圍分成若干個區間（稱為 “bins” 或 “buckets”），然後計算落在每個區間內的數據的數量（稱為 “frequency”），來展示數據集的分佈情況。直方圖的 X 軸表示數據範圍，Y 軸表示每個區間中的頻數。直方圖可以幫助我們快速了解數據的分佈情況，特別是數據的中心趨勢、數據的離散程度和是否存在異常值等。 25.2.1 Histogram with different number of bins p10 <- vilmaster %>% ggplot() + aes(年齡) + geom_histogram(bins=10, fill='royalblue') + th p20 <- vilmaster %>% ggplot() + aes(年齡) + geom_histogram(bins=20, fill='royalblue') + th p30 <- vilmaster %>% ggplot() + aes(年齡) + geom_histogram(bins=30, fill='royalblue') + th p40 <- vilmaster %>% ggplot() + aes(年齡) + geom_histogram(bins=40, fill='royalblue') + th cowplot::plot_grid( p10, p20, p30, p40, labels = c("(a) bins=10", "(b) bins=20", "(c) bins=30", "(b) bins=40"), nrow = 2, rel_widths = c(1, 1) ) 25.2.2 Density vs histogram Histogram通常用來顯示數據的分佈情況，它會把數據區間分成若干個等寬的區間，然後計算每個區間內數據的頻率，再將這些頻率表示在y軸上。因此，histogram顯示的是數據的頻率，而不是數據的密度。 Density plot則是用來顯示數據的概率密度函數，它會通過核密度估計（Kernel Density Estimation, KDE）方法，將數據點周圍的密度估計出來，然後將這些估計值表示在y軸上。因此，density plot顯示的是數據的密度，而不是數據的頻率。 pd <- vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_density(alpha=0.5) + th + scale_fill_manual( values=c("1"='gold', '2'="skyblue"), labels=c('1'="Male",'2'="Female"), name='Sex' ) ph <- vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_histogram(bins=20, position="dodge") + th + scale_fill_manual(values=c("1"='gold', '2'="skyblue ")) + theme(legend.position="none") cowplot::plot_grid( pd, ph, labels = c("(a) geom_density()", "(b) geom_histogram()"), nrow = 1, rel_widths = c(6, 4) ) 25.2.3 Positions of bar chart p.hist.dodge <- vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_histogram(bins=20, position="dodge") + th + scale_fill_manual( values=c("1"='gold', '2'="skyblue "), labels=c('1'="Male",'2'="Female"), name='Sex' ) p.hist.stack <- vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_histogram(bins=20, position="stack") + th + scale_fill_manual(values=c("1"='gold', '2'="skyblue ")) + theme(legend.position="none") cowplot::plot_grid( p.hist.dodge, p.hist.stack, labels = c("(a) position:dodge", "(b) position:stack"), nrow = 1, rel_widths = c(6, 4) ) 25.2.4 Display two groups histogram by facet_wrap() geom_histogram(bins=20, position=\"dodge\") 用於繪製直方圖， bins=20表示將數據分成20個區間， position=\"dodge\"表示將不同性別的數據分開顯示。 th 是本範例在最早先所建立的ggplot主題，用於設置圖表的樣式（例如背景顏色、字體等）。 scale_fill_manual() 用於手動設置填充顏色， values=c(\"1\"='gold', '2'=\"skyblue\") 表示性別為1時填充金色，性別為2時填充天藍色。 labels=c('1'=\"Male\",'2'=\"Female\") 表示將性別1標記為Male，性別2標記為Female。 name='Sex' 表示設置顏色圖例的標題為Sex。 facet_wrap(.~性別, nrow=1) 表示將不同性別的數據分開顯示，每直行顯示一個性別。.~性別 表示將數據按性別分組。 vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_histogram(bins=20, position="dodge") + th + scale_fill_manual( values=c("1"='gold', '2'="skyblue "), labels=c('1'="Male",'2'="Female"), name='Sex' ) + facet_wrap(.~性別, nrow=1) 25.3 Pyramid Plot 金字塔圖（Pyramid plot）是一種用於比較兩個群體的統計圖表。它的形狀像一座金字塔，通常用於展示男女或年齡分佈等相關的數據。金字塔圖以垂直線為軸線，其中一側代表一個群體（如男性），另一側代表另一個群體（如女性）。圖表的左右兩側是對稱的，並以一條中心線分開。圖表中的每一行表示一個年齡段，而每一列則表示一個群體的比例或頻數。金字塔圖的高度表示總人數或總比例，並且可以用不同的顏色區分不同的群體。金字塔圖可以直觀地顯示兩個群體之間的差異，特別是在不同年齡段之間。 25.3.1 Modify geom_col() to pyramid plot vilmaster %>% group_by(性別) %>% mutate(age_group = cut(年齡, 0:20*5+.01)) %>% count(age_group) %>% ungroup() %>% ggplot() + aes(x=age_group, y=ifelse(性別=='1', -1, 1)*n, fill=factor(性別)) + geom_col() + scale_y_continuous(name = "Count", breaks = 250*(-6:2), labels = c("1500", "1250", "1000", "750", "500", "250", "0", "250", "500")) + coord_flip() + scale_fill_manual( values=c("1"='gold', '2'="skyblue "), labels=c('1'="Male",'2'="Female"), name='Sex' ) + th + labs(y="Count", x="Age Group") 25.4 Box plot: Muitiple Distrubution 箱形圖（Box plot）是一種用於展示數據分佈情況的統計圖表。它通常顯示數據的中位數、四分位數、極值和異常值等統計量。箱形圖的中間線表示數據的中位數，箱子的上下邊界則分別表示數據的上四分位數和下四分位數。箱子的高度表示數據的變異程度，而箱子外的線段則表示數據的最大值和最小值。如果數據中存在異常值，則通常使用圓圈或星號等符號來標記。箱形圖可以用來比較不同數據集之間的分佈情況，以及檢查數據是否存在異常值。 25.4.1 TW-Salary (boxplot) Inspired by Six Myths About Choosing a College Major - The New York Times (nytimes.com) and What’s Going On in This Graph? | Jan. 9, 2018 - The New York Times (nytimes.com) library(readxl) raw <- read_excel("data/tw_salary109.xlsx", sheet=1, trim_ws = T) raw Category Q1 Median Q3 Mean 男 39.0 53.2 82.3 70.7 女 35.1 46.8 67.6 58.6 未滿25歲 28.1 35.8 45.1 37.7 25-29歲 36.6 47.8 61.7 53.0 30-39歲 39.2 53.3 77.0 64.1 40-49歲 39.9 56.9 91.8 74.8 50-64歲 37.8 53.3 88.4 75.5 65歲以上 30.6 40.9 63.1 62.6 國中及以下 32.7 40.5 52.0 45.4 高中（職） 34.5 44.7 59.8 51.9 大專 38.6 53.7 80.2 67.0 研究所 60.9 96.0 139.3 116.4 礦業及土石採取業 34.2 57.2 91.7 68.5 製造業 38.7 50.4 73.2 64.8 電力及燃氣供應業 73.9 110.7 139.9 113.2 用水供應及污染整治業 31.9 45.7 63.9 54.6 營建工程業 34.1 46.1 64.0 54.7 批發及零售業 36.6 49.5 71.7 62.7 運輸及倉儲業 40.3 58.3 81.4 66.1 住宿及餐飲業 30.1 36.7 49.3 42.0 出版﹑影音製作﹑傳播及 資通訊服務業 53.0 71.5 111.2 88.8 金融及保險業 65.6 96.9 140.1 113.4 不動產業 36.8 52.2 76.6 65.0 專業科學及技術服務業 41.9 61.3 95.0 77.5 支援服務業 33.1 42.1 49.3 45.3 教育業-不含小學以上各級 學校 28.4 33.7 42.7 37.2 醫療保健及社會工作服務業 41.3 60.1 88.1 77.1 藝術娛樂及休閒服務業 28.8 39.2 57.2 48.8 其他服務業 30.6 35.8 49.1 43.6 raw %>% slice(-(1:12)) %>% mutate(Category = reorder(Category, desc(Median))) %>% ggplot() + aes(y = Category, xlower=Q1, xmiddle=Median, xupper=Q3, xmin=0, xmax=150) + geom_boxplot(stat = "identity", color="white", fill="skyblue") + geom_point(aes(x = Mean)) + th + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank()) 25.4.2 TW-Income (boxplot) 本案例用BoxPlot來呈現某個行政區（鄉鎮市區）各村里的所得中位數、平均數、四分位數的分佈。如果在箱型圖中，平均數高於第三分位數，這代表數據集呈現右偏分佈。也就是說，數據中的大部分觀測值都分佈在第一、二分位數之間，但存在一些較大的極端值，使平均值被往右偏移。從這樣的分佈中可以察覺某些里因為有少數極端高收入住戶，而使得平均高於四分位數。 library(gghighlight) toplot <- read_csv("data/tw_income_107.csv", ) %>% filter(!`村里` %in% c("合計", "其他", "福住里")) %>% filter(鄉鎮市區 %in% c("信義區")) %>% mutate(村里 = reorder(村里, desc(中位數))) toplot %>% mutate(group = if_else((平均數>第三分位數), "highlight", "none")) %>% ggplot() + aes(y = 村里, xlower=第一分位數, xmiddle=中位數, xupper=第三分位數, xmin= min(第一分位數), xmax=max(第三分位數), fill=group) + geom_boxplot(stat = "identity", color="white") + scale_fill_manual(values = c("highlight"="orangered", "none"="skyblue")) + guides(fill=FALSE) + geom_point(aes(x = 平均數)) + xlab("年所得（單位：千元）") + th + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank()) 25.5 Likert plot raw <- read_rds("data/tfc_survey.rds") dt <- raw %>% mutate(QA3_lv = ordered(QA3, levels=c("20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70及以上"), labels = c("青年", "青年", "壯年", "壯年", "壯年", "中年", "中年", "中年", "中年", "老年", "老年"))) %>% mutate(Q7 = ordered(Q7, levels=c("一點也不會", "不會", "會", "絕對會"))) %>% mutate(Q8 = ordered(Q8, levels=c("一點也不會", "不會", "會", "絕對會"))) 25.5.1 Stacked or dodged bar 要比較不同年齡層在某個題項的填答結果時，最常見的是用Stacked或Dodged長條圖。Stacked是便於看到各組的總數大小但難以比較各組之間回應的比例，而Dodged是便於比較各組之間每個項目的比例，而不容易觀察總數大小。但這兩種呈現方法，以上面這個例子來說，從視覺化上均難以閱讀出來，哪個年齡層的填答比較靠近「會或絕對會」，又哪個年齡層比較靠近「絕對不會或不會」。 這時候我們可以用一種繪製方法來表達這類Likert問卷的結果，這種圖表稱為Likert Plot（Graph）。 p1 <- dt %>% count(QA3_lv, Q7) %>% ggplot() + aes(QA3_lv, n, fill=Q7) + geom_col(position = position_stack(reverse = TRUE)) + coord_flip() + th p2 <- dt %>% count(QA3_lv, Q7) %>% ggplot() + aes(QA3_lv, n, fill=Q7) + geom_col(position="dodge") + th cowplot::plot_grid( p1, NULL, p2, labels = c("(a) Stacked", "", "(b) Dodged"), ncol = 1, rel_heights = c(1, 0.1, 1) ) 25.5.2 Likert Graph Likert Graph繪製重點有幾個： 要轉用比例來繪製。例如下圖就是用絕對的數值來繪製，因為年齡層人數的不同，例如壯年人數比較多，而老年人數少非常多，反而難以跨組比較。 ggstats的套件有gglikert()可以用（請見Plot Likert-type items with `gglikert()` • ggstats (larmarange.github.io)）的說明，但也可以用geom_segment()來自己刻。 用geom_segment()時在aes()多了幾個參數，為該資料在X軸的起始點與終點（x, xend）與Y軸的起始點與終點（y, yend）。要自己運算。 color <- c("#9393C6", "#A8A8A8","#FFA166", "#FF6200") dt %>% count(QA3_lv, Q7) %>% mutate(y_acc = cumsum(n)) %>% group_by(QA3_lv) %>% mutate(y_end = y_acc - min(y_acc) - n[[2]]) %>% mutate(y_start = y_end - n) %>% ungroup() %>% ggplot() + aes(x = QA3_lv, xend = QA3_lv, y = y_start, yend = y_end, , color=Q7) + geom_segment(linewidth = 18) + coord_flip() + theme_bw() + scale_color_manual("", labels = c("一點也不會", "不會", "會", "絕對會"), values = color, guide = "legend") + th 正確用比例繪製的結果如下。Likert Graph和本節所提到的Pyramid Graph在數位敘事上的效果很類似，都是對應到一般的Stacked或Dodged長條圖不易做組間比較。Pyramid Graph適於做兩組間的數值左右對照，Likert Graph則有助於快速看出不同題項或不同組別間的填答差異。 library(scales) dt %>% count(QA3_lv, Q7) %>% group_by(QA3_lv) %>% mutate(perc = n/sum(n)) %>% mutate(y_acc = cumsum(perc)) %>% mutate(y_end = y_acc - y_acc[[2]]) %>% # mutate(y_end = y_acc - perc[[1]] - perc[[2]]) %>% # mutate(y_end = y_acc - min(y_acc) - perc[[2]]) %>% mutate(y_start = y_end - perc) %>% ungroup() %>% ggplot() + aes(x = QA3_lv, xend = QA3_lv, y = y_start, yend = y_end, , color=Q7) + geom_segment(linewidth = 18) + scale_y_continuous(labels = percent_format()) + coord_flip() + scale_color_manual("", labels = c("一點也不會", "不會", "會", "絕對會"), values = color, guide = "legend") + ylab("Perc(%)") + xlab("Age group") + th "],["proportion.html", "Chapter 26 PROPORTION 26.1 Pie Chart 26.2 Dodged Bar Chart 26.3 Treemap: Nested Proportion", " Chapter 26 PROPORTION 26.1 Pie Chart 26.2 Dodged Bar Chart 26.3 Treemap: Nested Proportion Treemap是一種資料視覺化工具，用於呈現層級式結構的數據。它通常使用矩形或正方形區域來表示不同的數據單元，並將它們分層排列以形成層次樹狀結構。Treemap的特點包括： 易於理解：Treemap以直觀的方式呈現數據，讓使用者能夠輕鬆地了解各個數據單元之間的比例關係。 節省空間：Treemap使用矩形或正方形區域排列數據，能夠更有效地利用空間，呈現更多的數據。 可互動性：Treemap通常支持互動式操作，使用者可以通過縮放、懸停等方式，進一步了解數據。 Treemap適用於以下情況： 層級式數據：Treemap適用於層級式數據，例如組織架構、檔案系統等。 大量數據：Treemap能夠有效地呈現大量數據，並在縮放時保持清晰度。 比例關係：Treemap適用於呈現不同數據單元之間的比例關係，例如市場份額、支出等。 26.3.1 NYT: Carbon by countries 本案例取自紐時所報導之Who Has The Most Historical Responsibility for Climate Change? - The New York Times (nytimes.com)。該新聞報導了聯合國氣候峰會在格拉斯哥舉行期間的一個重要議題：世界上最富裕的國家，即那些對全球暖化負責任的不成比例的國家，應如何賠償因全球氣溫上升所造成的貧困國家的損失。報導指出，現今全球人口中，包括美國、加拿大、日本以及西歐大部分國家在內的富裕國家僅佔12％，但是在過去的170年中，這些國家卻負責了50％的溫室氣體排放。貧困國家要求富裕國家提供更多資金以應對全球暖化所帶來的風險。在峰會上，來自最不發達國家聯盟的Sonam P. Wangdi指出，他的祖國不丹對全球暖化的責任較小，因為該國目前吸收的二氧化碳比汽車和房屋排放的少。然而，不丹仍然面臨著由氣溫上升所帶來的嚴重風險，喜馬拉雅山脈融化的冰川已經導致了洪水和泥石流，摧毀了村莊。報導指出，最不發達國家需要更多的資金和支持，以應對全球暖化所帶來的影響。 本案例的Treemap以面積顯示了各國的碳排放所佔比例，並用顏色視覺化各國的人均GDP。Per Capita是拉丁語，通常用來表示某種統計數據與人口數量之間的關係。它是指將某一特定數量的總量除以人口數目，以得出每個人所擁有的平均數量。例如，國家的人均GDP（Gross Domestic Product，國內生產總值）是指該國的總GDP除以該國的人口數，以反映一個人在該國經濟中所創造的平均貢獻。Per Capita常用於比較不同國家或地區之間的平均水平，以及分析人均收入、人均支出、人均消費等數據。 totreemap <- read_csv("data/GCB2021v34_MtCO2_flat.csv") %>% drop_na(`Total`) %>% filter(!Country %in% c("Global", "International Transport")) %>% filter(Year==2020) %>% arrange(desc(`Total`)) %>% mutate(perc = Total/sum(Total)) %>% slice(1:20) library(treemapify) totreemap %>% ggplot() + aes(area = perc, fill=`Per Capita`, label=Country) + geom_treemap() + geom_treemap_text(color="white", place="centre", grow=TRUE ) 26.3.2 TW: Taiwan Annual Expenditure 上述案例未能突顯出Treemap能夠呈現階層式資料的特色。因此本案例將使用台灣中央預算，階層化地顯示不同機構層級（大類、一級部會）等的預算佔比。例如衛福部、財政部與勞動部的預算均屬於社會福利支出。 這段程式碼中，使用了 zoo 套件中的 na.locf() 函數。此函數用於將 raw 資料框中的 款 欄位的缺失值 (NA) 以最近已知的值 (向前填補) 進行填補。 library(zoo) # raw <- readxl::read_excel("data/111B歲出政事別預算總表.xls") raw <- readxl::read_excel("data/111B歲出政事別預算表.xls", skip=3, col_names = F) names(raw) <- c("款", "科", "目", "節", "機構", "本年度預算", "上年度預算", "上年度決算", "預算差") # raw$款 <- na.locf(raw$款) cleand <- raw %>% filter(!is.na(款) | !is.na(科)) %>% slice(-(1:2)) %>% select(-目, -節) %>% mutate(org = purrr::map(機構, function(x){str_split(x, "\\n")[[1]][2]})) %>% mutate(款 = ifelse(!is.na(款), unlist(org), unlist(款))) %>% mutate(款 = zoo::na.locf(款)) %>% filter(!is.na(科)) %>% select(-科) %>% type_convert() %>% mutate(上年度預算 = as.numeric(上年度預算), 上年度決算 = as.integer(上年度決算), 預算差 = as.numeric(預算差)) %>% replace_na(list(上年度預算 = 0, 上年度決算 = 0)) %>% mutate(預算差 = 本年度預算 - 上年度預算) cleand %>% filter(款 %in% c("科學支出")) %>% ggplot() + aes(area = 本年度預算, fill=`本年度預算`, label=org) + geom_treemap() + geom_treemap_text(color="white", place="centre", grow=TRUE, family = "Heiti TC Light" ) + theme(title = element_text(family = "Heiti TC Light"), text = element_text(family = "Heiti TC Light")) library(treemapify) cleand %>% # filter(款 %in% c("科學支出", "教育支出", "國防支出", "司法支出")) %>% ggplot() + aes(area = 本年度預算, fill=`本年度預算`, label=org, subgroup = 款) + geom_treemap() + geom_treemap_subgroup_border(color="gold") + geom_treemap_subgroup_text(place = "centre", grow = T, alpha = 0.5, colour = "gold", min.size = 0, family = "Heiti TC Light") + geom_treemap_text(color="white", place="centre", grow=F, family = "Heiti TC Light" ) + theme(title = element_text(family = "Heiti TC Light"), text = element_text(family = "Heiti TC Light"), legend.position = "none") "],["association.html", "Chapter 27 ASSOCIATION 27.1 等比例座標軸", " Chapter 27 ASSOCIATION 27.1 等比例座標軸 27.1.1 UNICEF-Optimistic (WGOITH) https://www.nytimes.com/2021/11/17/upshot/global-survey-optimism.html https://changingchildhood.unicef.org/about plot.opt <- read_csv("data/unicef-changing-childhood-data.csv") %>% select(country = WP5, age = WP22140, bw = WP22092) %>% mutate(country = ordered(country, levels=c(1, 3, 4, 10, 11, 12, 13, 14, 17, 29, 31, 33, 35, 36, 60, 61, 77, 79, 81, 87, 165), labels=c("USA", "Morocco", "Lebanon", "Indonesia", "Bangladesh", "UK", "France", "Germany", "Spain", "Japan", "India", "Brazil", "Nigeria", "Kenya", "Ethiopia", "Mali", "Ukraine", "Cameroon", "Zimbabwe", "Argentina", "Peru"))) %>% count(country, age, bw) %>% group_by(country, age) %>% mutate(perc = n/sum(n)) %>% ungroup() %>% filter(bw == 1) %>% select(country, age, perc) %>% spread(age, perc) %>% rename(`15-24y` = `1`, `40+y` = `2`) plot.opt %>% head(10) %>% knitr::kable() country 15-24y 40+y USA 0.6679842 0.4611465 Morocco 0.4365079 0.4735812 Lebanon 0.5467197 0.4435798 Indonesia 0.7920605 0.8027344 Bangladesh 0.4624506 0.4319527 UK 0.5040000 0.4140000 France 0.3900000 0.2640000 Germany 0.5900000 0.3860000 Spain 0.5160000 0.3340000 Japan 0.6367265 0.2586873 plot.opt %>% ggplot() + aes(`40+y`, `15-24y`, label = country) + geom_point(color = "skyblue", size = 2) + xlim(0, 1) + ylim(0,1) + geom_text(hjust = -0.1, vjust = -0.5) + geom_abline(intercept = 0, slop = 1, color="lightgrey", alpha=0.5, linetype="dashed") + theme_minimal() + theme(aspect.ratio=1) "],["time-trends.html", "Chapter 28 TIME & TRENDS 28.1 Highlighting: Unemployed Population 28.2 Smoothing: Unemployed", " Chapter 28 TIME & TRENDS 28.1 Highlighting: Unemployed Population This example is referenced from Datacamp’s Introduction to data visualization with ggplot2。 28.1.1 The econimics data 這是一個包含美國經濟時間序列資料的資料集，資料來源為https://fred.stlouisfed.org/。economics是以「寬」表格方式儲存，而economics_long 資料框則以「長」表格方式儲存。每一列之date為資料收集的月份。 pce：個人消費支出，以十億美元為單位，資料來源為 https://fred.stlouisfed.org/series/PCE pop：總人口數，以千人為單位，資料來源為 https://fred.stlouisfed.org/series/POP psavert：個人儲蓄率，資料來源為 https://fred.stlouisfed.org/series/PSAVERT/ uempmed：失業中位數持續時間，以週為單位，資料來源為 https://fred.stlouisfed.org/series/UEMPMED unemploy：失業人數，以千人為單位，資料來源為 https://fred.stlouisfed.org/series/UNEMPLOY economics %>% head() ## # A tibble: 6 × 6 ## date pce pop psavert uempmed unemploy ## <date> <dbl> <dbl> <dbl> <dbl> <dbl> ## 1 1967-07-01 507. 198712 12.6 4.5 2944 ## 2 1967-08-01 510. 198911 12.6 4.7 2945 ## 3 1967-09-01 516. 199113 11.9 4.6 2958 ## 4 1967-10-01 512. 199311 12.9 4.9 3143 ## 5 1967-11-01 517. 199498 12.8 4.7 3066 ## 6 1967-12-01 525. 199657 11.8 4.8 3018 28.1.2 Setting marking area recess <- data.frame( begin = c("1969-12-01","1973-11-01","1980-01-01","1981-07-01","1990-07-01","2001-03-01", "2007-12-01"), end = c("1970-11-01","1975-03-01","1980-07-01","1982-11-01","1991-03-01","2001-11-01", "2009-07-30"), event = c("Fiscal & Monetary\\ntightening", "1973 Oil crisis", "Double dip I","Double dip II", "Oil price shock", "Dot-com bubble", "Sub-prime\\nmortgage crisis"), y = c(.01415981, 0.02067402, 0.02951190, 0.03419201, 0.02767339, 0.02159662, 0.02520715) ) library(lubridate) recess <- recess %>% mutate(begin = ymd(begin), end = ymd(end)) economics %>% ggplot() + aes(x = date, y = unemploy/pop) + ggtitle(c("The percentage of unemployed Americans \\n increases sharply during recessions")) + geom_line() + geom_rect(data = recess, aes(xmin = begin, xmax = end, ymin = -Inf, ymax = +Inf, fill = "Recession"), inherit.aes = FALSE, alpha = 0.2) + geom_label(data = recess, aes(x = end, y = y, label=event), size = 3) + scale_fill_manual(name = "", values="red", label="Recessions") 28.2 Smoothing: Unemployed Smooth by bin smoothing fit <- with(economics, ksmooth(date, unemploy, kernel = "box", bandwidth=210)) economics %>% mutate(smooth = fit$y) %>% ggplot() + aes(date, unemploy) + geom_point(alpha = 5, color = "skyblue") + geom_line(aes(date, smooth), color="red") + theme_minimal() 28.2.1 Polls_2008 Second Example comes from Rafael’s online book library(dslabs) span <- 7 polls_2008 ## # A tibble: 131 × 2 ## day margin ## <dbl> <dbl> ## 1 -155 0.0200 ## 2 -153 0.0300 ## 3 -152 0.065 ## 4 -151 0.06 ## 5 -150 0.07 ## 6 -149 0.05 ## 7 -147 0.035 ## 8 -146 0.06 ## 9 -145 0.0267 ## 10 -144 0.0300 ## # ℹ 121 more rows fit <- with(polls_2008, ksmooth(day, margin, kernel = "box", bandwidth = span)) polls_2008 %>% mutate(smooth = fit$y) %>% ggplot(aes(day, margin)) + geom_point(size = 3, alpha = .5, color = "grey") + geom_line(aes(day, smooth), color="red") + theme_minimal() "],["geospatial.html", "Chapter 29 GEOSPATIAL 29.1 World Map 29.2 Read Spatial Data from SEGIS 29.3 Town-level: Taipei income 29.4 Voting map - County level 29.5 Mapping data with grid", " Chapter 29 GEOSPATIAL 地圖是一種用來展示地理空間信息的視覺化工具，可以幫助我們更好地了解和分析地理現象。常見的地圖種類通常可以分為兩類：區域圖和點位圖。 區域圖（Choropleth Map）是通過將地理區域劃分為幾個區域，然後用不同的顏色、陰影或圖案等方式來表示這些區域的某種屬性或數量。這種地圖通常用於展示國家、省份、城市等區域的人口、經濟、地形、氣候等相關數據。區域圖能夠直觀地展示地理現象在不同區域之間的差異和變化，並有助於我們進行比較和分析。 點位圖（Dot Density Map）則是通過在地圖上用點或符號來表示某種地理空間現象的分布或密度。例如，可以用紅點表示城市、綠點表示森林、藍點表示湖泊等等。這種地圖通常用於展示地理現象在空間上的分布和密度，並能夠直觀地展示相對密度和稀疏程度。 區域圖的數據形式：有兩種基本數據模型：向量（Vector）和網格（Raster）。 向量數據模型使用點、線、多邊形等基本要素來描述地理空間現象。例如，可以用一個線段來表示一條河流，用一個多邊形來表示一個國家或城市的邊界等。向量數據模型具有比較強的邏輯性和表達能力，特別適合描述較簡單的地理現象。 網格數據模型則是將地理空間區域劃分為一個個大小相等的格子，每個格子都有一個固定的數值，用來表示這個區域的某種屬性，例如溫度、濕度、高程等等。網格數據模型適合描述分布比較連續和具有變化的地理現象。 通常繪製地理資訊地圖的時候，會需要因應你要繪製的地域去下載地圖空間數據檔案（例如.shape或geojson檔等）。如台灣的就可以去社會經濟資料服務平台 (moi.gov.tw)下載。但也有一些套件內部就包含這些地理空間數據，例如下一節的例子rworldmap套件本身就有世界地圖。或者可以嘗試ggmap或rgooglemap等第三方服務（參考簡介：Map Visualization in R · Data Science and R） 29.1 World Map library(readxl) library(rworldmap) # for drawing rworldmap rawdata <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) mapdata <- rawdata[,c(3, 6:24)] 29.1.1 Bind data to map data 這段程式碼是在將自己的數據mapdata與rworldmap世界地圖數據進行結合。 首先，使用 joinCountryData2Map() 函數，將自己的數據和世界地圖數據按照國家的 ISO3 代碼進行連接，生成一張新的地圖。其中， mapdata 是指世界地圖數據， joinCode 參數指定連接時使用的 ISO3 代碼（亦即你預先知道你自己的資料中有ISO3國家代碼）。 nameJoinColumn 參數則用於指定自己數據中與國家對應的欄位名稱為iso3。 還有其他的joinCode如「“ISO2”,“ISO3”,“FIPS”,“NAME”, “UN” = numeric codes」等可參見該套件的說明rworldmap package - RDocumentation。 # join your data with the world map data myMap <- joinCountryData2Map(mapdata, joinCode = "ISO3", nameJoinColumn = "iso3") ## 196 codes from your data successfully matched countries in the map ## 1 codes from your data failed to match with a country code in the map ## 47 codes from the map weren't represented in your data myMap$matleave_13 ## [1] 2 2 5 2 2 5 NA NA 3 5 5 2 4 3 3 3 5 2 5 5 3 2 3 3 2 ## [26] 2 3 4 3 4 3 3 3 3 3 3 3 5 NA 3 5 5 3 5 2 3 2 2 2 3 ## [51] 5 2 5 2 NA 4 3 4 3 2 3 4 2 2 4 NA 2 2 2 5 2 5 2 2 4 ## [76] 4 2 4 3 4 2 2 5 3 2 3 2 5 NA 2 2 2 2 3 2 2 5 4 5 3 ## [101] 5 3 2 4 3 2 5 5 2 3 2 2 2 NA 3 2 2 3 4 2 3 2 2 3 2 ## [126] 2 1 5 NA 2 4 2 2 5 5 2 NA 2 2 2 3 2 2 2 3 5 1 5 5 5 ## [151] 2 3 3 3 2 5 3 2 3 2 3 NA 2 2 5 2 1 5 4 4 2 NA 2 3 3 ## [176] 3 NA NA NA 3 NA NA 2 2 NA NA 2 2 3 2 NA NA 2 NA 1 NA NA 2 NA NA ## [201] NA NA NA NA NA NA 2 2 2 3 NA NA 3 2 1 3 NA NA 2 NA 1 1 NA 1 NA ## [226] 3 NA NA 5 NA 2 NA 3 NA 1 5 2 NA NA NA 2 2 NA 29.1.2 Drawing Map mapCountryData() 函數用於將數據繪製在地圖上。其中， myMap 是已經連接過的世界地圖數據和自己的數據，包含了各國的地理空間信息和相關的數據資訊。 nameColumnToPlot 指定要顯示在地圖上的數據欄位為matleave_13，也就是 2013 年的產假長度。 catMethod 參數是決定視覺化時的數據分類是類別或連續，categorical表示將數據分成幾個等級來展示在地圖上。 mapCountryData(myMap , nameColumnToPlot="matleave_13" , catMethod = "categorical" ) 29.1.3 Drawing map by specific colors # self-defined colors colors <- c("#FF8000", "#A9D0F5", "#58ACFA", "#0080FF", "#084B8A") mapCountryData(myMap , nameColumnToPlot="matleave_13" , catMethod = "categorical" , colourPalette = colors , addLegend="FALSE" ) 29.1.4 Practice. Drawing map for every years 繪製自1995至2013年每年的地圖並觀察其上的變化。 繪製的時候請嘗試使用par()來把每年的地圖繪製在同一張圖上，怎麼做？ 你能觀察出變化來嗎？可否透過顏色的調整來凸顯變化？你的策略是什麼？ 29.2 Read Spatial Data from SEGIS 要繪製地理地圖會要先下載地圖檔，可以查詢「直轄市、縣市界線(TWD97經緯度)」和鄉鎮市區界線(TWD97經緯度) | 政府資料開放平臺 (data.gov.tw)。 接下來是取得要繪製在地圖上的資料。前面的rworldmap是已知地圖檔和資料檔中都有每個國家的ISO3代碼，所以可以用ISO3代碼來連結地圖檔和資料檔。如果是臺灣的資料，可能就要用縣市名稱來做連結。或者，某些圖資本身就有經緯度，甚至它並非區域圖，而是有經緯度的點位圖。這類的圖資檔案可以到社會經濟資料服務平台 (moi.gov.tw)查找並下載。 通常地理圖資檔有兩種格式：一種是geojson，一種是shapefile。 shapefile 是一種老舊的地理圖資檔案格式，通常由 shp, shx, dbf, prj 等檔案組成。其中，shp 檔案包含了地理空間範圍和形狀的點與邊（邊通常是由點依序所構成，不會特別把邊標出來），shx 檔案是其索引文件，dbf 檔案則儲存了相關的屬性資訊，例如幾何特徵的名稱或變數，prj 檔案則是儲存了投影信息。shapefile 格式的優點是廣泛的應用性和支援程式豐富，可以在許多地理信息系統（GIS）和軟件中使用，是許多組織和機構最常用的地理圖資格式之一。 geojson 則是一種基於 JSON 格式的地理圖資檔案格式，內容包含了地理空間範圍和屬性。geojson 的優點是格式簡單、容易理解和易於編輯，支援性也比較好。由於 geojson 使用的是文本格式，因此可以直接在許多文本編輯器中編輯和查看，也可以輕易地轉換成其他格式的地理圖資檔案。 這邊我們所要用的套件是sf，sf 是一個在 R 環境下進行地理圖資處理和分析的套件，他不僅支援多種檔案格式，包括 shapefile、GeoJSON、KML 等，並且可以直接將這些檔案轉換為 R 中的空間資料框架，方便進行進一步的處理和分析。更方便的特色是在於，它可以用tidyverse的風格來寫作，方便對地理圖資和其他數據進行整合和分析，甚至在使用View()的時候，把圖資當成一個變項。 library(sf) 29.2.1 The case: Population and Density of Taipei 這個資料下載自社會經濟資料服務平台 (moi.gov.tw)的111年9月行政區人口統計_鄉鎮市區_臺北市，實際上內部的資料包含368個鄉鎮的依性別分人口數、家戶數等。 資料變項包含每個區的家戶數（H_CNT）、總人口數（P_CNT）、男性人口數（M_CNT）、女性人口數（F_CNT）。等一下要計算每平方公里的家戶數或人口數時，你會疑惑為何沒有面積資料。 sf_tpe <- st_read(dsn = "data/111年9月行政區人口統計_鄉鎮市區_臺北市_SHP/", layer = "111年9月行政區人口統計_鄉鎮市區", quiet = T) %>% mutate(across(where(is.character), ~iconv(., from = "BIG5", to = "UTF8"))) %>% # mutate(across(where(is.double), ~if_else(is.na(.),as.double(0),.))) %>% # st_set_crs(3826) %>% st_transform(4326) %>% # filter(COUNTY == "臺北市") filter(str_detect(COUNTY, "臺北市")) sf_tpe %>% head() ## Simple feature collection with 6 features and 9 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 300874.7 ymin: 2766756 xmax: 309745.8 ymax: 2776127 ## CRS: NA ## TOWN_ID TOWN COUNTY_ID COUNTY H_CNT P_CNT M_CNT F_CNT INFO_TIME ## 1 63000010 松山區 63000 臺北市 78977 187552 87625 99927 111Y09M ## 2 63000020 信義區 63000 臺北市 87407 201951 95884 106067 111Y09M ## 3 63000030 大安區 63000 臺北市 117243 280332 130596 149736 111Y09M ## 4 63000040 中山區 63000 臺北市 98825 210156 97114 113042 111Y09M ## 5 63000050 中正區 63000 臺北市 64491 146628 69663 76965 111Y09M ## 6 63000060 大同區 63000 臺北市 51988 118065 57003 61062 111Y09M ## geometry ## 1 MULTIPOLYGON (((307703.1 27... ## 2 MULTIPOLYGON (((307788.7 27... ## 3 MULTIPOLYGON (((304591.5 27... ## 4 MULTIPOLYGON (((305699 2776... ## 5 MULTIPOLYGON (((302203.6 27... ## 6 MULTIPOLYGON (((302217.9 27... 試著畫畫看。你會發現它的座標系是一個我們看不懂的數字，而不是想像中的經緯度。 sf_tpe %>% ggplot() + geom_sf() 29.2.2 Projection 投影的概念 投影是指將地球表面的三維空間坐標轉換為二維平面坐標的過程，這是因為在實際應用中需要將地球表面的訊息表示在平面上，方便分析和可視化。然而，由於地球是一個球體，不同的投影方式會導致在不同位置和距離上的形狀、面積和方向出現差異，因此在使用地理空間數據進行分析和視覺化時需要注意投影的選擇和轉換。 除了投影之外，每個地理區域還有適合的參考橢球體和大地基準面。橢球體是指地球表面的形狀，大地基準面則是指地球表面的平均高程面。這些概念的選擇取決於具體的地理區域和應用場景，並且可能會對數據分析結果產生影響。基準點（Datum）則是用來定義地球表面上的某個點，從而將地球表面的形狀和大小轉換為平面坐標系中的數值。基準點分為區域性的（local）和全球的（global）。區域性的基準點通常是針對某個特定的地理區域進行定義，而全球的基準點則是針對整個地球進行定義。全球最常用的基準點是WGS84，它以地球質心為中心；而台灣常用的區域性基準點是TWD97，舊版則是用TWD67。基準點的選擇也可能會對數據分析結果產生影響。 投影法有對應的代號稱為 EPSG（歐洲石油探勘組織），他們制定了空間參考識別系統（SRID）。可以記兩個重要的: WGS84 = 4326 TWD97 = 3826 參考：https://gis.stackexchange.com/questions/48949/epsg-3857-or-4326-for-googlemaps-openstreetmap-and-leaflet Google Earth採用WGS84坐標系統的地理坐標系統。(EPSG：4326) Google Maps採用以WGS84為基礎的投影坐標系統。(EPSG 3857) Open Street Map數據庫中的數據以WGS84坐標系統的十進制度為單位進行儲存。(EPSG：4326) Open Street Map瓦片和WMS服務採用以WGS84為基礎的投影坐標系統。(EPSG 3857) https://epsg.io/3825 是台灣的坐標系統（3826、3827等也是，你可以打開看看） 用得到投影的情境 研究區域，想轉換座標（changing projections）：修改 EPSG code 或是改掉 proj4string 的內容 原始資料缺投影方法：加上 EPSG code 或是加上 proj4string 的內容 如果需要進行投影轉換，可以使用 R 中的相關函數和方法。例如， 使用 st_crs() 函數可以取得地理空間數據的投影系統； 使用 st_transform() 函數可以進行地理空間數據的投影變換； 使用 st_set_crs() 函數可以設定地理空間數據的投影系統等等。 就下載的這個資料來說，他並沒有設定他的投影座標。 st_crs(sf_tpe)$proj4string ## [1] NA st_crs(sf_tpe) ## Coordinate Reference System: NA 我們會希望在讀取資料的時候，設定他的投影座標。例如以下的例子是設定為TWD96（3826）然後轉換為全球座標WGS84（4326）。 sf_tpe <- st_read(dsn = "data/111年9月行政區人口統計_鄉鎮市區_臺北市_SHP/", layer = "111年9月行政區人口統計_鄉鎮市區", quiet = T) %>% mutate(across(where(is.character), ~iconv(., from = "BIG5", to = "UTF8"))) %>% st_set_crs(3826) %>% # st_transform(4326) %>% filter(str_detect(COUNTY, "臺北市")) st_crs(sf_tpe)$proj4string ## [1] "+proj=tmerc +lat_0=0 +lon_0=121 +k=0.9999 +x_0=250000 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" st_crs(sf_tpe) ## Coordinate Reference System: ## User input: EPSG:3826 ## wkt: ## PROJCRS["TWD97 / TM2 zone 121", ## BASEGEOGCRS["TWD97", ## DATUM["Taiwan Datum 1997", ## ELLIPSOID["GRS 1980",6378137,298.257222101, ## LENGTHUNIT["metre",1]]], ## PRIMEM["Greenwich",0, ## ANGLEUNIT["degree",0.0174532925199433]], ## ID["EPSG",3824]], ## CONVERSION["Taiwan 2-degree TM zone 121", ## METHOD["Transverse Mercator", ## ID["EPSG",9807]], ## PARAMETER["Latitude of natural origin",0, ## ANGLEUNIT["degree",0.0174532925199433], ## ID["EPSG",8801]], ## PARAMETER["Longitude of natural origin",121, ## ANGLEUNIT["degree",0.0174532925199433], ## ID["EPSG",8802]], ## PARAMETER["Scale factor at natural origin",0.9999, ## SCALEUNIT["unity",1], ## ID["EPSG",8805]], ## PARAMETER["False easting",250000, ## LENGTHUNIT["metre",1], ## ID["EPSG",8806]], ## PARAMETER["False northing",0, ## LENGTHUNIT["metre",1], ## ID["EPSG",8807]]], ## CS[Cartesian,2], ## AXIS["easting (X)",east, ## ORDER[1], ## LENGTHUNIT["metre",1]], ## AXIS["northing (Y)",north, ## ORDER[2], ## LENGTHUNIT["metre",1]], ## USAGE[ ## SCOPE["Engineering survey, topographic mapping."], ## AREA["Taiwan, Republic of China - between 120°E and 122°E, onshore and offshore - Taiwan Island."], ## BBOX[20.41,119.99,26.72,122.06]], ## ID["EPSG",3826]] sf_tpe %>% ggplot() + geom_sf() sf_tpe %>% ggplot() + aes(fill = P_CNT) + geom_sf(color = NA) + scale_fill_gradient(low = "white", high = "purple") 面積資料可以用st_area()這個函式求得。st_area() 是 R 中一個與地理空間數據相關的函數，用於計算地理多邊形的面積。具體而言，st_area() 函數接受一個 Spatial* 或是 sf 的資料物件，可以計算其包含的每個多邊形的面積，並以相應的單位返回結果。其中 as.double(st_area(.))/1000000 的作用是將地理多邊形的面積從平方公尺轉換為平方公里。因為面積的單位是平方公尺，而人口密度的常用單位是人口數/平方公里，因此需要進行單位換算，將面積轉換為平方公里。 st_area() 函數的計算方式基於多邊形的投影，因此在使用該函數時需要注意地理空間數據的投影選擇和轉換。通常情況下，st_area() 函數可以自動識別多邊形的投影系統，並返回相應的面積值。如果需要在不同的投影系統間進行面積的轉換，則需要使用 st_transform() 函數進行投影變換。 需要注意的是，由於地球是一個球體，因此在計算面積時需要考慮到地球的曲率效應。st_area() 函數默認使用的是橢球面積計算公式（ellipsoidal area formula），可以更準確地計算地理多邊形的面積。如果需要更精確的面積計算結果，也可以使用球面面積計算公式（spherical area formula）或是進行局部的面積校正。 sf_tpe %>% mutate(p_density = P_CNT/(as.double(st_area(.))/1000000)) %>% ggplot() + aes(fill = p_density) + geom_sf(color = NA) + scale_fill_gradient(low = "white", high = "purple") 29.3 Town-level: Taipei income 有時候我們所希望繪製的資料並非來自SEGIS這類有圖資的平台（例如下面所用的台北各區每人平均所得），那我們就會需要先取得另一份圖資資料（例如下例的鄉鎮市區界圖資），再透過一些索引（Index）來結合這兩方的資料。而下面這個例子，還為了要將鄉鎮市區名稱打在各區的中央，結合了另一份資料，一共結合了三方的資料。 29.3.1 Reading income data taipei_income <- readxl::read_xlsx('data/台北各區每人所得.xlsx') taipei_income %>% head() ## # A tibble: 6 × 2 ## district income ## <chr> <dbl> ## 1 松山區 1012678 ## 2 信義區 909336 ## 3 大安區 1038921 ## 4 中山區 861415 ## 5 中正區 1022438 ## 6 大同區 814439 29.3.2 Read Taipei zip code 等一下我打算把每區的名稱打在各區上，但是我沒有各區的名稱應該打在哪裡的經緯度，恰好Zip Code這份資料裡面有台北市各區的經緯度中心，因此先把它讀進來合併用。 library(jsonlite) twzipcode_json <- fromJSON("data/twzipcode.json")[[1]] taipei_zipcode <- twzipcode_json %>% filter(city == "台北市") taipei_zipcode %>% head() ## zip_code district city lat lng ## 1 100 中正區 台北市 25.0324 121.520 ## 2 103 大同區 台北市 25.0634 121.513 ## 3 104 中山區 台北市 25.0697 121.538 ## 4 105 松山區 台北市 25.0600 121.558 ## 5 106 大安區 台北市 25.0268 121.543 ## 6 108 萬華區 台北市 25.0286 121.498 # install.packages("rmapshaper") st_read("data/shapefiles/TOWN_MOI_1100415.shp") %>% filter(COUNTYNAME == "臺北市") %>% # st_transform(3825) %>% #3857 # rmapshaper::ms_simplify(keep=0.05) %>% left_join(taipei_income, by = c("TOWNNAME" = "district")) %>% left_join(taipei_zipcode, by= c("TOWNNAME" = "district")) %>% ggplot() + aes(fill = income) + geom_sf() + scale_fill_gradient2(low = "#FF8888", high = "#0000AA", midpoint = median(taipei_income$income)) + geom_text(aes(x = lng, y = lat, label = TOWNNAME), family = "Heiti TC Light", color = "black", size = 2.5) ## Reading layer `TOWN_MOI_1100415' from data source ## `/Users/jirlong/Library/CloudStorage/Dropbox/Programming/JOUR5014/data/shapefiles/TOWN_MOI_1100415.shp' ## using driver `ESRI Shapefile' ## Simple feature collection with 368 features and 7 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 114.3593 ymin: 10.37135 xmax: 124.5611 ymax: 26.38528 ## Geodetic CRS: TWD97 29.4 Voting map - County level 本練習將以2016年總統選舉為例，比較朱立倫、宋楚瑜、蔡英文在不同縣市的得票率，並繪製為地圖。該地圖比較有趣的是，因為台灣的地圖實際上是由很多點連成的，在這麼大的規模如果把全部的點全部繪製上去，會繪製非常久，而讀者也不盡然能夠看清楚這個差別，所以可以降低點的數量。 29.4.1 Loading county-level president voting rate president_vote <- readxl::read_xlsx('data/president.xlsx') %>% mutate(total = chu + tsai + song) %>% mutate(chu_ratio = chu / total, tsai_ratio = tsai / total, song_ratio = song / total, tsai_chu_ratio = tsai / chu) 29.4.2 sf to load county level shp https://fidanalytics.co.uk/blog/simplifying-polygons-r county_sf <- st_read("data/shapefiles/COUNTY_MOI_1090820.shp") ## Reading layer `COUNTY_MOI_1090820' from data source ## `/Users/jirlong/Library/CloudStorage/Dropbox/Programming/JOUR5014/data/shapefiles/COUNTY_MOI_1090820.shp' ## using driver `ESRI Shapefile' ## Simple feature collection with 22 features and 4 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 114.3593 ymin: 10.37135 xmax: 124.5611 ymax: 26.38528 ## Geodetic CRS: TWD97 # plot(county_sf) # Taking very long time 29.4.3 Simplfying map polygon county_ms_simp <- st_read("data/shapefiles/COUNTY_MOI_1090820.shp") %>% # rmapshaper::ms_simplify(county_sf, keep=0.001) st_simplify(dTolerance = 100) ## Reading layer `COUNTY_MOI_1090820' from data source ## `/Users/jirlong/Library/CloudStorage/Dropbox/Programming/JOUR5014/data/shapefiles/COUNTY_MOI_1090820.shp' ## using driver `ESRI Shapefile' ## Simple feature collection with 22 features and 4 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 114.3593 ymin: 10.37135 xmax: 124.5611 ymax: 26.38528 ## Geodetic CRS: TWD97 plot(county_ms_simp) # install.packages("rmapshaper") plot_chu <- st_read("data/shapefiles/COUNTY_MOI_1090820.shp") %>% # st_transform(3825) %>% #3857 st_simplify(dTolerance = 10) %>% # rmapshaper::ms_simplify(keep=0.01) %>% right_join(president_vote, by=c("COUNTYNAME"="county")) ## Reading layer `COUNTY_MOI_1090820' from data source ## `/Users/jirlong/Library/CloudStorage/Dropbox/Programming/JOUR5014/data/shapefiles/COUNTY_MOI_1090820.shp' ## using driver `ESRI Shapefile' ## Simple feature collection with 22 features and 4 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 114.3593 ymin: 10.37135 xmax: 124.5611 ymax: 26.38528 ## Geodetic CRS: TWD97 plot_chu %>% ggplot(aes(fill = chu_ratio)) + geom_sf(color="white", size=0.2) + scale_fill_gradient(low = "#FFFFFF", high = "#0000FF") 29.4.4 Practice. Drawing Taiwan county-scale map from SEGIS data 這個練習希望你從SEGIS下載一個縣市層級的資料，並測試以下函式的結果： 運用st_transform()和st_set_crs()等函式測試用3826或4326座標系有何不同？ 在用st_area()計算面積時會不會有何不同？ 在視覺化的時候可否看出來有何不同？請寫程式測試看看。 st_simplify()這個函式可以降低點的數量，但運用st_simplify(dTolerance = 100)，dTolerance的設定是如何影響點的數量？100所指的是什麼？公尺嗎？ 用st_bbox()可以得知上下界為何，請試用這個函式看看？ 如何運用st_crop()切出台灣本島（不包含澎湖、金門、馬祖）得地圖？ 29.5 Mapping data with grid library(sf) 29.5.1 Loading Taiwan map TW.island <- st_read("data/shapefiles/COUNTY_MOI_1090820.shp") %>% st_transform(3826) %>% mutate(id = row_number()) ## Reading layer `COUNTY_MOI_1090820' from data source ## `/Users/jirlong/Library/CloudStorage/Dropbox/Programming/JOUR5014/data/shapefiles/COUNTY_MOI_1090820.shp' ## using driver `ESRI Shapefile' ## Simple feature collection with 22 features and 4 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 114.3593 ymin: 10.37135 xmax: 124.5611 ymax: 26.38528 ## Geodetic CRS: TWD97 29.5.2 Building grid # Defining grid size grid.extent <- matrix(c(-50000, 2920000, # (Xmin, Ymax) 610000, 2920000, # (Xmax, Ymax) 610000, 2420000, # (Xmax, Ymin) -50000, 2420000, # (Xmin, Ymin) -50000, 2920000), # (Xmin, Ymax) byrow = TRUE, ncol = 2) %>% list() %>% # convert to list for st_polygon() st_polygon() %>% # generate polygon st_sfc(crs = 3826) # convert format and crs # plot(grid.extent) # Generating grid Grid.sys <- st_make_grid(grid.extent, n = c(132, 100), # Resolution of grids crs = 3826, # crs: TWD97 121 what = 'polygons') %>% # output format: polygon st_sf('geometry' = ., data.frame('ID' = 1:length(.))) # convert to sf with id # st_transform(3826) # assigning crs again ? plot(Grid.sys) Grid.TW <- Grid.sys[subset(TW.island),] plot(Grid.TW) 29.5.3 loading data president_vote <- readxl::read_xlsx('data/president.xlsx') %>% mutate(total = chu + tsai + song) %>% mutate(chu_ratio = chu / total, tsai_ratio = tsai / total, song_ratio = song / total, tsai_chu_ratio = tsai / chu) 29.5.4 Merging data tw_info <- TW.island %>% st_set_geometry(NULL) %>% left_join(president_vote, by=c("COUNTYNAME"="county")) # TW_info <- sf::st_intersects(Grid.TW, TW.island) # creat a data.frame of IDs in IBA for 1km grid grid_id <- sapply(st_intersects(Grid.TW, TW.island), function(z) if (length(z)==0) NA_integer_ else z[1]) Grid.TW <- Grid.TW %>% mutate(grid_id = grid_id) %>% left_join(tw_info, by=c("grid_id"="id")) Grid.TW %>% ggplot(aes(fill = tsai_ratio)) + geom_sf(lwd = 0.1, color="black") + scale_fill_continuous(high="#2EFF71", low="blue") + theme_void() "],["network-vis.html", "Chapter 30 NETWORK VIS 30.1 Generating networks 30.2 Retrieve Top3 Components 30.3 Motif visualization and analysis", " Chapter 30 NETWORK VIS 網絡視覺化其實已經有非常好的簡介和指南。但在此補充一些常用的網絡視覺化參數 library(igraph) 30.1 Generating networks 30.1.1 Random network g <- barabasi.game(500, directed = T) message("\\n(V, E, Reciprocity, nComponent)\\n", length(V(g)), "\\t", length(E(g)), "\\t", sprintf("%.3f\\t", reciprocity(g)), count_components(g, mode = "weak") ) l <- layout.fruchterman.reingold(g) # l <- layout_with_kk(g) # l <- layout_in_circle(g) par(mar = c(0,0,0,0) + 0.1) plot(g, layout = l, vertex.color = rgb(1, 1, 0, 0.2), # vertex.color = factor(V(g)$blocked), vertex.size = 3, # vertex.size = sqrt(V(g)$degree)*3, vertex.frame.color= rgb(0, 0, 0, 0.5), # vertex.label = V(g)$display, # vertex.label = str_sub(V(g)$name, 1, 10), vertex.label.cex = 0.6, vertex.label.color = rgb(0, 0, 0, 0.7), vertex.label.family = 'Heiti TC Light', edge.curved = 0.1, edge.arrow.size = 0.1, # edge.width = sqrt(E(g)$weight), # edge.color = E(g)$year, # edge.color = E(g)$weight, edge.color = "#4169E1", # edge.color = E(g)$color, # edge.label = E(g)$weight, # edge.label = E(g)$year, edge.label.cex = 0.4, edge.label.color = rgb(1, 0, 0) ) 30.1.2 Random network rg <- sample_gnm(length(V(g)), length(E(g)), directed=T) message("\\n(V, E, Reciprocity, nComponent)\\n", length(V(rg)), "\\t", length(E(rg)), "\\t", sprintf("%.3f\\t", reciprocity(rg)), count_components(rg, mode = "weak") ) l <- layout.fruchterman.reingold(rg) par(mar = c(0,0,0,0) + 0.1) plot(rg, layout = l, vertex.color = rgb(1, 1, 0, 0.2), vertex.size = 3, vertex.frame.color= rgb(0, 0, 0, 0.5), vertex.label.cex = 0.6, vertex.label.color = rgb(0, 0, 0, 0.7), vertex.label.family = 'Heiti TC Light', edge.curved = 0.1, edge.arrow.size = 0.1, edge.color = "#4169E1", edge.label.cex = 0.4, edge.label.color = rgb(1, 0, 0) ) 30.2 Retrieve Top3 Components components <- igraph::clusters(rg, mode="weak") biggest_cluster_id <- which.max(components$csize) # which.max(components$csize) # components$csize # biggest_cluster_id top3_break <- sort(unique(components$csize), decreasing = T)[3] biggest_cluster_id <- which(components$csize >= top3_break) vert_ids <- V(rg)[components$membership %in% biggest_cluster_id] rg <- igraph::induced_subgraph(rg, vert_ids) message("\\n(V, E, Reciprocity, nComponent)\\n", length(V(rg)), "\\t", length(E(rg)), "\\t", sprintf("%.3f", reciprocity(rg)) ) 30.2.1 Visualize again l <- layout.fruchterman.reingold(rg) par(mar = c(0,0,0,0) + 0.1) plot(rg, layout = l, vertex.color = rgb(1, 1, 0, 0.2), vertex.size = 3, vertex.frame.color= rgb(0, 0, 0, 0.5), vertex.label.cex = 0.6, vertex.label.color = rgb(0, 0, 0, 0.7), vertex.label.family = 'Heiti TC Light', edge.curved = 0.1, edge.arrow.size = 0.1, edge.color = "#4169E1", edge.label.cex = 0.4, edge.label.color = rgb(1, 0, 0) ) 30.3 Motif visualization and analysis 30.3.1 Motif type library(igraph) par(mfrow=c(4,4), mai= rep(0.2, 4)) for(i in 0:15){ g1 <- graph_from_isomorphism_class(3, i) plot(g1, vertex.color = "gold", vertex.size = 20, # vertex.size = (V(g)$nTweets)^(1/3)+1, vertex.frame.color= "black", vertex.label = NA, edge.color = "black", edge.arrow.size = 0.5) title(i, line=-3, adj=0.4 ,col.main="royalblue") } 30.3.2 Motif analysis 30.3.2.1 Generate network res <- motifs(g, 3) res ## [1] NA NA 4085 NA 419 0 0 0 0 0 0 0 0 0 0 ## [16] 0 writeLines(as.character(res), sep = "\\t") ## NA NA 4085 NA 419 0 0 0 0 0 0 0 0 0 0 0 30.3.3 Generate motives barabas_motif <- function(e){ g <- barabasi.game(e, directed = T) vec <- motifs(g, 3) %>% replace_na(0) for(i in 1:99){ g <- barabasi.game(e, directed = T) tmp <- motifs(g, 3) %>% replace_na(0) vec <- vec + tmp } vec <- vec / 100 writeLines(as.character(vec), sep = "\\t") } random_net_motif <- function(v, e){ g <- sample_gnm(v, e, directed=T) vec <- motifs(g, 3) %>% replace_na(0) for(i in 1:99){ g <- sample_gnm(v, e, directed=T) tmp <- motifs(g, 3) %>% replace_na(0) vec <- vec + tmp } vec <- vec / 100 writeLines(as.character(vec), sep = "\\t") } random_net_motif(length(V(g)), length(E(g))) ## 0 0 245.78 0 490.12 0.87 247.04 0.77 0 0.78 0 0.36 0.01 0 0 0 barabas_motif(length(E(g))) ## 0 0 2517.01 0 459.54 0 0 0 0 0 0 0 0 0 0 0 "],["interactivity.html", "Chapter 31 Interactivity 31.1 ggplotly 31.2 產製圖表動畫", " Chapter 31 Interactivity 31.1 ggplotly Scatter plots with ggplot2 (plotly.com) 31.1.1 LINE CHART Line plots with R (plotly.com) NW <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(Category, year, Net_Worth) %>% group_by(Category) %>% arrange(year) %>% ungroup() 如果希望滑鼠在移到折線上時就會有浮出的資訊（tips）顯示該資料點的屬性特徵，可以採用plotly()這個套件。這個套件原本就是做線上互動圖表的，但他開發了R client讓R的使用者可以很輕易地把ggplot2的結果轉為互動圖表。但這所謂的互動也僅限於滑鼠移過去所浮出的資訊罷了，不過已經能夠達到吸引部分讀者目光、提供訊息的效果。 而plotly的設計非常簡單，就是把ggplot的結果指給一個變數後，然後用ggplotly(NW.plot)將其轉為plotly即可。但要注意的是，並不是每一個圖都可以順利轉換。例如本節最後一個例子Treemap便無法成功轉換。 設定：原本plotly會帶一個操控列，可以在ggplotly()指令後加入config()便可將其隱藏。 NW.plot <- NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", x = "Year", y = "Net Worth") + th library(plotly) ggplotly(NW.plot) %>% config(displayModeBar = FALSE) 可以在aes()設定要帶入圖的變數時，新增一個text變數，手動設定要呈現的動態呈現方塊。但要注意的是，要多加入一個group=1才能夠作用（WHY？）。但前例浮出視窗的原始內容所顯示的是原本的變數名稱和值，往往不易觀察。比較好的方式是在下ggplot() + aes()指令時，在aes()中指定text來作為後續浮出視窗內容。指定方法如下。要注意的是，該浮出視窗的語法是HTML，所以如果要改寫浮出視窗內容，要用paste0()將變數和HTML的標籤給銜接起來。以下例子中的<b>代表粗體的意思，<br>則是換行符號。 NW.plot <- NW %>% ggplot() + aes(year, Net_Worth, color=Category, text = paste0("<b>年(X): </b>", year, "<br>", "<b>淨資產(Y): </b>", Net_Worth,"<br>", "<b>年齡組: </b>", Category), group=1) + geom_line() + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", x = "Year", y = "Net Worth") + th ggplotly(NW.plot, tooltip = "text") %>% config(displayModeBar = FALSE) 其他例子中使用ggplotly()都是直接照前面的方法套用即可。唯獨在Treemap中無法用這樣的方法來做互動的視覺化。想想這也正常，畢竟Treemap是用非ggplot的第三方套件（library(treemapify)）。 除此之外，可以把R Markdown中Code Cell的的設定加入include=FALSE，這樣可以讓RMD在編製為HTML檔時，不要顯示程式碼，而直接顯示互動的視覺化介面。 31.1.2 SCATTER bw <- read_csv("data/unicef-changing-childhood-data.csv") %>% select(country = WP5, age = WP22140, bw = WP22092) %>% mutate(country = ordered(country, levels=c(1, 3, 4, 10, 11, 12, 13, 14, 17, 29, 31, 33, 35, 36, 60, 61, 77, 79, 81, 87, 165), labels=c("USA", "Morocco", "Lebanon", "Indonesia","Bangladesh", "UK", "France", "Germany", "Spain", "Japan", "India", "Brazil", "Nigeria", "Kenya", "Ethiopia", "Mali", "Ukraine", "Cameroon", "Zimbabwe","Argentina", "Peru"))) %>% count(country, age, bw) %>% group_by(country, age) %>% mutate(perc = n/sum(n)) %>% ungroup() %>% filter(bw == 1) %>% select(country, age, perc) %>% spread(age, perc) %>% rename(`15-24y` = `1`, `40+y` = `2`) bw.p <- bw %>% ggplot() + aes(`40+y`, `15-24y`, label = country) + geom_point(color = "skyblue", size = 2) + xlim(0.2, 0.85) + ylim(0.2, 0.85) + geom_text(hjust = -0.1, vjust = -0.5) + geom_abline(intercept = 0, slop = 1, color="lightgrey", alpha=0.5, linetype="dashed") + th + theme(aspect.ratio=1) bw.p %>% ggplotly() 31.1.3 Barplot Bar charts with R (plotly.com) county <- read_csv("data/tw_population_opendata110N010.csv") %>% slice(-1, -(370:375)) %>% type_convert() %>% mutate(county = str_sub(site_id, 1, 3)) %>% group_by(county) %>% summarize( area = sum(area), people_total = sum(people_total) ) %>% ungroup() population.p <- county %>% mutate(county = reorder(county, people_total)) %>% ggplot() + aes(county, people_total) %>% geom_col(fill="skyblue") + coord_flip() + th population.p %>% ggplotly() 31.1.4 Boxplot Box plots with ggplot2 (plotly.com) aqi.toplot <- read_rds("https://github.com/p4css/R4CSS/raw/master/data/AQI_Chaozhou.rds") %>% arrange(日期)%>% filter(測項=="PM2.5") %>% gather("hour", "PM25", 4:28) %>% mutate(PM25 = as.numeric(PM25)) %>% drop_na() %>% mutate(year = lubridate::year(日期), month = lubridate::month(日期)) %>% filter(month %in% c(11, 12, 1, 2, 3)) aqi.plot <- aqi.toplot %>% mutate(year = as.character(year)) %>% ggplot() + aes(x=year, y=PM25) + geom_boxplot(fill="skyblue", alpha=0.2) + ylim(0, 200) + coord_flip() + theme_minimal() aqi.plot %>% ggplotly 31.1.5 Treemap (Global Carbon) 其他例子中使用ggplotly()都是直接照前面的方法套用即可。唯獨在Treemap中無法用這樣的方法來做互動的視覺化。想想這也正常，畢竟Treemap是用非ggplot的第三方套件（library(treemapify)）。 totreemap <- read_csv("data/GCB2021v34_MtCO2_flat.csv") %>% drop_na(`Total`) %>% filter(!Country %in% c("Global", "International Transport")) %>% filter(Year==2020) %>% arrange(desc(`Total`)) %>% mutate(perc = Total/sum(Total)) %>% slice(1:20) library(treemapify) carbon.p <- totreemap %>% ggplot() + aes(area = perc, fill=`Per Capita`, label=Country) + geom_treemap() + geom_treemap_text(color="white", place="centre", grow=TRUE ) # carbon.p %>% ggplotly 31.2 產製圖表動畫 https://gist.github.com/rafapereirabr/0d68f7ccfc3af1680c4c8353cf9ab345 R也有套工具可以產製圖表動畫，概念上就是沿著一條資料維度，把多張圖給疊在一起變成一個gif動畫。本例子即是把產假之薪的範例沿著時間軸做動畫。每個時間點都是當年各國產假支薪給付程度的地圖，但由於有19年的資料，所以可以把年代當成動畫的時間軸。 以下是清理資料的步驟，會彙整出國名、國家代碼（ISO3）、年、和給付等級四個變項。預期利用國名、國家代碼和給付等級就可以畫出每年的圖。然後將年作為動畫的時間軸，便可產生地圖動畫。 pml <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) %>% select(country, iso3, contains("matleave"), -contains("wrr")) %>% gather("year", "degree", 3:21) %>% replace_na(list(degree=0)) %>% mutate(year2=as.POSIXct(strptime(year, "matleave_%y"))) %>% mutate(year3 = strftime(year2, "%Y")) %>% select(country, ISO3=iso3, year=year3, degree) 31.2.1 地圖下載與轉換投影方法 此為下載地圖並處理地圖成為可以用geom_polygom()繪圖的多邊形資料點。 library(rworldmap) wmap <- getMap(resolution="low") wmap <- spTransform(wmap, CRS("+proj=robin")) # reproject wmap <- fortify(wmap) wmap %>% filter(!duplicated(id)) %>% head(10) ## long lat order hole piece id ## 1 -6558139.1 1331765.9 1 FALSE 1 Aruba ## 2 6607120.5 3981587.8 1 FALSE 1 Afghanistan ## 3 1357824.3 -630231.6 1 FALSE 1 Angola ## 4 -5863722.7 1948851.8 1 FALSE 1 Anguilla ## 5 1723246.7 4546403.9 1 FALSE 1 Albania ## 6 1506389.0 6371182.0 1 FALSE 1 Aland ## 7 146562.7 4541753.0 1 FALSE 1 Andorra ## 8 5174600.6 2734691.9 1 FALSE 1 United Arab Emirates ## 9 -6057672.4 -2363055.4 1 FALSE 1 Argentina ## 10 3911094.7 4398155.0 1 FALSE 1 Armenia ## group ## 1 Aruba.1 ## 2 Afghanistan.1 ## 3 Angola.1 ## 4 Anguilla.1 ## 5 Albania.1 ## 6 Aland.1 ## 7 Andorra.1 ## 8 United Arab Emirates.1 ## 9 Argentina.1 ## 10 Armenia.1 pml_map <- wmap %>% left_join(pml, by=c("id"="country")) %>% filter(!is.na(ISO3)) %>% mutate(year = as.integer(year)) # devtools::install_github("thomasp85/transformr") pml_map %>% select(id) %>% filter(!duplicated(.)) %>% head(10) ## id ## 1 Afghanistan ## 2 Angola ## 3 Albania ## 4 Andorra ## 5 United Arab Emirates ## 6 Argentina ## 7 Armenia ## 8 Antigua and Barbuda ## 9 Australia ## 10 Austria 31.2.2 靜態繪圖測試 pml_map %>% filter(year==1995) %>% ggplot() + aes(x = long, y = lat, group=group, fill=factor(degree)) + geom_polygon(color="grey") + theme_void() + scale_fill_manual(values=c("1"="red", "2"="LightCyan", "3"="lightskyblue", "4"="DodgerBlue", "5"="MediumBlue")) + coord_cartesian(xlim = c(-11807982, 14807978)) 在採用gganimate繪圖時，僅需要多加一個動畫繪圖函式+ transition_time(year)即可，其他繪圖部分並無修改。最後才用animate()函式把這整個繪圖指令轉製為動畫，包含指定fps（frame per second）和長寬等參數。 library(gganimate) pml.ani <- pml_map %>% ggplot() + aes(x = long, y = lat, group=group, fill=factor(degree)) + geom_polygon(color="grey") + theme_void() + scale_fill_manual(values=c("1"="red", "2"="LightCyan", "3"="lightskyblue", "4"="DodgerBlue", "5"="MediumBlue")) + coord_cartesian(xlim = c(-11807982, 14807978)) + transition_time(year) # + # ease_aes("linear") + # enter_fade() + # exit_fade() animate(pml.ani, fps = 10, end_pause = 30, width = 750, height = 450, renderer = gifski_renderer()) anim_save("jour5014/pml2.gif", animation = last_animation()) knitr::include_graphics("jour5014/pml2.gif") "],["wgoitg.html", "Chapter 32 WGOITG of NyTimes", " Chapter 32 WGOITG of NyTimes 紐約時報提供的what’s going on in the graph 系列教學旨在幫助讀者更好地理解和解讀圖表，特別是在時事和政治等敏感領域中的圖表。這些教學以實際的新聞圖表為例，介紹了如何分析和評估圖表的質量、有效性和可靠性，並提供了一些技巧和策略，幫助讀者從圖表中獲取準確和全面的資訊。 具體來說，what’s going on in the graph系列教學的目的包括以下幾點： 提高讀者對圖表的識讀能力和分析能力，讓讀者能夠更加自信和準確地理解和評估圖表。 幫助讀者識別和處理常見的資訊偏差和誤導，如選擇性展示數據、扭曲比例、誤導標籤等。 強調圖表應該為讀者服務，而不是為了強調某個立場或觀點而有意歪曲事實。 提供了一些有效的技巧和策略，如注意圖表的標題、軸標籤和單位、比較數據的趨勢和範圍、理解圖表的背景和上下文等。 "],["inequality-net-worth-by-age-group.html", "Chapter 33 Inequality: Net Worth by Age Group", " Chapter 33 Inequality: Net Worth by Age Group LEARNING NOTES 座標軸從數值到增加值 這個教學案例來自紐約時報的「What’s going on in this gragh」系列資料視覺化教學之Teach About Inequality With These 28 New York Times Graphs - The New York Times (nytimes.com) 。該圖表呈現在不同年代、不同年齡層的人所擁有的淨資產（包含土地、存款、投資等減去債務）。該圖表的結果指出，在不同年代的老年人是越來越有錢，但年輕人卻越來越窮（該曲線為減去1989年 淨資產（Net worth）是一個財務術語，指的是一個人或機構的總資產減去總負債後剩餘的價值。換言之，Net worth是一個人或機構在財務上的價值或實力。如果一個人或機構的總資產超過了總負債，那麼其net worth為正值，反之則為負值。在個人財務上，Net worth通常用來評估一個人的財務健康狀況。一個人的Net worth越高，通常代表其擁有更多的財富和投資，並能夠更好地應對突發事件和生活變數。因此，許多投資者和財務顧問都會建議人們注重提高自己的net worth。 Sorted by arrange() function. p1 <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(year, Category, Net_Worth) %>% group_by(Category) %>% arrange(year) %>% ungroup() p1 %>% filter(year <= 1992) %>% knitr::kable() year Category Net_Worth 1989 Less than 35 16.17019 1989 35-44 112.47530 1989 45-54 195.11630 1989 55-64 195.25554 1989 65-74 154.34277 1989 75 or older 144.29855 1992 Less than 35 16.60780 1992 35-44 79.91050 1992 45-54 139.97745 1992 55-64 203.44104 1992 65-74 176.44667 1992 75 or older 155.35173 library(gghighlight) p1 %>% ggplot() + aes(year, Net_Worth, color = Category) + geom_line(linetype="dotted") + geom_point() + gghighlight(Category %in% c("65-74", "35-44")) + theme_minimal() + scale_x_continuous(breaks = NULL) + theme(panel.background = element_rect(fill = "white", colour = "white", size = 0.5, linetype = "solid")) p2 <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(year, Category, NW = Net_Worth) %>% group_by(Category) %>% arrange(year) %>% mutate(increase = (NW-first(NW))/first(NW)) %>% ungroup() p2 %>% filter(year <= 1992) %>% knitr::kable() year Category NW increase 1989 Less than 35 16.17019 0.0000000 1989 35-44 112.47530 0.0000000 1989 45-54 195.11630 0.0000000 1989 55-64 195.25554 0.0000000 1989 65-74 154.34277 0.0000000 1989 75 or older 144.29855 0.0000000 1992 Less than 35 16.60780 0.0270627 1992 35-44 79.91050 -0.2895285 1992 45-54 139.97745 -0.2825948 1992 55-64 203.44104 0.0419220 1992 65-74 176.44667 0.1432131 1992 75 or older 155.35173 0.0765994 p2 %>% ggplot() + aes(year, increase, color = Category) + geom_line(linetype="dotted") + geom_point() + gghighlight(Category %in% c("65-74", "35-44")) + theme_minimal() + scale_y_continuous(labels=scales::parse_format()) + scale_x_continuous(breaks = NULL) + theme(panel.background = element_rect(fill = "white", colour = "white", size = 0.5, linetype = "solid")) "],["optimism-survey-by-countries.html", "Chapter 34 Optimism Survey by Countries", " Chapter 34 Optimism Survey by Countries 這個練習為紐約時報的一則報導「Where Are Young People Most Optimistic? In Poorer Nations. - The New York Times (nytimes.com)」。該報導乃根據一項涵蓋 21 個國家的大型調查，這項調查比較了不同國家和年齡層（年輕人對成年人）對於下一代的生活是否會比現在更好的看法。該調查還比較了不同國家（富裕與貧窮）和年齡層（年輕人對成年人）對於當今兒童在基本方面的狀況，以及對於社會和環境問題的看法。此外，調查還比較了不同國家和年齡層對於現代科技對年輕人生活的影響看法，以及對於焦慮和壓力等方面的看法。 聯合國兒童基金會與 Gallup 共同進行了這項調查，該調查共有 21,000 名受訪者，分為兩個年齡組別——15 至 24 歲和 40 歲以上，並包括來自世界各地的代表性樣本。年輕組表示，當今兒童在教育、醫療保健和身體安全等基本方面都比他們的父母更好。在中位數國家中，有 57％ 的年輕人表示，隨著每一代的到來，世界正在變得越來越美好，而這一比例在老年人中僅有 39％。然而，在富裕國家，56％ 的年輕人和 64％ 的老年人表示，當今兒童在經濟方面將比他們的父母更加困難——這種觀點與近年來許多人的經濟現實相符。 視覺化的重點是等比例之座標軸的運用 plot.opt <- read_csv("data/unicef-changing-childhood-data.csv") %>% select(country = WP5, age = WP22140, bw = WP22092) %>% mutate(country = ordered(country, levels=c(1, 3, 4, 10, 11, 12, 13, 14, 17, 29, 31, 33, 35, 36, 60, 61, 77, 79, 81, 87, 165), labels=c("USA", "Morocco", "Lebanon", "Indonesia", "Bangladesh", "UK", "France", "Germany", "Spain", "Japan", "India", "Brazil", "Nigeria", "Kenya", "Ethiopia", "Mali", "Ukraine", "Cameroon", "Zimbabwe", "Argentina", "Peru"))) %>% count(country, age, bw) %>% group_by(country, age) %>% mutate(perc = n/sum(n)) %>% ungroup() %>% filter(bw == 1) %>% select(country, age, perc) %>% spread(age, perc) %>% rename(`15-24y` = `1`, `40+y` = `2`) plot.opt %>% head(10) %>% knitr::kable() country 15-24y 40+y USA 0.6679842 0.4611465 Morocco 0.4365079 0.4735812 Lebanon 0.5467197 0.4435798 Indonesia 0.7920605 0.8027344 Bangladesh 0.4624506 0.4319527 UK 0.5040000 0.4140000 France 0.3900000 0.2640000 Germany 0.5900000 0.3860000 Spain 0.5160000 0.3340000 Japan 0.6367265 0.2586873 plot.opt %>% ggplot() + aes(`40+y`, `15-24y`, label = country) + geom_point(color = "skyblue", size = 2) + xlim(0, 1) + ylim(0,1) + geom_text(hjust = -0.1, vjust = -0.5) + geom_abline(intercept = 0, slop = 1, color="lightgrey", alpha=0.5, linetype="dashed") + theme_minimal() + theme(aspect.ratio=1) "],["taiwan.html", "Chapter 35 Case Studies (Taiwan) 35.1 TW AQI Visual Studies", " Chapter 35 Case Studies (Taiwan) 35.1 TW AQI Visual Studies library(tidyverse) ## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ── ## ✔ dplyr 1.1.4 ✔ readr 2.1.5 ## ✔ forcats 1.0.0 ✔ stringr 1.5.1 ## ✔ ggplot2 3.5.0 ✔ tibble 3.2.1 ## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1 ## ✔ purrr 1.0.2 ## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ── ## ✖ dplyr::filter() masks stats::filter() ## ✖ dplyr::lag() masks stats::lag() ## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors library(readxl) # options(stringsAsFactors = F) 35.1.1 eda-load-data-from-github # aqi_data <- read_rds("https://github.com/p4css/R4CSS/raw/master/data/AQI_Chaozhou.rds") aqi_data <- read_rds("data/AQI_Chaozhou.rds") 35.1.2 Trending: Central tendency toplot <- aqi_data %>% arrange(日期)%>% filter(測項=="PM2.5") %>% gather("hour", "PM25", 4:28) %>% mutate(PM25 = as.numeric(PM25)) %>% drop_na() %>% group_by(日期) %>% summarize(avg = mean(PM25)) %>% ungroup() %>% mutate(year = lubridate::year(日期), month = lubridate::month(日期)) %>% group_by(year, month) %>% summarize(avg = mean(avg)) %>% ungroup() ## Warning: There was 1 warning in `mutate()`. ## ℹ In argument: `PM25 = as.numeric(PM25)`. ## Caused by warning: ## ! NAs introduced by coercion ## `summarise()` has grouped output by 'year'. You can override using the ## `.groups` argument. Counting data by month and plotting to ensure the degree of data loss. aqi_data %>% filter(測項=="PM2.5") %>% arrange(日期)%>% gather("hour", "PM25", 4:28) %>% mutate(PM25 = as.numeric(PM25)) %>% drop_na() %>% group_by(日期) %>% summarize(avg = mean(PM25)) %>% ungroup() %>% arrange(日期) %>% mutate(year = lubridate::year(日期), month = lubridate::month(日期)) %>% count(year, month) %>% mutate(rn = row_number()) %>% ggplot() + aes(rn, n) + geom_line() + theme_minimal() ## Warning: There was 1 warning in `mutate()`. ## ℹ In argument: `PM25 = as.numeric(PM25)`. ## Caused by warning: ## ! NAs introduced by coercion 科普小學堂-空氣中的懸浮粒子 台灣PM2.5三大面向：空汙現況多嚴重？要怪中國還是怪自己？ - 第 1 頁 - The News Lens 關鍵評論網 library(gghighlight) toplot %>% mutate(month = as.character(month)) %>% group_by(month) %>% arrange(year) %>% # mutate(diff = avg -first(avg), # month = as.character(month)) %>% # ungroup() %>% ggplot() + aes(year, avg, color = month) + geom_line() + # geom_point() + gghighlight(month %in% c("11", "12", "1", "2", "3")) + theme_minimal() ## Warning: Tried to calculate with group_by(), but the calculation failed. ## Falling back to ungrouped filter operation... ## label_key: month 35.1.3 Trending: Extreme value toplot2 <- aqi_data %>% arrange(日期)%>% filter(測項=="PM2.5") %>% gather("hour", "PM25", 4:28) %>% mutate(PM25 = as.numeric(PM25)) %>% drop_na() %>% group_by(日期) %>% summarize(avg = sum(PM25)/24) %>% ungroup() %>% mutate(year = lubridate::year(日期), month = lubridate::month(日期)) %>% group_by(year, month) %>% summarize(purple = sum(avg>150), red = sum(avg>54), orange = sum(avg>35)) %>% ungroup() ## Warning: There was 1 warning in `mutate()`. ## ℹ In argument: `PM25 = as.numeric(PM25)`. ## Caused by warning: ## ! NAs introduced by coercion ## `summarise()` has grouped output by 'year'. You can override using the ## `.groups` argument. toplot2 %>% mutate(month = as.character(month)) %>% group_by(month) %>% arrange(year) %>% ggplot() + aes(year, orange, color = month) + geom_line() + # geom_point() + gghighlight(month %in% c("11", "12", "1", "2", "3")) + ylab("Days (PM25 > 35) in one month") + theme_minimal() ## Warning: Tried to calculate with group_by(), but the calculation failed. ## Falling back to ungrouped filter operation... ## label_key: month toplot3 <- aqi_data %>% arrange(日期)%>% filter(測項=="PM2.5") %>% gather("hour", "PM25", 4:28) %>% mutate(PM25 = as.numeric(PM25)) %>% drop_na() %>% mutate(year = lubridate::year(日期), month = lubridate::month(日期)) %>% filter(month %in% c(11, 12, 1, 2, 3)) ## Warning: There was 1 warning in `mutate()`. ## ℹ In argument: `PM25 = as.numeric(PM25)`. ## Caused by warning: ## ! NAs introduced by coercion toplot3 %>% mutate(year = as.character(year)) %>% ggplot() + aes(y=year, x=PM25) + geom_boxplot(fill="skyblue", alpha=0.2) + xlim(0, 200) + theme_minimal() "],["appendix.html", "Chapter 36 Appendix 36.1 Dataset", " Chapter 36 Appendix 36.1 Dataset 111B歲出政事別預算表.xls - 111B歲出政事別預算總表.xls 臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv opendata107Y020.csv opendata110Y060.csv tptheft.csv tw_income_107.csv tw_population_opendata110N010.csv tw_salary109.xlsx villmast_excel.xls WORLD-MACHE_Gender_6.8.15.xls "],["404.html", "Page not found", " Page not found The page you requested cannot be found (perhaps it was moved or renamed). You may want to try searching to find the page's new location, or use the table of contents to find the page you are looking for. "]] +[["index.html", "R for Data Journalism About", " R for Data Journalism HSIEH, JI-LUNG 2024-03-24 About 這本書是寫給臺大新聞所「新聞資料分析與視覺化」課程使用。該課程並重三個面向的訓練：程式語言、視覺化、資料新聞。學生必須先能夠熟練地使用R語言來操作、讀取、清理、視覺化資料；然後以產製新聞為課程目標，了解資料要如何清理，以及選擇適合的視覺化的方法來強化新聞敘事，並避免視覺化方式引起讀者對新聞的理解謬誤。準此，本書分為幾個部分，包含PART I介紹程式語言基礎；PART II則以國際或國內新聞為個案，來介紹資料獲取（爬蟲）、清理、合併、篩選、轉換；PART III則著重如何用資料視覺化來強化敘事。 本書所沿用的資料分析與視覺化案例均為國內、國外的新聞案例如各國產假支薪等級、居住正義、空氣污染、人口議題、COVID-19、資源區域分佈不均、選舉與公投、運輸交通等相關議題的新聞。並大量採用紐約時報挑選作為數據理解與視覺化推廣的「What’s going on in this graph?」系列新聞，包含美國不同年代各年齡層的淨資產來做視覺化案例。在視覺化教材的設計上，本書大量參考紐時「What’s going on in this graph?」的分類與(Wilke 2019)所著「Fundamentals of Data Visualization」一書的內容安排，強調利用資料視覺化方法來呈現新聞數據中的數量、分佈、比例、趨勢等，並均換用國內或紐時的相關資料新聞案例做範例，以利中文讀者的理解。 學習路徑 References "],["introduction.html", "Chapter 1 Introduction 1.1 Preloaded tool kits 1.2 Dataset used in the book 1.3 Cases in the book", " Chapter 1 Introduction 本書從基本的 base R 語法開始學習，因為 R 語言最初是為統計學研究而開發的。因此，許多統計套件和基礎操作都是使用 base R 語法編寫的，這些知識對於瞭解 R 的核心功能和基本操作是非常重要的，並能夠建立起對於數據分析和統計建模的基礎知識。不過，現在 tidyverse 風格的編寫方式越來越流行，這種方式使得程式碼撰寫效率更高且可讀性更強，對於數據科學家而言是非常有用的。因此，本書會接續使用 tidyverse 中的主要函式庫和函數，例如 dplyr、ggplot2 和 tidyr，以便讀者能夠掌握這些工具，並能夠有效地應用於實際數據分析項目中。 1.1 Preloaded tool kits 當 R 的程式開始執行時，會預載入一些基本的套件，包括 stats、graphics、grDevices、utils 和 datasets。這些套件為 R 提供了基本的數據處理、統計分析、圖形顯示和檔案處理等功能。以下是這些套件的重要函式： stats：這個套件包含了許多統計分析相關的函式，例如假設檢定、方差分析、線性迴歸和時間序列分析等。其中，比較常用的函式有 t.test()、lm()、glm()、anova()、cor() 等。 graphics：這個套件提供了用於繪製各種圖形的函式，例如散佈圖、直方圖、盒鬚圖、線圖、散點矩陣等。其中，常用的函式有 plot()、hist()、boxplot()、lines()、points() 等。 grDevices：這個套件包含了用於輸出圖形的函式，例如 pdf()、png()、jpeg() 和 tiff() 等。 utils：這個套件包含了一些實用的函式，例如 install.packages()、help()、data() 等。 datasets：這個套件包含了一些內建的數據集，可以用來進行測試和練習，例如 iris、mtcars、CO2 等。可以使用 data() 函式載入這些數據集。 1.2 Dataset used in the book 本書所採用的資料可以從台大新聞所「新聞資料分析與視覺呈現」的github repository下載。R4CSS/data。 1.3 Cases in the book WP: Paid maternity leave Taipei Residential Hot spot: Contingency table, categorical data Trump’s tweets: Line plot, Bar chart, timeline, and text processing NYT: Net worth: Line plot NYT: Carbon Proportion: Treemap NYT: Optimism by countries NYT: Population growth Annual Budget of TW government: NA Processing, Treemap Vaccinating proportion by country x year: Proportion NYT: LeBron James’s Achievement "],["basic.html", "Chapter 2 R Basic 2.1 Using RStudio 2.2 First Attempt 2.3 R Q&A", " Chapter 2 R Basic 本章介紹如何使用 RStudio 編寫和執行 R 程式語言、R語言的基本語法、以及Vector和data.frame資料型態。 2.1 Using RStudio 2.1.1 RStudio Interface RStudio的介面主要分為四大區塊： 左上的區塊是「Source」（可切換至「Visual」）是撰寫程式碼與R Markdown的區塊； 左下角「Console」的區塊，每行程式碼的執行和執行結果都會出現在此，也可觀察程式執行結果； 右上角區塊最常用的是「Environment」這個分頁，程式碼執行過程產生的變數／變項都會出現在這裡。 右下角區塊我最常用的是「Files」這個分頁，顯示的是我自己電腦本機端的檔案目錄。右下角區塊也常常用到「Packages」，可查閱現在的程式執行環境有載入哪些套件；當用help(some_function)查詢某個套件或某個函式的功能是，就會自動跳到「Help」分頁。 2.1.2 Writing R Markdown R Markdown這種格式讓程式寫作者可以將程式碼和非程式碼的內容寫在同一份文件中。例如我想要寫作一本關於程式的書，裡面有很多的程式碼，但也要有很多說明、章節與段落。此時，這些非程式碼的區塊通常被稱為「內容區塊（Text Cell）」，而程式碼的區塊就稱為「Code Cell」。尤其是資料分析師或資料科學家很愛用這種格式，因為經常要為程式的執行結果寫很多說明，甚至利用標題一、標題二來區分章節。 內容區塊使用Markdown格式撰寫，顧名思義，支援用Markdown這種標記語法來快速撰寫如標題一、標題二、點列、編號等格式化文字。詳細指令可以參考rmarkdown-cheatsheet (rstudio.com)。這種格式的靈活性和強大功能，使得 R Markdown 成為撰寫技術文檔和學術報告的理想選擇，能夠有效地將敘述性文本與程式碼結果結合，提升文檔的互動性和表達力。 程式碼區塊可以用下列鍵盤指令來新增和執行。 Cmd(Ctrl)+Option(Alt)+i 新增一個程式碼區塊 Cmd+Enter (Ctrl+Enter in Window) 執行程式碼區塊中游標所在的那一行指令。 Cmd(Ctrl)+Shift+Enter 執行游標所在的整個程式碼區塊 其他常用鍵盤指令 - 註解：用滑鼠或鍵盤圈選某幾行程式碼後，可用Cmd(Ctrl)+Shift+c來將這幾行標記為註解或將其去除註解標記。 Practice. 用鍵盤快速鍵新增一個程式碼區塊、輸入以下程式碼並嘗試用鍵盤快速鍵執行。 a <- c(1, 2, 3, 4, 5) b <- 4 a*b 2.1.3 Installing third-party packages 套件的使用分為安裝(install.packages(\"pkg_name\"))和載入（library(pkg_name)）兩個動作。通常安裝好R的時候就已經安裝好基本base套件。當執行R時便會將base套件預載入程式的執行環境中。 熱心的R使用者會編寫第三方套件，並且將這些套件開放給群眾使用。通常這些套件已經被上載到R cran提供下載。而R cran上的套件我們可以使用install.packages(\"package_name\")來自動安裝到我們的電腦中。 Practice 1. 執行以下程式碼 install.packages("tidyverse") install.packages("jsonlite") install.packages("httr") 2.1.3.1 Loading package 在安裝這些第三方套件之後，需要將它們載入到程式的運行環境中，然後才能使用。因此，需要使用 library(package_name) 命令來載入它們。 library(tidyverse) library(jsonlite) library(httr) 2.1.4 Code “Comment” 下列程式碼中開頭有#符號者為註解，程式設計師用這種註解來為程式碼做說明，便於自己日後閱讀或與他人溝通。程式在執行時會自動忽略前面有#符號的程式碼。如果要執行以下程式碼，要把前面的#記號給拿掉。在RStudio中你可以用滑鼠或鍵盤圈選下三行，然後用快速鍵command(ctrl)+shift+c就可以開關（Comment/Un-comment)這幾行程式碼。 # a <- c(1, 2, 3, 4, 5) # b <- 4 # a*b 2.2 First Attempt 2.2.1 Loading Open Data from the MOI MOS（Ministry of the Interior）: 中華民國行政院內政部 library(httr) library(jsonlite) url <- "https://www.ris.gov.tw/rs-opendata/api/v1/datastore/ODRP024/107?page=1" first_page <- fromJSON(content(GET(url), "text")) # head(first_page$responseData) head(first_page$responseData) %>% rename(戶長=headhousehold_count) ## statistic_yyy district_code site_id village edu sex 戶長 ## 1 107 65000010001 新北市板橋區 留侯里 博畢 男 3 ## 2 107 65000010001 新北市板橋區 留侯里 碩畢 男 26 ## 3 107 65000010001 新北市板橋區 留侯里 大畢 男 71 ## 4 107 65000010001 新北市板橋區 留侯里 專畢 男 52 ## 5 107 65000010001 新北市板橋區 留侯里 高中畢 男 122 ## 6 107 65000010001 新北市板橋區 留侯里 國中畢 男 40 2.2.2 Obtaining Taipei Youbike (v2) Realtime Data 觀察臺北市資料大平臺 (data.taipei)上關於Youbike的資料，你認為哪些資料是具有資料新聞價值的？ YouBike區域互補站點 YouBike站位每月熱門站點 YouBike場站建置成本 YouBike臺北市權利金與補助支出 YouBike臺北市站位每月使用量 YouBike起訖站點統計 YouBike見車率統計 YouBike潛在需求預測 YouBike2.0臺北市公共自行車即時資訊 url <- "https://tcgbusfs.blob.core.windows.net/dotapp/youbike/v2/youbike_immediate.json" ubike.df <- fromJSON(content(GET(url),"text", encoding = "utf-8")) head(ubike.df) %>% select(1:6) ## sno sna tot sbi sarea mday ## 1 500101001 YouBike2.0_捷運科技大樓站 28 9 大安區 2024-02-25 20:06:18 ## 2 500101002 YouBike2.0_復興南路二段273號前 21 7 大安區 2024-02-25 19:49:18 ## 3 500101003 YouBike2.0_國北教大實小東側門 16 10 大安區 2024-02-25 20:06:18 ## 4 500101004 YouBike2.0_和平公園東側 11 9 大安區 2024-02-25 20:06:18 ## 5 500101005 YouBike2.0_辛亥復興路口西北側 16 11 大安區 2024-02-25 20:02:04 ## 6 500101006 YouBike2.0_復興南路二段280號前 11 10 大安區 2024-02-25 20:06:14 2.2.3 Reading Taipei Residential Burglary Data 該資料網址可到臺北市資料大平臺 (data.taipei)上查詢「住宅竊盜點位資訊」後，點選「API」後複製取得。 url <- "https://data.taipei/api/v1/dataset/93d9bc2d-af08-4db7-a56b-9f0a49226fa3?scope=resourceAquire" res <- read_json(url, simplifyVector = T) df <- res$result$results head(df) dplyr::glimpse(df) 2.3 R Q&A 2.3.1 Encoding and Language Sys.setlocale(category = "LC_ALL", locale = "UTF-8") Sys.setlocale(category = "LC_ALL", locale = "cht") 如果讀取到資料有中文的話，此時，你只需要指定locale為cht，然後重開該data.frame就可以解決該問題。 Sys.setlocale(category = "LC_ALL", locale = "cht") 但你在寫程式剖析HTML時若使用了rvest這個套件，有可能在html_node()函式時會因為編碼而產生問題，此時你會需要把locale改為C。這個C指的是C語言的C。 Sys.setlocale(category = "LC_ALL", locale = "C") 參考連結：http://psmethods.postach.io/post/ru-he-geng-gai-rde-yu-she-yu-xi 參考連結：https://stat.ethz.ch/R-manual/R-devel/library/base/html/locales.html The locale describes aspects of the internationalization of a program. Initially most aspects of the locale of R are set to “C” (which is the default for the C language and reflects North-American usage) 2.3.2 RMD/R Notebook無法儲存 R Notebook 要存檔的時候檔名絕對不要有空白，若有空白就用底線_代替，否則Notebook寫到一半會無法預覽下半部的程式並出現錯誤訊息。若仍然無法儲存或出現錯誤訊息，應該只要開另外一個R Notebook檔案，複製程式碼即可。 "],["r-basic.html", "Chapter 3 R Basic 3.1 R Syntax 3.2 Vector 3.3 Calculating with vectors 3.4 Data types 3.5 Character operations", " Chapter 3 R Basic R base是R語言的基本程式庫和核心功能，提供了許多常用的指令和函數。以下是一些常見的R base指令： assignment operators（賦值運算符）：<- 或 = 用來將數值、向量、函數等資料物件賦值給變數。 arithmetic operators（算術運算符）：+、-、*、/、^、%/%和%%用於數值運算，如加、減、乘、除、指數、整除和取餘等。 relational operators（關係運算符）：==、!=、>、>=、<和<=用於比較數值或字符型資料的大小關係，返回邏輯值（TRUE或FALSE）。 logical operators（邏輯運算符）：&、|和!用於對邏輯值進行運算，如AND、OR和NOT等。 control flow statements（流程控制語句）：if、else、for、while、repeat、break和next用於控制程式的執行流程。 functions（函數）：R base提供了許多內置函數，如sum、mean、var、sd、cor、lm等，用於數值計算、統計分析、線性回歸等常見操作。 data structures（資料結構）：R base提供了多種資料結構，如向量、矩陣、數組、列表、因子等，用於存儲和處理不同類型的資料。 data input/output（資料輸入輸出）：R base提供了多種函數和工具，如read.table、write.table、read.csv、write.csv等，用於讀取和寫入資料。 3.1 R Syntax R可以做很複雜的加減乘除，例如直接在程式碼中打上(1+3)*2.01，總之，看你算式怎麼寫，他就會算出相對應的數值。但其實我們通常使用R語言是要餵給他資料，然後讓他來做運算。此時，要有一個容器來容納這些數值或資料，這個容器就是變數（Variable）。 3.1.1 Assignment <- 將右邊的算式或數值指（Assign）給左邊的變數。左側都是變數，右側則可能是數字或變數。你可以把他想像為把右側做完了以後，指（Assign）給左側的變數。 Assignment對變數型態（Variable Type）的影響：<-右側如果是numeric，那左側的變數就是numeric變數；右側如果是character，左側的變數就是character變數。 在幾乎所有程式語言中，單等號=指的是assignment，把右方的算式、值或物件指給左方的變數。而比較兩者相不相等，則用雙等號==，例如1==3-2。R當初在設計時可能是為了避免混淆，所以把assignment的符號設計為<-。 a <- 1 b <- c(1, 2, 3, 4) c <- c("1", "2", "3", "4") d <- c(b, a) e <- "abcd" 3.1.2 Comments 註解 註解：在程式碼區塊若前面有#字號後面跟著空白的話，那代表那行被標示為註解，程式執行時會自動跳過註解不執行。 快速鍵：當游標在某一行程式碼時打cmd(ctrl)-shift-c，就可以產生註解。 # df <- data.frame(a = c(1, 2, 3), b = c(3, 4, 5)) 3.2 Vector 但我如果要為所有我要運算的數字都產生一個與之對應的變數，這樣做不完。所以，我們會很常使用其他種序列或者對應的結構來儲存多筆資料。例如vector、list或Data.Frame。 在R語言中，vector是一種基本的資料類型，它是由相同類型的元素組成的序列，可以存儲數值、文字、邏輯值等不同類型的資料。例如，以下是一個由整數元素組成的vector：my_vector <- c(1, 2, 3, 4, 5)。而我如果要存取第一個數字，我便可用my_vector[1]的方式存取，分別代表my_vector中第一個位置的內容（第二個、第三個依此類推）。 在程式碼中，只要是文字必用成對的雙引號或單引號包含其中，以區隔「變數」和「數字」。例如如果看到沒有雙引號的「英文字母」必定是變數名稱，或函式名稱。如果看到有雙引號的數字，那也是文字。 以下資料來自各縣市平均每月薪資所得或各縣市人口數。 3.2.1 Creating vectors vector通常用c()函數創建，其中c表示”combine”或”concatenate”，可以將多個元素組合成一個vector。 income <- c(70100, 51300, 51100, 48400, 47600, 43000) county <- c("台北", "新北", "桃園", "高雄", "台中", "台南") population <- c(2.6, 3.9, 2.2, 2.7, 2.8, 1.8) area <- c(271.8, 2052.5, 1221, 2951.9, 2214.9, 2191.7) income ## [1] 70100 51300 51100 48400 47600 43000 county[c(5, 3, 1)] ## [1] "台中" "桃園" "台北" county <- county[c(5, 3, 1)] county ## [1] "台中" "桃園" "台北" area ## [1] 271.8 2052.5 1221.0 2951.9 2214.9 2191.7 population ## [1] 2.6 3.9 2.2 2.7 2.8 1.8 3.2.1.1 Creating a sequence a <- seq(11, 99, 11) a ## [1] 11 22 33 44 55 66 77 88 99 b <- 11:20 b ## [1] 11 12 13 14 15 16 17 18 19 20 3.2.1.2 Creating sequences by distribution x <- runif(10000000, 1, 10) # uniform dist, n=1000 plot(density(x)) x <- rnorm(1000, 1, 10) # uniform dist, n=1000 plot(density(x)) x <- rnorm(10000000, 1, 10) # normal dist, n=1000 plot(density(x)) 3.2.2 Creating a fake data with ChatGPT 你可以嘗試這麼問ChatGPT以獲得一些測試資料「可否幫我建立一個R語言的測試資料，為台北11個行政區的區名、人口數、地理面積。分別用vector來儲存，最後再把三個vector合併為一個dataframe」，觀察看看會有什麼樣的結果。 3.2.3 Viewing county ## [1] "台中" "桃園" "台北" income ## [1] 70100 51300 51100 48400 47600 43000 head(county) ## [1] "台中" "桃園" "台北" tail(county) ## [1] "台中" "桃園" "台北" length(county) ## [1] 3 mode(county) ## [1] "character" class(county) ## [1] "character" # View(county) length(county) ## [1] 3 length(income) ## [1] 6 3.2.4 Subsetting, filtering vector可以用中括號[]搭配數字來取用vector中的元素，下標從1開始。例如，要取用上述的vector中的第三個元素，可以使用my_vector[3]。 It is important to know how to neglect first n or last n elements. For example, a[1:(length(a)-2)] will neglect the last two elements. Thinking why I need parentheses for length(a)-2 here. county ## [1] "台中" "桃園" "台北" county[c(5, 3, 1)] # how about country[c(1, 3, 5)] ## [1] NA "台北" "台中" county[3:6] # is it equal to country[c(3, 4, 5, 6)] ## [1] "台北" NA NA NA a <- 11:19 a[3:length(a)] ## [1] 13 14 15 16 17 18 19 a[length(a):3] ## [1] 19 18 17 16 15 14 13 3.2.5 Deleting Without assignment, deletion won’t change original vectors b <- 11:20 b[-(3:5)] ## [1] 11 12 16 17 18 19 20 b[-c(1, 3, 5)] ## [1] 12 14 16 17 18 19 20 b ## [1] 11 12 13 14 15 16 17 18 19 20 Correct deleting operations with assignment to replace original vector b <- b[-(3:5)] b ## [1] 11 12 16 17 18 19 20 a <- seq(11, 99, 11) a <- a[-c(1, 3, 5)] a ## [1] 22 44 66 77 88 99 3.2.6 Concatenating Concatenating is quite useful for web crawling when you crawl article links page by page. You may be not sure the number of page you need to crawl. So you need to append entire new vector to old vector. It is concatenating. (“Appending” often means adding one new element at the end of data.) a <- 1:10 a <- c(a, 11) a ## [1] 1 2 3 4 5 6 7 8 9 10 11 b ## [1] 11 12 16 17 18 19 20 a <- c(a, b) a ## [1] 1 2 3 4 5 6 7 8 9 10 11 11 12 16 17 18 19 20 a <- c(a, a, b) a ## [1] 1 2 3 4 5 6 7 8 9 10 11 11 12 16 17 18 19 20 1 2 3 4 5 6 7 ## [26] 8 9 10 11 11 12 16 17 18 19 20 11 12 16 17 18 19 20 3.3 Calculating with vectors 3.3.1 Arithmetic operations a <- 11:19 a + 3 ## [1] 14 15 16 17 18 19 20 21 22 a / 2 ## [1] 5.5 6.0 6.5 7.0 7.5 8.0 8.5 9.0 9.5 a %% 2 ## [1] 1 0 1 0 1 0 1 0 1 a %/% 2 ## [1] 5 6 6 7 7 8 8 9 9 a %% 2== 0 ## [1] FALSE TRUE FALSE TRUE FALSE TRUE FALSE TRUE FALSE which(a %% 2== 0) ## [1] 2 4 6 8 a[which(a%% 2 == 0)] ## [1] 12 14 16 18 a[c(2, 4, 6, 8)] ## [1] 12 14 16 18 a %% 2 != 0 ## [1] TRUE FALSE TRUE FALSE TRUE FALSE TRUE FALSE TRUE a[a%% 2 == 0] ## [1] 12 14 16 18 a[a%%2 != 0] ## [1] 11 13 15 17 19 a <- a %% 2 # modular arithmetic, get the reminder a <- a %/% 2 # Quotient 3.3.2 Logic comparisons a %% 2 == 0 # deteting odd/even number ## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE a %% 2 != 0 ## [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE a[a%%2==0] ## [1] 0 0 0 0 0 0 0 0 0 a > b ## [1] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE income > mean(income) ## [1] TRUE FALSE FALSE FALSE FALSE FALSE TRUE == T # == equal to, ## [1] TRUE TRUE != F # != Not equal to ## [1] TRUE any(a>11) # is there any element larger than 1 ## [1] FALSE all(a>11) # are all elements larger than 1 ## [1] FALSE 3.3.3 Subsetting by logic comparisons two methods to filter data from vectors, by index vector or a logical vector with equal length. a <- seq(11, 55, 11) a[c(T, F, T, F, T)] ## [1] 11 33 55 a[a%%2==1] ## [1] 11 33 55 a%%2 ## [1] 1 0 1 0 1 a%%2==1 ## [1] TRUE FALSE TRUE FALSE TRUE a <- c("你好","你好棒棒","你好棒","你真的好棒") a[nchar(a)>3] ## [1] "你好棒棒" "你真的好棒" # which will return "index-of" a <- seq(11, 55, 11) a[which(a%%2==1)] ## [1] 11 33 55 which(a%%2==1) ## [1] 1 3 5 3.3.4 Sorting and ordering sort(x)的結果必須用<-覆蓋原本的x，此時的x才算被排序的結果。 order(x)函式會傳回x數值由小到大的索引。這個例子的結果是5, 4, 3, 6, 1, 2，也就是5位置的那個數最小、4那個位置的數次小、接下來3, 6, 1, 2。 x[order(x)]把order(x)結果（也就是c(5, 4, 3, 6, 1, 2)）傳給原本的x便會使得原本的x重新排序。通常order()的用途是，我們可以將兩個等長的variables例如var1和var2，依據var2來重新排序var1，例如var1[order(var2)]。 x <- c(33, 55, 22, 13, 4, 24) mode(x) ## [1] "numeric" class(x) ## [1] "numeric" sort(x) ## [1] 4 13 22 24 33 55 # x <- sort(x) # assign to replace original x order(x) ## [1] 5 4 3 6 1 2 x[order(x)] ## [1] 4 13 22 24 33 55 x[c(5, 4, 3, 6, 1, 2)] ## [1] 4 13 22 24 33 55 3.3.5 Built-in math functions a <- 11:19 min(a); max(a); mean(a); median(a); sd(a) ## [1] 11 ## [1] 19 ## [1] 15 ## [1] 15 ## [1] 2.738613 log2(a) ## [1] 3.459432 3.584963 3.700440 3.807355 3.906891 4.000000 4.087463 4.169925 ## [9] 4.247928 log1p(a) ## [1] 2.484907 2.564949 2.639057 2.708050 2.772589 2.833213 2.890372 2.944439 ## [9] 2.995732 ?log1p 3.4 Data types 3.4.1 Checking data type mode(county) # character ## [1] "character" mode(income) # numeric ## [1] "numeric" mode(income > mean(income)) # logical ## [1] "logical" testing <- c("26.142", "12.008", "7.032", "13.646", "4.589") mode(testing) # character ## [1] "character" 3.4.2 Converting data type numeric vector可以用as.character(x)轉成charcter；logical vector可以用as.numeric(x)轉為numeric。概念上可以說是character > numeric > logical。 如果硬是在logical vector後附加一個numeric element的話，那就會整個vector被轉為numeric vector；相仿地，如果numeric vector後附加一個character element的話那整個vector就會被轉為character vector。 可以用sum()函式來計算logical vector有幾個TRUE值。例如sum(a%%2==1)就是計算a中有幾個奇數。TRUE可視為1、FALSE可視為0，所以加總起來就是TRUE有幾個。 income.c <- as.character(income) population.c <- as.numeric(population) a <- seq(11, 99, 11) a <- c(a, "100") a <- seq(11, 99, 11) sum(a%%2==1) ## [1] 5 max(a) ## [1] 99 3.5 Character operations a <- seq(11, 55, 11) paste("A", a) # concatenate ## [1] "A 11" "A 22" "A 33" "A 44" "A 55" paste0("A", a) # concatenate ## [1] "A11" "A22" "A33" "A44" "A55" "],["dataframe.html", "Chapter 4 Dataframe 4.1 基本操作 4.2 簡易繪圖 4.3 延伸學習 4.4 Paid Maternity Leave", " Chapter 4 Dataframe 4.1 基本操作 4.1.1 產生新的Dataframe 4.1.1.1 建立資料並Assign給vector 用以下ChatGPT問句來產生測試資料「我現在正在準備R的教學範例， 請協助我產生台北市所有行政區的資料，包含行政區名、面積、人口數 分別指給town, area, population三個變數」。 town = c("松山區", "信義區", "大安區", "中山區", "中正區", "大同區", "萬華區", "文山區", "南港區", "內湖區", "士林區", "北投區") area = c(9.2878, 11.2077, 11.3614, 13.6821, 7.6071, 5.6815, 8.8522, 31.5090, 21.8424, 31.5787, 62.3682, 56.8216) # 單位：平方公里 population = c(206375, 225561, 309835, 203276, 159608, 132397, 194160, 275207, 122103, 287726, 288324, 255688) # 2023年的估計值 4.1.1.2 合併等長vector為dataframe df <- data.frame(town, population, area) df$density = df$population / df$area str(df) ## 'data.frame': 6 obs. of 4 variables: ## $ town : chr "中正" "大同" "中山" "松山" ... ## $ population: num 158228 126687 228075 204903 308383 ... ## $ area : num 7.61 5.68 13.68 9.29 11.36 ... ## $ density : num 20800 22298 16670 22062 27143 ... summary(df) ## town population area density ## Length:6 Min. :126687 Min. : 5.681 Min. :16670 ## Class :character 1st Qu.:165651 1st Qu.: 7.918 1st Qu.:20907 ## Mode :character Median :196412 Median : 9.070 Median :21645 ## Mean :202366 Mean : 9.412 Mean :21700 ## 3rd Qu.:222282 3rd Qu.:10.843 3rd Qu.:22239 ## Max. :308383 Max. :13.682 Max. :27143 # View(df) 4.1.1.3 存放台灣貿易各國進出口量 運用國際貿易署貿易統計系統 (trade.gov.tw)獲取臺灣進出口貿易資料。 country <- c("CN", "US", "JP", "HK", "KR", "SG", "DE", "MY", "VN", "PH", "TH", "AU", "NL", "SA", "ID", "GB", "IN", "FR", "IT", "AE") import <- c(26.142, 12.008, 7.032, 13.646, 4.589, 5.768, 2.131, 2.802, 3.428, 3.019, 1.976, 1.118, 1.624, 0.449, 0.983, 1.302, 1.027, 0.553, 0.670, 0.455) export <- c(22.987, 12.204, 11.837, 7.739, 5.381, 4.610, 2.866, 2.784, 2.414, 2.092, 1.839, 1.788, 1.665, 1.409, 1.391, 1.075, 0.974, 0.899, 0.800, 0.728) 4.1.1.4 合併vector為data.frame 當我們讀取或創建資料框架時，過去R預設會將字符串類型的變數轉換為因子（Factors），這對於統計分析而言是有益的，因為統計分析經常將文字型態的數據視為類別變數來處理。然而，隨著資料科學領域的快速發展，需要處理大量文字數據的情況日益增多，這時將文字資料預設為因子型態可能不再適合所有情境。因此，現在R的預設的處理方式已經改變，預設將文字型態的變數保持為字符型態（Character），而不是自動將其轉換為因子。這意味著，當我們使用read.csv等函數讀取數據時，除非明確指定，否則讀入的字符串不會自動轉換為Factors型態。 如果你在進行統計分析時希望將文字型態的變數作為類別變數（即因子）處理，你需要手動設定stringsAsFactors參數為TRUE。這可以在讀取數據時（如使用read.csv函數）或在數據處理過程中明確進行轉換。例如，當使用read.csv讀取CSV文件時，若想將所有的字符串變數自動轉為因子型態，可以這樣做：df <- read.csv(\"your_file.csv\", stringsAsFactors = TRUE)。若已經讀取數據且數據框架中的文字型態變數仍為Character型態，而你希望將其轉換為Factors，可以使用factor函數進行轉換：df$your_column <- factor(df$your_column)。 df <- data.frame(country, import, export, stringsAsFactors = TRUE) str(df) ## 'data.frame': 20 obs. of 3 variables: ## $ country: Factor w/ 20 levels "AE","AU","CN",..: 3 19 11 7 12 17 4 13 20 15 ... ## $ import : num 26.14 12.01 7.03 13.65 4.59 ... ## $ export : num 22.99 12.2 11.84 7.74 5.38 ... df <- data.frame(country, import, export) str(df) ## 'data.frame': 20 obs. of 3 variables: ## $ country: chr "CN" "US" "JP" "HK" ... ## $ import : num 26.14 12.01 7.03 13.65 4.59 ... ## $ export : num 22.99 12.2 11.84 7.74 5.38 ... 其他功能：建立一個新且空的data.frame。 df.test <- data.frame() 4.1.2 觀察dataframe 當我們處理數據框架（dataframe）時，有幾種常用的方法可以幫助我們更好地了解和觀察數據的結構和內容。 View(df): 使用RStudio提供的圖形使用者介面直接觀看dataframe。這個功能允許你直觀地瀏覽整個數據集，方便地查看不同行（變數）和列（觀測值）。這對於初步瞭解數據的分佈和檢查數據的格式特別有用。 head(df): 這個函數用於取出數據框架的前六筆資料（也就是前六列）。這可以讓我們快速概覽數據集的開頭部分，了解數據的基本結構和內容。如果需要查看更多或更少的列，可以向head函數傳遞一個額外的參數，如head(df, n = 10)來查看前十列。 class(df): 此函數返回該變數的類型。對於dataframe，它將返回”DataFrame”，表明該對象是一個dataframe。了解對象的類型是重要的基礎步驟，尤其是在R中，不同類型的變項能夠做的操作和應用的函數也不同。 str(df): str是結構（structure）的縮寫，這個函數提供了dataframe的詳細結構信息，包括變項的數量、變項名稱、變項數據類型以及每個變項前幾個值。這是一個非常強大的函數，用於深入了解數據集的內部結構，特別是當處理大型數據集時。 summary(df): 此函數提供了數據框架的摘要統計信息，包括數值變數的最小值、最大值、中位數、平均值、第一四分位數和第三四分位數，以及因子變數的水平計數。這對於快速獲取數據集的統計概述非常有用。 # View(df) head(df) # get first part of the data.frame ## country import export ## 1 CN 26.142 22.987 ## 2 US 12.008 12.204 ## 3 JP 7.032 11.837 ## 4 HK 13.646 7.739 ## 5 KR 4.589 5.381 ## 6 SG 5.768 4.610 class(df) ## [1] "data.frame" str(df) ## 'data.frame': 20 obs. of 3 variables: ## $ country: chr "CN" "US" "JP" "HK" ... ## $ import : num 26.14 12.01 7.03 13.65 4.59 ... ## $ export : num 22.99 12.2 11.84 7.74 5.38 ... summary(df) ## country import export ## Length:20 Min. : 0.449 Min. : 0.728 ## Class :character 1st Qu.: 1.016 1st Qu.: 1.312 ## Mode :character Median : 2.054 Median : 1.966 ## Mean : 4.536 Mean : 4.374 ## 3rd Qu.: 4.884 3rd Qu.: 4.803 ## Max. :26.142 Max. :22.987 # look up help help(summary) ?summary 4.1.2.1 觀察資料維度 dim(df) ## [1] 20 3 ncol(df) ## [1] 3 nrow(df) ## [1] 20 length(df) ## [1] 3 4.1.3 操作dataframe 4.1.3.1 取出一個變項 names(df) 列出變數名稱 df$發生.現.地點 顯示該變數內容 df$發生時段 顯示該變數內容 length(df$發生時段) 顯示該變數的長度（相當於有幾個） names(df) ## [1] "country" "import" "export" head(df$export) ## [1] 22.987 12.204 11.837 7.739 5.381 4.610 length(df$import) ## [1] 20 summary(df) ## country import export ## Length:20 Min. : 0.449 Min. : 0.728 ## Class :character 1st Qu.: 1.016 1st Qu.: 1.312 ## Mode :character Median : 2.054 Median : 1.966 ## Mean : 4.536 Mean : 4.374 ## 3rd Qu.: 4.884 3rd Qu.: 4.803 ## Max. :26.142 Max. :22.987 4.1.3.2 (mutate)透過運算產生新變數 這裡容易犯錯的是，要記得跟程式講說你要加總或四則運算的是哪個df的variable。 從下面的這個操作中，該data.frame會產生一個新的變數sub，這就相當於Excel中的某一行減去某一行，然後把資料放在新的一行。 df$sub <- df$import - df$export 4.1.3.3 (filter)篩選資料、選取變數 注意，要告訴程式import和export是哪個data.frame的。 df[,]為存取df中某個區段的數值或某個數值的方法。因此df[1, 1]會取出第一行第一列，也就是第一筆資料的第一個vector。df[2, 3]則會取出第二筆資料的第三個variable。 下面的例子nrow(df)為1894，有1894筆資料，所以自然df\\(import與df\\)export的長度都是1894。因此，比較這兩個變數的大小會得到一個長度為1894的boolean (logical) variable。因此把這個長度為1894、充滿TRUE和FALSE的logical vector丟進df的row之處，因為取自df，大小判斷式結果的長度自然和原本的df的列數相同。因此當這個TRUE/FALSE被丟在df的列之處，便會篩選出import大於p.xport的數值。 原本的df有五個variable，而上述的操作是篩選資料，所以被篩選的是列，因此行的數量、名稱都不會變。因此，我篩選完後，直接存取這個被篩選過的data.frame的country variable，自然是可以的。 df ## country import export sub ## 1 CN 26.142 22.987 3.155 ## 2 US 12.008 12.204 -0.196 ## 3 JP 7.032 11.837 -4.805 ## 4 HK 13.646 7.739 5.907 ## 5 KR 4.589 5.381 -0.792 ## 6 SG 5.768 4.610 1.158 ## 7 DE 2.131 2.866 -0.735 ## 8 MY 2.802 2.784 0.018 ## 9 VN 3.428 2.414 1.014 ## 10 PH 3.019 2.092 0.927 ## 11 TH 1.976 1.839 0.137 ## 12 AU 1.118 1.788 -0.670 ## 13 NL 1.624 1.665 -0.041 ## 14 SA 0.449 1.409 -0.960 ## 15 ID 0.983 1.391 -0.408 ## 16 GB 1.302 1.075 0.227 ## 17 IN 1.027 0.974 0.053 ## 18 FR 0.553 0.899 -0.346 ## 19 IT 0.670 0.800 -0.130 ## 20 AE 0.455 0.728 -0.273 names(df) ## [1] "country" "import" "export" "sub" nrow(df) ## [1] 20 # filter row data by column value df[df$import > df$export,] ## country import export sub ## 1 CN 26.142 22.987 3.155 ## 4 HK 13.646 7.739 5.907 ## 6 SG 5.768 4.610 1.158 ## 8 MY 2.802 2.784 0.018 ## 9 VN 3.428 2.414 1.014 ## 10 PH 3.019 2.092 0.927 ## 11 TH 1.976 1.839 0.137 ## 16 GB 1.302 1.075 0.227 ## 17 IN 1.027 0.974 0.053 df[df$import > df$export,]$country ## [1] "CN" "HK" "SG" "MY" "VN" "PH" "TH" "GB" "IN" df[df$import > df$export,1] ## [1] "CN" "HK" "SG" "MY" "VN" "PH" "TH" "GB" "IN" # 1 row == a data.frame with only one data entry class(df[df$import > df$export,1]) ## [1] "character" class(df[,1]) # character vector ## [1] "character" class(df[1,]) # data.frame ## [1] "data.frame" class(unlist(df[1, -1])) # filter the 1st row and select all columns except 1 ## [1] "numeric" 4.1.3.4 (arrange) 按某個變數排序 df.sorted <- df[order(df$import),]會使得整個df照import的大小排序重新做排列。因為order(df$import)會把資料照指定順序排列後的位置傳回來，所以把他丟給df的列的位置，便會使得df的資料照指定的順序排列。 預設是由小到大，加上decreasing = T這個參數後變成由大而小。 # sort rows by df$import column df.sorted <- df[order(df$import),] # View(df.sorted) # sort rows in decreasing order df.sorted <- df[order(df$import, decreasing = T),] # add - to column in order() can sort in decreasing order df.sorted <- df[order(-df$import),] head(df.sorted) ## country import export sub ## 1 CN 26.142 22.987 3.155 ## 4 HK 13.646 7.739 5.907 ## 2 US 12.008 12.204 -0.196 ## 3 JP 7.032 11.837 -4.805 ## 6 SG 5.768 4.610 1.158 ## 5 KR 4.589 5.381 -0.792 4.2 簡易繪圖 graphics::plot()為會預載入R的繪圖套件，如果希望繪圖的同時加上回歸線和資料點標籤的話，必須要三行一起執行。 # plot(df) # raise error, 1st column is a character vector plot(df[, 2:3]) plot(df[1:10, 2:3]) text(import, export, labels=country, cex= 0.5, pos=3) lines(1:25, 1:25, col='red') ?plot ## Help on topic 'plot' was found in the following packages: ## ## Package Library ## graphics /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library ## base /Library/Frameworks/R.framework/Resources/library ## ## ## Using the first match ... 4.3 延伸學習 4.3.1 使用dplyr library(dplyr) df <- data.frame(country, import, export, stringsAsFactors = F) df <- mutate(df, sub = import - export) filter(df, import > export) ## country import export sub ## 1 CN 26.142 22.987 3.155 ## 2 HK 13.646 7.739 5.907 ## 3 SG 5.768 4.610 1.158 ## 4 MY 2.802 2.784 0.018 ## 5 VN 3.428 2.414 1.014 ## 6 PH 3.019 2.092 0.927 ## 7 TH 1.976 1.839 0.137 ## 8 GB 1.302 1.075 0.227 ## 9 IN 1.027 0.974 0.053 select(df, c(1, 3)) ## country export ## 1 CN 22.987 ## 2 US 12.204 ## 3 JP 11.837 ## 4 HK 7.739 ## 5 KR 5.381 ## 6 SG 4.610 ## 7 DE 2.866 ## 8 MY 2.784 ## 9 VN 2.414 ## 10 PH 2.092 ## 11 TH 1.839 ## 12 AU 1.788 ## 13 NL 1.665 ## 14 SA 1.409 ## 15 ID 1.391 ## 16 GB 1.075 ## 17 IN 0.974 ## 18 FR 0.899 ## 19 IT 0.800 ## 20 AE 0.728 message(df$country) print(df$country) ## [1] "CN" "US" "JP" "HK" "KR" "SG" "DE" "MY" "VN" "PH" "TH" "AU" "NL" "SA" "ID" ## [16] "GB" "IN" "FR" "IT" "AE" 4.3.2 比較tibble, data_frame, data.frame 警告： \"data_frame()\" was deprecated in tibble 1.1.0. Please use \"tibble()\" instead. df <- data.frame(a=1:2, b=3:4, c=5:6) class(df) ## [1] "data.frame" df <- data_frame(a=1:2, b=3:4, c=5:6) class(df) ## [1] "tbl_df" "tbl" "data.frame" df <- tibble(a=1:2, b=3:4, c=5:6) class(df) ## [1] "tbl_df" "tbl" "data.frame" 4.4 Paid Maternity Leave 本案例將使用R重新製作華盛頓郵報2016年8月13日的一篇報導，該報導探討了美國婦女產假支薪情況。案例中將應用data.frame和基本的繪圖與資料摘要方法。 原始新聞來源：The world is getting better at paid maternity leave. The U.S. is not. - The Washington Post。該篇報導提及，美國因為目前的政策不保障帶薪產假，許多女性感到必須在工作和照顧家庭之間做出選擇，這種性別不平等破壞了她們在工作機會上的平等機會。同時，世界各地的婦女待遇正在逐漸改善。至少190個國家對嬰兒的母親規定了某種形式的帶薪假期，產假待遇在56個國家有所提高。專家表示，現在美國城市和州正通過不同形式的帶薪家庭假法案，這顯示美國雇主正在展示有競爭力的福利不會影響員工表現。特別是科技公司，如Twitter、Facebook和Google等，處於提供員工帶薪產假福利的前沿，美國可能有望追趕其他國家。 本案例主要呈現核心的視覺化概念，可以在Review Paid Maternity by dplyr找到更詳盡的案例說明與解析。 4.4.1 Reading .xlsx by readxl package 在進行產假支薪調查數據的分析與視覺化時，我們從該調查網站上所下載的資料是一個Excel文件。由於R語言本身不直接支援讀取Excel格式的文件，我們必須依靠外部的套件來實現這一功能，如readxl套件。它是專門設計來讀取.xls和.xlsx格式文件的強大工具。readxl套件是tidyverse套件集的一部分。tidyverse是一組旨在數據科學和數據處理領域提供便利的R套件集合，包括了ggplot2、dplyr、tidyr等多個流行的套件。如果你之前已經安裝了tidyverse，那麼readxl套件應該也已經安裝在你的系統上，無需進行重複安裝。 然而，即便readxl已經安裝，它並不會隨著tidyverse套件集的其他部分自動加載到R的執行環境中。這意味著，在你打算使用readxl套件來讀取Excel文件之前，需要先手動執行library(readxl)命令來加載它。 # Import readxl package # install.packages("tidyverse") library(readxl) 這段程式碼使用read_excel()函式從data資料夾中的WORLD-MACHE_Gender_6.8.15.xls檔案中的Sheet1工作表讀取資料。其中col_names=T為該函式的參數，表示第一列為欄位名稱。讀取後的資料會被Assign給變數df。 # Use read_excel() to convert excel sheet to data.frame df <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) 4.4.2 Previewing data by View(), class(), dim(), str(), summary() and names() # View(df) class(df) # [1] "tbl_df" "tbl" "data.frame" ## [1] "tbl_df" "tbl" "data.frame" dim(df) ## [1] 197 156 # Show names of variables (vectors, columns) by names() names(df) ## [1] "country" "iso2" "iso3" ## [4] "region" "wb_econ" "matleave_95" ## [7] "matleave_96" "matleave_97" "matleave_98" ## [10] "matleave_99" "matleave_00" "matleave_01" ## [13] "matleave_02" "matleave_03" "matleave_04" ## [16] "matleave_05" "matleave_06" "matleave_07" ## [19] "matleave_08" "matleave_09" "matleave_10" ## [22] "matleave_11" "matleave_12" "matleave_13" ## [25] "matleave_wrr_95" "matleave_wrr_96" "matleave_wrr_97" ## [28] "matleave_wrr_98" "matleave_wrr_99" "matleave_wrr_00" ## [31] "matleave_wrr_01" "matleave_wrr_02" "matleave_wrr_03" ## [34] "matleave_wrr_04" "matleave_wrr_05" "matleave_wrr_06" ## [37] "matleave_wrr_07" "matleave_wrr_08" "matleave_wrr_09" ## [40] "matleave_wrr_10" "matleave_wrr_11" "matleave_wrr_12" ## [43] "matleave_wrr_13" "bf_dur_95" "bf_dur_96" ## [46] "bf_dur_97" "bf_dur_98" "bf_dur_99" ## [49] "bf_dur_00" "bf_dur_01" "bf_dur_02" ## [52] "bf_dur_03" "bf_dur_04" "bf_dur_05" ## [55] "bf_dur_06" "bf_dur_07" "bf_dur_08" ## [58] "bf_dur_09" "bf_dur_10" "bf_dur_11" ## [61] "bf_dur_12" "bf_dur_13" "mat_bfeed_6mon_95" ## [64] "mat_bfeed_6mon_96" "mat_bfeed_6mon_97" "mat_bfeed_6mon_98" ## [67] "mat_bfeed_6mon_99" "mat_bfeed_6mon_00" "mat_bfeed_6mon_01" ## [70] "mat_bfeed_6mon_02" "mat_bfeed_6mon_03" "mat_bfeed_6mon_04" ## [73] "mat_bfeed_6mon_05" "mat_bfeed_6mon_06" "mat_bfeed_6mon_07" ## [76] "mat_bfeed_6mon_08" "mat_bfeed_6mon_09" "mat_bfeed_6mon_10" ## [79] "mat_bfeed_6mon_11" "mat_bfeed_6mon_12" "mat_bfeed_6mon_13" ## [82] "minage_fem_leg_95" "minage_fem_leg_96" "minage_fem_leg_97" ## [85] "minage_fem_leg_98" "minage_fem_leg_99" "minage_fem_leg_00" ## [88] "minage_fem_leg_01" "minage_fem_leg_02" "minage_fem_leg_03" ## [91] "minage_fem_leg_04" "minage_fem_leg_05" "minage_fem_leg_06" ## [94] "minage_fem_leg_07" "minage_fem_leg_08" "minage_fem_leg_09" ## [97] "minage_fem_leg_10" "minage_fem_leg_11" "minage_fem_leg_12" ## [100] "legal_diff_leg_95" "legal_diff_leg_96" "legal_diff_leg_97" ## [103] "legal_diff_leg_98" "legal_diff_leg_99" "legal_diff_leg_00" ## [106] "legal_diff_leg_01" "legal_diff_leg_02" "legal_diff_leg_03" ## [109] "legal_diff_leg_04" "legal_diff_leg_05" "legal_diff_leg_06" ## [112] "legal_diff_leg_07" "legal_diff_leg_08" "legal_diff_leg_09" ## [115] "legal_diff_leg_10" "legal_diff_leg_11" "legal_diff_leg_12" ## [118] "minage_fem_pc_95" "minage_fem_pc_96" "minage_fem_pc_97" ## [121] "minage_fem_pc_98" "minage_fem_pc_99" "minage_fem_pc_00" ## [124] "minage_fem_pc_01" "minage_fem_pc_02" "minage_fem_pc_03" ## [127] "minage_fem_pc_04" "minage_fem_pc_05" "minage_fem_pc_06" ## [130] "minage_fem_pc_07" "minage_fem_pc_08" "minage_fem_pc_09" ## [133] "minage_fem_pc_10" "minage_fem_pc_11" "minage_fem_pc_12" ## [136] "legal_diff_pc_95" "legal_diff_pc_96" "legal_diff_pc_97" ## [139] "legal_diff_pc_98" "legal_diff_pc_99" "legal_diff_pc_00" ## [142] "legal_diff_pc_01" "legal_diff_pc_02" "legal_diff_pc_03" ## [145] "legal_diff_pc_04" "legal_diff_pc_05" "legal_diff_pc_06" ## [148] "legal_diff_pc_07" "legal_diff_pc_08" "legal_diff_pc_09" ## [151] "legal_diff_pc_10" "legal_diff_pc_11" "legal_diff_pc_12" ## [154] "minwage_ppp_2013" "mw_overtime" "oecd" 4.4.3 Select variables 由於所需要的資料為第三欄的變數iso3（為國家代碼）和第六至24欄的matleave95~matleave13共29年的資料，所以需要在df[ , ]中選出這幾欄。只要把所要取的欄以vector的型態放在df[row,col]之col的位置，便可以選出所要的欄。 # Select the 3rd and 6th to 24th columns matleave <- df[ , c(3, 6:24)] # Use class(), dim(), and str() to inspect the data class(matleave) ## [1] "tbl_df" "tbl" "data.frame" dim(matleave) ## [1] 197 20 str(matleave) ## tibble [197 × 20] (S3: tbl_df/tbl/data.frame) ## $ iso3 : chr [1:197] "AFG" "ALB" "DZA" "AND" ... ## $ matleave_95: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_96: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_97: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_98: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_99: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_00: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_01: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_02: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_03: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_04: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_05: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_06: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_07: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_08: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_09: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_10: num [1:197] 2 5 3 3 2 2 2 5 NA 5 ... ## $ matleave_11: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_12: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_13: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... 4.4.4 Check & Replace NAs 處理開放資料常常會遇到紀錄遺漏的情形，這些遺漏的值在R語言中通常以NA（Not Available）來表示。這種情況很常見，特別是當數據來自於廣泛的來源，如網絡調查或公開資料庫時。適當處理這些NA值對於維持分析的準確性和可靠性至關重要。 為了識別和處理這些NA值，R提供了一些有用的函數和技巧。例如，is.na(v)函數可以用來檢測向量v中的NA值。如果你想選擇所有的NA紀錄，可以使用v[is.na(v)]這樣的語法。這個表達式會傳回所有在向量v中為NA的元素，這對於進一步的分析和資料清洗非常有幫助。 在某些情況下，你可能會想要以某個特定值來取代NA值，以避免在繪圖或進行其他數據分析時產生錯誤。例如，你可以選擇以0來取代所有的NA值，這可以通過v[is.na(v)] <- 0來實現。這樣，所有原本為NA的資料格都會被賦予0值。 此外，sum(is.na(v))這個表達式可以用來檢測向量v中還有多少NA值。這個函數的運作機制是計算所有is.na(v)為TRUE的情況，即所有NA值的總數。如果這個結果不是0，那麼就表示在向量或dataframe中還存在NA值。這對於確保數據清理工作已經完成，並且數據集準備好進行分析是非常有用的。 # is.na() to indicate each element is NA or NOT(TRUE/FALSE) head(is.na(matleave), n=20) ## iso3 matleave_95 matleave_96 matleave_97 matleave_98 matleave_99 ## [1,] FALSE FALSE FALSE FALSE FALSE FALSE ## [2,] FALSE FALSE FALSE FALSE FALSE FALSE ## [3,] FALSE FALSE FALSE FALSE FALSE FALSE ## [4,] FALSE FALSE FALSE FALSE FALSE FALSE ## [5,] FALSE FALSE FALSE FALSE FALSE FALSE ## [6,] FALSE FALSE FALSE FALSE FALSE FALSE ## [7,] FALSE FALSE FALSE FALSE FALSE FALSE ## [8,] FALSE FALSE FALSE FALSE FALSE FALSE ## [9,] FALSE FALSE FALSE FALSE FALSE FALSE ## [10,] FALSE FALSE FALSE FALSE FALSE FALSE ## [11,] FALSE FALSE FALSE FALSE FALSE FALSE ## [12,] FALSE FALSE FALSE FALSE FALSE FALSE ## [13,] FALSE FALSE FALSE FALSE FALSE FALSE ## [14,] FALSE FALSE FALSE FALSE FALSE FALSE ## [15,] FALSE FALSE FALSE FALSE FALSE FALSE ## [16,] FALSE FALSE FALSE FALSE FALSE FALSE ## [17,] FALSE FALSE FALSE FALSE FALSE FALSE ## [18,] FALSE FALSE FALSE FALSE FALSE FALSE ## [19,] FALSE FALSE FALSE FALSE FALSE FALSE ## [20,] FALSE FALSE FALSE FALSE FALSE FALSE ## matleave_00 matleave_01 matleave_02 matleave_03 matleave_04 matleave_05 ## [1,] FALSE FALSE FALSE FALSE FALSE FALSE ## [2,] FALSE FALSE FALSE FALSE FALSE FALSE ## [3,] FALSE FALSE FALSE FALSE FALSE FALSE ## [4,] FALSE FALSE FALSE FALSE FALSE FALSE ## [5,] FALSE FALSE FALSE FALSE FALSE FALSE ## [6,] FALSE FALSE FALSE FALSE FALSE FALSE ## [7,] FALSE FALSE FALSE FALSE FALSE FALSE ## [8,] FALSE FALSE FALSE FALSE FALSE FALSE ## [9,] FALSE FALSE FALSE FALSE FALSE FALSE ## [10,] FALSE FALSE FALSE FALSE FALSE FALSE ## [11,] FALSE FALSE FALSE FALSE FALSE FALSE ## [12,] FALSE FALSE FALSE FALSE FALSE FALSE ## [13,] FALSE FALSE FALSE FALSE FALSE FALSE ## [14,] FALSE FALSE FALSE FALSE FALSE FALSE ## [15,] FALSE FALSE FALSE FALSE FALSE FALSE ## [16,] FALSE FALSE FALSE FALSE FALSE FALSE ## [17,] FALSE FALSE FALSE FALSE FALSE FALSE ## [18,] FALSE FALSE FALSE FALSE FALSE FALSE ## [19,] FALSE FALSE FALSE FALSE FALSE FALSE ## [20,] FALSE FALSE FALSE FALSE FALSE FALSE ## matleave_06 matleave_07 matleave_08 matleave_09 matleave_10 matleave_11 ## [1,] FALSE FALSE FALSE FALSE FALSE FALSE ## [2,] FALSE FALSE FALSE FALSE FALSE FALSE ## [3,] FALSE FALSE FALSE FALSE FALSE FALSE ## [4,] FALSE FALSE FALSE FALSE FALSE FALSE ## [5,] FALSE FALSE FALSE FALSE FALSE FALSE ## [6,] FALSE FALSE FALSE FALSE FALSE FALSE ## [7,] FALSE FALSE FALSE FALSE FALSE FALSE ## [8,] FALSE FALSE FALSE FALSE FALSE FALSE ## [9,] FALSE FALSE FALSE FALSE TRUE FALSE ## [10,] FALSE FALSE FALSE FALSE FALSE FALSE ## [11,] FALSE FALSE FALSE FALSE FALSE FALSE ## [12,] FALSE FALSE FALSE FALSE FALSE FALSE ## [13,] FALSE FALSE FALSE FALSE FALSE FALSE ## [14,] FALSE FALSE FALSE FALSE FALSE FALSE ## [15,] FALSE FALSE FALSE FALSE FALSE FALSE ## [16,] FALSE FALSE FALSE FALSE FALSE FALSE ## [17,] FALSE FALSE FALSE FALSE FALSE FALSE ## [18,] FALSE FALSE FALSE FALSE FALSE FALSE ## [19,] FALSE FALSE FALSE FALSE FALSE FALSE ## [20,] FALSE TRUE TRUE FALSE FALSE FALSE ## matleave_12 matleave_13 ## [1,] FALSE FALSE ## [2,] FALSE FALSE ## [3,] FALSE FALSE ## [4,] FALSE FALSE ## [5,] FALSE FALSE ## [6,] FALSE FALSE ## [7,] FALSE FALSE ## [8,] FALSE FALSE ## [9,] FALSE FALSE ## [10,] FALSE FALSE ## [11,] FALSE FALSE ## [12,] FALSE FALSE ## [13,] FALSE FALSE ## [14,] FALSE FALSE ## [15,] FALSE FALSE ## [16,] FALSE FALSE ## [17,] FALSE FALSE ## [18,] FALSE FALSE ## [19,] FALSE FALSE ## [20,] FALSE FALSE # Assign 0 to those NA data matleave[is.na(matleave)] <- 0 # anyNA() to check if there are still NA cells. anyNA(matleave) ## [1] FALSE # sum(is.na()) to count the number of NA sum(is.na(matleave)) ## [1] 0 4.4.5 Filtering data 4.4.5.1 Filtered by the last year value matleave[matleave$'matleave_13'==5, ]中的第一個matleave表示要篩選的資料集，中括號中的matleave$'matleave_13'==5是篩選條件，表示將篩選matleave資料集中的matleave_13變數值等於5的列；中括號中的逗號後方未有欄位名稱表示將保留所有欄位（變項），僅篩選出符合條件的列，並將篩選後所產生的dataframe指給變數m5。 # Use logical comparison to see if the last year equals to 5 # Assign matching data to var m5 m5 <- matleave[matleave$'matleave_13'==5, ] # nrow() to count matching data nrow(m5) ## [1] 34 # Is it possible to use length() to check the data length? # matleave$'matleave_13' # matleave$'matleave_13'==5 # length(matleave$'matleave_13'==5) 4.4.5.2 Filtered data by the first year value 接下來我們再做一次篩選，從m5中篩選出matleave_95這個欄位為5的資料，並指給m55；同時也從m5中篩選出matleave_95這個欄位不為5的資料，並指給m05。m5、m55和m05無特殊含義，只是變數名稱而已。 # filter rows whose 'matleave_95' is 5, and assign to var m55 m55<- m5[m5$'matleave_95'==5,] # filter rows whose 'matleave_95' is not 5, and assign to var m05 m05<- m5[m5$'matleave_95'!=5,] 4.4.6 Plotting 當我們在R中進行資料視覺化時，理解資料結構對於正確使用圖形化函數是非常重要的。以matleave資料集為例，如果我們想要繪製其第二列所有行（除了第一行）的條形圖，這裡有一段示範程式碼及相關的概念解釋。 首先，為何要除去第一行？因為第一行為國家名稱。所以我們利用class(matleave[2, -1])來查看matleave資料集第二行和除了第一列外所有列的資料類型。這個操作返回的是一個data.frame的資料類型，因為即使是單一行的選取，R仍然保持了資料的data.frame結構。 然而，當我們嘗試使用barplot()函數繪製長條圖時，就不能直接把data.frame給barplot()進行繪製。。這是因為barplot()函數期望的輸入是一個vector。因此，我們使用unlist(matleave[2, -1])將單行的data.frame轉換成vector。unlist()函數的作用是將一個列表（或在這個案例中是data.frame）中的所有元素合併成一個vector，這樣就可以用於barplot()。 為了進一步理解這種差異，我們可以使用class()或str()函數來觀察未經unlist()處理的資料。這將顯示出資料仍然保留在data.frame結構中，與unlist()後轉換為vector的結構有顯著的不同。這種轉換對於使用某些特定的繪圖函數，如barplot()，是必要的，因為它們需要一個vector作為輸入來正確地繪製圖形。 4.4.6.1 Plotting one row (one country) # barplot() the second row of m55 # barplot(m55[2, ]) # raise error # barplot() the second row when neglecting the first column # barplot(m55[2, -1]) # raise error # Take a look at the data type of matleave[2, ] class(matleave[2, -1]) ## [1] "tbl_df" "tbl" "data.frame" class(unlist(matleave[2, -1])) ## [1] "numeric" # unlist() to convert a single row data.frame to a vector for barplot() barplot(unlist(m55[2, -1])) Testing # View(matleave[1]) # select the 1st variable # View(matleave[ ,1]) # select the 1st column # View(matleave[1, ]) # select the 1st row class(m55[1]) # "tbl_df" "tbl" "data.frame" ## [1] "tbl_df" "tbl" "data.frame" class(m55[ ,1]) # "tbl_df" "tbl" "data.frame" ## [1] "tbl_df" "tbl" "data.frame" class(m55[1, ]) # "tbl_df" "tbl" "data.frame" ## [1] "tbl_df" "tbl" "data.frame" class(m55$iso3) # character (vector) ## [1] "character" 4.4.6.2 More arguments (args) 接下來我們要微調一下視覺化的結果。這行程式碼使用R中的barplot函數繪製一個長條圖，其中的參數說明如下： unlist(m55[2, -1]): 將m55資料集的第2行（不包括第1欄）轉換為一個向量，並作為長條圖的高度（即每個長條的高度）。 ylim=c(0, 5): 設置y軸的範圍為0到5，即長條圖的最大高度為5。 space=0: 設置相鄰兩個長條之間的距離為0，即長條緊密相連。 border=NA: 設置長條的邊框為透明，即不顯示邊框。 xaxt=\"n\": 不顯示x軸的標籤。 yaxt=\"n\": 不顯示y軸的標籤。 # barplot() the unlisted second row (neglecting the first col) barplot(unlist(m55[2, -1])) # use ?barplot to know more argument of the function. ?barplot # Add arguments ylim, space, border, and axat/yaxt one by one to barplot() barplot(unlist(m55[2, -1]), ylim=c(0, 5)) barplot(unlist(m55[2, -1]), ylim=c(0, 5), space=0) barplot(unlist(m55[2, -1]), ylim=c(0, 5), space=0, border=NA) barplot(unlist(m55[2, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") 4.4.6.3 Plotting multiple lines 我們已經成功繪製了一個國家的資料，接下來我們要繪出所有國家的資料。以m55這個篩選後的資料為例，我分別要繪製出第1列至第6列的國家。底下可以看見每一行非常相似且一致的特徵，僅有matleave內的索引由1被列出至6。對於這種重複的程式碼，最好的方法是用迴圈（for-loop）的方式將相同的程式碼，從1~6之間做六次。 # plot the first row barplot(unlist(m55[1, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") # plot the second to 6th rows barplot(unlist(m55[2, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") barplot(unlist(m55[3, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") barplot(unlist(m55[4, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") barplot(unlist(m55[5, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") barplot(unlist(m55[6, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") 4.4.6.4 for-loop to plot multiple lines 這段R語言程式碼使用for-loop來重複執行一個指定的程式區塊，將m55資料集的前六行資料分別繪製成長條圖。在這段程式碼中，變數i控制了for-loop的迭代次數，它從1到6依次取值，然後依次執行所指定的程式區塊。 一般的for-loop的結構如下：for (variable in sequence) {# code block to be executed}。其中，變數variable是用來控制for-loop的迭代次數的，它會從序列sequence中逐一取出元素，並將其賦值給變數variable，然後執行大括號{...}中所指定的程式區塊。 # use for loop and use i as index to barplot multiple subgraphs for(i in 1:6){ barplot(unlist(m55[i, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") } 4.4.6.5 Subplots 但這樣一個國家就要畫成一個Plot，如果要將多個國家、也就是多個Plots繪製在同一張圖上的話，R也有支援Subplot的函式與設定。在R語言中，par（parameter的縮寫）是一個用於設置繪圖參數的函數，通過它可以控制繪圖的外觀、尺寸、排列等各方面，以便更好地展示數據和分析結果。par函數可以用來設置以下參數： mfrow：設置畫布的分割，即將畫布分為多少行和多少列，例如mfrow=c(3,2)代表三列二行。 mai：設置畫布的邊緣大小，包括上下左右四個邊緣的大小。 cex：設置字體大小的縮放比例。 col：設置線條、點和字體的顏色。 pch：設置散點圖中點的形狀。 lty：設置線條的類型。 在這段程式碼中，par函數被用來設置畫布的分割和邊緣大小，具體來說，par(mfrow=c(3,2), mai= c(0.2, 0.2, 0.2, 0.2))表示將畫布分為3行2列的子圖，並設置邊緣大小為0.2，包括上下左右四個邊緣。這樣可以方便地在同一張畫布上顯示多個圖形，並控制它們之間的排列和間距。 # use ?par to get more plotting parameters ?par # use par() to set-up the layout of subgraphs # use the parameter main=c(0.2, 0.2, 0.2, 0.2) to thrink the padding of figures. par(mfrow=c(3,2), mai= c(0.2, 0.2, 0.2, 0.2)) for(i in 1:6){ barplot(unlist(m55[i, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") } 接下來我們用相同的for-loop來繪製10張子圖（十個國家）看看。會發現mfrow=c(3,2)可以容納六張子圖，多餘六張子圖時，會繪製至下一張。 # plot more rows to see what happens par(mfrow=c(3,2), mai= c(0.2, 0.2, 0.2, 0.2)) for(i in 1:10){ barplot(unlist(m55[i, -1]), ylim=c(0, 5), space=0, border=NA, xaxt="n", yaxt="n") } # plot all subplots in a figure 最後，我用nrow(m55)來取得m55這個data.frame共有多少個國家，然後，我讓for-loop從1:nrow(m55)相當於繪製完所有m55中的子圖。注意我已經修改了mfrow為mfrow=c(4, 6)。 # nrow() to check number of row of m55. nrow(m55) ## [1] 18 # use par() to set-up plotting parameters. par(mfrow=c(4, 6), mai= c(0.2, 0.2, 0.2, 0.2)) # use for-loop to plot all graph as subgraph for (i in 1:nrow(m55)){ barplot(unlist(m55[i, -1]), border=NA, space=0, xaxt="n", yaxt="n", ylim = c(0,5)) } 在每個子圖上，我要加上每個國家的國別代碼iso3，也就是m55的第一行，我用同樣的i來掃過每一列，繪製完barplot()後，便用title()函式來繪製文字。結果如下。注意我的設定title(m55[i,1], line = -4, cex.main=3)。line為繪製文字的基線，而cex.main是字型大小。 par(mfrow=c(4,6), mai= c(0.2, 0.2, 0.2, 0.2)) for (i in 1:nrow(m55)){ barplot(unlist(m55[i, -1]), border=NA, space=0,xaxt="n", yaxt="n", ylim = c(0,5)) title(m55[i,1], line = -4, cex.main=3) } 4.4.7 Practice. Plotting more 請繪製m05的資料，也就是matleave_95!=5但matleave_13==5的資料。 請繪製m04的資料，也就是matleave_95!=4但matleave_13==4的資料。 請繪製m44的資料，也就是matleave_95==4但matleave_13==4的資料。 # plotting matleave_95 != 5 but matleave_13 == 5 # plotting for matleave_13 == 4 4.4.8 Practice. Selecting and filtering by dplyr I 請嘗試問問ChatGPT，如果將以下程式碼改為dplyr的寫法，要怎麼寫。 df <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) # select columns by index # matleave <- df[ , c(3, 6:24)] # select all NA cells and assign 0 to them # matleave[is.na(matleave)] <- 0 # filter rows by condition # m5 <- matleave[matleave$'matleave_13' == 5, ] # filter rows by condition # m55<- m5[m5$'matleave_95' == 5,] # plot par(mfrow=c(4,6), mai= c(0.2, 0.2, 0.2, 0.2)) for (i in c(1:nrow(m55))){ barplot(unlist(m55[i,-1]), border=NA, space=0,xaxt="n", yaxt="n", ylim = c(0,5)) title(m55[i,1], line = -4, cex.main=3) } 4.4.9 (More) Clean version # readxl::read_excel() to import the xls file df <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) # select iso3, and matleave columns by index matleave <- df[ , c(3, 6:24)] # str() to inspect the data structure of str(matleave) ## tibble [197 × 20] (S3: tbl_df/tbl/data.frame) ## $ iso3 : chr [1:197] "AFG" "ALB" "DZA" "AND" ... ## $ matleave_95: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_96: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_97: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_98: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_99: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_00: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_01: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_02: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_03: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_04: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_05: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_06: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_07: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_08: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_09: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_10: num [1:197] 2 5 3 3 2 2 2 5 NA 5 ... ## $ matleave_11: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_12: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_13: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... # select all NA cells and assign 0 to them matleave[is.na(matleave)] <- 0 # filter rows by condition m5 <- matleave[matleave$'matleave_13' == 5, ] # filter rows by condition m55<- m5[m5$'matleave_95' == 5,] # plot par(mfrow=c(4,6), mai= c(0.2, 0.2, 0.2, 0.2)) for (i in c(1:nrow(m55))){ barplot(unlist(m55[i,-1]), border=NA, space=0,xaxt="n", yaxt="n", ylim = c(0,5)) title(m55[i,1], line = -4, cex.main=3) } 4.4.10 (More) The fittest version to compute staySame # staySame version # staySame <- apply(m5[,2:20], 1, function(x) length(unique(x[!is.na(x)]))) # m55 <- m5[staySame, ] # m50 <- m5[!staySame, ] "],["crosstab.html", "Chapter 5 Counting and Cross-tabulation 5.1 Taipei Residential Burglary 5.2 Read online files 5.3 Counting Review 5.4 Pivoting long-wide tables 5.5 Residuals analysis", " Chapter 5 Counting and Cross-tabulation 交叉分析是一種對兩個或多個變數進行聯合分析的方法，通常用於研究不同類別或組別之間的關係和差異。交叉分析可以幫助我們發現變數之間的相互作用，以及不同類別或組別之間的異同點，進而進行更深入的分析和解釋。 在交叉分析中，通常會使用交叉表（cross tabulation）或稱為列聯表（contingency table）來對變數進行分析。交叉表是一種二維資料表格，其中一個變數作為行，另一個變數作為列，每個資料格中則表示兩個變數的交叉次數或百分比。交叉表可以幫助我們從不同角度瞭解變數之間的關係和差異，例如： 發現變數之間的相關性：可以通過交叉表計算兩個變數之間的相關係數或卡方檢定值，以評估它們之間的相關性程度。 比較不同類別或組別之間的差異：可以通過交叉表比較不同類別或組別之間的差異，例如不同性別、年齡、教育程度、地區等對某一變數的影響。 發現變數之間的交互作用：可以通過交叉表比較不同類別或組別之間的差異，並分析它們之間的交互作用，以進一步瞭解變數之間的關係和影響。 5.1 Taipei Residential Burglary 觀察值、點位資料：公部門所發布的開放資料通常會根據某些類別進行統計，例如年齡、性別、教育程度、地區等等，只有少部分的資料會用觀察值（Observation）的方式來記錄，也就是每一個案例紀錄一筆資料。例如疫情一開始人數還少的時候，會逐一記錄每個個案；地理資訊系統上面記錄某些機構或某些特定地點的時候也是點位資料；或在觀察輿情時，每筆發言或留言都是一筆觀察值。「臺北市住宅竊盜點位資訊」就是逐案紀錄的點位資料。而以下的例子也是點位資料，主要為主要為噪音、竊盜、交通事故等相關點位資料。 臺北市街頭隨機強盜案件點位資訊、 臺北市街頭隨機搶奪案件點位資訊、 臺北市汽車竊盜點位資訊、 臺北市機車竊盜點位資訊、 臺北市自行車竊盜點位資訊、 臺北市道路交通事故斑點圖、 臺北市娛樂營業場所噪音告發案件點位資訊、 臺北市非營業用卡拉OK噪音告發案件點位資訊、 臺北市營建工程噪音告發案件點位資訊等， 5.1.1 讀取檔案 規劃比較完善的開放資料平台會提供API給程式設計者存取，例如臺北資料大平台或內政部開放資料平台。但我們這邊用下載CSV（Common Separated Value）檔的方式來讀取這筆資料，以理解CSV這種檔案型態如何儲存資料。首先要至臺北資料大平台上查詢「住宅竊盜」，可以找到臺北市住宅竊盜點位資訊。將該CSV檔下載至個人本機端，置入data 資料夾中，便可以用read.csv()讀取該檔案。或可用tidyverse系列套件中的readr::read_csv()來直接讀取該網址所指到的檔案。 我習慣在Console視窗中用??read_csv()查詢到這些函式的用法。 read.csv() to read csv and convert it to a data.frame readr::read_csv() to read csv or read a csv by an url 如果知道這個套件是readr的話，也可以到右下方的工作區塊找到「Packages」工作視窗，裡面有列出現在載入的所有的套件，也有套件中的所有函式。偶而看一看會發現一些自己平常忽略的好用工具。 library(knitr) library(kableExtra) library(tidyverse) df <- read.csv("data/臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv") head(df) ## 編號 案類 發生日期 發生時段 發生地點 ## 1 1 住宅竊盜 1030623 08~10 臺北市中正區廈門街91~120號 ## 2 2 住宅竊盜 1040101 00~02 臺北市文山區萬美里萬寧街1~30號 ## 3 3 住宅竊盜 1040101 00~02 臺北市信義區富台里忠孝東路5段295巷6弄1~30號 ## 4 4 住宅竊盜 1040101 06~08 臺北市中山區新生北路1段91~120號 ## 5 5 住宅竊盜 1040101 10~12 臺北市文山區明興里興隆路4段1~30號 ## 6 6 住宅竊盜 1040102 00~02 臺北市士林區天福里1鄰忠誠路2段130巷1~30號 用read_csv()來讀取。除了 base套件的read.csv()外，也可使用readr套件的read_csv()函式來讀取，該套件屬於tidyverse套件系的其中一個套件，如果已經有用install.packages(\"tidyverse\")安裝過，只要用library(tidyverse)就可以使用read_csv()函式。在此鼓勵各位使用tidyverse系列套件。普遍來說，read_csv() 的功能和效果都會比read.csv()好，該函式還會自動猜測每個變數的變數型態並直接進行轉換（尤其是有時間欄位的時候，會非常方便）。 萬一遇到中文檔案會有讀檔編碼問題時，有可能該檔案是用big5來儲存的，可以在read_csv()中設定locale來指定讀取的編碼方法。如read_csv(url, locale = locale(encoding = \"Big5\")) library(readr) df <- read_csv("data/臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv") # df <- read_csv("data/臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv", locale = locale(encoding = "Big5")) head(df) ## # A tibble: 6 × 5 ## 編號 案類 發生日期 發生時段 發生地點 ## <dbl> <chr> <dbl> <chr> <chr> ## 1 1 住宅竊盜 1030623 08~10 臺北市中正區廈門街91~120號 ## 2 2 住宅竊盜 1040101 00~02 臺北市文山區萬美里萬寧街1~30號 ## 3 3 住宅竊盜 1040101 00~02 臺北市信義區富台里忠孝東路5段295巷6弄1~30號 ## 4 4 住宅竊盜 1040101 06~08 臺北市中山區新生北路1段91~120號 ## 5 5 住宅竊盜 1040101 10~12 臺北市文山區明興里興隆路4段1~30號 ## 6 6 住宅竊盜 1040102 00~02 臺北市士林區天福里1鄰忠誠路2段130巷1~30號 5.1.1.1 觀察變數 names(df) 列出所有變數名稱 df$發生地點 顯示該變數內容 df$發生時段 顯示該變數內容 length(df$發生時段) 顯示該變數的長度（相當於有幾個） 5.1.2 萃取所需新變項 該data.frame包含編號、案類、發生日期、發生時段、發生地點五個變項。其中比較有意義的應該是發生日期、發生時段和發生地點。然而，發生地點幾乎是完整地址，除非要繪製發生的地圖點位地圖，才會需要近乎完整的地址。假設我們的目標是抽取出台北市的「行政區」，發生地點的格式還蠻一致的如「臺北市中正區廈門街91~120號」。因此，我們只要抽出發生地點的第4至6個字即可。 從一個字串中抽取出第n個字到第m個字，要用substr()或stringr套件的str_sub()。可以用?substr或?str_sub查詢help中的相關用法。在此 我將中文變數現在時間的資料指給一個新的英文變項time。 從變數發生地點，用substr()取出行政區（region） 或用stringr::str_sub() ?substr查詢其用法和意義。相當於getting sub string since x to y。 # Get substring of var "發生時段" and assign to a new time var df$time <- df$發生時段 # Get substring of var "發生地點" and assign to a new region var df$region <- substr(df$發生地點, 4, 5) head(df) ## # A tibble: 6 × 7 ## 編號 案類 發生日期 發生時段 發生地點 time region ## <dbl> <chr> <dbl> <chr> <chr> <chr> <chr> ## 1 1 住宅竊盜 1030623 08~10 臺北市中正區廈門街91~120號 08~10 中正 ## 2 2 住宅竊盜 1040101 00~02 臺北市文山區萬美里萬寧街1~30號 00~02 文山 ## 3 3 住宅竊盜 1040101 00~02 臺北市信義區富台里忠孝東路5段29… 00~02 信義 ## 4 4 住宅竊盜 1040101 06~08 臺北市中山區新生北路1段91~120號 06~08 中山 ## 5 5 住宅竊盜 1040101 10~12 臺北市文山區明興里興隆路4段1~30… 10~12 文山 ## 6 6 住宅竊盜 1040102 00~02 臺北市士林區天福里1鄰忠誠路2段1… 00~02 士林 5.1.3 使用table()計數 清理完資料後，我們要回答的第一個數據問題通常是「那XXX的案例有幾個？」例如：大安區有多少竊盜案？10~12這個時段有多少案例。 table()函式可以對Vector中的值進行計數（Counting）。table(df$time) 相當於去計數不同的時間區間出現多少起案例；table(df$region) 相當於去計數不同地區各出現多少起案例。 提示：可以用class(tb_1) 觀察用table() 計數後所產生的資料型態（table）。 ## table # counting the frequency of region variable (table(df$region)) ## ## 中山 中正 信義 內湖 北投 南港 士林 大同 大安 文山 松山 萬華 ## 438 263 214 303 318 181 373 172 311 204 220 350 # counting the frequency of time variable (tb_1 <- table(df$time)) # %>% View ## ## 00~02 02~04 03~05 04~06 05~07 06~08 08~10 09~11 10~12 11~03 11~13 12~14 12~15 ## 272 214 8 156 23 191 305 6 338 1 26 338 2 ## 14~16 15~17 15~18 16~18 17~19 18~20 18~21 19~21 20~22 21~23 21~24 22~24 23~01 ## 342 3 1 246 21 314 1 4 303 5 1 206 20 class(tb_1) ## [1] "table" 5.1.4 依變數值篩選資料 該項竊盜案資料整理時經常不慎用不同的時間區間來標記，有時候也會不小心把新北市的資料給那進來，所以需要做資料篩選。從各個時間區間的竊盜案出現次數來觀察，有少數的案件出現在奇數的時間區間如09~11或12~15等等需要篩除；從各個行政區的竊盜案出現次數來觀察，確實都是台北市的竊盜案。 接下來要用base套件的R，根據某個變數值（例如上述的時間）來篩出符合條件的資料，或者篩去不符合條件的資料。其語法是要在df[ , ]逗號前加上篩選的條件，也就是對資料列進行篩選，篩出或篩除都是以整列為單位。在此的條件是df$time在00~02、02~04、…之間；或者是df$time不在03~05、05~07、…之間。表示法分別如下： df$time %in% c("00~02", "02~04", "04~6",...) !df$time %in% c("03~05", "05~07", ...) %in% 表示的是左方df$time的值是否是右方Vector中的其中一個 如果要表示不包含，就在df%time加一個NOT，也就是!。 依照各組時間的案例個數統計後，篩除資料未足100的時間區間如下，最後再用table(df$time) 計算一次，發現每個時段都兩三、百個案例，且涵蓋整日的時間。清理後沒有重疊的時間區間，做類別資料分析會比較準確。 # filter out irrelevant timestamp df <- df[!df$time %in% c("03~05", "05~07", "09~11", "11~13", "11~03", "12~15", "15~17", "15~18", "17~19", "18~21", "19~21", "21~23", "21~24", "23~01"), ] table(df$time) ## ## 00~02 02~04 04~06 06~08 08~10 10~12 12~14 14~16 16~18 18~20 20~22 22~24 ## 272 214 156 191 305 338 338 342 246 314 303 206 # filter out irrelevant region(area) # df <- df[!df$region %in% c("三重", "中和", "淡水", "板橋"), ] 5.1.5 做雙變數樞紐分析：table() 類別變項分析通常是要考驗兩個變項間的關係，從上述的計數中，我可以看見不同行政區或者不同時間的竊盜案數量，但我進一步想知道，那不同行政區的竊盜案常發生時間是否不同？這時後就要做時間和行政區的交叉分析。我們同樣可以用table()和tapply()來做兩個變項的交叉分析，寫法如下。 用table()來交叉分析的結果如下，所得到的結果之變數型態仍是table型態。 # Tabulating time and region variables (res_table <- table(df$time, df$region)) ## ## 中山 中正 信義 內湖 北投 南港 士林 大同 大安 文山 松山 萬華 ## 00~02 62 15 27 20 24 19 28 15 24 17 4 17 ## 02~04 26 22 12 15 17 12 29 10 15 14 13 29 ## 04~06 22 7 11 15 17 6 14 15 14 8 5 22 ## 06~08 20 19 13 16 24 13 17 9 19 9 11 21 ## 08~10 45 27 20 27 22 16 24 17 31 18 24 34 ## 10~12 38 20 18 33 35 19 35 12 34 18 35 41 ## 12~14 30 25 20 26 34 15 46 12 49 25 23 33 ## 14~16 43 19 18 39 32 20 40 26 32 19 22 32 ## 16~18 21 19 8 24 33 11 30 13 25 16 20 26 ## 18~20 39 42 23 22 40 18 31 13 23 23 17 23 ## 20~22 40 13 22 34 17 20 41 13 26 15 25 37 ## 22~24 33 20 16 18 15 9 23 9 12 17 14 20 # Checking it class and its content class(res_table) ## [1] "table" ## [1] "table" 5.1.6 繪圖 通常這種類別資料交叉分析最常用的圖表型態之一便是Mosaic Plot（但事實上Mosaic Plot不見能夠被一眼就了解）。我們可以把交叉分析後的變項res_table直接用MosaicPlot來繪圖。 # mosaicplot() to plot 2-dim categorical vars. mosaicplot(res_table) # Add argument main (figure title) mosaicplot(res_table, main="mosaic plot") 5.1.6.1 解決圖表無法顯示中文 大部分的視覺化套件都無法順利顯示中文，除非特別指定所要用的中文字型。這方面網路上可以找到很多的說明，但非常討厭的是，幾乎每換一套視覺化工具，換一套語言，就有不同的中文字體指定方式。例如用base的plot()來繪圖或用ggplot()的中文字型指定方法便不同，且軸上面有中文、圖標有中文、或者圖內有中文都要分開指定，非常討人厭。 Mosaic Plot屬於base R的plot()，其中文指定方法要指定在繪圖前的par()函式中（par為parameter的意思），指定方法為par(family=('Heiti TC Light'))，Heiti TC Light為字體名稱，為OSX上在用的黑體細字，STKaiti則為標楷體。然後，par()和mosaicplot()兩個函式要「同時執行」，也就是請你直接用shift-cmd(ctrl)-Enter執行整個code-cell，或者將該兩個函式選起來一次執行。 par(family=('STKaiti')) # par(family=('Heiti TC Light')) mosaicplot(res_table, main="mosaic plot", color=T) 5.1.6.2 自訂顏色 目前顏色實在過醜，你可以自訂顏色指給mosaicplot()。例如我底下便產製了12種顏色後，將其作為mosaicplot()的參數 # Set up color by yourself. colors <- c('#D0104C', '#DB4D6D', '#E83015', '#F75C2F', '#E79460', '#E98B2A', '#9B6E23', '#F7C242', '#BEC23F', '#90B44B', '#66BAB7', '#1E88A8') # par(family=('STKaiti')) par(family=('Heiti TC Light')) mosaicplot(res_table, color=colors, border=0, off = 3, main="Theft rate of Taipei city (region by hour)") 5.1.7 Practices 5.1.7.1 萃取月份作為新變項month 除了時間和地區可能會有差別外，那月份會不會竊盜案的數量也有差異呢？會不會冬天小偷也都在家休息了，夏天多呢？請嘗試從發生日期萃取出竊盜案發生的月份，並儲存為一個新的變項month。 5.1.7.2 使用count()來計數 請練習看看如果用count()來計數單一變項，如前述的region、time或前面練習中新產生的month。 5.1.7.3 分週末與週間計算 使用lubridate套件可以將文字表示的日期轉換為R的時間物件，進而可以用lubridate的wday()函式求取該日期是週幾，便可以計算，週間和週末的竊盜率有何差別。可以先計算看看，週一到週日分別有什麼差別，再去計算週間與週末的平均會有什麼差別（要注意，週末和週間天數並不同） 5.2 Read online files 方法一：直接依資料網址讀取檔案。現在的程式語言所設計的讀取檔案函式通常會允許使用者直接讀取資料所在的URL。所以，我們可以直接從網路上載入台北市竊盜案資料。首先要至臺北資料大平台上查詢「住宅竊盜」，可以找到臺北市住宅竊盜點位資訊，點選後對右上方的下載按右鍵可取得鏈結到該資料的URL（如https://data.taipei/api/getDatasetInfo/downloadResource?id=68785231-d6c5-47a1-b001-77eec70bec02&rid=93d9bc2d-af08-4db7-a56b-9f0a49226fa3）。 由於該資料網址似非永久網址，故本範例並未執行以下程式碼，僅提供範例程式碼讓個人替換網址來做測試。 方法二：用R程式將該網址的檔案抓回本機端儲存。部分Mac電腦無法使用read.csv()從網路上取得資料又轉為data.frame，一個可行的辦法是先用GET(url,write_disk(\"data/tptheft.csv\"))將其取回並命名為data/tptheft.csv，之後再用df <- read.csv(\"data/tptheft.csv\")直接讀取該檔案。 {library(httr)} GET(url, write_disk(\"data/tptheft.csv\", overwrite = TRUE)) df <- read.csv(\"data/tptheft.csv\") 5.3 Counting Review 5.3.1 tapply() 我們也可用tapply() 函式來達到一樣的目的。Apply家族的函式都是，針對某個資料，將某個函式套用到某個物件上。tapply() 即是用來做計數的，tapply(df$編號, df$time, length)有三個輸入，第一個輸入為整體物件，第二個輸入為要據以彙整的變項，在此為df$time，第三個是要用來彙整的函式，因為這裡要做計數，所以要用length函式。 註：同樣用class()來觀察彙整後的資料型態為array，和前者的table資料型態不同。 5.3.2 tapply() two variables 用tapply()來做兩個變數交叉分析的語法如下，必須要把兩個Vector包在一個list()中。其他不變。兩個變項用tapply()交叉分析後的結果，變數型態會變成matrix。前者用table()來交叉分析的仍是table型態。 res_tapply ## 中山 中正 信義 內湖 北投 南港 士林 大同 大安 文山 松山 萬華 ## 00~02 62 15 27 20 24 19 28 15 24 17 4 17 ## 02~04 26 22 12 15 17 12 29 10 15 14 13 29 ## 04~06 22 7 11 15 17 6 14 15 14 8 5 22 ## 06~08 20 19 13 16 24 13 17 9 19 9 11 21 ## 08~10 45 27 20 27 22 16 24 17 31 18 24 34 ## 10~12 38 20 18 33 35 19 35 12 34 18 35 41 ## 12~14 30 25 20 26 34 15 46 12 49 25 23 33 ## 14~16 43 19 18 39 32 20 40 26 32 19 22 32 ## 16~18 21 19 8 24 33 11 30 13 25 16 20 26 ## 18~20 39 42 23 22 40 18 31 13 23 23 17 23 ## 20~22 40 13 22 34 17 20 41 13 26 15 25 37 ## 22~24 33 20 16 18 15 9 23 9 12 17 14 20 # View(res) 5.3.3 dplyr::count() two variables 這邊多介紹一個用dplyr套件的count()函式來做交叉分析的方法（未來會常用這個方法，因為dplyr是tidyverse系列套件的核心套件。dplyr的函式第一個參數永遠是該data.frame， 例如count()；後面time與region則是這個data.frame中的兩個變項。不像tapply()或table()的結果一樣，欄與列分別為time與region，count()出來的結果會有兩個變項分別是指定要計數的time與region ，且會新增一個變項n，代表這組數據（time x region）共有幾個。這種表達型態通常稱為long-table（長表）、而tapply()或table() 的結果通常稱為wide-table（寬表）為典型的交叉分析表。 目前大部分的類別資料分析還是會採用交叉分析表的型態，但未來我們要用tidyverse系列套件做大量的數據彙整或視覺化時，都會盡可能想辦法轉為Long-table型態，讓每一欄剛好就是一個變項。只要是tidyverse系列套件所計算出來的資料型態幾乎都是類似data.frame的型態，例如觀察count的結果便是\"tbl_df\" \"tbl\" \"data.frame\"。 5.4 Pivoting long-wide tables 5.4.1 long-to-wide 那長表列可以轉為寬表嗎？可以，tidyverse系列套件中的tidyr套件有個函式spread()可以接著把某個變項展開為欄。例如原本上述的列是時間與行政區的交叉組合，但我可以把行政區展開為欄、或者把時間展開為欄 。如下例，spread(res_count, region, n, fill = 0) 有四個參數，遵循tidyverse系列套件的規則，第一個位置為data.frame，第二個參數則是要被展開至欄的變項這裡為region，第三個參數則是因應region被展開後，那中間交叉分析的數值就是n，最後一個參數是避免spread時有些交叉組是沒有資料的，因此fill=0可以指定，如果某個time x region的交叉組別是沒資料的，就填上0，也有可能是用fill=NA填上NA。以下的例子中也提供了將time 展開至欄的寫法供參考。 現在spread()函式已經被新的函式取代，為pivot_wider()。spread(res_count, region, n, fill = 0) 在此需要改寫為pivot_wider(res_count, names_from = region, values_from = n, values_fill = 0)。大致上和spread()用法是一樣的，只是要寫清楚，哪個變數要給哪一個參數。 展開後的資料型態和前者計數後的資料型態一樣，都是\"tbl_df\" \"tbl\" \"data.frame\"。這是為什麼tidyverse系列的套件逐漸變成R的顯學的原因之一。 library(tidyr) # spreading the region into columns # (res_count_spread <- spread(res_count, region, n, fill = 0)) res_count_spread <- pivot_wider(res_count, names_from = region, values_from = n, values_fill = 0) class(res_count_spread) ## [1] "tbl_df" "tbl" "data.frame" # spreading the time into columns # res_count_spread <- spread(res_count, time, n, fill = 0) res_count_spread # %>% View ## # A tibble: 12 × 13 ## time 中山 中正 信義 內湖 北投 南港 士林 大同 大安 文山 松山 萬華 ## <chr> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> ## 1 00~02 62 15 27 20 24 19 28 15 24 17 4 17 ## 2 02~04 26 22 12 15 17 12 29 10 15 14 13 29 ## 3 04~06 22 7 11 15 17 6 14 15 14 8 5 22 ## 4 06~08 20 19 13 16 24 13 17 9 19 9 11 21 ## 5 08~10 45 27 20 27 22 16 24 17 31 18 24 34 ## 6 10~12 38 20 18 33 35 19 35 12 34 18 35 41 ## 7 12~14 30 25 20 26 34 15 46 12 49 25 23 33 ## 8 14~16 43 19 18 39 32 20 40 26 32 19 22 32 ## 9 16~18 21 19 8 24 33 11 30 13 25 16 20 26 ## 10 18~20 39 42 23 22 40 18 31 13 23 23 17 23 ## 11 20~22 40 13 22 34 17 20 41 13 26 15 25 37 ## 12 22~24 33 20 16 18 15 9 23 9 12 17 14 20 # ??dplyr::count 5.4.2 Wide-to-long 寬表格亦可用tidyr的gather()函式轉回長表格型態。但gather()近期也已經被新的函式pivot_longer()取代。原先的gather(res_count_spread, region, n, -time)應取代為pivot_longer(res_count_spread, -time, names_to = \"region\", values_to = \"n\")。 # (long_table <- tidyr::gather(res_count_spread, region, n, -time)) long_table <- pivot_longer(res_count_spread, -time, names_to = "region", values_to = "n") 5.5 Residuals analysis mosaicplot()有幾個參數可以用，包含off與shade可用於呈現殘差分析。 off: vector of offsets to determine percentage spacing at each level of the mosaic (appropriate values are between 0 and 20, and the default is 20 times the number of splits for 2-dimensional tables, and 10 otherwise). Rescaled to maximally 50, and recycled if necessary. shade: a logical indicating whether to produce extended mosaic plots, or a numeric vector of at most 5 distinct positive numbers giving the absolute values of the cut points for the residuals. By default, shade is FALSE, and simple mosaics are created. Using shade = TRUE cuts absolute values at 2 and 4. # par(family=('STKaiti')) par(family=('Heiti TC Light')) mosaicplot(res_table, color=T, shade = T, border=0, off = 3, main="Theft rate of Taipei city (region by hour)") "],["base2dplyr.html", "Chapter 6 From base R to dplyr 6.1 dplyr 6.2 Taipie Theft Count (base to dplyr) 6.3 Paid Maternity Leave", " Chapter 6 From base R to dplyr From base to tidyverse style 相較於R base的較為傳統的R編程風格，tidyverse style的R programming具有以下幾個特點： 基於tidy data理念：tidyverse style的R programming基於tidy data理念，即資料應該以規律的方式組織，以方便分析和視覺化。tidyverse style的R程式庫提供了一些工具和函數，用於處理和轉換tidy data格式的資料，如dplyr、tidyr等。 使用管道操作符：tidyverse style的R programming通常使用管道操作符（%>%），將資料通過多個函數連接起來，形成一個清晰和易於理解的資料處理流程。使用管道操作符可以簡化程式碼並提高程式的可讀性。 強調函數庫的一致性：tidyverse style的R programming強調函數庫之間的一致性，即不同函數庫之間使用相似的函數名稱、參數名稱和返回值等，以方便使用者的學習和使用。 使用簡潔的命名方式：tidyverse style的R programming通常使用簡潔和易於理解的變數和函數命名方式，例如使用動詞表示操作，使用名詞表示資料，以方便使用者理解程式碼的含義。 提供高級的視覺化工具：tidyverse style的R programming提供了一些高級的視覺化工具，如ggplot2、gganimate等，可以幫助使用者更加輕鬆地進行資料視覺化和探索。 6.1 dplyr dplyr是一個tidyverse風格的R程式庫，用於對資料進行快速、一致、直觀的操作和轉換。dplyr提供了一些高效能的函數和工具，如filter、select、mutate、group_by和summarize等，用於對資料進行選擇、篩選、轉換、分組和摘要等操作。 以下是dplyr常用的函數： filter：用於選擇符合特定條件的資料列。 select：用於選擇特定的欄位。 mutate：用於新增或修改欄位。 group_by：用於按照特定欄位進行分組。 summarize：用於對分組後的資料進行摘要統計。 arrange：用於按照欄位的特定順序進行排序。 dplyr具有以下優點： 簡潔而直觀的語法：dplyr的函數名稱和語法都十分簡潔而直觀，易於使用和理解，尤其對於新手來說更加友好。 高效的運行速度：dplyr的設計考慮了資料處理的效率，使用C++實現了部分函數，因此dplyr在處理大型資料集時運行速度較快。 與tidyverse相容：dplyr與其他tidyverse程式庫，如ggplot2和tidyr，可以很好地相容，並且能夠與其他常用的R程式庫進行集成，提供更加全面和高效的資料分析和可視化工具。 6.2 Taipie Theft Count (base to dplyr) library(tidyverse) # options(stringsAsFactors = F) # default options in R ver.> 4.0 6.2.1 Reading data # Read by read_csv() # Will raise error # Error in make.names(x) : invalid multibyte string at '<bd>s<b8><b9>' # df <- read_csv("data/tp_theft.csv") # read_csv() with locale = locale(encoding = "Big5") library(readr) df <- read_csv("data/臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv") 6.2.2 Cleaning data I Renaming variables by select() Generating variable year by mutate() Generating variable month by mutate() Retrieving area by mutate() 6.2.2.1 (1) Without pipeline I df1 <- select(df, id = 編號, cat = 案類, date = `發生日期`, time = `發生時段`, location = `發生地點`) df2 <- mutate(df1, year = date %/% 10000) df3 <- mutate(df2, month = date %/% 100 %% 100) df4 <- mutate(df3, area = str_sub(location, 4, 6)) selected_df <- mutate(df4, county = str_sub(location, 1, 3)) 6.2.2.2 (2) Without pipeline II library(stringr) selected_df <- select(df, id = 編號, cat = 案類, date = `發生日期`, time = `發生時段`, location = `發生地點`) selected_df <- mutate(selected_df, year = date %/% 10000) selected_df <- mutate(selected_df, month = date %/% 100 %% 100) selected_df <- mutate(selected_df, area = str_sub(location, 4, 6)) selected_df <- mutate(selected_df, county = str_sub(location, 1, 3)) 6.2.2.3 (3) With pipeline library(stringr) selected_df <- df %>% select(id = 編號, cat = 案類, date = `發生日期`, time = `發生時段`, location = `發生地點`) %>% mutate(year = date %/% 10000) %>% mutate(month = date %/% 100 %% 100) %>% mutate(area = str_sub(location, 4, 6)) %>% mutate(county = str_sub(location, 1, 3)) 6.2.3 Cleaning data II Filtering out irrelevant data records # readr::guess_encoding("data/tp_theft.csv") filtered_df <- selected_df %>% # count(year) %>% View filter(county == "臺北市") %>% filter(year >= 104) %>% # count(time) %>% View # count(location) %>% filter(!area %in% c("中和市", "板橋市")) 6.2.4 Long to wide form count() two variables pivot_wider() spread one variable as columns to wide form # count() then pivot_wider() df.wide <- filtered_df %>% count(time, area) %>% pivot_wider(names_from = area, values_from = n, values_fill = 0) ??pivot_wider 6.2.5 Setting time as row.name for mosaicplot row.names(df.wide) <- df.wide$time df.wide$time <- NULL # Specify fonts for Chinese # par(family=('STKaiti')) par(family=('Heiti TC Light')) # for mac # Specify colors colors <- c('#D0104C', '#DB4D6D', '#E83015', '#F75C2F', '#E79460', '#E98B2A', '#9B6E23', '#F7C242', '#BEC23F', '#90B44B', '#66BAB7', '#1E88A8') # mosaicplot() mosaicplot(df.wide, color=colors, border=0, off = 3, main="Theft rate of Taipei city (region by hour)") 6.2.6 Clean version library(readr) # options(stringsAsFactors = F) df <- read_csv("data/臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv") selected_df <- df %>% select(id = 編號, cat = 案類, date = `發生日期`, time = `發生時段`, location = `發生地點`) %>% mutate(year = date %/% 10000) %>% mutate(month = date %/% 100 %% 100) %>% mutate(area = stringr::str_sub(location, 4, 6)) %>% mutate(county = stringr::str_sub(location, 1, 3)) selected_df %>% count(year) ## # A tibble: 9 × 2 ## year n ## <dbl> <int> ## 1 103 1 ## 2 104 687 ## 3 105 663 ## 4 106 560 ## 5 107 501 ## 6 108 411 ## 7 109 304 ## 8 110 189 ## 9 111 31 selected_df %>% count(time) %>% head(10) ## # A tibble: 10 × 2 ## time n ## <chr> <int> ## 1 00~02 272 ## 2 02~04 214 ## 3 03~05 8 ## 4 04~06 156 ## 5 05~07 23 ## 6 06~08 191 ## 7 08~10 305 ## 8 09~11 6 ## 9 10~12 338 ## 10 11~03 1 selected_df %>% arrange(time) %>% head(10) ## # A tibble: 10 × 9 ## id cat date time location year month area county ## <dbl> <chr> <dbl> <chr> <chr> <dbl> <dbl> <chr> <chr> ## 1 2 住宅竊盜 1040101 00~02 臺北市文山區萬美里萬寧… 104 1 文山… 臺北市 ## 2 3 住宅竊盜 1040101 00~02 臺北市信義區富台里忠孝… 104 1 信義… 臺北市 ## 3 6 住宅竊盜 1040102 00~02 臺北市士林區天福里1鄰… 104 1 士林… 臺北市 ## 4 12 住宅竊盜 1040105 00~02 臺北市中山區南京東路3… 104 1 中山… 臺北市 ## 5 33 住宅竊盜 1040115 00~02 臺北市松山區饒河街181~… 104 1 松山… 臺北市 ## 6 74 住宅竊盜 1040131 00~02 臺北市南港區重陽路57巷… 104 1 南港… 臺北市 ## 7 75 住宅竊盜 1040201 00~02 臺北市北投區中心里中和… 104 2 北投… 臺北市 ## 8 92 住宅竊盜 1040210 00~02 臺北市北投區大同路200… 104 2 北投… 臺北市 ## 9 95 住宅竊盜 1040212 00~02 臺北市萬華區萬大路493… 104 2 萬華… 臺北市 ## 10 106 住宅竊盜 1040216 00~02 臺北市信義區吳興街269… 104 2 信義… 臺北市 filtered_df <- selected_df %>% # count(year) %>% View filter(year >= 104) %>% filter(!time %in% c("03~05", "05~07", "09~11", "11~13", "15~17", "17~19", "18~21", "21~23", "23~01")) # count(time) %>% View # count(location) %>% # filter(!area %in% c("中和市", "板橋市")) df.wide <- filtered_df %>% count(time, area) %>% pivot_wider(names_from = area, values_from = n, values_fill = 0) %>% as.data.frame() row.names(df.wide) <- df.wide$time df.wide$time <- NULL par(family=('Heiti TC Light')) # for mac # Specify colors colors <- c('#D0104C', '#DB4D6D', '#E83015', '#F75C2F', '#E79460', '#E98B2A', '#9B6E23', '#F7C242', '#BEC23F', '#90B44B', '#66BAB7', '#1E88A8') # mosaicplot() mosaicplot(df.wide, color=colors, border=0, off = 3, main="Theft rate of Taipei city (region by hour)") 6.3 Paid Maternity Leave 6.3.1 Visual Strategies 這個例子之所以有趣在於記者選定了「美國沒有產假支薪」作為新聞的賣點。在呈現的時候，就必須要盡可能地凸顯這樣的情形。一般來說，會繪製世界地圖來呈現美國是目前少數沒有產假支薪的國家之一（在本資料197個國家中僅有9國目前沒有給付產假薪水。其實該筆來自Word Policy Analysis Center資料含有自1995年至2003年共19年的資料（本案例即就是下載該中心所分享的調查資料，不用申請帳號）。於是該專題的作者便構思利用過去到現在的資料來凸顯美國在這方面一直沒有改變。 但要處理197個國家的在19年間的變化相當不易。例如若為每年繪製一張世界地圖，然後以動畫或動態卷軸來凸顯這19年間美國的變化，也會因為國家數過多而難以聚焦在作者想突顯的美國。 而這便是作者在視覺化上相當具有巧思的地方。由於產假給付程度在該調查中分為五個等級，包含0週、0-14週、14-25週、26-51週、52週以上等。作者便從給付程度最高的層級開始做長條圖，共五個階層的子圖。而每個階層的子圖，作者又將該層級的圖分為「保持不變（Stay Same）」和「持續增加（Increase）」兩組。經過這樣的分組，會得到9個子圖。分別為等級5（保持不變、持續增加）、等級4（保持不變、持續增加）、…、等級1（保持不變）。讀者在看的時候，會依次看到給付程度最高到最低的國家，也可以看到哪些國家在這19年間制度有所變化（通常是增加）。但看到最後的時候，便會看到美國的情形，即是無產假給付。 6.3.2 Code by base R library(readxl) # readxl::read_excel() to import the xls file df <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) # select iso3, and matleave columns by index matleave <- df[ , c(3, 6:24)] # str() to inspect the data structure of str(matleave) ## tibble [197 × 20] (S3: tbl_df/tbl/data.frame) ## $ iso3 : chr [1:197] "AFG" "ALB" "DZA" "AND" ... ## $ matleave_95: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_96: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_97: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_98: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_99: num [1:197] 2 5 3 2 2 2 2 3 1 5 ... ## $ matleave_00: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_01: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_02: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_03: num [1:197] 2 5 3 3 2 2 2 3 1 5 ... ## $ matleave_04: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_05: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_06: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_07: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_08: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_09: num [1:197] 2 5 3 3 2 2 2 5 1 5 ... ## $ matleave_10: num [1:197] 2 5 3 3 2 2 2 5 NA 5 ... ## $ matleave_11: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_12: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... ## $ matleave_13: num [1:197] 2 5 3 3 2 2 2 5 3 5 ... # select all NA cells and assign 0 to them matleave[is.na(matleave)] <- 0 # filter rows by condition m5 <- matleave[matleave$'matleave_13' == 5, ] # filter rows by condition m55<- m5[m5$'matleave_95' == 5,] # plot par(mfrow=c(4,6), mai= c(0.2, 0.2, 0.2, 0.2)) for (i in c(1:nrow(m55))){ barplot(unlist(m55[i,-1]), border=NA, space=0,xaxt="n", yaxt="n", ylim = c(0,5)) title(m55[i,1], line = -4, cex.main=3) } 6.3.3 Code by dplyr 首先，程式碼使用 filter() 函數篩選出符合條件的列，其中 matleave_13 和 matleave_95 兩欄都必須等於 5。接著，pivot_longer() 函數將資料框轉換成長格式（long format），將從第二欄到第二十欄的資料整合到兩個欄位 year 和 degree 中。這裡 names_to 參數指定新欄位 year 的名稱，values_to 參數指定新欄位 degree 的名稱，cols 參數指定要整合的欄位範圍。 接下來，replace_na() 函數將 degree 欄位中的 NA 值替換為 0。然後，mutate() 函數使用 as.POSIXct() 函數將 year 欄位中的字串轉換為日期時間格式，再使用 year() 函數從日期時間中提取年份，最終將年份資訊存儲回 year 欄位中。其中 “matleave_%y” 是日期時間格式字串，其中 “%y” 表示兩位數的年份（例如 “13”）。這樣就將 “matleave_13”、“matleave_14” 等字串轉換成了對應的日期時間。 ggplot() 函數創建了一個空的 ggplot2 圖形物件，使用 aes() 函數定義了 x 軸 year 和 y 軸 degree 的變數名稱。geom_col() 函數指定用長條圖呈現資料，設置了顏色和填充顏色。ylim() 函數限制了 y 軸的範圍，將其設置為 0 到 5，無論y軸資料有沒有到5或者是否超過5，都會限定在0到5之間。facet_wrap() 函數則根據 iso3 欄位生成多個子圖。最後，theme_void() 函數將圖形主題設置為空白，不帶任何邊框或背景。 library(tidyverse) ## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ── ## ✔ dplyr 1.1.4 ✔ readr 2.1.5 ## ✔ forcats 1.0.0 ✔ stringr 1.5.1 ## ✔ ggplot2 3.5.0 ✔ tibble 3.2.1 ## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1 ## ✔ purrr 1.0.2 ## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ── ## ✖ dplyr::filter() masks stats::filter() ## ✖ dplyr::lag() masks stats::lag() ## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors options(scipen = 999) library(readxl) matleave <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) %>% select(iso3, 6:24) matleave %>% filter(matleave_13 == 5, matleave_95 == 5) %>% pivot_longer(names_to = "year", values_to = "degree", cols = 2:20) %>% replace_na(list(degree = 0)) %>% mutate(year = year(as.POSIXct(strptime(year, "matleave_%y")))) %>% ggplot() + aes(year, degree) + geom_col(color = "royalblue", fill = "royalblue") + ylim(0, 5) + facet_wrap(~ iso3) + theme_void() 下圖為原始資料的截圖，matleave_95代表1995年的資料，每個變數的數據1至5分別代表產假時給付薪水的月數區間共有五個區間。區間大小通常需要查看編碼簿來獲取定義。 這類資料由於採用數字（其實是Factor）來替代類別，通常隨著數據會釋出該調查的編碼簿（Code Book），這個案例的編碼（1至5）如下： 6.3.4 Generating each 在 R 中，函式是一個可重複使用的程式碼塊，可以接受輸入參數，並返回計算結果。函式可以簡化程式碼，使其更易於維護和修改。為了不要重複相同的程式碼，以下程式碼將視覺化的部分改用「函式」來進行撰寫，再輸入不同子圖所要使用的資料來進行繪圖。 在這個程式碼中，generating_plot() 是一個自定義的函式，它接受一個資料框 df 作為輸入參數。成對大括號內部為該函式所執行的步驟，包含pivot_longer()、replace_na()等。輸出則是一個 ggplot2 圖形物件，其中包含了將這些資料轉換為長條圖的視覺化表示。 在 R 中，創建一個函式需要使用 function() 關鍵字。一個最簡單的函式可能只包含一個輸入參數和一個返回值，例如：my_function <- function(x) {return(x^2)}。在這個例子中，函式名稱是 my_function，它有一個輸入參數 x，函式主體是 x^2，表示將輸入的 x 參數平方。函式主體的執行結果通過 return() 函數返回，並可以存儲到變數中，例如：result <- my_function(3)。函式的定義亦可包含多個輸入參數，可以用數字、list、或Data.Frame等當成輸入參數。 library(tidyverse) options(scipen = 999) library(readxl) matleave <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) %>% select(iso3, 6:24) generating_plot <- function(df){ df %>% pivot_longer(names_to = "year", values_to = "degree", cols = 2:20) %>% replace_na(list(degree = 0)) %>% mutate(year = year(as.POSIXct(strptime(year, "matleave_%y")))) %>% ggplot() + aes(year, degree) + geom_col(color = "royalblue", fill = "royalblue") + ylim(0, 5) + facet_wrap(~ iso3) + theme_void() + theme(strip.text = element_text(size = 14, face = "bold", vjust=0.5), strip.placement = "inside" ) } matleave %>% filter(matleave_13 == 5, matleave_95 == 5) %>% generating_plot() matleave %>% filter(matleave_13 == 5, matleave_95 != 5) %>% generating_plot() matleave %>% filter(matleave_13 == 4, matleave_95 == 4) %>% generating_plot() matleave %>% filter(matleave_13 == 4, matleave_95 != 4) %>% generating_plot() matleave %>% filter(matleave_13 == 3, matleave_95 == 3) %>% generating_plot() matleave %>% filter(matleave_13 == 3, matleave_95 != 3) %>% generating_plot() matleave %>% filter(matleave_13 == 2, matleave_95 == 2) %>% generating_plot() matleave %>% filter(matleave_13 == 2, matleave_95 != 2) %>% generating_plot() matleave %>% filter(matleave_13 == 1) %>% generating_plot() 6.3.5 Gathering subplots by cowplot 這段程式碼的作用是將多個 ggplot2 圖形物件組合成一個網格，然後將這個網格圖形儲存為一個圖像文件。首先，這段程式碼定義了多個變數，如 plot_row1、plot_row2、plot_row3 等，每個變數都是一個網格圖形。這些變數通過 plot_grid() 函數來創建，這個函數可以將多個 ggplot2 圖形物件組合成一個網格。在 plot_grid() 函數中，可以設置 labels 參數來為每個子圖添加標籤。 然後，這些變數通過 plot_grid() 函數再次組合，形成一個更大的網格圖形。這裡使用 ncol = 1 參數將多個網格排列成一列。最後，使用 ggsave() 函數將這個網格圖形儲存為一個圖像文件。在這個例子中，圖像文件的名稱是 “test.png”，大小為 10 英寸 x 30 英寸，分辨率為 300 DPI。 總的來說，這段程式碼的作用是將多個 ggplot2 圖形物件組合成一個網格，並將這個網格圖形儲存為一個圖像文件。這樣做可以方便地進行圖像導出和共享，並且可以將多個圖形合併在一起進行比較和分析。 library(cowplot) plot55 <- matleave %>% filter(matleave_13 == 5, matleave_95 == 5) %>% generating_plot() plot05 <- matleave %>% filter(matleave_13 == 5, matleave_95 != 5) %>% generating_plot() plot44 <- matleave %>% filter(matleave_13 == 4, matleave_95 == 4) %>% generating_plot() plot04 <- matleave %>% filter(matleave_13 == 4, matleave_95 != 4) %>% generating_plot() plot33 <- matleave %>% filter(matleave_13 == 3, matleave_95 == 3) %>% generating_plot() plot03 <- matleave %>% filter(matleave_13 == 3, matleave_95 != 3) %>% generating_plot() plot22 <- matleave %>% filter(matleave_13 == 2, matleave_95 == 2) %>% generating_plot() plot02 <- matleave %>% filter(matleave_13 == 2, matleave_95 != 2) %>% generating_plot() plot11 <- matleave %>% filter(matleave_13 == 1) %>% generating_plot() plot_row1 <- plot_grid(plot55, plot05, labels = c('STAY 5', 'INCREASE TO 5')) plot_row2 <- plot_grid(plot44, plot04, labels = c('STAY 4', 'INCREASE TO 4')) plot_row3 <- plot_grid(plot33, plot03, labels = c('STAY 3', 'INCREASE TO 3')) plot_row4 <- plot_grid(plot22, plot02, labels = c('STAY 2', 'INCREASE TO 2')) final_plot <- plot_grid( plot_row1, plot_row2, plot_row3, plot_row4, plot11, ncol = 1 ) ggsave("test.png", final_plot, width=10, height=30, dpi=300) "],["joindata.html", "Chapter 7 Data manipultaiton: Join data 7.1 讀取內政部人口統計資料 7.2 讀取公投資料", " Chapter 7 Data manipultaiton: Join data 7.1 讀取內政部人口統計資料 先使用slice(-1)減去第一行中文欄位名稱。再來，目前縣市鄉鎮市區（site_id）和村里（village）分別是兩個變項，由於不同的鄉鎮市可能會有相同的村里名，所以把site_id與village粘接起來成為完整的村里名vname。 這邊我多加了一行程式碼讓vname可以排到前面一點的變項欄，可以用select()達到這個目的，我之後的變項欄的還要寶劉，所以我多打一個everything()就可以把剩下的變項欄都擺放在後面。因此這個重排變項欄的完整程式碼為select(vname, everything())。 raw <- read_csv("data/opendata107Y030.csv") %>% slice(-1) %>% mutate(vname = str_c(site_id, village)) %>% select(vname, everything()) raw %>% head ## # A tibble: 6 × 157 ## vname statistic_yyy district_code site_id village single_age_15down_m ## <chr> <chr> <chr> <chr> <chr> <chr> ## 1 新北市板橋區… 107 65000010001 新北市… 留侯里 118 ## 2 新北市板橋區… 107 65000010002 新北市… 流芳里 119 ## 3 新北市板橋區… 107 65000010003 新北市… 赤松里 60 ## 4 新北市板橋區… 107 65000010004 新北市… 黃石里 113 ## 5 新北市板橋區… 107 65000010005 新北市… 挹秀里 123 ## 6 新北市板橋區… 107 65000010006 新北市… 湳興里 351 ## # ℹ 151 more variables: single_age_15_19_m <chr>, single_age_20_24_m <chr>, ## # single_age_25_29_m <chr>, single_age_30_34_m <chr>, ## # single_age_35_39_m <chr>, single_age_40_44_m <chr>, ## # single_age_45_49_m <chr>, single_age_50_54_m <chr>, ## # single_age_55_59_m <chr>, single_age_60_64_m <chr>, ## # single_age_65_69_m <chr>, single_age_70_74_m <chr>, ## # single_age_75_79_m <chr>, single_age_80_84_m <chr>, … # raw %>% glimpse() 7.1.1 分析規劃 建立各鄉鎮市區的老年人口比例 建立各鄉鎮市區的年齡中位數 讀取所有（某一）公投案的結果 視覺化年齡與公投結果間的相關性 7.1.2 清理資料 我們之前在談資料的「觀察、統計、和二維表格」三種型態時，曾經談到統計型態和二維表格型態間的差異。當時所提到的「統計型態」，也就是每個變項欄恰好是我們所認知的單一變項（如每一個變項欄恰是人口統計變項的年齡、性別、教育程度、數量），會有助於進行統計分析，也就是tidy型態的資料。相較之下，上述的表格是把資料攤成二維的型態，每一個變項是某個年齡層的某種性別的某種婚姻狀況，包含了三個人口統計變項，是方便一般大眾讀的，但不是適合進行統計的tidy型態。 這類的資料tidyverse的相關套件把它稱為tidy form。遵守tidy form形式的資料是，每一個欄恰好一個變項。例如在內政部開放資料「15歲以上現住人口按性別、年齡、婚姻狀況及教育程度分」中，每個變數（年齡、婚姻狀況、教育程度、人口數等等）均各自為一個欄上的變項。 15歲以上現住人口按性別、年齡、婚姻狀況及教育程度分 | 政府資料開放平臺 (data.gov.tw) 接下來，我要把表格型態的資料轉為tidy型態資料。原本的資料是這樣的型態。 我要將後方的數值變項欄（single_age_15down_m等）轉為單一變項key的值，再把其所對應到的資料值，也轉為單一變項value。請注意看上圖和程式碼後方結果圖的顏色區塊。南投縣中寮鄉中寮村（綠色）被複製且展開為多列。而原本多個年齡層和資料的變數項（紅色）變成一個變項欄的資料，分別對應到其原本對應的數值（藍色）。 tidy_data <- raw %>% pivot_longer(names_to = "key", values_to = "value", cols = 6:ncol(.)) 相對於pivot_wider()把變項展開成欄，pivot_longer()函式可以收合被展開的變項，在此將要收合的變數名稱統一稱為key，並將該變數所對應到的數值稱為value。並且我用6:ncol(.)來指定我要收合哪些變項欄。 ncol(.)的「.」代表從前面%>% pipe進來的那個data.frame。 pivot_longer()後資料列從7760增加至1,179,520列。（灰底部分用來觀察結果用） 由於每一列恰好是一種婚姻狀態、一個年齡層和一個性別，所以，我們可以把key中的婚姻狀態、年齡層和性別切割出來做為變數。觀察key欄位發現其格式有一些規律性，主要是婚姻狀態_年齡下界_年齡上界_性別的形式。標準的範例如married_15_10_m或widowed_25_29_f，但有一些並非這種形式，例如： single_age_15_19_m：其中single_age之間多了一個底線，所以把single_age取代為single就好。 married_15down_m：因為是15down少了一個底線，所以取代為0_14。 married_100up_f：因為100up少了一個底線，所以取代為100_105。 之後，我使用tidyr::separate()函式將key切成四個變項，分別為married、ageLower、ageUpper、gender。 separate()有一個參數是remove=T（預設值），意思是說，當把key變項切割為四個變項後，預設把key變項給丟棄；但如果未來你還會用到key變項的話，你可以把remove改為FALSE，代表切割完後，還保留key變項。 tidyr::separate()：Given either regular expression or a vector of character positions, separate() turns a single character column into multiple columns. 此時我清理出來的資料大致如下： 最後就剩零星的操作，包含轉換資料為數值型態、或者你也可以在這裡建立新的指標（例如年齡平均）。最後加上一個arrange(vname)讓他按照村里的全名排序。 tidy_data <- raw %>% pivot_longer(names_to = "key", values_to = "value", cols = 6:ncol(.)) %>% mutate(key = str_replace(key, "_age", "")) %>% mutate(key = str_replace(key, "100up", "100_110")) %>% mutate(key = str_replace(key, "15down", "0_15")) %>% separate(key, c("married", "ageLower", "ageUpper", "gender")) %>% mutate(ageLower = as.numeric(ageLower), # age = str(ageLower, ageUpper), ageUpper = as.numeric(ageUpper), value = as.numeric(value)) %>% select(-statistic_yyy) %>% arrange(vname) 7.1.3 進階：運用rowwise() raw %>% mutate_at(vars(6:157), as.numeric) %>% replace(is.na(.), 0) %>% rowwise() %>% mutate(married = sum(c_across(matches("widowed|divorced|married")), na.rm = T)) %>% mutate(lt65 = sum(c_across(matches("65|70|75|80|85|90|95|100")), na.rm = T)) %>% select(vname, married, lt65) %>% head ## # A tibble: 6 × 3 ## # Rowwise: ## vname married lt65 ## <chr> <dbl> <dbl> ## 1 新北市板橋區留侯里 920 272 ## 2 新北市板橋區流芳里 826 280 ## 3 新北市板橋區赤松里 463 149 ## 4 新北市板橋區黃石里 632 210 ## 5 新北市板橋區挹秀里 1061 365 ## 6 新北市板橋區湳興里 3157 838 7.1.4 建立鄉鎮市區與村里指標 7.1.4.1 使用group_by()建立村里指標 將資料轉換為tidy型態後，接下來要做的事情是建立村里、鄉鎮市區、縣市的分級指標。針對每個村里，我希望計算出總人口數people（原本依據年齡與性別、婚姻情形分割）、老年人總數elderSum、曾結婚人口總數marriedSum。之後再分別除以該村里的總人口數people，老年人的人口比例elderPerc以及結婚的人口比例marriedPerc。 因為一個村里的資料會根據不同性別、不同婚姻情形、不同年齡層被切割為不同的資料列，共2X4X19個資料列。因此，如果我想知道一個村里的總人口數或相關統計資料，就不需彙整這些資料列。dplyr有非常強大的group_by()可以根據群組來進行運算，我用村里代號（district_code）來做群組運算，所以是group_by(district_code)或用我們所產生的vname作為群組基準來運算group_by(vname)。 語法上，通常group_by()之後經常會跟著summarise()，跟mutate()的語法有點像，都會產生新變數，但因為這邊用group_by()針對某個或某幾個變數做彙整，相當於base套件的apply()函式，因此會根據每個不同的群組做組內的數值彙整運算。比方說，在以下的程式碼中，我用sum(num)計算了該群組內的總人數，然後同樣累計了年齡大於等於65歲的總人數，以及婚姻狀態不為single的總人數。 簡單地說，相當於按照不同的村里（district_code）各別做value的加總（該村里的總人口數）、篩選出年齡65歲以上的人口組別進行加總、篩選出不是單身者的人口組別進行加總。之後會加一個ungroup()解開群組。 最後一行left_join(raw %>% select(vname, site_id), by = \"vname\")是由於group_by()後會讓其他變數消失（例如鄉鎮市區名site_id），所以我希望將原本資料raw中的site_id給併回來。我可以抽取出raw中的vname和site_id兩個變項，然後以vname為key，用left_join()將site_id給併回來。 筆記：當group_by()、summarize()後不參與的變項會消失，但可以透過left_join()的方式將原有的變項併回來。 village_stat <- tidy_data %>% filter(ageLower >= 20) %>% group_by(vname) %>% summarise(legalPopulation = sum(value), elderSum = sum(value[ageLower >= 65]), marriedSum = sum(value[married %in% c("married", "divorced", "widowed")]), womenSum = sum(value[gender == "f"])) %>% ungroup() %>% left_join(raw %>% select(vname, site_id), by = "vname") 測試 7.1.4.2 將村里指標匯總為鄉鎮市區指標 剛剛是根據村里（village）來建立指標，現在要根據鄉鎮市區來建立指標。走過前方的邏輯後，我們只需要把原本用來做group_by()的村里變項vname改為鄉鎮市區的變項site_id，就可以完成這件事，其他都一樣，你發現沒？ 不過這邊我要多做一件事。因為三民區和鳳山區兩個區非常的大（我猜），所以內政資料中的鄉鎮市區資料有分「三民一」、「三民二」、「鳳山一」、「鳳山二」。我們只要在彙整資料前，將site_id的這四類值取代好，便可以在鄉鎮市區的指標中一併彙整。以下我一共彙整出四種資料，分別為該區人口數（legalPopulation）、老年人口數（elderSum）、曾婚人口數（marriedSum）、女性人口數（womenSum）。不難想像接下來可以計算出各鄉鎮市區的老年人口比例、曾婚比例、女性比例等。 town_stat <- village_stat %>% # mutate(site_id = str_sub(vname, 1, 6)) %>% mutate(site_id = str_replace(site_id, "三民一|三民二", "三民區")) %>% mutate(site_id = str_replace(site_id, "鳳山一|鳳山二", "鳳山區")) %>% group_by(site_id) %>% summarize(legalPopulation = sum(legalPopulation), elderSum = sum(elderSum), marriedSum = sum(marriedSum), womenSum = sum(womenSum) )%>% ungroup() 7.1.5 視覺化測試（老年人口數 x 曾婚人口數） town_stat %>% mutate(marriedPerc = marriedSum / legalPopulation) %>% mutate(womenPerc = womenSum / legalPopulation) %>% mutate(elderPerc = elderSum / legalPopulation) %>% ggplot() + aes(marriedPerc, elderPerc) + geom_point(alpha = 0.3) # geom_jitter(alpha = 0.3) 7.2 讀取公投資料 首先，先讀取資料並重新命名每個變項。由於我們要連結公投資料和前面的內政部人口統計資料，所以要注意兩筆資料間是否有共通的key（資料庫稱為鍵值）。town_stat的是以site_id鄉鎮市區名為主鍵，所以公投資料這邊也產生一個同名的鄉鎮市區變項site_id。 ref10 <- read_csv("data/ref10.csv") %>% select(county = 縣市, town = 鄉鎮市區, agree = 同意票數, disagree = 不同意票數, legalVote = 有效票數, illegalVote = 無效票數, vote = 投票數, legalPopulation = 投票權人數) %>% mutate(site_id = str_c(county, town)) %>% drop_na(site_id) names(ref10) ## [1] "county" "town" "agree" "disagree" ## [5] "legalVote" "illegalVote" "vote" "legalPopulation" ## [9] "site_id" 合併資料測試，注意，由於兩邊都有legalPopulation，所以town_stat中的legalPopulation增生為legalPopulation.x，而ref10中的legalPopulation則重新命名為legalPopulation.y。 town_stat %>% left_join(ref10, by = "site_id") ## # A tibble: 368 × 13 ## site_id legalPopulation.x elderSum marriedSum womenSum county town agree ## <chr> <dbl> <dbl> <dbl> <dbl> <chr> <chr> <dbl> ## 1 南投縣中寮… 12791 3272 9553 5824 南投縣 中寮… 5748 ## 2 南投縣仁愛… 12172 1713 9078 5899 南投縣 仁愛… 5702 ## 3 南投縣信義… 12860 1847 9050 5938 南投縣 信義… 6891 ## 4 南投縣南投… 81874 15855 57042 41343 南投縣 南投… 37547 ## 5 南投縣名間… 32388 7106 23375 15304 南投縣 名間… 14533 ## 6 南投縣國姓… 16196 3744 11826 7434 南投縣 國姓… 7089 ## 7 南投縣埔里… 66699 13411 46316 33718 南投縣 埔里… 29571 ## 8 南投縣水里… 15023 3644 10850 7106 南投縣 水里… 6392 ## 9 南投縣竹山… 45629 10154 33201 22244 南投縣 竹山… 19254 ## 10 南投縣草屯… 80426 15141 56384 40008 南投縣 草屯… 35215 ## # ℹ 358 more rows ## # ℹ 5 more variables: disagree <dbl>, legalVote <dbl>, illegalVote <dbl>, ## # vote <dbl>, legalPopulation.y <dbl> 7.2.1 合併公投資料並視覺化 由於人口統計資料中的鄉鎮市區若只有兩個字如「東區」中間有一全形空白「東 區」，但公投資料中並沒有這樣的空白，所以為了兩者要能夠正確合併，需要先做好取代。可以逐一取代，或者，直接取代掉該全形空白為空字串即可。 town_stat %>% mutate(site_id = str_replace(site_id, " ", "")) %>% # mutate(site_id = str_replace(site_id, "東 區", "東區"), # site_id = str_replace(site_id, "西 區", "西區"), # site_id = str_replace(site_id, "南 區", "南區"), # site_id = str_replace(site_id, "北 區", "北區"), # site_id = str_replace(site_id, "中 區", "中區")) %>% left_join(ref10, by = "site_id") %>% mutate(agreeRate = agree / legalVote, marriedPerc = marriedSum / legalPopulation.x) %>% # select(site_id, agree, legalVote, marriedSum, legalPopulation.x) %>% ggplot() + aes(agreeRate, marriedPerc) + geom_point(alpha = 0.5, color = "royalblue") + theme_light() "],["categorical.html", "Chapter 8 Categorical Data Analysis 8.1 Survey Analysis 8.2 The Case: Misinformation Perception 8.3 Factorizing data 8.4 Order-to-factor 8.5 Cross-tabulating", " Chapter 8 Categorical Data Analysis 8.1 Survey Analysis 國外不少媒體會用智庫或者學術單位所發佈的調查結果作為資料新聞素材，我們所曾經處理過的華盛頓郵報的產假支薪案例也是。以下為該案例資料的截圖。matleave_95代表1995年的資料，每個變數的數據1至5分別代表產假時給付薪水的月數區間共有五個區間。區間大小通常需要查看編碼簿來獲取定義。 這類資料由於採用數字（其實是Factor）來替代類別，通常隨著數據會釋出該調查的編碼簿（Code Book），這個案例的編碼（1至5）如下： 8.2 The Case: Misinformation Perception 這個範例涵括了在做問卷分析時常用的處理步驟。最核心的步驟是將文字陳述的類別資料轉換為便於後續運算的factor或數值資料。如果類別數量過多的時候，在這個過程會順便進行重新分組。例如依照年齡組把填答者分為老年、中壯年、青少年、兒童四組。 raw <- read_rds("data/tfc_survey.rds") raw ## # A tibble: 1,216 × 6 ## Q7 Q8 QAParty QASide QA3 QA4 ## <chr> <chr> <chr> <chr> <chr> <chr> ## 1 會 絕對會 民主進步黨 非常接近泛綠 25-29 研究所及以上 ## 2 會 絕對會 沒有政黨偏好 接近泛藍 35-39 研究所及以上 ## 3 不會 絕對會 沒有政黨偏好 接近泛綠 35-39 大專（專科與大學） ## 4 會 會 台灣民眾黨 接近泛綠 20-24 大專（專科與大學） ## 5 不會 不會 民主進步黨 非常接近泛綠 45-49 研究所及以上 ## 6 會 絕對會 沒有政黨偏好 非常接近泛藍 25-29 大專（專科與大學） ## 7 不會 絕對會 民主進步黨 接近泛綠 30-34 大專（專科與大學） ## 8 會 絕對會 台灣民眾黨 接近泛綠 20-24 大專（專科與大學） ## 9 會 絕對會 沒有政黨偏好 接近泛藍 20-24 大專（專科與大學） ## 10 會 會 民主進步黨 接近泛綠 55-59 高中、高職 ## # ℹ 1,206 more rows 8.3 Factorizing data 通常問卷會分為兩種類型的資料，一種是人口統計用的基本資料（如性別、年齡組、教育程度）、另一種是問卷本身要問的題項。以下是常見的問卷型態，包含把年齡從20歲開始每五年作為一組，70歲以上則歸類為一組，共會有十一組。而教育程度則常分為五至六組，但在問卷設計的時候，通常會需要增加「拒答」的選項。如果問卷中包含政黨意識形態，就必須要決定要以黨派作為類別變項，或者以意識形態做順序尺度。以下即為一個順序尺度的案例，從「非常接近泛綠」到「非常接近泛藍」共五個等第，但另增「拒答」選項。 dt <- raw %>% mutate(QA3 = ordered(QA3, levels=c("20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70及以上"))) %>% mutate(QA3_lv = ordered(QA3, levels=c("20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70及以上"), labels = c("青年", "青年", "壯年", "壯年", "壯年", "中年", "中年", "中年", "中年", "老年", "老年"))) %>% mutate(QA4 = ordered(QA4, levels=c("拒答", "國小及以下", "初中、國中", "高中、高職", "大專（專科與大學）", "研究所及以上"), labels=c("拒答", "國小以下", "國中", "高中職", "大專", "研究所以上"))) %>% mutate(QASide=ordered(QASide, exclude="拒答", levels=c("非常接近泛綠", "接近泛綠", "都不接近", "接近泛藍", "非常接近泛藍"))) 8.3.1 factor-to-order 在一開始清理資料的時候，會建議先把類別變數（通常是文字型態）轉為factor型態。常用的函式是用mutate()搭配ordered()來改變變數型態。ordered()會照類別順序來標定該factor所對應到的數字。可以用as.integer()將factor轉為整數後就可以看到各類別的順序。 mutate(QA3 = ordered(QA3, levels=c("20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70及以上"))) %>% dt$QA3[1:10] ## [1] 25-29 35-39 35-39 20-24 45-49 25-29 30-34 20-24 20-24 55-59 ## 11 Levels: 20-24 < 25-29 < 30-34 < 35-39 < 40-44 < 45-49 < 50-54 < ... < 70及以上 as.integer(dt$QA3[1:10]) ## [1] 2 4 4 1 6 2 3 1 1 8 8.3.2 Excluding 如果有某些類別變數的值（如「拒答」）不想被編入factor，可以在reorder()中加入exclude的參數指定不想被編入類別值。 mutate(QASide=ordered(QASide, exclude="拒答", levels=c("非常接近泛綠", "接近泛綠", "都不接近", "接近泛藍", "非常接近泛藍"))) dt$QASide[1:10] ## [1] 非常接近泛綠 接近泛藍 接近泛綠 接近泛綠 非常接近泛綠 ## [6] 非常接近泛藍 接近泛綠 接近泛綠 接近泛藍 接近泛綠 ## Levels: 非常接近泛綠 < 接近泛綠 < 都不接近 < 接近泛藍 < 非常接近泛藍 as.integer(dt$QASide[1:10]) ## [1] 1 4 2 2 1 5 2 2 4 2 8.3.3 Grouping-up 如果有某些類別變數的類別過多，希望再次群組化為較少的組別，如重新群組各年齡層為青年、壯年、中年與老年四個尺度。此時除了levels參數外，可以另外加入labels的參數，指定每個類別變數值所要對應到的群組。以下為群組後的結果，仔細觀察剩下多少個尺度。 mutate(QA3_lv = ordered(QA3, levels=c("20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70及以上"), labels = c("青年", "青年", "壯年", "壯年", "壯年", "中年", "中年", "中年", "中年", "老年", "老年"))) %>% dt$QA3[1:10] ## [1] 25-29 35-39 35-39 20-24 45-49 25-29 30-34 20-24 20-24 55-59 ## 11 Levels: 20-24 < 25-29 < 30-34 < 35-39 < 40-44 < 45-49 < 50-54 < ... < 70及以上 as.integer(dt$QA3[1:10]) ## [1] 2 4 4 1 6 2 3 1 1 8 dt$QA3_lv[1:10] ## [1] 青年 壯年 壯年 青年 中年 青年 壯年 青年 青年 中年 ## Levels: 青年 < 壯年 < 中年 < 老年 8.4 Order-to-factor Q7 請問您會不會受到假消息影響？ Q8 請問您認為其他人會不會受到假消息的影響？ 對於Q7、Q8的問題是詢問填答者認為自己或他人會不會受到假消息影響，並從「一點也不會」、「不會」、「會」到「絕對會」共分四個等第。Q7分別是「81, 446, 650, 39」、Q8分別是「5, 58, 803, 350」。相較於Q7，Q8的分佈略為左傾，亦即傾向於認為其他人較容易受影響。此時如果想要分析Q7和Q8間的關係，由於各有四個等第，其交叉分析表會有16個項目，相當難以分析。 dt2 <- dt %>% mutate(Q7 = ordered(Q7, levels=c("一點也不會", "不會", "會", "絕對會"))) %>% mutate(Q8 = ordered(Q8, levels=c("一點也不會", "不會", "會", "絕對會"))) %>% mutate(Q7_3rd = as.numeric(Q8)-as.numeric(Q7)) %>% mutate(Q7_3rd_lv = ifelse(Q7 %in% c("一點也不會", "不會") & Q8 %in% c("會", "絕對會"), "高", "低")) %>% mutate(Q7_3rd_lv = ordered(Q7_3rd_lv, levels=c("低", "高"))) 這時候一種策略是把這兩題視為順序尺度變數，然後把兩題的分數相減。相減後的分數從「-1, 0, 1, 2, 3」各有「12, 482, 600, 103, 19」，不難猜到會是一個較為集中的分佈，後續僅能當作順序尺度或連續變項來分析，不適合找一個閾值轉類別變項。 另一種策略是，分別先把Q7與Q8的「一點也不會」和「不會」群組為「不會」、再把「會」與「絕對會」群組為「會」，這樣Q7與Q8的交叉分析表會變成2X2的分析表，雖然群組數量比較少，但別忘記Q7的填答結果集中在會與不會、而Q8為一個較為偏右的分佈，集中在「會」和「絕對會」。Q8勢必會造成比例不均的分組。 dt2 %>% count(as.integer(Q8)-as.integer(Q7)) ## # A tibble: 5 × 2 ## `as.integer(Q8) - as.integer(Q7)` n ## <int> <int> ## 1 -1 12 ## 2 0 482 ## 3 1 600 ## 4 2 103 ## 5 3 19 最後這題所採行的策略是，做高、低第三人效果分組，也就是根據認為自己「一點也不會」、「不會」受影響，而他人「會」或「絕對會」受影響的重新群組為「高第三人效果組」，其他則為「低第三人效果組」。亦即，分組的一句是在對自己與他人的認知上，無模糊空間的分組方法（也就是認為自己至少不會，和認為別人應該會）。 dt2 %>% count(Q7_3rd_lv) ## # A tibble: 2 × 2 ## Q7_3rd_lv n ## <ord> <int> ## 1 低 746 ## 2 高 470 8.5 Cross-tabulating 在R語言中，xtabs()是一個用於建立交叉表（cross-tabulation）的函數。它可以將資料中的變數進行交叉分類，並計算每個交叉組合的頻次或其他統計量。 chisq.test(xtb)分析結果指出 X-squared（卡方值）等於10.017，df（自由度）等於3，p-value（p值）等於0.01842。 這個結果顯示在這個交叉表中，QA3_lv（年齡層）Q7_3rd_lv（第三人效應）間的分類狀態並非完全獨立，而是存在某種統計上的關聯性。 由於p值小於我們事先選定的顯著性水準（通常為0.05），我們可以拒絕虛無假設（兩個變數獨立），並認為這個關聯性是統計上顯著的。 對於vcd::assocstats(xtb)的分析結果： 這些統計量用於評估QA3_lv和Q7_3rd_lv之間的關聯性程度。 連續性係數（Contingency Coeff.）和克拉瑪爾V（Cramer’s V）的值，表示兩個變數之間的關聯性較弱，但仍存在一定程度的相關性。 (xtb <- xtabs(~QA3_lv + Q7_3rd_lv, data=dt2)) ## Q7_3rd_lv ## QA3_lv 低 高 ## 青年 178 110 ## 壯年 370 199 ## 中年 157 134 ## 老年 41 27 (chi2 <- chisq.test(xtb)) ## ## Pearson's Chi-squared test ## ## data: xtb ## X-squared = 10.017, df = 3, p-value = 0.01842 vcd::assocstats(xtb) ## X^2 df P(> X^2) ## Likelihood Ratio 9.9301 3 0.01917 ## Pearson 10.0173 3 0.01842 ## ## Phi-Coefficient : NA ## Contingency Coeff.: 0.09 ## Cramer's V : 0.091 print(round(chi2$observed, 2)) ## Q7_3rd_lv ## QA3_lv 低 高 ## 青年 178 110 ## 壯年 370 199 ## 中年 157 134 ## 老年 41 27 print(round(chi2$expected, 2)) ## Q7_3rd_lv ## QA3_lv 低 高 ## 青年 176.68 111.32 ## 壯年 349.07 219.93 ## 中年 178.52 112.48 ## 老年 41.72 26.28 print(round(chi2$residuals, 2)) ## Q7_3rd_lv ## QA3_lv 低 高 ## 青年 0.10 -0.12 ## 壯年 1.12 -1.41 ## 中年 -1.61 2.03 ## 老年 -0.11 0.14 par(family="Heiti TC Light") gplots::balloonplot(t(xtb), xlab="第三人效果", ylab="年齡組", main="", dotsize=4/max(strwidth(40),strheight(40)), text.size=1.5,label.size=2, rowmar=1, colmar=1) par(family="Heiti TC Light") corrplot::corrplot(chi2$residuals, is.corr = F) xtb %>% as_tibble() %>% group_by(QA3_lv) %>% mutate(fill = if_else(n == max(n), "orangered", "skyblue")) %>% ungroup() %>% mutate(QA3_lv = ordered(QA3_lv, levels=c("青年", "壯年", "中年", "老年"))) %>% arrange(desc(QA3_lv)) %>% ggplot() + aes(y = QA3_lv, x=Q7_3rd_lv, color = fill, size = n) + scale_size_area(max_size=70, guide = "none") + geom_point(alpha=0.7) + scale_color_manual(values = c("orangered", "skyblue"), guide = "none") + geom_text(aes( label=n, vjust=1.3, size=10 ), color="black",) + theme_minimal() + theme(text = element_text(family="Heiti TC Light"), title = element_text(family="Heiti TC Light")) "],["timeline.html", "Chapter 9 Processing Timeline 9.1 Time object 9.2 Example: Processing time object in social opinions", " Chapter 9 Processing Timeline 9.1 Time object 在當前的數位時代，網路上充斥著豐富的開放資料，許多其中包含著關鍵的時間資訊，如訂單成立的時間、氣象觀測的時刻以及股票的交易時間等。這些時間數據往往以字串形式存在，但若需進行時間計算或構建時間序列分析，在程式處理前必須將其轉化為專門的時間物件。 在R語言中，主要有兩種時間物件：POSIXct和POSIXlt，它們可通過as.POSIXct()和as.POSIXlt()函數將字串轉換成相應的時間物件形式。一旦轉換完成，各種時間相關的計算操作，如時間點之間的差異計算、時區轉換、時間序列的特定區間提取等，便可輕鬆進行。具體而言，POSIXct是以1970年1月1日00:00:00 UTC至當前的總秒數來表示時間點，適合於進行數學計算；而POSIXlt則採用結構化列表形式存儲，包括年、月、日、小時、分、秒等時間單位，更便於人工閱讀與理解。這兩種時間物件的主要差異在於，POSIXct較為適合於計算處理，POSIXlt則在時間元素的展示與處理上更為直觀。 此外，利用Sys.time()函數能夠獲取當前時刻的時間物件，這為時間數據的動態處理提供了便利。學習如何有效運用這些時間物件進行日期與時間的計算在許多領域，例如金融、氣象、交通等，都是非常關鍵的能力。 9.2 Example: Processing time object in social opinions 9.2.1 Char-to-Time 在 R 裡面，我們可以使用 strptime() 函數將字串轉換為時間物件，其中 %Y、%m、%d、%H、%M、%S 等是用來表示時間的格式碼。在這段程式碼中，我們使用 strptime() 函數將 ptime 這個字串轉換為一個時間物件，其中 %Y-%m-%dT%H:%M:%SZ 是該字串的時間格式，也就是說這個字串是以 ISO 8601 的格式表示的時間，例如 2022-03-31T14:30:00Z。tz = \"ASIA/Taipei\" 則是指定時間所在的時區，這裡指定的是台灣時間。轉換完成後，我們使用 as.POSIXct() 函數將 strptime() 轉換出來的時間物件再轉換為POSIXct時間物件，並將其存入 ptime 這個欄位中。這段程式碼的作用是將一個 ISO 8601 格式的字串轉換為 POSIXct 時間物件，並指定時區為台灣，方便之後進行時間相關的運算。 在 strptime() 函數中，可以使用不同的格式碼來指定時間的格式。以下是常用的幾種格式碼及其意義： %Y：四位數的年份，例如 2022。 %m：兩位數的月份，範圍是 01 到 12。 %d：兩位數的日期，範圍是 01 到 31。 %H：兩位數的小時，範圍是 00 到 23。 %M：兩位數的分鐘，範圍是 00 到 59。 %S：兩位數的秒數，範圍是 00 到 59。 %b：縮寫形式的月份名稱，例如 Jan。 %B：完整形式的月份名稱，例如 January。 %a：縮寫形式的星期幾名稱，例如 Mon。 %A：完整形式的星期幾名稱，例如 Monday。 %p：AM 或 PM，例如 AM。 在 strptime() 函數中，你可以使用這些格式碼來指定一個字串的時間格式，以便將其轉換為時間物件。例如，如果一個字串的格式是 2022-03-31 14:30:00，那麼可以使用 %Y-%m-%d %H:%M:%S 這個時間格式來將其轉換為一個時間物件。 # Reading from url # ptturl <- "https://github.com/P4CSS/R4CSSData/raw/main/ptt_hang_posts.csv" # raw <- read.csv(url(ptturl)) # read_csv() won't convert timestamp to POSIXct automatically # raw <- read.csv("data/ptt_hang_posts.csv") # clean <- raw %>% # mutate(ptime = as.POSIXct(strptime(ptime, "%Y-%m-%dT%H:%M:%SZ"))) # read_csv() will convert timestamp to POSIXct automatically clean <- read_csv("data/ptt_hang_posts.csv") t <- "2019-04-12T00:48:19Z" class(t) ## [1] "character" ?strptime t1 <- strptime(t, "%Y-%m-%dT%H:%M:%SZ") clean %>% head # %>% View ## # A tibble: 6 × 7 ## plink board pcontent poster ptitle ptime ipaddr ## <chr> <chr> <chr> <chr> <chr> <dttm> <chr> ## 1 https://www.ptt.cc/bb… Hate… "\\n\\n韓… loveb… Re: [… 2019-04-12 02:21:14 83.22… ## 2 https://www.ptt.cc/bb… Hate… "\\n\\n\\n… ikr36… Re: [… 2019-04-12 02:13:45 114.4… ## 3 https://www.ptt.cc/bb… Hate… "\\n\\n正… sunye… Re: [… 2019-04-12 02:10:18 118.1… ## 4 https://www.ptt.cc/bb… Hate… "\\n:\\n\\… rock7… Re: [… 2019-04-12 02:03:14 118.1… ## 5 https://www.ptt.cc/bb… Hate… "\\n\\n我… btm97… Re: [… 2019-04-12 02:01:12 101.1… ## 6 https://www.ptt.cc/bb… Hate… "\\n\\n\\n… cblade [討論… 2019-04-12 01:55:06 180.2… 9.2.2 Density plot along time 在資料分析的過程中，我們經常需要對資料進行分布分析，以了解資料的特性。ggplot2 套件提供了 geom_density() 函數，可以用來繪製密度圖（density plot）。密度圖顯示了一個連續變量的概率密度函數的近似值，可以用來了解該變量的分佈情況。密度圖與直方圖類似，但它是基於核密度估計方法繪製的，所以在某些情況下可以提供更好的分佈近似。它將一個連續變量區間劃分為若干個小區間，然後對每個小區間的密度進行估計，再將這些小區間的密度估計值連接起來，形成一條平滑曲線，用以描述變量的分佈情況。 在 ggplot2 中，使用 geom_density() 函數可以很方便地繪製密度圖。我們只需要指定變量名稱，即可繪製出該變量的密度圖。此外，我們也可以使用 stat_density() 函數來繪製密度圖，這個函數允許我們對密度圖進行更多的自定義設置，例如指定核函數、調整帶寬等。繪製密度圖可以讓我們更直觀地了解變量的分佈情況，進而對資料進行更深入的分析和探索。 clean %>% ggplot() + aes(ptime) + geom_density() 9.2.3 Freq by month 如果想要詳細觀察逐年逐月的變化，使用密度圖可能不夠直觀，此時可以考慮使用直方圖來呈現資料。直方圖可以將資料劃分為若干個等寬的區間，並計算每個區間內資料的頻率，然後將這些頻率顯示為長方形柱，以反映資料的分佈情況。對於時間序列資料，我們可以將其劃分為月、週等時間單位，然後計算每個時間單位內資料的出現次數，再使用 ggplot2 中的 geom_col() 函數繪製直方圖。 以上程式碼中，我們使用 mutate() 函數將 ptime 欄位轉換為月份 m，然後使用 count() 函數計算每個月份出現的次數。接著使用 ggplot() 函數初始化一個 ggplot 對象，指定 aes() 函數的 x 軸為月份 m，y 軸為出現次數 n，然後使用 geom_col() 函數繪製直方圖。這樣可以很直觀地看到每個月份資料的出現次數，進而觀察到逐年逐月的變化趨勢。如果需要更詳細的觀察，可以將資料劃分為更小的時間單位，例如週，然後使用類似的方法繪製直方圖。 ?lubridate clean %>% mutate(m = month(ptime)) %>% count(m) %>% ggplot() + aes(m, n) + geom_col() 9.2.4 Freq-by-date (good) 在處理時間序列資料時，我們常常需要將資料劃分為不同的時間單位，例如月、週、日等，以便進行更精細的分析和視覺化。然而，如果只是單純地提取出時間序列資料中的某一個時間單位，例如月份，就會失去時間軸在年的特性，因此需要採取一些方法來保留日期（如年）的特性。 以上程式碼中，我們使用 filter() 函數選取了時間範圍為 2019 年 3 月 18 日到 4 月 1 日的資料，然後使用 floor_date() 函數將每個時間點取整為當天的起始時間，以保留日期（如年）的特性。這樣可以確保同一天的資料都被歸到同一個時間單位中，進而保留時間軸在年的特性。接著使用 count() 函數計算每個時間單位內資料的出現次數，再使用 ggplot() 函數和 geom_col() 函數繪製直方圖，可以看到在時間軸上的年份特性被保留了下來。 總之，當我們需要從時間序列資料中提取某一個時間單位時，應該採用能夠保留日期（如年）特性的方法，例如使用 floor_date() 函數，以便進行更加精細的分析和視覺化。 clean %>% filter(ptime >= as_date("2019-03-18") & ptime < as_date("2019-04-01")) %>% mutate(m = floor_date(ptime, unit = "day")) %>% count(m) %>% ggplot() + aes(m, n) + geom_col() 9.2.5 Freq-by-hour 透過觀察資料在週末和週間的變化，可以幫助我們了解不同時間段的資料分佈情況。以下是一個範例程式碼，可以根據每天的時間點和文章數來觀察資料在週末和週間的變化。相較於將資料分為週間和週末，這個範例程式碼使用 X 軸作為 24 小時的時間點，而 Y 軸為不同日期的文章量，使用分組的方式，針對不同日期繪製折線圖，最後使用 facet_wrap() 函數將資料分成週末和週間兩個子圖來進行比較。 首先，我們使用 filter() 函數選取時間範圍為 2019 年 3 月 25 日到 4 月 1 日的資料。接著，使用 floor_date() 函數將每個時間點取整為當天的起始時間，以便進行統計。然後，使用 hour() 函數取出每個時間點的小時數，以及使用 count() 函數計算每個時間點和日期的文章數。接著，使用 wday() 函數取出每個日期的星期幾，並使用 ifelse() 函數將週末和週間的日期標記為不同的類別。最後，使用 ggplot() 函數初始化一個 ggplot 對象，指定 aes() 函數的 x 軸為小時數 h，y 軸為文章數 n，以及日期 d 的類別 color。然後，使用 geom_line() 函數繪製折線圖，並使用 facet_wrap() 函數將資料分為週末和週間兩個子圖。 透過這樣的方式，我們可以很清楚地看到週末和週間的文章量變化趨勢，從而對資料進行更深入的分析和探索。 clean %>% filter(ptime >= as_datetime("2019-03-25") & ptime < as_datetime("2019-04-01")) %>% mutate(d = floor_date(ptime, unit = "day")) %>% mutate(h = hour(ptime)) %>% count(d, h) %>% mutate(wd = wday(d, label = F, locale = Sys.getlocale("LC_TIME"))) %>% mutate(isweekend = ifelse(wd >= 6, "weekend", "weekday")) %>% ggplot() + aes(h, n, color = as.character(d)) + geom_line() + facet_wrap(~isweekend) ?ifelse "],["na.html", "Chapter 10 NA Processing 10.1 Cleaning Gov Annual Budget 10.2 Cleaning Covid Vaccinating data", " Chapter 10 NA Processing 許多統計資料都會有不同程度的NA（缺失值、遺漏值）。缺失值產生的原因不一，可能有以下原因： 資料運算的時候產生的填缺失值。例如spread()和pivot_wider()經常會產生NA，也經常會指定值（例如0）來取代可能產生的NA。 資料紀錄的時候遺漏某些時間點的資料。 開放資料在開放時已經被整理成階層化、易於展示、一般人易懂的表格型態。此時，若將其讀入也會產生非常大量的NA。例如本章節所要提到的政府各部會預算比例。 紀錄資料筆數非常龐大、來源眾多、紀錄時間不一時，雖然有很多紀錄，但這些紀錄必須要被對齊、刪減，才能夠獲得有意義的可計算資料。例如本章節會提到的世界各國疫苗注射資料。 10.1 Cleaning Gov Annual Budget 這個範例將清理中央政府111年度的歲出預算表。由於政府預算有款、科、目、節與機構，會呈現一個大部會到小布會的樹狀階層，因此非常適合用Treemap來做視覺化，預期視覺化的結果如下（視覺化的部分可參考章節26.3）： 在讀入資料後，由於資料具有階層性、從最大的科款、項、目，由於是給一般讀者所閱讀的資料，在原本的EXCEL表格中，比較大的階層可能會合併數個資料格來表示，這會使得較大的階層會有相當多的缺失值。此時，我們會需要依據其他列的值，來回填這些NA值，所用的函式為zoo::na.locf()。 raw <- readxl::read_excel("data/111B歲出政事別預算表.xls", skip=3, col_names = F) raw %>% head(10) ## # A tibble: 10 × 9 ## ...1 ...2 ...3 ...4 ...5 ...6 ...7 ...8 ...9 ## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> ## 1 科 … <NA> <NA> <NA> <NA> 本年… 上年… 前年… "本… ## 2 款 項 目 節 "名 … <NA> <NA> <NA> <NA> ## 3 <NA> <NA> <NA> <NA> "\\n… 2262… 2135… 2039… "126… ## 4 <NA> <NA> <NA> <NA> "\\n(… 2101… 2026… 1907… "750… ## 5 1 <NA> <NA> <NA> "310… 1210… 1186… 1176… "233… ## 6 <NA> 1 <NA> <NA> "310… 1004… 9789… 9973… "258… ## 7 <NA> <NA> 1 <NA> "310… 9205… 8963… 8821… "241… ## 8 <NA> <NA> 2 <NA> "310… 30000 30000 2999… "-" ## 9 <NA> <NA> 3 <NA> "310… 15760 15760 4557… "-" ## 10 <NA> <NA> 4 <NA> "310… 5332 5332 6720… "-" 10.1.1 Basic Cleaning 重新命名欄位名稱 刪去被當成表格標題的多於列（通常是前兩三列）slice(-(1:2))。 觀察資料，「款」可以說是支出大類的代號，例如總統府、行政支出、立法支出、軍事支出、教育支出等。「科」為該單位底下的部門或者項目，例如「行政支出」下有行政院、主計總處支出等。更底下的細類「目」並非本例的分析對象，所以可以刪除。所以，如果款、科均為缺失值的話，代表其為更細的「目」。因此篩去款科為缺失值的所有項目。filter(!is.na(款) | !is.na(科)) 將機構id和機構名稱切分開來，視覺化的時候只會用到機構名稱。separate(機構, c(\"oid\", \"org\"), sep=\"\\n\") names(raw) <- c("款", "科", "目", "節", "機構", "本年度預算", "上年度預算", "上年度決算", "預算差") cleaned <- raw %>% slice(-(1:2)) %>% filter(!is.na(款) | !is.na(科)) %>% select(-目, -節) %>% separate(機構, c("oid", "org"), sep="\\n") cleaned %>% head(10) ## # A tibble: 10 × 8 ## 款 科 oid org 本年度預算 上年度預算 上年度決算 預算差 ## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> ## 1 1 <NA> 3100000000 國務支出 1210301 1186955 1176955.12… 23346 ## 2 <NA> 1 3102010000 總統府 1004797 978916 997305.545… 25881 ## 3 <NA> 2 3102100000 國家安全會議 205504 208039 179649.579… -2535 ## 4 2 <NA> 3200000000 行政支出 6134276 5836481 5477154.58… 297795 ## 5 <NA> 1 3203010000 行政院 1256043 1286646 1268295.23 -30603 ## 6 <NA> 2 3203100000 主計總處 1604967 1478173 1578781.89… 126794 ## 7 <NA> 3 3203300000 人事行政總處 555363 573447 489516.177… -18084 ## 8 <NA> 4 3203340000 公務人力發展… 244346 239453 229852.261… 4893 ## 9 <NA> 5 3203420000 檔案管理局 787429 646081 443133.207… 141348 ## 10 <NA> 6 3203900000 大陸委員會 900896 900866 792491.221… 30 10.1.2 Processing NA 觀察一下現在的資料，發現，行政院、主計總處等均屬於行政支出，但行政支出卻自有一列。依照長表格的格式來說，應嘗試把「款」作為機構的變項。所以將款的數字取代為「行政支出」等支出類別的名稱。 cleaned %>% mutate(款 = ifelse(!is.na(款), org, 款)) %>% head(10) ## # A tibble: 10 × 8 ## 款 科 oid org 本年度預算 上年度預算 上年度決算 預算差 ## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> ## 1 國務支出 <NA> 3100000000 國務支出 1210301 1186955 1176955.1… 23346 ## 2 <NA> 1 3102010000 總統府 1004797 978916 997305.54… 25881 ## 3 <NA> 2 3102100000 國家安全會… 205504 208039 179649.57… -2535 ## 4 行政支出 <NA> 3200000000 行政支出 6134276 5836481 5477154.5… 297795 ## 5 <NA> 1 3203010000 行政院 1256043 1286646 1268295.23 -30603 ## 6 <NA> 2 3203100000 主計總處 1604967 1478173 1578781.8… 126794 ## 7 <NA> 3 3203300000 人事行政總… 555363 573447 489516.17… -18084 ## 8 <NA> 4 3203340000 公務人力發… 244346 239453 229852.26… 4893 ## 9 <NA> 5 3203420000 檔案管理局 787429 646081 443133.20… 141348 ## 10 <NA> 6 3203900000 大陸委員會 900896 900866 792491.22… 30 接下來，希望能夠在「款==NA」的地方填入該欄的「前一個值」例如行政支出。查詢一下（關鍵字如「Fill in NA column values with the last value that was not NA」）還真的有這樣的函式可以操作： zoo::na.locf()：zoo::na.locf() 是 R 語言中 zoo 套件提供的函式，其作用是將缺失值（NA）用最後一個非缺失值（non-missing value）填充。具體而言，na.locf() 函式將會從第一個非缺失值開始向下填充，直到下一個非缺失值出現為止。這種方法稱為 “last observation carried forward”（LOCF），意思是最後觀測值向前填充。 library(zoo) cleaned %>% mutate(款 = ifelse(!is.na(款), org, 款)) %>% mutate(款 = zoo::na.locf(款)) %>% head(10) ## # A tibble: 10 × 8 ## 款 科 oid org 本年度預算 上年度預算 上年度決算 預算差 ## <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> ## 1 國務支出 <NA> 3100000000 國務支出 1210301 1186955 1176955.1… 23346 ## 2 國務支出 1 3102010000 總統府 1004797 978916 997305.54… 25881 ## 3 國務支出 2 3102100000 國家安全會… 205504 208039 179649.57… -2535 ## 4 行政支出 <NA> 3200000000 行政支出 6134276 5836481 5477154.5… 297795 ## 5 行政支出 1 3203010000 行政院 1256043 1286646 1268295.23 -30603 ## 6 行政支出 2 3203100000 主計總處 1604967 1478173 1578781.8… 126794 ## 7 行政支出 3 3203300000 人事行政總… 555363 573447 489516.17… -18084 ## 8 行政支出 4 3203340000 公務人力發… 244346 239453 229852.26… 4893 ## 9 行政支出 5 3203420000 檔案管理局 787429 646081 443133.20… 141348 ## 10 行政支出 6 3203900000 大陸委員會 900896 900866 792491.22… 30 太神奇了！看見沒！接下來只要把「科 is NA」的那些該大類支出總數的紀錄給刪除，資料就乾淨了。最後就只會剩下一些資料清理的功伕。完整程式碼可以看下一節。 10.1.3 Complete Code library(zoo) # raw <- readxl::read_excel("data/111B歲出政事別預算總表.xls") raw <- readxl::read_excel("data/111B歲出政事別預算表.xls", skip=3, col_names = F) names(raw) <- c("款", "科", "目", "節", "機構", "本年度預算", "上年度預算", "上年度決算", "預算差") # raw$款 <- na.locf(raw$款) cleaned <- raw %>% filter(!is.na(款) | !is.na(科)) %>% slice(-(1:2)) %>% select(-目, -節) %>% separate(機構, c("oid", "org"), sep="\\n") %>% mutate(款 = ifelse(!is.na(款), org, 款)) %>% mutate(款 = zoo::na.locf(款)) %>% filter(!is.na(科)) %>% select(-科) %>% type_convert() %>% mutate(上年度預算 = as.numeric(上年度預算), 上年度決算 = as.integer(上年度決算), 預算差 = as.numeric(預算差)) %>% replace_na(list(上年度預算 = 0, 上年度決算 = 0)) %>% mutate(預算差 = 本年度預算 - 上年度預算) cleaned %>% head() ## # A tibble: 6 × 7 ## 款 oid org 本年度預算 上年度預算 上年度決算 預算差 ## <chr> <dbl> <chr> <dbl> <dbl> <int> <dbl> ## 1 國務支出 3102010000 總統府 1004797 978916 997305 25881 ## 2 國務支出 3102100000 國家安全會議 205504 208039 179649 -2535 ## 3 行政支出 3203010000 行政院 1256043 1286646 1268295 -30603 ## 4 行政支出 3203100000 主計總處 1604967 1478173 1578781 126794 ## 5 行政支出 3203300000 人事行政總處 555363 573447 489516 -18084 ## 6 行政支出 3203340000 公務人力發展學院 244346 239453 229852 4893 10.2 Cleaning Covid Vaccinating data 這個案例是希望視覺化不同國家（Y）在不同時間點（X）的疫苗施打涵蓋率（將使用熱區圖，所以將用顏色來表示涵蓋率）。涵蓋率的表示法在該資料中為每百萬人施打疫苗數，但也可以轉為百分比，有多少比例的人已經施打過第一劑、第二劑或第三劑等。 資料來源為： https://ourworldindata.org/covid-vaccinations https://github.com/owid/covid-19-data/tree/master/public/data/vaccinations 預期希望看見的結果如下，如何將這份疫苗施打比例的資料做視覺化，請見視覺化的章節??： 10.2.1 觀察並評估資料概況 這是一份資料缺失相當多的資料。評估資料概況後可發現這個資料集每一列就是某一個國家某一天所上傳的紀錄。所以，一個國家會有很多列。乍聽之下不難處理，但事實上每個國家不會每天上傳、也不會固定某一天上傳、哪一週、哪一個月開始上傳也不一定，也有可能會漏掉一些月份或週次。所以，制定出一個時間單位（例如週、月）、然後延著時間軸將資料「對齊」，讓每個國家在每個時間單位都有資料。但每個國家疫情發展程度不一，所以也不可能有一個完美的對齊，所以通常會建議就所要觀察的國家進行對齊即可。至於想刪除的那些資料列，幾乎都可以當成是所謂的缺失值。 raw <- read_csv("data/vaccinations.csv") dim(raw) ## [1] 99442 16 raw %>% head(20) ## # A tibble: 20 × 16 ## location iso_code date total_vaccinations people_vaccinated ## <chr> <chr> <date> <dbl> <dbl> ## 1 Afghanistan AFG 2021-02-22 0 0 ## 2 Afghanistan AFG 2021-02-23 NA NA ## 3 Afghanistan AFG 2021-02-24 NA NA ## 4 Afghanistan AFG 2021-02-25 NA NA ## 5 Afghanistan AFG 2021-02-26 NA NA ## 6 Afghanistan AFG 2021-02-27 NA NA ## 7 Afghanistan AFG 2021-02-28 8200 8200 ## 8 Afghanistan AFG 2021-03-01 NA NA ## 9 Afghanistan AFG 2021-03-02 NA NA ## 10 Afghanistan AFG 2021-03-03 NA NA ## 11 Afghanistan AFG 2021-03-04 NA NA ## 12 Afghanistan AFG 2021-03-05 NA NA ## 13 Afghanistan AFG 2021-03-06 NA NA ## 14 Afghanistan AFG 2021-03-07 NA NA ## 15 Afghanistan AFG 2021-03-08 NA NA ## 16 Afghanistan AFG 2021-03-09 NA NA ## 17 Afghanistan AFG 2021-03-10 NA NA ## 18 Afghanistan AFG 2021-03-11 NA NA ## 19 Afghanistan AFG 2021-03-12 NA NA ## 20 Afghanistan AFG 2021-03-13 NA NA ## # ℹ 11 more variables: people_fully_vaccinated <dbl>, total_boosters <dbl>, ## # daily_vaccinations_raw <dbl>, daily_vaccinations <dbl>, ## # total_vaccinations_per_hundred <dbl>, people_vaccinated_per_hundred <dbl>, ## # people_fully_vaccinated_per_hundred <dbl>, ## # total_boosters_per_hundred <dbl>, daily_vaccinations_per_million <dbl>, ## # daily_people_vaccinated <dbl>, daily_people_vaccinated_per_hundred <dbl> 10.2.2 按月對齊資料 首先要挑選要拿來做視覺化的資料欄位。這邊所選擇的是people_fully_vaccinated_per_hundred，也就是每百人接種二劑疫苗的人數，相當於接種二劑疫苗的百分比。 接下來便是缺失值處理，如果這個欄位沒有數值的就直接用drop_na()篩除即可。 這個範例希望把該資料視覺化為Y軸為年、X軸為時間的熱區圖。但整個疫情資料橫亙二年多，如果以週為彙整單位的話，那勢必X軸會有近百個資料點。所以打算以「月」為單位來彙整這些資料，因為且資料中也有不少國家缺數週的資料，所以以月為彙整單位是一個權衡後的選擇（仍可以嘗試用週作為彙整單位試試看）。所以，運用了lubridate::floor_date()來將日期資料轉換為月，例如2022-03-12和2022-03-14都會被轉換為2022-03-01。 依照國家與時間群組彙整資料。接下來就依照各國的月份來做彙整（注意，此時會有不少資料同屬於某個月的資料）。彙整的方法是，經過對「日期」（不是對月）做排序後，僅留下第一筆資料，也就是僅留下最接近月份開頭的資料。經由這樣的操作，會使得各國在每個月剛好留下一筆資料，如下面程式的範例輸出。 library(lubridate) fullvaccinated <- raw %>% select(country = location, date, people_fully_vaccinated_per_hundred) %>% drop_na(people_fully_vaccinated_per_hundred) %>% mutate(m = floor_date(date, unit = "month")) %>% group_by(country, m) %>% arrange(date) %>% slice(1) %>% ungroup() %>% select(-date) fullvaccinated %>% head(10) ## # A tibble: 10 × 3 ## country people_fully_vaccinated_per_hundred m ## <chr> <dbl> <date> ## 1 Afghanistan 0.14 2021-05-01 ## 2 Afghanistan 0.36 2021-06-01 ## 3 Afghanistan 0.48 2021-07-01 ## 4 Afghanistan 1.08 2021-08-01 ## 5 Afghanistan 8 2021-11-01 ## 6 Afghanistan 9.42 2021-12-01 ## 7 Afghanistan 9.56 2022-01-01 ## 8 Afghanistan 9.82 2022-02-01 ## 9 Afghanistan 10.8 2022-03-01 ## 10 Afghanistan 11.4 2022-04-01 10.2.3 處理遺漏資料的月份 接下來要處理的是資料紀錄的缺漏值。每個國家登錄資料的時間是很不一致的，某些國家會缺某些月份，或者某些國家是在某年某月以後才開始登記，或者最近沒在登記。但這個範例所要視覺化的資料是接種疫苗的比例，所以即使是現在沒在登記了，但接種比例應列計最後一次資料紀錄的接種比例。 首先我要讓每個國家都有所有月份，這裡應會有某個函式可以做到這件事，但我沒查到這個函式。不過我可以很技巧性地用pivot_wider()（spread()）和pivot_longer()（gather()）來完成這件事。spread()在展開時對於缺少的資料項可以自動補NA。所以我就只要把資料的月份展開後再gather()回來後，就可以自動讓每個國家所擁有的月份資料一致。以下為spread()後的結果，可以觀察到每一列是一個國家，每一欄是個月份，如果當月都沒資料紀錄，那該月的值就會是缺失值。可以看見缺失值是相當多的，也就是在那段時間都沒有資料紀錄。 fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% head(10) ## # A tibble: 10 × 19 ## country `2020-12-01` `2021-01-01` `2021-02-01` `2021-03-01` `2021-04-01` ## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> ## 1 Afghanistan NA NA NA NA NA ## 2 Africa NA NA 0 0.02 0.3 ## 3 Albania NA NA 0 NA NA ## 4 Algeria NA NA NA NA NA ## 5 Andorra NA NA NA 1.52 5.8 ## 6 Angola NA NA NA NA NA ## 7 Anguilla NA NA NA NA 5.18 ## 8 Antigua and… NA NA NA NA NA ## 9 Argentina 0 0 0.26 0.69 1.56 ## 10 Armenia NA NA NA NA NA ## # ℹ 13 more variables: `2021-05-01` <dbl>, `2021-06-01` <dbl>, ## # `2021-07-01` <dbl>, `2021-08-01` <dbl>, `2021-09-01` <dbl>, ## # `2021-10-01` <dbl>, `2021-11-01` <dbl>, `2021-12-01` <dbl>, ## # `2022-01-01` <dbl>, `2022-02-01` <dbl>, `2022-03-01` <dbl>, ## # `2022-04-01` <dbl>, `2022-05-01` <dbl> 在以下的範例輸出可以看到gather()後的結果。注意，需要照國家和月份來排序後才便於觀察。 fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% gather(month, perc, -country) %>% arrange(country, month) %>% head(20) ## # A tibble: 20 × 3 ## country month perc ## <chr> <chr> <dbl> ## 1 Afghanistan 2020-12-01 NA ## 2 Afghanistan 2021-01-01 NA ## 3 Afghanistan 2021-02-01 NA ## 4 Afghanistan 2021-03-01 NA ## 5 Afghanistan 2021-04-01 NA ## 6 Afghanistan 2021-05-01 0.14 ## 7 Afghanistan 2021-06-01 0.36 ## 8 Afghanistan 2021-07-01 0.48 ## 9 Afghanistan 2021-08-01 1.08 ## 10 Afghanistan 2021-09-01 NA ## 11 Afghanistan 2021-10-01 NA ## 12 Afghanistan 2021-11-01 8 ## 13 Afghanistan 2021-12-01 9.42 ## 14 Afghanistan 2022-01-01 9.56 ## 15 Afghanistan 2022-02-01 9.82 ## 16 Afghanistan 2022-03-01 10.8 ## 17 Afghanistan 2022-04-01 11.4 ## 18 Afghanistan 2022-05-01 NA ## 19 Africa 2020-12-01 NA ## 20 Africa 2021-01-01 NA 接下來是最技巧性的部分。就接種比例而言是個遞增數列，所以如果這個月有紀錄，但下個月沒紀錄（NA），那下個月的資料應以這個月的資料來替代。此時可以用zoo套件的na.locf()來填NA值，其填NA值的規則是用最後一筆非NA值的資料來替代NA值。但要注意的是，因為資料紀錄可能到第六個月或第七個月才開始紀錄，但在前面的月份都沒資料紀錄，也就是說那些NA值沒有更早的資料紀錄權充填充值。原本na.locf()會把這些找不到參考對象的NA值直接刪除，但我們可以在裡面加一個參數使其不會被刪除（na.locf(perc, na.rm = F)）。 最後，就把這些沒被刪除也沒得參考的早期資料項，用replace_na()填上0即可。 fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% gather(month, perc, -country) %>% arrange(country, month) %>% group_by(country) %>% arrange(month) %>% mutate(perc = zoo::na.locf(perc, na.rm = F)) %>% ungroup() %>% arrange(country, month) %>% head(10) ## # A tibble: 10 × 3 ## country month perc ## <chr> <chr> <dbl> ## 1 Afghanistan 2020-12-01 NA ## 2 Afghanistan 2021-01-01 NA ## 3 Afghanistan 2021-02-01 NA ## 4 Afghanistan 2021-03-01 NA ## 5 Afghanistan 2021-04-01 NA ## 6 Afghanistan 2021-05-01 0.14 ## 7 Afghanistan 2021-06-01 0.36 ## 8 Afghanistan 2021-07-01 0.48 ## 9 Afghanistan 2021-08-01 1.08 ## 10 Afghanistan 2021-09-01 1.08 最後，就把這些沒被刪除也沒得參考的早期資料項，用replace_na()填上0即可。大功告成。 fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% gather(month, perc, -country) %>% arrange(country, month) %>% group_by(country) %>% arrange(month) %>% mutate(perc = zoo::na.locf(perc, na.rm = F)) %>% ungroup() %>% arrange(country, month) %>% replace_na(list(perc=0)) %>% arrange(country, month) %>% head(10) ## # A tibble: 10 × 3 ## country month perc ## <chr> <chr> <dbl> ## 1 Afghanistan 2020-12-01 0 ## 2 Afghanistan 2021-01-01 0 ## 3 Afghanistan 2021-02-01 0 ## 4 Afghanistan 2021-03-01 0 ## 5 Afghanistan 2021-04-01 0 ## 6 Afghanistan 2021-05-01 0.14 ## 7 Afghanistan 2021-06-01 0.36 ## 8 Afghanistan 2021-07-01 0.48 ## 9 Afghanistan 2021-08-01 1.08 ## 10 Afghanistan 2021-09-01 1.08 10.2.4 完整程式碼 library(lubridate) raw <- read_csv("data/vaccinations.csv") fullvaccinated <- raw %>% select(country = location, date, people_fully_vaccinated_per_hundred) %>% drop_na(people_fully_vaccinated_per_hundred) %>% mutate(m = floor_date(date, unit = "month")) %>% group_by(country, m) %>% arrange(date) %>% slice(1) %>% ungroup() %>% select(-date) vperc_by_month <- fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% gather(month, perc, -country) %>% arrange(country, month) %>% group_by(country) %>% arrange(month) %>% mutate(perc = zoo::na.locf(perc, na.rm = F)) %>% ungroup() %>% arrange(country, month) %>% replace_na(list(perc=0)) 如何將這份疫苗施打比例的資料做視覺化，請見視覺化的章節?? "],["tm.html", "Chapter 11 Text Processing", " Chapter 11 Text Processing "],["trump.html", "Chapter 12 Trump’s tweets 12.1 Loading data 12.2 Cleaning data 12.3 Visual Exploring 12.4 Keyness", " Chapter 12 Trump’s tweets 本範例取材自David Robinson的blog文章「Text analysis of Trump’s tweets confirms he writes only the (angrier) Android half」。David Robinson是「Text Mining with R」的共同作者， 可參考該書籍上的範例「7 Case study: comparing Twitter archives | Text Mining with R (tidytextmining.com)」。 這篇文章探討了美國前總統川普（Donald Trump）的推特帳號。有一個假設聲稱，當川普在推特上祝福奧運會選手好運時，他使用的是 iPhone ；當他侮辱競爭對手時，他通常是用 Android 來發推。文章作者想要透過數據分析來探討這個假設的真實性。 作者使用了文字探勘和情感分析等技術，從川普的推特內容入手，分析了不同時間和使用不同手機所發的推文。結果顯示，Android 和 iPhone 所發的推文顯然是由不同的人所發，他們在使用標籤、連結和轉推的方式上也不同。此外，Android 的推文更加憤怒和負面，而 iPhone 的推文則傾向於發佈善意的公告和圖片。整體而言，這些分析讓我們能夠區分出競選團隊所發佈的推文（iPhone）和川普自己所發佈的推文（Android）。 這個教學案例涵蓋了使用 R 語言進行社群輿論資料（tweets）的探索性分析的各種技術和工具。除了使用常見的資料處理套件 dplyr 和視覺化套件 ggplot 外，還使用了文字處理套件 stringr 和時間處理套件 lubridate，以及關鍵字分析技術 keyness。 透過這個教學案例，學習者可以掌握如何： 使用 dplyr 和 ggplot 進行資料處理和視覺化。 使用 stringr 和 extract() 進行文字處理，例如從文本中提取關鍵字。 使用 lubridate 進行時間處理，例如轉換時間格式和提取時間戳記。 學習關鍵字分析技術 keyness，以找出在不同文本之間對彼此相對突出的關鍵字。 這段程式碼是用來設計 ggplot2 的主題風格。作者首先定義了一個名為 th 的自訂主題，基於 ggplot2 的 theme_minimal() 主題，並設置了不同元素的字型、大小和樣式等屬性。接著，作者定義了一個名為 new_style() 的函數，用於更精細的主題風格設置，包括圖表標題、圖例、軸標籤和刻度標籤等。透過這些設置，可以讓 ggplot2 圖表更具有視覺吸引力，並強調重要的圖形元素，使圖表更加清晰易懂。這兩種方式都可以用來定義主題 library(tidyverse) # library(lubridate) # has been included in tidyverse options(scipen = 999) # Self-designed theme th <- theme_minimal() + theme(plot.title = element_text(size=24, face="bold"), legend.title = element_text(size=18, face="bold"), legend.text = element_text(size=18), axis.title = element_text(hjust=0.5, size=18, face="italic"), axis.text = element_text(size=18) ) # more settings new_style <- function() { font <- "Helvetica" theme( plot.title = element_text(family=font, size=28, face="bold"), plot.subtitle = element_text(family=font, size=22, margin=margin(9,0,9,0)), plot.caption = element_blank(), legend.position = "top", legend.text.align = 0, legend.background = element_blank(), # legend.title = element_blank(), legend.key = element_blank(), legend.text = element_text(family=font, size=18, color="#222222"), axis.text = element_text(family=font, size=18, color="#222222"), axis.text.x = element_text(margin=margin(5, b = 10)), axis.ticks = element_blank(), axis.line = element_blank(), panel.grid.minor = element_blank(), panel.grid.major.y = element_line(color="#cbcbcb"), panel.grid.major.x = element_blank(), panel.background = element_blank(), strip.background = element_rect(fill="white"), strip.text = element_text(size = 22, hjust = 0) ) } 12.1 Loading data load(url("http://varianceexplained.org/files/trump_tweets_df.rda")) dim(trump_tweets_df) ## [1] 1512 16 names(trump_tweets_df) ## [1] "text" "favorited" "favoriteCount" "replyToSN" ## [5] "created" "truncated" "replyToSID" "id" ## [9] "replyToUID" "statusSource" "screenName" "retweetCount" ## [13] "isRetweet" "retweeted" "longitude" "latitude" trump_tweets_df %>% select(id, text, created, favoriteCount, retweetCount, statusSource) %>% head(10) ## # A tibble: 10 × 6 ## id text created favoriteCount retweetCount statusSource ## <chr> <chr> <dttm> <dbl> <dbl> <chr> ## 1 7626698825… "My … 2016-08-08 15:20:44 9214 3107 "<a href=\\"… ## 2 7626415954… "Joi… 2016-08-08 13:28:20 6981 2390 "<a href=\\"… ## 3 7624396589… "#IC… 2016-08-08 00:05:54 15724 6691 "<a href=\\"… ## 4 7624253718… "Mic… 2016-08-07 23:09:08 19837 6402 "<a href=\\"… ## 5 7624008698… "The… 2016-08-07 21:31:46 34051 11717 "<a href=\\"… ## 6 7622845333… "I s… 2016-08-07 13:49:29 29831 9892 "<a href=\\"… ## 7 7621109187… "Tha… 2016-08-07 02:19:37 19223 5784 "<a href=\\"… ## 8 7621069044… ".@L… 2016-08-07 02:03:39 19543 7930 "<a href=\\"… ## 9 7621044117… "I a… 2016-08-07 01:53:45 75488 24663 "<a href=\\"… ## 10 7620164261… "#Cr… 2016-08-06 20:04:08 23661 7903 "<a href=\\"… 12.2 Cleaning data 這段程式碼的目的是從一個叫做trump_tweets_df的data.frame中，選擇幾個欄位並且進行過濾和轉換，最後將結果存儲在一個名為tweets的新data.frame中。 extract()函數用於從statusSource欄位中提取出一個新欄位source，該欄位包含了statusSource中的Twitter for iPhone和Twitter for Android這兩種可能的字串。這裡使用了一個正則表達式Twitter for (.*?)<，該表達式表示提取出以Twitter for開頭，且在<符號之前的任意字元序列，並將結果存儲在名為source的新欄位中。 最後，filter()函數用於過濾出source欄位中值為iPhone或Android的記錄，並將過濾結果存儲在tweets資料框中。 # tidyr::extract() # stringr::str_replace trump_tweets_df$statusSource[1] ## [1] "<a href=\\"http://twitter.com/download/android\\" rel=\\"nofollow\\">Twitter for Android</a>" tweets <- trump_tweets_df %>% select(id, statusSource, text, created) %>% # mutate(source = str_replace(statusSource, # ".*Twitter for (.*?)<.*", "\\\\1")) %>% # mutate(source = str_extract(statusSource, 'Twitter for (.*?)<')) %>% View extract(statusSource, "source", "Twitter for (.*?)<") %>% filter(source %in% c("iPhone", "Android")) # Using stringr::str_replace() to mutate a new source variable, replacing tidyr:: # str(tweets) Practice. 有時候我們會希望避免用太多種套件來寫程式，例如上面的extract()便屬於tidyr的函式。事實上我們可以用stringr::str_replace()來達到這個目的。嘗試寫寫看？或者嘗試問ChatGPT看看？ Prompt. 我如果希望用stringr::str_replace來達到extract(statusSource, \"source\", \"Twitter for (.*?)<\") %>%的功能，我該怎麼寫？ mutate(source = stringr::str_replace(statusSource, \".*Twitter for (.*?)<.*\", \"\\\\1\")) %>% 12.3 Visual Exploring 12.3.1 Productivity by time hour = hour(with_tz(created, \"EST\"))這段程式碼使用了with_tz()函數將created欄位的時區轉換為\"EST\"所對應的時區，然後使用hour()函數提取出該日期時間對應的小時數，並將結果存儲在hour變數中。該程式碼會將例如\"2023-04-12 12:30:00\"轉換為美國東部標準時間對應的小時數，即12（因為12點30分所在的小時是12點）。他所取出的並非某日的12時，他就只是取出是12時。 toplot1和toplot2的差異在於對source欄位的分組處理不同。具體來說，toplot1中沒有對source欄位進行分組，而是在後面使用mutate()函數將計數結果中的n列和sum(n)相除，得到了百分比列percent。這導致計算的是整個資料集中的hour和source的計數和百分比。相反，toplot2中使用了group_by()函數將source欄位進行分組處理，並在後面使用mutate()函數和ungroup()函數計算了每個source和hour的計數和百分比，即分別計算了iPhone和Android的計數和百分比。因此，toplot1和toplot2的計算結果是不同的，前者的計算結果中包含了整個資料集的計數和百分比，而後者的計算結果則分別對iPhone和Android進行了計數和百分比的計算。 程式碼使用了ggplot()函數創建了一個ggplot2物件，並使用aes()函數設置了hour和percent欄位作為X軸和Y軸的變數，並且設置color = source表示以source欄位的值作為不同群組（iPhone vs. Android）折線的顏色。接著，程式碼使用geom_line()函數添加折線到圖中，設置了折線的粗細為1。使用scale_color_manual()函數設置了圖例的名稱為Phone System，標籤依照分組指定為為Android和iPhone，顏色分別為royalblue和gold，並使用scale_y_continuous()函數設置了Y軸刻度標籤的格式為百分比形式，即0%到100%之間的數值。注意：percent_format()並非ggplot2既有的函式，要另外安裝並匯入library(scales)。 library(scales) # for percent_format() # lubridate::hour() # lubridate::with_tz() # scales::percent_format() toplot1 <- tweets %>% count(source, hour = hour(with_tz(created, "EST"))) %>% # group_by(source) %>% mutate(percent = n / sum(n)) # ungroup() %>% toplot2 <- tweets %>% count(source, hour = hour(with_tz(created, "EST"))) %>% group_by(source) %>% mutate(percent = n / sum(n)) %>% ungroup() p1 <- toplot1 %>% ggplot() + aes(hour, percent, color = source) + geom_line(linewidth = 1) + scale_color_manual(name = "Phone System", labels = c("Android", "iPhone"), values = c("royalblue", "gold")) + scale_y_continuous(labels = percent_format()) + labs(x = "Hour of day (EST)", y = "% of tweets", color = "") + theme_minimal() p2 <- toplot2 %>% ggplot() + aes(hour, percent, color = source) + geom_line(linewidth = 1) + scale_color_manual(name = "Phone System", labels = c("Android", "iPhone"), values = c("royalblue", "gold")) + scale_y_continuous(labels = percent_format()) + labs(x = "Hour of day (EST)", y = "% of tweets", color = "") + theme_minimal() cowplot::plot_grid( p1, NULL, p2, labels = c("(a) Normalized by all", "", "(b) Normalized in group"), nrow = 1, rel_widths = c(1, 0.1, 1) ) 12.3.2 Tweeting with figures 首先，filter()函數用於從tweets資料框中過濾出不以\"字符開頭的推文，即過濾掉引號開頭的推文。這裡使用了!str_detect(text, '^\"')表示將text欄位中以\"字符開頭的推文過濾掉，即保留那些不以引號開頭的推文。'^\"'是一個正規表示式（Regular Expression），'^'符號代表字串的開頭。 接著，mutate()函數用於在tweets資料框中添加一個新欄位picture，該欄位根據推文中是否包含t.co字串來判斷推文中是否包含圖片或者連結。具體來說，這裡使用了if_else()函數，如果text欄位中包含t.co字串，則將picture欄位設置為\"Picture/link\"，否則設置為\"No picture/link\"。 最後，使用count()函數計算tweets資料框中每個source和picture的記錄數，並將結果存儲在toplot資料框中。最終的結果是一個展示tweets資料框中source和picture的記錄數的資料框，其中picture欄位表示推文中是否包含圖片或連結。 p1和p2的主要區別在於barplot的呈現方式不同。具體來說： p1中使用了position=\"stack\"的參數，表示將不同分組的bar疊加在一起，以展示每個source的總推文數量，並且bar的寬度設置為0.5（使用width參數），使得bar之間有一定的間隔。這種方式可以方便地比較不同source的總推文數量，並且可以看到每個source中有多少推文包含圖片或連結。 p2中使用了position=\"dodge\"的參數，表示將不同分組的bar並排放置，以便比較不同source中包含或不包含圖片或連結的推文數量。這種方式可以顯示出每個source中有多少推文包含或不包含圖片或連結，並且可以清楚地比較不同source之間的差異。 toplot <- tweets %>% filter(!str_detect(text, '^"')) %>% mutate(picture = if_else(str_detect(text, "t.co"), "Picture/link", "No picture/link")) %>% count(source, picture) p1 <- toplot %>% ggplot() + aes(source, n, fill = picture) + geom_col(position="stack", width = 0.5) + scale_fill_manual(name = "With Picture/link?", labels = c("No", "Yes"), values = c("gold", "royalblue")) + labs(x = "", y = "Number of tweets", fill = "") + theme_minimal() p2 <- toplot %>% ggplot() + aes(source, n, fill = picture) + geom_col(position="dodge") + scale_fill_manual(name = "With Picture/link?", labels = c("No", "Yes"), values = c("gold", "royalblue")) + labs(x = "", y = "Number of tweets", fill = "") + theme_minimal() cowplot::plot_grid( p1, NULL, p2, labels = c("(a) Stacked", "", "(b) Dodged"), nrow = 1, rel_widths = c(1, 0.1, 1) ) 12.4 Keyness Keyness是一種文本分析方法，用於比較兩個文本集合中某些詞彙的使用頻率（例如我們要比較用iPhone和Android兩支手機所發表的內容是否有文字上的差異），以評估這些詞彙在不同文本集合中的重要性或關鍵程度。Keyness分析通常用於比較兩個文本集合，其中一個是目標文本集合，另一個是參照文本集合，並且通常會將這些文本集合中的單詞或詞彙按照出現頻率排序。 使用filter()函數過濾出不以\"字符開頭的推文，即過濾掉引號開頭的推文，將結果存儲在tweets資料框中。 使用mutate()函數將推文中的URL和&amp;字符替換為空白字符，即將推文中的網址和HTML實體轉換為正常的字符，方便後續的文本處理。 使用mutate()函數將tweets資料框中的text欄位拆分為單詞序列，存儲在word欄位中。這裡使用了str_split()函數將每個推文按照空格進行拆分，得到一個由單詞序列組成的列表，然後將這個列表存儲在word欄位中。 使用select()函數選擇需要的欄位，包括tweets資料框中的id、text和word欄位，以及tweets資料框中的所有其他欄位。 使用unnest()函數將word欄位中的單詞序列展開成一個單詞資料框，每個單詞對應一行記錄。 使用filter()函數過濾掉停用詞和非英文字符，其中停用詞（stop words）列表存儲在stop_words資料框中，通過!word %in% stop_words$word條件過濾掉停用詞，並且通過str_detect(word, \"[a-z]\")條件過濾掉不包含英文字母的單詞。最終，將結果存儲在tweets資料框中。 停用詞（stop words）指的是在文本中出現頻率非常高，但對於文本的內容和意義貢獻不大的詞彙。這些詞彙通常是一些常見的介詞、連詞、代詞、冠詞、助動詞等，例如”the”、“and”、“a”、“in”等。在文本分析中，停用詞通常被過濾掉，以便更好地捕捉文本中的主題和意義。在中文文本分析中，常見的停用詞包括一些虛詞、代詞、介詞、助詞等，例如”的”、“是”、“在”、“和”、“了”、“一”等。這些詞在中文文本中出現的頻率非常高，但對於文本的內容和意義貢獻不大，因此在文本分析中通常被過濾掉。 停用詞的列表通常是由人為構建的，根據具體的文本分析任務和文本的特徵來決定。在自然語言處理中，通常會使用預先定義好的停用詞列表，例如英文中的NLTK（Natural Language Toolkit）庫中就包含了一個預先定義好的停用詞列表。 在進行文本分析時，過濾掉停用詞可以幫助減少文本資料的雜訊和冗余訊息，提高分析的準確性和效率。但是，在某些特定的文本分析任務中，停用詞可能具有一定的重要性，例如情感分析中的否定詞（如”not”）可能對情感分析的結果產生重要的影響，因此需要特殊處理。如果進行的是網絡舆情分析，那麼一些特定的網絡用語和表情符號可能也需要被加入停用詞列表中，以避免對分析結果產生干擾。 unnest_tokens()和mutate()函數都可以用於將文本data.frame中的文本數據進行分詞處理，但它們的實現方式有所不同。mutate()函數使用str_split()函數將每個文本按照指定的分隔符（如上述程式碼即以空白\" \"做為分隔符號）進行拆分，得到一個由單詞序列組成的list。這樣做的缺點是無法同時將文本中的標點符號、空格、停用詞等過濾掉，因此在進行文本分析時需要額外進行過濾處理。 unnest_tokens()函數則使用更靈活的正則表達式（regex）來指定單詞的分割方式，可以將文本中的單詞、標點符號、空格等都分割開來，並且可以通過指定特定的正則表達式來過濾停用詞、非英文字符等。unnest_tokens()函數還可以將分割後的單詞list展開成一個單詞data.frame，每個單詞對應一行記錄，這樣更容易進行後續的文本分析和可視化。在unnest_tokens(word, text, token = \"regex\", pattern = \"[^A-Za-z\\\\d#@']\") %>%中，word表示新建的單詞欄位的名稱，text表示原始文本欄位的名稱，token表示使用的分割方式，這裡指定為正則表達式；pattern則是指定的正則表達式，其中[^A-Za-z\\\\d#@']表示匹配不屬於字母、數字、@、#、’的任意字符，即過濾掉非英文字符和一些標點符號。 library(tidytext) # unnest_tokens() library(stringr) # str_detect(), str_replace_all() # View(test) stop_words$word ## [1] "a" "a's" "able" "about" ## [5] "above" "according" "accordingly" "across" ## [9] "actually" "after" "afterwards" "again" ## [13] "against" "ain't" "all" "allow" ## [17] "allows" "almost" "alone" "along" ## [21] "already" "also" "although" "always" ## [25] "am" "among" "amongst" "an" ## [29] "and" "another" "any" "anybody" ## [33] "anyhow" "anyone" "anything" "anyway" ## [37] "anyways" "anywhere" "apart" "appear" ## [41] "appreciate" "appropriate" "are" "aren't" ## [45] "around" "as" "aside" "ask" ## [49] "asking" "associated" "at" "available" ## [53] "away" "awfully" "b" "be" ## [57] "became" "because" "become" "becomes" ## [61] "becoming" "been" "before" "beforehand" ## [65] "behind" "being" "believe" "below" ## [69] "beside" "besides" "best" "better" ## [73] "between" "beyond" "both" "brief" ## [77] "but" "by" "c" "c'mon" ## [81] "c's" "came" "can" "can't" ## [85] "cannot" "cant" "cause" "causes" ## [89] "certain" "certainly" "changes" "clearly" ## [93] "co" "com" "come" "comes" ## [97] "concerning" "consequently" "consider" "considering" ## [101] "contain" "containing" "contains" "corresponding" ## [105] "could" "couldn't" "course" "currently" ## [109] "d" "definitely" "described" "despite" ## [113] "did" "didn't" "different" "do" ## [117] "does" "doesn't" "doing" "don't" ## [121] "done" "down" "downwards" "during" ## [125] "e" "each" "edu" "eg" ## [129] "eight" "either" "else" "elsewhere" ## [133] "enough" "entirely" "especially" "et" ## [137] "etc" "even" "ever" "every" ## [141] "everybody" "everyone" "everything" "everywhere" ## [145] "ex" "exactly" "example" "except" ## [149] "f" "far" "few" "fifth" ## [153] "first" "five" "followed" "following" ## [157] "follows" "for" "former" "formerly" ## [161] "forth" "four" "from" "further" ## [165] "furthermore" "g" "get" "gets" ## [169] "getting" "given" "gives" "go" ## [173] "goes" "going" "gone" "got" ## [177] "gotten" "greetings" "h" "had" ## [181] "hadn't" "happens" "hardly" "has" ## [185] "hasn't" "have" "haven't" "having" ## [189] "he" "he's" "hello" "help" ## [193] "hence" "her" "here" "here's" ## [197] "hereafter" "hereby" "herein" "hereupon" ## [201] "hers" "herself" "hi" "him" ## [205] "himself" "his" "hither" "hopefully" ## [209] "how" "howbeit" "however" "i" ## [213] "i'd" "i'll" "i'm" "i've" ## [217] "ie" "if" "ignored" "immediate" ## [221] "in" "inasmuch" "inc" "indeed" ## [225] "indicate" "indicated" "indicates" "inner" ## [229] "insofar" "instead" "into" "inward" ## [233] "is" "isn't" "it" "it'd" ## [237] "it'll" "it's" "its" "itself" ## [241] "j" "just" "k" "keep" ## [245] "keeps" "kept" "know" "knows" ## [249] "known" "l" "last" "lately" ## [253] "later" "latter" "latterly" "least" ## [257] "less" "lest" "let" "let's" ## [261] "like" "liked" "likely" "little" ## [265] "look" "looking" "looks" "ltd" ## [269] "m" "mainly" "many" "may" ## [273] "maybe" "me" "mean" "meanwhile" ## [277] "merely" "might" "more" "moreover" ## [281] "most" "mostly" "much" "must" ## [285] "my" "myself" "n" "name" ## [289] "namely" "nd" "near" "nearly" ## [293] "necessary" "need" "needs" "neither" ## [297] "never" "nevertheless" "new" "next" ## [301] "nine" "no" "nobody" "non" ## [305] "none" "noone" "nor" "normally" ## [309] "not" "nothing" "novel" "now" ## [313] "nowhere" "o" "obviously" "of" ## [317] "off" "often" "oh" "ok" ## [321] "okay" "old" "on" "once" ## [325] "one" "ones" "only" "onto" ## [329] "or" "other" "others" "otherwise" ## [333] "ought" "our" "ours" "ourselves" ## [337] "out" "outside" "over" "overall" ## [341] "own" "p" "particular" "particularly" ## [345] "per" "perhaps" "placed" "please" ## [349] "plus" "possible" "presumably" "probably" ## [353] "provides" "q" "que" "quite" ## [357] "qv" "r" "rather" "rd" ## [361] "re" "really" "reasonably" "regarding" ## [365] "regardless" "regards" "relatively" "respectively" ## [369] "right" "s" "said" "same" ## [373] "saw" "say" "saying" "says" ## [377] "second" "secondly" "see" "seeing" ## [381] "seem" "seemed" "seeming" "seems" ## [385] "seen" "self" "selves" "sensible" ## [389] "sent" "serious" "seriously" "seven" ## [393] "several" "shall" "she" "should" ## [397] "shouldn't" "since" "six" "so" ## [401] "some" "somebody" "somehow" "someone" ## [405] "something" "sometime" "sometimes" "somewhat" ## [409] "somewhere" "soon" "sorry" "specified" ## [413] "specify" "specifying" "still" "sub" ## [417] "such" "sup" "sure" "t" ## [421] "t's" "take" "taken" "tell" ## [425] "tends" "th" "than" "thank" ## [429] "thanks" "thanx" "that" "that's" ## [433] "thats" "the" "their" "theirs" ## [437] "them" "themselves" "then" "thence" ## [441] "there" "there's" "thereafter" "thereby" ## [445] "therefore" "therein" "theres" "thereupon" ## [449] "these" "they" "they'd" "they'll" ## [453] "they're" "they've" "think" "third" ## [457] "this" "thorough" "thoroughly" "those" ## [461] "though" "three" "through" "throughout" ## [465] "thru" "thus" "to" "together" ## [469] "too" "took" "toward" "towards" ## [473] "tried" "tries" "truly" "try" ## [477] "trying" "twice" "two" "u" ## [481] "un" "under" "unfortunately" "unless" ## [485] "unlikely" "until" "unto" "up" ## [489] "upon" "us" "use" "used" ## [493] "useful" "uses" "using" "usually" ## [497] "uucp" "v" "value" "various" ## [501] "very" "via" "viz" "vs" ## [505] "w" "want" "wants" "was" ## [509] "wasn't" "way" "we" "we'd" ## [513] "we'll" "we're" "we've" "welcome" ## [517] "well" "went" "were" "weren't" ## [521] "what" "what's" "whatever" "when" ## [525] "whence" "whenever" "where" "where's" ## [529] "whereafter" "whereas" "whereby" "wherein" ## [533] "whereupon" "wherever" "whether" "which" ## [537] "while" "whither" "who" "who's" ## [541] "whoever" "whole" "whom" "whose" ## [545] "why" "will" "willing" "wish" ## [549] "with" "within" "without" "won't" ## [553] "wonder" "would" "would" "wouldn't" ## [557] "x" "y" "yes" "yet" ## [561] "you" "you'd" "you'll" "you're" ## [565] "you've" "your" "yours" "yourself" ## [569] "yourselves" "z" "zero" "i" ## [573] "me" "my" "myself" "we" ## [577] "our" "ours" "ourselves" "you" ## [581] "your" "yours" "yourself" "yourselves" ## [585] "he" "him" "his" "himself" ## [589] "she" "her" "hers" "herself" ## [593] "it" "its" "itself" "they" ## [597] "them" "their" "theirs" "themselves" ## [601] "what" "which" "who" "whom" ## [605] "this" "that" "these" "those" ## [609] "am" "is" "are" "was" ## [613] "were" "be" "been" "being" ## [617] "have" "has" "had" "having" ## [621] "do" "does" "did" "doing" ## [625] "would" "should" "could" "ought" ## [629] "i'm" "you're" "he's" "she's" ## [633] "it's" "we're" "they're" "i've" ## [637] "you've" "we've" "they've" "i'd" ## [641] "you'd" "he'd" "she'd" "we'd" ## [645] "they'd" "i'll" "you'll" "he'll" ## [649] "she'll" "we'll" "they'll" "isn't" ## [653] "aren't" "wasn't" "weren't" "hasn't" ## [657] "haven't" "hadn't" "doesn't" "don't" ## [661] "didn't" "won't" "wouldn't" "shan't" ## [665] "shouldn't" "can't" "cannot" "couldn't" ## [669] "mustn't" "let's" "that's" "who's" ## [673] "what's" "here's" "there's" "when's" ## [677] "where's" "why's" "how's" "a" ## [681] "an" "the" "and" "but" ## [685] "if" "or" "because" "as" ## [689] "until" "while" "of" "at" ## [693] "by" "for" "with" "about" ## [697] "against" "between" "into" "through" ## [701] "during" "before" "after" "above" ## [705] "below" "to" "from" "up" ## [709] "down" "in" "out" "on" ## [713] "off" "over" "under" "again" ## [717] "further" "then" "once" "here" ## [721] "there" "when" "where" "why" ## [725] "how" "all" "any" "both" ## [729] "each" "few" "more" "most" ## [733] "other" "some" "such" "no" ## [737] "nor" "not" "only" "own" ## [741] "same" "so" "than" "too" ## [745] "very" "a" "about" "above" ## [749] "across" "after" "again" "against" ## [753] "all" "almost" "alone" "along" ## [757] "already" "also" "although" "always" ## [761] "among" "an" "and" "another" ## [765] "any" "anybody" "anyone" "anything" ## [769] "anywhere" "are" "area" "areas" ## [773] "around" "as" "ask" "asked" ## [777] "asking" "asks" "at" "away" ## [781] "back" "backed" "backing" "backs" ## [785] "be" "became" "because" "become" ## [789] "becomes" "been" "before" "began" ## [793] "behind" "being" "beings" "best" ## [797] "better" "between" "big" "both" ## [801] "but" "by" "came" "can" ## [805] "cannot" "case" "cases" "certain" ## [809] "certainly" "clear" "clearly" "come" ## [813] "could" "did" "differ" "different" ## [817] "differently" "do" "does" "done" ## [821] "down" "down" "downed" "downing" ## [825] "downs" "during" "each" "early" ## [829] "either" "end" "ended" "ending" ## [833] "ends" "enough" "even" "evenly" ## [837] "ever" "every" "everybody" "everyone" ## [841] "everything" "everywhere" "face" "faces" ## [845] "fact" "facts" "far" "felt" ## [849] "few" "find" "finds" "first" ## [853] "for" "four" "from" "full" ## [857] "fully" "further" "furthered" "furthering" ## [861] "furthers" "gave" "general" "generally" ## [865] "get" "gets" "give" "given" ## [869] "gives" "go" "going" "good" ## [873] "goods" "got" "great" "greater" ## [877] "greatest" "group" "grouped" "grouping" ## [881] "groups" "had" "has" "have" ## [885] "having" "he" "her" "here" ## [889] "herself" "high" "high" "high" ## [893] "higher" "highest" "him" "himself" ## [897] "his" "how" "however" "i" ## [901] "if" "important" "in" "interest" ## [905] "interested" "interesting" "interests" "into" ## [909] "is" "it" "its" "itself" ## [913] "just" "keep" "keeps" "kind" ## [917] "knew" "know" "known" "knows" ## [921] "large" "largely" "last" "later" ## [925] "latest" "least" "less" "let" ## [929] "lets" "like" "likely" "long" ## [933] "longer" "longest" "made" "make" ## [937] "making" "man" "many" "may" ## [941] "me" "member" "members" "men" ## [945] "might" "more" "most" "mostly" ## [949] "mr" "mrs" "much" "must" ## [953] "my" "myself" "necessary" "need" ## [957] "needed" "needing" "needs" "never" ## [961] "new" "new" "newer" "newest" ## [965] "next" "no" "nobody" "non" ## [969] "noone" "not" "nothing" "now" ## [973] "nowhere" "number" "numbers" "of" ## [977] "off" "often" "old" "older" ## [981] "oldest" "on" "once" "one" ## [985] "only" "open" "opened" "opening" ## [989] "opens" "or" "order" "ordered" ## [993] "ordering" "orders" "other" "others" ## [997] "our" "out" "over" "part" ## [1001] "parted" "parting" "parts" "per" ## [1005] "perhaps" "place" "places" "point" ## [1009] "pointed" "pointing" "points" "possible" ## [1013] "present" "presented" "presenting" "presents" ## [1017] "problem" "problems" "put" "puts" ## [1021] "quite" "rather" "really" "right" ## [1025] "right" "room" "rooms" "said" ## [1029] "same" "saw" "say" "says" ## [1033] "second" "seconds" "see" "seem" ## [1037] "seemed" "seeming" "seems" "sees" ## [1041] "several" "shall" "she" "should" ## [1045] "show" "showed" "showing" "shows" ## [1049] "side" "sides" "since" "small" ## [1053] "smaller" "smallest" "some" "somebody" ## [1057] "someone" "something" "somewhere" "state" ## [1061] "states" "still" "still" "such" ## [1065] "sure" "take" "taken" "than" ## [1069] "that" "the" "their" "them" ## [1073] "then" "there" "therefore" "these" ## [1077] "they" "thing" "things" "think" ## [1081] "thinks" "this" "those" "though" ## [1085] "thought" "thoughts" "three" "through" ## [1089] "thus" "to" "today" "together" ## [1093] "too" "took" "toward" "turn" ## [1097] "turned" "turning" "turns" "two" ## [1101] "under" "until" "up" "upon" ## [1105] "us" "use" "used" "uses" ## [1109] "very" "want" "wanted" "wanting" ## [1113] "wants" "was" "way" "ways" ## [1117] "we" "well" "wells" "went" ## [1121] "were" "what" "when" "where" ## [1125] "whether" "which" "while" "who" ## [1129] "whole" "whose" "why" "will" ## [1133] "with" "within" "without" "work" ## [1137] "worked" "working" "works" "would" ## [1141] "year" "years" "yet" "you" ## [1145] "young" "younger" "youngest" "your" ## [1149] "yours" tweet_words <- tweets %>% filter(!str_detect(text, '^"')) %>% mutate(text = str_replace_all(text, "https://t.co/[A-Za-z\\\\d]+|&amp;", "")) %>% # unnest_tokens(word, text) %>% # unnest_tokens(word, text, token = "regex", pattern = "[^A-Za-z\\\\d#@']") %>% mutate(word = str_split(text, " ")) %>% select(id, text, word, everything()) %>% unnest(word) %>% filter(!word %in% stop_words$word) %>% filter(str_detect(word, "[a-z]")) # View(tweet_words) 這段程式碼用於分析文本數據中出現頻率最高的單詞（word），並使用barplot進行視覺化呈現。具體來說，這段程式碼實現了以下幾個步驟： 使用count()函數對data.frame中的單詞word進行計數，得到每個單詞出現的次數，並按照次數降序排列。 使用head()函數選擇出現次數最高的前20個單詞，並用mutate()函數將這20個單詞按照出現次數重新排序（注意reorder()的寫法）。 geom_col()函數用於繪製barplot，coord_flip()函數用於將x軸和y軸互換，以便更好地顯示barplot。 tweet_words %>% count(word, sort = TRUE) %>% head(20) %>% mutate(word = reorder(word, n)) %>% ggplot(aes(word, n)) + geom_col(fill = "royalblue") + ylab("Occurrences") + coord_flip() + theme_minimal() + theme(axis.text = element_text(size=10)) 12.4.1 Log-likelihood ratio word_by_source的程式碼用於將單詞按照來源（source）進行分類，並統計每個來源中每個單詞出現的次數： 使用count()函數對單詞資料框中的單詞按照來源進行計數，並且將計數結果按照單詞和來源兩個變數進行分組。並使用filter()函數過濾掉在所有來源中出現次數少於5次的單詞。 使用pivot_wider()函數將分組後的資料框進行重構，將每個來源的單詞出現次數作為新欄（也就是把iPhone和Android展開成為欄位名稱），以便更方便地進行後續分析和可視化。這裡的names_from參數指定重構後的欄位名稱來自原來的source欄位，values_from參數指定要重構的值來自原來的count欄位，values_fill參數指定在重構後的資料框中缺失值的填充值，這裡設置為0。 android_iphone_ratios這段程式碼用於計算每個單詞在Android和iPhone兩個來源中的keyness的log likelihood ratio。具體來說，這段程式碼實現了以下幾個步驟： 從上一步驟得到的word_by_source資料框中，選擇了Android和iPhone兩個來源的單詞出現次數資訊。 對Android和iPhone兩個來源的單詞出現次數進行標準化處理，以便進行後續的keyness計算。具體來說，這裡使用了Laplace平滑處理（add-k smoothing），將每個來源的所有單詞出現次數都增加1，然後再將這些出現次數除以各自來源的總次數加1，得到每個單詞在Android和iPhone兩個來源中的出現概率。 對Android和iPhone兩個來源中的每個單詞，分別計算其在Android和iPhone兩個來源中的keyness log ratio。這裡使用了常見的對數比值（log ratio）方法，計算Android來源中單詞出現概率和iPhone來源中單詞出現概率的比值的對數，以此來衡量單詞在Android和iPhone兩個來源中的關鍵性差異。 將計算得到的log ratio值按照降序排列，以便進一步進行分析和可視化。 test <- tweet_words %>% count(word, source) %>% filter(n >= 5) %>% pivot_wider(names_from = source, values_from = n, values_fill = 0) # View(test) word_by_source <- tweet_words %>% count(word, source) %>% filter(n >= 5) %>% pivot_wider(names_from = source, values_from = n, values_fill = 0) %>% # spread(source, n, fill = 0) %>% ungroup() sum(word_by_source$iPhone) ## [1] 1383 sum(word_by_source$Android) ## [1] 2132 android_iphone_ratios <- word_by_source %>% mutate(iPhone = (iPhone+1)/sum(iPhone+1)) %>% mutate(Android = (Android+1)/sum(Android+1)) %>% # mutate_at(.cols = vars(iPhone, Android), # .funs = funs((. + 1) / sum(. + 1))) %>% mutate(logratio = log2(Android / iPhone)) %>% arrange(desc(logratio)) 這兩行分子分母加1的處理稱為拉普拉斯平滑。mutate(iPhone = (iPhone+1)/sum(iPhone+1)) %>% 拉普拉斯平滑（add-k smoothing）是一種用於處理計數資料中零值問題的技巧，其主要目的是將出現次數為零的類別在計算機率時賦予一個非零的機率值，以避免出現無限大的情況，從而影響後續的計算結果。 在這段程式碼中，拉普拉斯平滑的目的是對每個單詞在Android和iPhone兩個來源中的出現次數進行標準化處理，以便進行後續的keyness計算。這是因為在標準化的計算中，如果某個來源中出現次數為0的單詞，則計算出來的概率值會為0，而這樣的結果可能會產生一些問題，例如無法取log或分母為零的情形。因此，為了避免這種問題，需要對每個單詞在Android和iPhone兩個來源中的出現次數進行拉普拉斯平滑處理，使得每個單詞在Android和iPhone兩個來源中的出現概率都能夠有一個非零的值，從而進行後續的計算和分析。 12.4.2 Plotting keyness 這段程式碼是用來繪製Android和iPhone兩個來源中關鍵性差異最大的單詞的keyness log ratio的條形圖。在繪製條形圖時，使用了fill = logratio < 0的參數設置，這是一個布林值，當單詞在Android和iPhone兩個來源中的log ratio小於0時，填充的顏色是gold，否則填充的顏色是royalblue。 這種設計原理的目的是將Android和iPhone兩個來源中關鍵性不同的單詞進行區分，並用不同的填充顏色來表示。當單詞在Android來源中的出現概率高於在iPhone來源中的出現概率時，其log ratio值會為正，此時填充的顏色為royalblue；反之，當單詞在Android來源中的出現概率低於在iPhone來源中的出現概率時，其log ratio值會為負，此時填充的顏色為gold。 android_iphone_ratios %>% group_by(logratio > 0) %>% top_n(15, abs(logratio)) %>% ungroup() %>% mutate(word = reorder(word, logratio)) %>% ggplot(aes(word, logratio, fill = logratio < 0)) + geom_col() + coord_flip() + ylab("Android / iPhone log ratio") + scale_fill_manual(name = "", labels = c("Android", "iPhone"), values = c("royalblue", "gold")) + theme_minimal() + theme(axis.text = element_text(size=14)) "],["re.html", "Chapter 13 Regular expression 13.1 RE applications on string operations 13.2 RE Case studies 13.3 Useful cases", " Chapter 13 Regular expression library(tidyverse) 正規表達式（Regular Expression）是一種用來描述、搜尋和操作文本的強大工具。它是由一系列字元和特殊符號所組成的模式，用於匹配和處理符合特定模式的字串。 正規表達式提供了一種靈活且強大的方式來執行字串的模式匹配。這些模式可以包含字母、數字、特殊字符和控制字符等各種元素。使用正規表達式，可以進行字串的搜尋、替換、提取、驗證和分割等操作。 Online tools for detecting regular expression (RE) https://regex101.com/ http://regexr.com/ RE Patterns 在正規表達式中，一些特殊符號和字符具有特殊的含義。例如，\\d可以匹配任何一個數字，\\w可以匹配任何一個字母或數字，.可以匹配除換行符之外的任何一個字符，+表示前面的模式可以出現一次或多次，*表示前面的模式可以出現零次或多次，?表示前面的模式可以出現零次或一次，[]用於指定一組字符中的任意一個等等。較完整的表格如下。要注意到的是，如果是\\d的話，R中要以\\\\d雙斜線來表示。 pattern <- \"\\\\b[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\\\\.[A-Za-z]{2,}\\\\b\"為一個用R來寫RE的範例：在R中，我們使用雙反斜線（\\）來表示正規表達式中的特殊字符。在這個示例中，使用的正規表達式模式包括以下幾個部分： \\\\b：匹配單詞的邊界，確保郵件地址不是部分字詞的一部分。 [A-Za-z0-9._%+-]+：匹配郵件地址的用戶名部分，它可以包含字母、數字、點（.）、下劃線（_）、百分比（%）、加號（+）和減號（-）。注意這個在中括號中的點（.）並非用來匹配任意字。後面的+號意思是代表至少要有一個字以上。 @：匹配郵件地址中的「@」符號。 [A-Za-z0-9.-]+：匹配郵件地址的域名部分，它可以包含字母、數字、點（.）和減號（-）。 \\\\.：匹配郵件地址中的點（.），需要使用反斜線進行轉義。 [A-Za-z]{2,}：匹配郵件地址的頂級域名部分，它可以是由至少兩個字母組成的字詞。 Pattern Description ^ Matches beginning of line. $ Matches end of line. . Matches any single character except newline. Using m option allows it to match newline as well. [...] Matches any single character in brackets. [^...] Matches any single character not in brackets re* Matches 0 or more occurrences of preceding expression. re+ Matches 1 or more occurrence of preceding expression. re? Matches 0 or 1 occurrence of preceding expression. *?, +?, ?? *, +和?預設是greedy的，如果要匹配’<H1>title</H1>‘時，會匹配整個句子。如果不希望它是greedy的，就要在上述符號後面加一個？。Using .*? in the previous expression will match only ’<H1>’. re{ n} Matches exactly n number of occurrences of preceding expression. re{ n,} Matches n or more occurrences of preceding expression. re{n, m} Matches at least n and at most m occurrences of preceding expression. a| b Matches either a or b. (re) 問號括住的部分就是match要留下來的部分。Groups regular expressions and remembers matched text. (?imx) Temporarily toggles on i, m, or x options within a regular expression. If in parentheses, only that area is affected. (?-imx) Temporarily toggles off i, m, or x options within a regular expression. If in parentheses, only that area is affected. (?: re) Groups regular expressions without remembering matched text. (?imx: re) Temporarily toggles on i, m, or x options within parentheses. (?-imx: re) Temporarily toggles off i, m, or x options within parentheses. (?#...) Comment. (?= re) Specifies position using a pattern. Doesn’t have a range. (?! re) Specifies position using pattern negation. Doesn’t have a range. (?> re) Matches independent pattern without backtracking. \\w Matches word characters. \\W Matches nonword characters. \\s Matches whitespace. Equivalent to [\\t\\n\\r\\f]. \\S Matches nonwhitespace. \\d Matches digits. Equivalent to [0-9]. \\D Matches nondigits. \\A Matches beginning of string. \\Z Matches end of string. If a newline exists, it matches just before newline. \\z Matches end of string. \\G Matches point where last match finished. \\b Matches word boundaries when outside brackets. Matches backspace (0x08) when inside brackets. \\B Matches nonword boundaries. \\n, \\t, etc. Matches newlines, carriage returns, tabs, etc. \\1...\\9 Matches nth grouped subexpression. \\10 Matches nth grouped subexpression if it matched already. Otherwise refers to the octal representation of a character code. 13.1 RE applications on string operations Replacing specific pattern Replacing all space or new line character to one space or empty string Deleting all number and alphabetic by empty string Deleting all HTML tags Detecting if it exists some specific pattern Fitering if one sentence starting with “. Extracting some words by specific pattern Extracting hashtags in text Extracting timestamp, email, hyperlink, or url in text Extracting number after some specific patterns Splitting Splitting string into several parts when detecting some specific pattern successfully. Replacing \\s matching any whitespace character including space, tabs, and line breaks R uses \\\\s, instead of \\s. \\\\d digit, \\\\D not digit \\\\s whitepsace, \\\\S not whitespace \\\\w word, \\\\W not word . matches any [A-Z0-9a-z] range [ABC] character set [^ABC] neglect set (Leadning ^ in [] means neglecting) s <- " 123 456 789 " str_replace_all(s, "\\\\s", "") ## [1] "123456789" 13.1.1 Extracting + means matching word occurring at least one time, matching longer is better * means matching word occurring any time, matching longer is better {1,3} means matching at least one time, but at most 3 times {3} means matching 3 times exactly. 13.1.1.1 by str_extract() 以下這個例子是在爬取PTT資料後，嘗試能夠取出每則貼文的ID與暱稱。 pname <- c("pttid111(kefan)", "pid2(hangfan)") # extracting at least one words until not word str_extract(pname, "\\\\w") ## [1] "p" "p" str_extract(pname, "\\\\w+") ## [1] "pttid111" "pid2" str_extract(pname, "[A-Za-z0-9]+") ## [1] "pttid111" "pid2" str_extract(pname, "[A-Za-z0-9]*") ## [1] "pttid111" "pid2" str_extract(pname, "[A-Za-z0-9]{8}") ## [1] "pttid111" NA str_extract(pname, "[A-Za-z0-9]{1,8}") ## [1] "pttid111" "pid2" # extracting word between () # () is controlled vocabulary in regular expression, needing \\\\( and \\\\) to specify the character themself str_extract(pname, "\\\\(\\\\w+\\\\)") %>% str_replace_all("[\\\\(\\\\)]", "") ## [1] "kefan" "hangfan" str_extract(pname, "\\\\(.+\\\\)") ## [1] "(kefan)" "(hangfan)" 13.1.1.2 by str_extract for data frame data_frame(pname) %>% mutate(nickname = str_extract(pname, "\\\\(\\\\w+\\\\)") %>% str_replace_all("[\\\\(\\\\)]", "")) %>% mutate(id = str_extract(pname, "\\\\w+")) ## Warning: `data_frame()` was deprecated in tibble 1.1.0. ## ℹ Please use `tibble()` instead. ## This warning is displayed once every 8 hours. ## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was ## generated. ## # A tibble: 2 × 3 ## pname nickname id ## <chr> <chr> <chr> ## 1 pttid111(kefan) kefan pttid111 ## 2 pid2(hangfan) hangfan pid2 13.1.1.3 by str_replace() (\\\\w+)的括號代表，我等一下要抽取出這個pattern的字 \\\\(.+\\\\)則是把剩下的pattern matching 完 \\\\1代表我要抽取前面第一組抽取出來的pattern，也就是(\\\\w+)中間的\\\\w+。 data_frame(pname) %>% mutate(id = str_replace(pname, "(\\\\w+)\\\\(.+\\\\)", "\\\\1")) ## # A tibble: 2 × 2 ## pname id ## <chr> <chr> ## 1 pttid111(kefan) pttid111 ## 2 pid2(hangfan) pid2 13.1.1.4 by tidyr::extract() for data frame data_frame(pname) %>% tidyr::extract(pname, c("id", "nickname"), "(\\\\w+)\\\\((.+)\\\\)", remove = F) ## # A tibble: 2 × 3 ## pname id nickname ## <chr> <chr> <chr> ## 1 pttid111(kefan) pttid111 kefan ## 2 pid2(hangfan) pid2 hangfan ?tidyr::extract 13.1.2 Detecting with non-greedy 這段程式碼使用R中的tidyverse套件中的extract()函數，從source向量中的每個元素中提取出「device」的資訊。假設我們希望從<p>和</p>之間提取「Twitter for iPhone」這個資訊。 此時我們會需要理解正規表示式的寫法預設是貪婪（greedy）的概念。當我們談到正規表達式的「貪婪」（greedy）和「非貪婪」（non-greedy）時，我們指的是模式匹配時的行為。 「貪婪」指的是匹配器在尋找模式時傾向於匹配盡可能多的字符。換句話說，它會儘可能地擴展匹配範圍。在正規表達式中，默認情況下，量詞（如*和+）是貪婪的。這意味著它們會匹配盡可能長的字串。 「非貪婪」（或稱「勉強」）則相反，它傾向於匹配最短的可能字串。在正規表達式中，可以在量詞後面加上「?」來表示非貪婪匹配。這樣一來，量詞就會儘可能少地匹配字符。 回到我們的例子，當使用默認的貪婪模式時，我們的正則表達式\"Twitter for (.*)<\"會從第一個<p>開始匹配，直到找到最後一個<之前的所有字符。這意味著它會將整個<p>Twitter for iphone</p><div><p>作為匹配結果，而不僅僅是<p>Twitter for iphone</p>。 但如果我們想要只匹配第一個<p>和之後的字符，而不是將整個<p>標籤內容都包括在內，我們可以使用「非貪婪」模式，將正則表達式修改為\"Twitter for (.*?)<\"，在量詞*後面加上「?」。這樣，它會匹配到第一個<之前的最短字串，即只匹配到<p>Twitter for iphone。 source <- c("<p>Twitter for iphone</p>", "<div><p>Twitter for iphone</p></div>") data_frame(source) %>% extract(source, "device", "Twitter for (.*)<") # Greedy ## # A tibble: 2 × 1 ## device ## <chr> ## 1 iphone ## 2 iphone</p> data_frame(source) %>% extract(source, "device", "Twitter for (.*?)<") # Non-Greedy ## # A tibble: 2 × 1 ## device ## <chr> ## 1 iphone ## 2 iphone 13.1.3 Detecting multiple patterns https://stackoverflow.com/questions/8020848/how-is-the-and-or-operator-represented-as-in-regular-expressions 以下練習重點是讓學生理解如何使用 str_detect() 函數和正則表達式進行模式匹配，以及如何進行邏輯操作來組合和篩選符合特定模式的句子。 str_detect(teststr, re1) & str_detect(teststr, re2) 通過 & 進行邏輯「與」操作，將兩個邏輯向量進行元素級別的「與」運算，得到一個新的邏輯向量。該向量指示哪些句子同時符合 re1 和 re2 的模式。 str_detect(teststr, re1) | str_detect(teststr, re2) 通過 | 進行邏輯「或」操作，將兩個邏輯向量進行元素級別的「或」運算，得到一個新的邏輯向量。該向量指示哪些句子符合 re1 或 re2 的模式。 teststr <- c("B和A是不是男女朋友呢", "C與B是不是在一起呢", "A就是B。") re1 <- "(.*B.*呢$)" re2 <- "(.*A.*)" str_detect(teststr, re1) ## [1] TRUE TRUE FALSE str_detect(teststr, re2) ## [1] TRUE FALSE TRUE str_detect(teststr, re1) & str_detect(teststr, re2) ## [1] TRUE FALSE FALSE str_detect(teststr, re1) | str_detect(teststr, re2) ## [1] TRUE TRUE TRUE 13.1.4 Extracting nearby words 13.1.4.1 Extracting nearby 3 English words string2 <- "..., compelled to defend as never before the hard-charging progressivism and ...." data_frame(string2) %>% mutate(string2 = str_extract(string2, "(\\\\S+\\\\s){3}before(\\\\s\\\\S+){3}")) %>% extract(string2, c("prefix","hit", "tail"), "(.+)(before)(.+)") ## # A tibble: 1 × 3 ## prefix hit tail ## <chr> <chr> <chr> ## 1 "defend as never " before " the hard-charging progressivism" 13.1.4.2 Extracting nearby 3 Chinese words string3 <- c("呵呵呵呵呵呵呵我家就住在台灣，那是個美麗的地方", "臺灣真是個美麗的地方齁齁齁", "呵呵呵呵呵呵呵我愛台灣臺灣") str_extract(string3, ".{5}台灣.{5}|.{5}臺灣.{5}") ## [1] "我家就住在台灣，那是個美" NA ## [3] NA str_extract(string3, ".{1,5}台灣.{1,5}|.{1,5}臺灣.{1,5}") ## [1] "我家就住在台灣，那是個美" NA ## [3] "呵呵呵我愛台灣臺灣" 13.1.4.3 Extracting nearby 3 Chinese words df <- data_frame(string3) df %>% extract(string3, c("pre", "hit", "tail"), "(.{0,5})(台灣|臺灣)(.{0,5})") ## # A tibble: 3 × 3 ## pre hit tail ## <chr> <chr> <chr> ## 1 "我家就住在" 台灣 ，那是個美 ## 2 "" 臺灣 真是個美麗 ## 3 "呵呵呵我愛" 台灣 臺灣 13.2 RE Case studies 13.2.1 Getting the last page of PTT HatePolitics 這段程式碼的目的是從URL中提取出頁數或特定的部分，並進行一些後續處理和轉換。這些操作可用於從URL中獲取有用的訊息，例如網頁索引、頁數等。 urls <- c("https://www.ptt.cc/bbs/HatePolitics/index4086.html", "https://www.ptt.cc/bbs/HatePolitics/index348.html") df <- tibble(urls) str_extract(urls, "index(\\\\d+)\\\\.html") ## [1] "index4086.html" "index348.html" str_replace(urls, ".*index(\\\\d+)\\\\.html", "\\\\1") %>% as.numeric() ## [1] 4086 348 data_frame(urls) %>% extract(urls, "last_page", "index(\\\\d+)\\\\.html", remove = F) ## # A tibble: 2 × 2 ## urls last_page ## <chr> <chr> ## 1 https://www.ptt.cc/bbs/HatePolitics/index4086.html 4086 ## 2 https://www.ptt.cc/bbs/HatePolitics/index348.html 348 13.2.2 Practice. Ask CHATGPT 我現在有一程式碼如下 ``` urls <- c("https://www.ptt.cc/bbs/HatePolitics/index4086.html", "https://www.ptt.cc/bbs/HatePolitics/index348.html") df <- tibble(urls) ``` 我希望來抽取出頁面的編號，新增一個page_num的變項，使得 ``` ...index4086.html: 4086 ...index348.html: 348 ``` 請以tidyverse pipeline的方式寫，並使用stringr的函式 以下為chatgpt的回答。 您可以使用tidyverse和stringr的函式來實現這個目標。以下是一個使用tidyverse pipeline和stringr的範例程式碼： library(tidyverse) urls <- c("https://www.ptt.cc/bbs/HatePolitics/index4086.html", "https://www.ptt.cc/bbs/HatePolitics/index348.html") df <- tibble(urls) %>% mutate(page_num = str_extract(urls, "(?<=index)\\\\d+(?=.html)")) PROMPT：請解釋(?<=index)\\\\d+(?=.html) (?<=index): 是一個Positive Lookbehind。它表示匹配位置之前必須出現”index”字串。在這種情況下，我們希望匹配的數字出現在”index”之後，所以使用正向肯定後願式來確定位置。 \\\\d+: 這是一個數字的匹配模式。\\\\d表示匹配一個數字字符（0-9），而+表示匹配一個或多個連續的數字字符。這樣可以確保我們匹配到的是一個或多個數字。 (?=.html): 是一個Positive Lookahead。它表示匹配位置之後必須出現”.html”字串。在這種情況下，我們希望匹配的數字出現在”.html”之前，所以使用正向肯定前願式來確定位置。 index：匹配字串中的”index”字串。 (\\\\d+)：這是一個捕獲組（Capture Group），用於捕獲一個或多個連續的數字字符。\\\\d表示匹配一個數字字符（0-9），而+表示匹配一個或多個連續的數字字符。 \\\\.html：匹配字串中的”.html”字串。由於”.”在正則表達式中具有特殊意義，所以需要使用\\\\進行轉義。 urls <- c("https://www.ptt.cc/bbs/HatePolitics/index4086.html", "https://www.ptt.cc/bbs/HatePolitics/index348.html") df <- tibble(urls) %>% mutate(page_num = str_extract(urls, "(?<=index)\\\\d+(?=.html)")) df ## # A tibble: 2 × 2 ## urls page_num ## <chr> <chr> ## 1 https://www.ptt.cc/bbs/HatePolitics/index4086.html 4086 ## 2 https://www.ptt.cc/bbs/HatePolitics/index348.html 348 13.3 Useful cases 13.3.1 Matching URL 這個正規表達式用於檢測是否符合超連結的格式。它可以匹配包含 http://、https://、ftp://、www. 或 ftp. 前綴的URL，並確保後續的部分符合網址的正確格式，例如域名、路徑和查詢參數等。 ^ 表示匹配字符串的開頭。 ((https?|ftp)://|(www|ftp)\\\\.)? 是一個可選的前綴，它匹配以 http://、https://、ftp://、www. 或 ftp. 開頭的部分。其中 ? 表示前綴部分是可選的。 [a-z0-9-]+ 匹配一個或多個小寫字母、數字或破折號字符。 (\\\\.[a-z0-9-]+)+ 是一個重複組，它匹配一個或多個點（.）後跟一個或多個小寫字母、數字或破折號字符。 ([/?].*)? 是另一個可選的後綴，它匹配以 / 或 ? 開頭的部分，並跟隨著任意字符。 $ 表示匹配字符串的結尾。 根據需求和特定的使用情境，可以有不同的寫法。以下是一些可能的替代寫法： 捕獲更多的URL前綴：當前的正規表達式只捕獲了 http://、https://、ftp://、www. 和 ftp. 這些前綴。如果需要捕獲更多的前綴，可以擴展前綴部分，例如 ((https?|ftp|file)://|(www|ftp)\\\\.)?，這樣可以捕獲 file:// 這樣的前綴。 更精確的域名部分：當前的正規表達式使用 [a-z0-9-]+(\\\\.[a-z0-9-]+)+ 匹配域名部分，這允許了字母、數字和破折號字符。如果需要更精確的域名匹配，可以使用更複雜的正規表達式，例如 (?!-)[A-Za-z0-9-]{1,63}(?<!-)\\\\.(?!-)[A-Za-z0-9-]{1,63}(?<!-)，這樣可以確保符合域名規範。 pattern <- "^((https?|ftp)://|(www|ftp)\\\\.)?[a-z0-9-]+(\\\\.[a-z0-9-]+)+([/?].*)?$" str_detect("http://www.yahoo.com.tw", pattern) ## [1] TRUE str_detect("https://m.facebook.com/story.php?story_fbid=1483357095305703&id=1435979486710131", pattern) ## [1] TRUE str_detect("https://www.facebook.com/groups/335691256571414/permalink/774316322708903/", pattern) ## [1] TRUE 13.3.2 Removing all html tags but keeping comment content ANS: \"推 ya870801: 推 218.166.12.10 10/16 15:56\" comment <- '<div class="push"><span class="hl push-tag">推 </span><span class="f3 hl push-userid">ya870801</span><span class="f3 push-content">: 推</span><span class="push-ipdatetime"> 218.166.12.10 10/16 15:56</span></div>' str_replace_all(comment, "<.+?>", "") ## [1] "推 ya870801: 推 218.166.12.10 10/16 15:56" str_replace_all(comment, "<.*?>", "") ## [1] "推 ya870801: 推 218.166.12.10 10/16 15:56" 13.3.3 Removing space # Removing space in Chinese sentence sentence <- c(' 噓 wwHui: 這批安好純 \\n 辛苦了 \\n 噓 ', '噓 wwHui: 這批安好純 ', '辛苦了 ') # Removing all space characters str_replace_all(sentence, "\\\\s", "") ## [1] "噓wwHui:這批安好純辛苦了噓" "噓wwHui:這批安好純" ## [3] "辛苦了" # Removing leading and ending space by str_replace_all() # You cannot use trimws() str_replace_all(sentence, "^\\\\s+|\\\\s+$", "") ## [1] "噓 wwHui: 這批安好純 \\n 辛苦了 \\n 噓" ## [2] "噓 wwHui: 這批安好純" ## [3] "辛苦了" 13.3.4 Testing teststr1 <- c("我最近過的挺爽", "最近我過的不是很好。", "我最近過得不太好。") re1 <- "(^我.+)" re2 <- "(.*。)" str_detect(teststr1, str_c(re1,re2, sep = "")) ## [1] FALSE FALSE TRUE str_detect(teststr1, str_c(re1,re2, sep = "|")) ## [1] TRUE TRUE TRUE "],["tmchi.html", "Chapter 14 Text processing in Chinese 14.1 Preprocessing 14.2 Tokenization 14.3 Exploring wording features 14.4 TF-IDF", " Chapter 14 Text processing in Chinese tidyverse內涵繪圖和操作資料所需要的ggplot2和dplyr stringr雖然隨著tidyverse被安裝了，但不會隨著tidyverse被載入，要另外載入。 在中文斷詞的時候要用到tidytext和jiebaR。 處理時間時要用到lubridate。 14.1 Preprocessing 14.1.1 Assigning unique id to each doc 為了便於後續建立Document-Term-Matrix，這時候若Document自身沒有編號的話，就得把整個Document內容當成該篇文章的id，但也有（極小）可能有兩篇Document內容相同，那就會被視為同一篇文章或發生錯誤。所以必須要編id。 row_number()產生每列的編號，所以這邊就直接把每列的編號視為每篇文章的id，可以保持該id的唯一性。當你在進行文本探勘或資料分析時，為每篇文章分配一個唯一的ID是非常重要的。唯一的ID確保每篇文章都有獨一無二的標識符號。這對於跟踪和識別特定文章非常重要，特別是當你處理大量的文本資料時。在進行資料合併時，唯一的ID可用於將不同來源的資料準確地匹配和合併在一起。這是非常實用的，尤其當你需要整合來自多個來源的文本資料時，例如合併多個資料集或者在不同時間點上進行的數據採集。 news.df <- readRDS("data/typhoon.rds") %>% mutate(doc_id = row_number()) %>% drop_na(title) 14.2 Tokenization 14.2.1 Initializer tokenizer cutter <- worker()這行程式碼使用worker()函式來初始化jieba分詞器，將其指派給名為cutter的變數。jieba是一個常用的中文分詞套件，用於將漢字序列分割成詞彙。初始化分詞器後，可以使用它來對中文文本進行分詞操作。 斷詞的時候不見能把我們要的字詞斷出來，比方說你可能希望台北市不會被斷開，偏偏被斷成台北+市。最簡單的辦法就是把他窮舉舉完。new_user_word(cutter, segment_not)這行程式碼使用new_user_word()函式將segment_not這個vector中的詞彙加入使用者自定義詞典。這樣做的目的是防止該詞彙被分詞器切分成不同的部分。使用者可以根據需要將自定義詞彙加入詞典，以確保這些詞彙在分詞過程中被正確處理。 載入中文停用詞：stopWords <- readRDS(\"data/stopWords.rds\") 這行程式碼載入中文停用詞（stop words）的資料，並將其讀取到名為stopWords的變數中。停用詞是在文本分析中被視為無意義或不重要的詞彙，例如連接詞、介詞、助詞等。載入停用詞列表後，可以在文本處理過程中使用它來過濾掉這些不需要的詞彙，以提高分析的效果。常見的中文停用詞包含 助詞：的、了、着、地、得、之等。 連詞：和、與、或、及、還、而等。 代詞：我、你、他、她、它、們、這、那等。 冠詞：一、個、些、這、那等。 介詞：在、從、到、以、為、因、應、對等。 虛詞：的、地、得、過、過去等。 數詞：一、二、三、十、百、千、萬等。 副詞：很、非常、太、真、已經、還、就等。 連接詞：而、並、所以、因此、然而、只是等。 感嘆詞：嗯、哦、啊、呀、吧、喔等。 # segment_not to avoid to be segmented by jeiba cutter segment_not <- c("第卅六條", "第卅八條", "蘇南成", "災前", "災後", "莫拉克", "颱風", "應變中心", "停班停課", "停課", "停班", "停駛", "路樹", "里長", "賀伯", "採收", "菜價", "蘇迪", "受災戶", "颱風警報", "韋恩", "台東縣", "馬總統", "豪大雨", "梅姬", "台東", "台北市政府", "工務段", "漂流木", "陳菊", "台南縣", "卡玫基", "魚塭", "救助金", "陳情", "全省", "強颱", "中颱", "輕颱", "小林村", "野溪", "蚵民", "農委會", "來襲", "中油公司", "蔣總統經國", "颱風天", "土石流", "蘇迪勒", "水利署", "陳說", "颱風假", "颱風地區", "台灣", "臺灣", "柯羅莎", "八八風災", "紓困","傅崑萁", "傅崐萁","台中", "文旦柚", "鄉鎮市公所", "鄉鎮市", "房屋稅", "高雄", "未達", "台灣省", "台北市") # Initialize jieba cutter cutter <- worker() # Add segment_not into user defined dictionary to avoid being cutted new_user_word(cutter, segment_not) ## [1] TRUE # loading Chinese stop words stopWords <- readRDS("data/stopWords.rds") # load("../segment_not.R") 14.2.2 Tokenization Tokenization（分詞）在文本探勘的過程中是將文本轉換為更小單位的步驟。它將連續的文本序列（例如句子或段落）分割成一系列被稱為「詞彙」或「tokens」的個別單位。在文本探勘中，進行分詞的目的是將文本轉換為可以進一步處理和分析的基本單位。每個詞彙代表著文本中的一個有意義的單詞、詞組或符號，例如一個英文單詞、一個漢字、一個數字等等。這些詞彙可以作為後續分析的基礎，用於進行文本處理、特徵提取、語義分析、情感分析等各種任務。 分詞的過程可以包括以下步驟： 斷句：如果文本是一個段落或一個文檔，首先需要將其分成句子。這可以使用標點符號（如句號、問號、驚嘆號等）作為分隔符號來實現。 分詞：將每個句子進一步分成詞彙或tokens。具體的分詞方法取決於文本的語言和特定的工具或套件。對於中文，常用的分詞工具包括jieba、SnowNLP等；而對於英文，常用的分詞方法是基於空格或標點符號進行切分。 去除停用詞：在分詞過程中，通常會過濾掉停用詞，這些詞彙被認為對文本分析沒有太大的意義。停用詞可以是常用的連接詞、介詞、助詞、冠詞等。 正規化：進行詞彙的正規化，例如將詞彙轉換成小寫，移除標點符號，處理詞彙的變體形式（如單數、複數、時態等）。 建立詞彙表：將所有詞彙收集到一個詞彙表或詞彙索引中，該詞彙表可以用於後續的文本處理和分析。 例如一個句子「今天天氣真好，我打算去公園散步。」可以被斷成「今天 天氣 真好 ， 我 打算 去 公園 散步 。」 實際上中文斷詞相當不容易，常見的問題包括： 歧義詞彙：中文中存在許多具有歧義性的詞彙，例如「打開」可以是「開啟」的意思，也可以是「打碎」的意思。在分詞時，選擇正確的分詞方式對於確定詞彙的真正含義非常重要。 新詞辨識：中文是一個活躍的語言，新詞彙的產生非常頻繁。在分詞過程中，如果遇到未在詞典中出現的新詞彙，可能會無法正確切分，導致語義的失真或信息的丟失。 縮略詞和缺詞：中文中常使用縮略詞，例如「國際象棋」可以縮寫為「國象」。在分詞時，需要考慮這些縮略詞的存在，並確保正確切分。另外，有些中文詞彙存在缺詞現象，例如「下雨了」可以簡化為「下雨」，需要根據上下文來識別和處理這些情況。 斷詞歧異：「台北市／長」或「台北／市長」 外文詞彙和混合語言：中文文本中常包含外文詞彙或混合語言的情況。在分詞時，需要考慮如何處理這些詞彙，例如是否將其當作一個整體進行切分，或者保留其原有的形式。 未知詞彙和低頻詞彙：分詞工具常基於詞典來進行切分，因此對於一些罕見或專有名詞、專術詞彙可能無法進行正確的切分。這些未知詞彙和低頻詞彙的處理需要特殊的處理策略，例如使用統計方法或自定義詞彙表。 在segment(x, cutter)後會產生一個多詞的向量。亦即每一格就是一個向量，你可以把它印出來看看。可以用unnest()將word列中的字詞向量展開，使每個單詞成為一列。這樣可以將每個單詞視為一個觀察值，方便後續的處理。 # news.df$time %>% summary tokenized.df <- news.df %>% slice(-3069) %>% mutate(timestamp=ymd(time)) %>% # filter(timestamp > as.Date("2009-01-01")) %>% select(-time) %>% select(title, text, cat, timestamp, everything()) %>% mutate(word = purrr::map(text, function(x)segment(x, cutter))) tokenized.df %>% select(title, word) %>% head() ## # A tibble: 6 × 2 ## title word ## <chr> <list> ## 1 "昨天上班的人沒加班費也不補假\\n依法 員工無權利要求•體恤 雇主可酌情嘉惠" <chr> ## 2 "走過桑梓千田\\n東台水保之旅" <chr> ## 3 "走過桑梓千田\\n東台水保之旅" <chr> ## 4 "總統祝福大家新春如意\\n期勉迎接挑戰贏得勝利" <chr> ## 5 "總統至為關切颱風災害\\n電囑儘速展開救災重建" <chr> ## 6 "總統關懷澎湖災情 俞揆冒雨巡視災區\\n指示搶修道路•優先供應水電 復建資金… <chr> # unnest() to spread character into a new word variable # filter out stop words # filter out alphabetical and numeric characters unnested.df <- tokenized.df %>% select(doc_id, text, word) %>% unnest(word) %>% filter(!(word %in% stopWords$word)) %>% filter(!str_detect(word, "[a-zA-Z0-9]+")) unnested.df %>% head ## # A tibble: 6 × 3 ## doc_id text word ## <int> <chr> <chr> ## 1 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 昨天 ## 2 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 颱風… ## 3 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 北部 ## 4 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 地區 ## 5 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 機關 ## 6 1 昨天颱風天，北部各地區機關、學校經主管機關宣佈放假一天。民營事業… 學校 14.3 Exploring wording features 14.3.1 Word frequency distribution 這兩個函式是用於對X軸和Y軸進行對數轉換。對數轉換可以將原始數據的數值範圍較大的部分進行壓縮，使其在視覺化時更易於比較和理解。對數尺度的使用有助於呈現數據的相對變化和細節，尤其是當數據範圍跨度較大時。 對X軸和Y軸進行對數轉換的目的是為了更好地觀察數據的分佈特徵，尤其是在存在長尾分佈（power-law distribution）或Zipf’s law的情況下。 長尾分佈（Power-law distribution）： 在長尾分佈中，少數的頻繁發生事件和大量的不太頻繁發生事件形成了一個長尾（即數量較小但頻率較高的事件非常稀有）。對於長尾分佈的數據，採取對數轉換可以將較大的數值範圍縮小，使得長尾部分的細節更容易被觀察和比較。這樣做可以更好地呈現數據的細微變化和分佈的特性。 Zipf’s law： Zipf’s law是一種描述詞彙頻率與詞彙排名之間關係的統計定律。根據Zipf’s law，詞彙的頻率與其在排序中的排名成反比。當觀察和分析詞彙頻率時，對X軸和Y軸進行對數轉換有助於更好地呈現Zipf’s law的特性。對數尺度轉換使我們能夠更清楚地觀察到詞彙頻率的排名和分佈情況。 在power-law distribution的情況下，如果對X軸和Y軸進行對數轉換，我們通常會看到以下情形： 直線關係：在對數尺度下，如果數據符合power-law distribution，我們會看到一條近似線性的直線關係。這表示在對數尺度下，數據點的分佈大致呈現線性趨勢，表示一種指數衰減或增長的規律。 長尾尾部：power-law distribution的特點是長尾尾部的存在，即少數極端值或稀有事件的出現頻率相對較高。在對數尺度下，我們能夠更清楚地看到這些極端值或稀有事件在數據分佈中的位置，因為它們在對數尺度下會呈現較為明顯的特徵。 分佈斜率：對數尺度下的power-law distribution，通常可以通過斜率來描述分佈的特性。斜率表示每個X單位變化對應的Y單位變化，或者說在對數尺度下，表示對數Y值相對於對數X值的變化率。如果數據點遵循power-law distribution，斜率會呈現相對恆定的特性。 word.count <- tokenized.df %>% unnest(word) %>% count(word, sort=T) %>% filter(!(word %in% stopWords$word)) %>% filter(nchar(word) > 1) %>% filter(!str_detect(word, "[a-zA-Z0-9]+")) %>% filter(n > 3) word.count %>% count(n, sort=T) %>% ggplot(aes(n, nn)) + geom_point(alpha=0.5, size = 1, color="#333333") word.count %>% count(n, sort=T) %>% ggplot(aes(n, nn)) + geom_point(alpha=0.5, size = 1, color="#333333") + scale_x_log10() + scale_y_log10() 14.3.2 Keyness by logratio 早、近期用字差異 cat_word.tf <- tokenized.df %>% unnest(word) %>% count(cat, word) %>% ungroup() %>% filter(!str_detect(word, "[a-zA-Z0-9]+")) %>% filter(!(word %in% stopWords$word)) %>% filter(nchar(word)>1) early_lat_ratio <- cat_word.tf %>% filter(n>1) %>% pivot_wider(names_from = cat, values_from = n, values_fill = 0) %>% # spread(cat, n, fill = 0) %>% ungroup() %>% mutate_if(is.numeric, funs((. + 1) / sum(. + 1))) %>% mutate(logratio = log2(early / lat)) %>% arrange(desc(logratio)) early_lat_ratio %>% group_by(logratio > 0) %>% top_n(20, abs(logratio)) %>% ungroup() %>% mutate(word = reorder(word, logratio)) %>% ggplot(aes(word, logratio, fill = logratio < 0)) + geom_bar(stat = "identity") + coord_flip() + ylab("early / recent log ratio") + scale_fill_manual(name = "", labels = c("early", "recent"), values = c("tomato", "lightblue")) + theme(axis.text.y=element_text(colour="black", family="Heiti TC Light")) 14.3.3 Keyness by scatter frequency <- cat_word.tf %>% filter(n>3) %>% group_by(cat) %>% mutate(proportion = n/sum(n)) %>% select(-n) %>% spread(cat, proportion) %>% na.omit() # datatable(frequency) library(scales) frequency %>% ggplot(aes(x = early, y = lat, color = abs(early - lat))) + geom_abline(color = "gray40", lty = 2) + geom_point(alpha = 0.1, size = 2.5, width = 0.3, height = 0.3) + geom_text(aes(label = word), check_overlap = TRUE, vjust = 1.5, family="Heiti TC Light", size = 3) + scale_x_log10(labels = percent_format()) + scale_y_log10(labels = percent_format()) + theme(legend.position="none") + coord_fixed(1) 14.4 TF-IDF TF-IDF (Term Frequency-Inverse Document Frequency) 是一種用於衡量一個詞彙在文本集合中重要性的統計方法。它結合了詞頻 (Term Frequency, TF) 和逆文檔頻率 (Inverse Document Frequency, IDF) 兩個指標。 詞頻 (Term Frequency, TF)：衡量一個詞彙在單篇文檔中出現的頻率。詞頻可以通過計算詞彙在文檔中出現的次數，或者使用歸一化的詞頻計算公式來得到。 逆文檔頻率 (Inverse Document Frequency, IDF)：衡量一個詞彙在整個文本集合中的普遍重要性。逆文檔頻率通過計算詞彙在文本集合中出現的文檔數量的倒數，並取對數來得到。這樣做的目的是對常見詞彙的重要性進行降低，並提高罕見詞彙的重要性。 TF-IDF 的計算公式如下：TF-IDF = TF * IDF 其中，TF表示詞頻，IDF表示逆文檔頻率。 TF-IDF 的應用主要有兩個方面： 文本檢索 (Information Retrieval)：在文本檢索中，使用TF-IDF來計算詞彙對於給定查詢的相關性。詞彙的TF-IDF值越高，表示該詞彙在文檔中的重要性越高，並且與查詢的相關性越大。 文本特徵表示 (Text Feature Representation)：在文本分析和機器學習中，使用TF-IDF來表示文本的特徵向量。將文本轉換為TF-IDF向量表示可以捕捉詞彙在文本中的重要性，並且有助於機器學習模型更好地理解和區分不同的文本。 14.4.1 Term-frequency word.tf <- tokenized.df %>% unnest(word) %>% count(cat, word, sort=T) %>% # mutate(total_words=sum(n)) %>% mutate(rank=row_number(), tf= n/sum(n)) 如果是跑histrogram因為不是常態分佈而是power-law分佈，通常會看不出什麼來 ggplot(word.tf, aes(tf, fill=cat)) + geom_histogram(show.legend = F) + xlim(NA, 0.0009) + scale_x_log10() + scale_y_log10() + facet_wrap(~cat, ncol=2, scales="free_y") 加上rank後可以看出最高rank到最後的差異，中段差不多，但是，相較於晚近的文章，早期文章用過很少次的字比較多，但用過很多次的字比較少。（是否可推論用字越來越貧乏？） word.tf %>% ggplot(aes(rank, tf, color=cat)) + geom_line(size=1.1, alpha=0.5) + scale_x_log10() + scale_y_log10() rank_subset <- word.tf %>% filter(rank < 500, rank > 10) lm_result <- lm(log10(tf) ~ log10(rank), data = rank_subset) lm_result$coefficients[[1]] ## [1] -1.739581 word.tf %>% ggplot(aes(rank, tf, color = cat)) + geom_abline(intercept = lm_result$coefficients[[1]], slope = lm_result$coefficients[[2]], color = "gray50", linetype = 2) + geom_line(size = 1.1, alpha = 0.8, show.legend = FALSE) + scale_x_log10() + scale_y_log10() 14.4.2 TF-IDF to filter significant words TF-IDF計算結果可以將原本的詞頻（TF）分布從一個長尾分佈轉變為一個呈現鐘形曲線的分佈。這種轉變使得我們能夠去除尾部，即刪除TF-IDF值很低的詞彙，從而重新優化我們要處理的詞彙集合。這樣的處理方式有兩個主要目的。 首先，透過刪除TF-IDF值很低的詞彙，我們可以去除那些在文本中出現頻率較低且普遍性較高的詞彙，這些詞彙對於區分不同文本的能力相對較低，因此可以忽略不計。 其次，我們可以僅保留大於平均值加上一個或兩個標準差的TF-IDF值較高的詞彙，這些詞彙可以作為有效辨識文章的關鍵字。這是因為這些詞彙在文本中出現的頻率較高，同時其與該文本的關聯性也相對較強。 透過這樣的過濾和選擇，我們可以得到一個更精簡且具有代表性的詞彙集合，這些詞彙能夠更好地描述和區分不同的文章。因此，使用TF-IDF計算結果進行這樣的處理，可以在文本分析和信息檢索等領域中提供更有價值的結果。 news_count <- tokenized.df %>% unnest(word) %>% count(doc_id, word) %>% bind_tf_idf(word, doc_id, n) %>% arrange(desc(tf_idf)) news_count %>% ggplot(aes(tf_idf)) + geom_histogram(bins = 100) + scale_x_log10() news_count %>% left_join(news.df, by="doc_id") %>% filter(!(word %in% c("NA"))) %>% group_by(cat) %>% arrange(desc(tf_idf)) %>% top_n(30, tf_idf) %>% ungroup() %>% mutate(word = reorder(word, tf_idf)) %>% ggplot(aes(word, tf_idf, fill = cat)) + geom_col(show.legend = FALSE) + labs(x = NULL, y = "tf-idf") + facet_wrap(~cat, ncol = 2, scales = "free") + coord_flip() + theme(axis.text.y=element_text(family="Heiti TC Light")) 14.4.3 Practice. Understanding TF-IDF TF-IDF也並非沒缺點，首先是會受到詞頻影響：TF-IDF主要依賴於詞頻作為計算的一部分，詞頻較高的詞彙往往具有較高的權重。這可能會導致在辨識關鍵字時，偏向於選擇出現頻率高的常見詞彙作為關鍵字，而忽略了一些在文本中出現頻率較低但具有重要性的詞彙。其次是長文本帶來的影響，在長文本中，由於詞彙的多樣性和詞彙數量的增加，TF-IDF計算可能導致高度稀疏的向量表示。這可能導致計算效率降低，並且在後續的處理和分析中增加了計算和存儲的負擔。 請就我們給的上述資料，選幾篇文章來觀察TF-IDF所抽出來的關鍵字，有哪一些真的是關鍵字？有哪一些不是呢？從TF和TF-IDF的數值來看，明明不是關鍵詞，但TF-IDF卻很高的誤判原因為何呢？ "],["crawler-overview.html", "Chapter 15 Introduction to Web Scraping 15.1 Using Web API 15.2 Webpage Scraping 15.3 Using Chrome DevTools", " Chapter 15 Introduction to Web Scraping 爬蟲主要分為兩大類：一類是使用網站所提供的 API，另一類則是需要寫網頁爬蟲來剖析網頁。 第一類是使用網站所提供的 API，API 是指應用程式介面，是網站提供的一種接口，用戶可以通過 API 向網站發送請求，獲取網站數據。API 可以是 RESTful API、SOAP API、XML-RPC API 等等，使用 API 的好處是可以直接獲取需要的數據，且數據格式結構化，易於處理。不過使用 API 需要瞭解 API 的參數格式，而且不是所有網站都提供 API。常見且提供API讓客戶端來取用資料的社群網站服務包含： Google Maps API：提供地圖、地理位置等相關的 API。 Twitter API：提供關於 Twitter 的相關數據，包括推文、用戶資訊等。 Facebook API：提供關於 Facebook 的相關數據，包括用戶資訊、頁面資訊等。 GitHub API：提供關於 GitHub 的相關數據，包括存儲庫資訊、用戶資訊等。 OpenWeatherMap API：提供天氣資訊的 API。 YouTube API：提供關於 YouTube 的相關數據，包括影片、頻道等。 Spotify API：提供關於音樂的相關數據，包括歌曲、歌手等。 第二類是需要寫網頁爬蟲來剖析網頁，這種方法通常使用一些開源的爬蟲框架，如 Python 的 Scrapy 和 Beautiful Soup、R 的 rvest 等等。網頁爬蟲是通過模擬瀏覽器的方式，向網站發送請求，獲取網頁的 HTML 源代碼，然後使用相應的庫對 HTML 進行解析和剖析，獲取需要的數據。網頁爬蟲需要考慮很多因素，如網站的反爬機制、網頁的動態載入、網頁的解析方式等等，需要編寫複雜的代碼來處理這些問題。例如爬取國內外報紙的搜尋結果大多需要直接剖析網頁來找到所需要的資料。 15.1 Using Web API 使用 Web API 需要瞭解 JSON 檔案格式，JSON 是一種輕量級的數據交換格式，可以被多種語言解析和生成，是目前 Web API 應用中使用最廣泛的數據格式之一。JSON 的全稱是 JavaScript Object Notation，為基於 JavaScript 語言的一種文本格式，可以被解析為不同的資料型態，如數字、布林代數、字串、數值組和物件等。JSON 與 XML 相比，具有更輕量級、更容易讀寫和解析等優勢，也因此在 Web API 中被廣泛應用。 JSON 格式的基本結構是一個鍵-值對應（Key-Value）集合，其中每個鍵都是一個字串，每個值可以是數字、布爾值、字串、數組或對象等類型。例如，以下是一個簡單的 JSON 。在 JSON 中，可以使用大括號 {} 表示鍵值對應（Key-Value），使用中括號 [] 表示序列（類似R中的List），鍵和值之間用冒號 : 分隔以對應，不同的鍵值對之間用逗號 , 分隔。JSON可以是樹狀多階層的，即一個鍵的值可以是另一個 JSON物件的鍵值對應。 在 R 語言中讀取 JSON 檔案需要先將其轉換為 R 的物件。這可以使用 R 的 jsonlite 套件中的 fromJSON() 函數來實現。jsonlite 套件是一個方便解析 JSON 的工具，它提供了從 JSON 字符串到 R 物件之間的轉換功能。 { "name": "John", "age": 30, "isMarried": false, "hobbies": ["reading", "music", "movies"], "address": { "street": "123 Main St", "city": "Anytown", "state": "CA" } } 15.2 Webpage Scraping 網頁爬蟲是一種自動化工具，可用於收集網頁上的資料。想要寫出高效能、穩定的爬蟲程式，需要掌握以下基礎知識： HTML 和 CSS：這些是用於設計和呈現網頁的標準技術。HTML 是網頁的基礎架構，而 CSS 用於設計和美化網頁的外觀。例如了解了解 HTML 標籤和屬性的基本語法和用法，以及網頁的基本結構，例如 head、body、div、span、table、a 等等。並瞭解了解 CSS 的基本語法和用法，包括如何設置元素的樣式、顏色、字體、大小、邊框等等，以及常用的選擇器和屬性。 XPath 和 CSS 選擇器：XPath 和 CSS 選擇器是用於定位 HTML 元素的語言。XPath 是 XML 語言的一部分，而 CSS 選擇器是 CSS 的一部分。Chrome 瀏覽器的 Inspector 是一個強大的工具，可以幫助我們查找 HTML 元素的 XPath 和 CSS 選擇器。 HTTP 協議：HTTP 協議是網絡通信協議，用於網頁服務器和瀏覽器之間的通信。理解 HTTP 協議可以幫助理解網頁如何工作。例如最常見的HTTP回應代碼有「401 Unauthorized：未經授權，無法訪問所需內容」以及「404 Not Found：所請求的內容不存在」。 防止反爬：由於網站經常會採取反爬蟲措施，因此開發者需要學習如何繞過這些措施，例如使用代理服務器、設置間隔時間、更換用戶代理等。 15.2.1 HTTP Status Code 回應代碼用於向客戶端通報伺服器對請求的處理狀態，以便客戶端根據不同的回應代碼進行相應的處理。例如，當客戶端發送一個請求到服務器時，如果服務器返回的回應代碼是 200 OK，這意味著該請求已經成功處理，服務器已經返回所需的內容，客戶端可以根據返回的內容進行下一步操作；如果服務器返回的是 404 Not Found，這意味著客戶端所請求的內容不存在，客戶端需要提示用戶請求的資源不存在。以下是 HTTP 協議中常見的一些代碼： 1xx（Informational）：這些代碼表示服務器已經接收到請求，但仍在處理中。 2xx（Successful）：這些代碼表示請求已經成功處理。 3xx（Redirection）：這些代碼表示客戶端需要採取進一步的操作才能完成請求。 4xx（Client Error）：這些代碼表示客戶端發生了錯誤，請求無法完成。 5xx（Server Error）：這些代碼表示服務器發生了錯誤，無法完成請求。 以下是常見的 HTTP 協議代碼： 200 OK：請求已經成功處理，並返回所需的內容。 301 Moved Permanently：請求的網頁已經永久轉移到新位置。 302 Found：請求的網頁暫時轉移到新位置。 400 Bad Request：請求的語法不正確。 401 Unauthorized：未經授權，無法訪問所需內容。 403 Forbidden：已經獲得授權，但仍無法訪問所需內容。 404 Not Found：所請求的內容不存在。 500 Internal Server Error：服務器內部錯誤，無法處理請求。 15.3 Using Chrome DevTools Chrome DevTools是一款由Google開發的網頁開發工具，可以幫助開發人員進行網頁測試、網頁性能分析、網頁設計等工作。DevTools提供了豐富的功能，包括元素查看器、Console、網絡監測器、源代碼編輯器等，可讓開發人員在開發過程中快速找到和解決問題。此外，DevTools還可以幫助開發人員模擬不同設備、網速，以及對網站進行性能分析和優化，提高網站的速度和使用體驗。 15.3.1 Observing web request 在開始網頁爬蟲之前，我們需要找到網頁中的JSON數據，以便進行後續的數據提取和處理。使用Chrome DevTools可以很容易地找到網頁背後的JSON檔案。以下是一些步驟： 打開Chrome瀏覽器，進入要爬取的網站。 按下F12鍵或右鍵點擊網頁上的任意位置並選擇「檢查」來開啟DevTools。 在DevTools中，選擇「Network」分頁。 在瀏覽器中執行您要查找JSON數據的操作，例如點擊一個按鈕或輸入一個查詢。 在DevTools的網絡監測器中，您可以看到所有網頁請求（Request）和回應（Response），包括我們感興趣的JSON檔案。如果您只想查看JSON請求，可以在過濾器中輸入「json」。 點選JSON請求，您可以查看Request和Response中的的詳細信息，包括URL、Headers、Request Payload和Response等。 在Response分頁中，您可以看到JSON數據的內容。如果JSON數據很大，您可以右鍵點擊JSON數據，然後選擇「Save Response As...」將其保存到本地檔案中。 "],["scraping-104.html", "Chapter 16 Scraping 104.com 16.1 Complete Code 16.2 Step-by-Step", " Chapter 16 Scraping 104.com 16.1 Complete Code 撰寫爬蟲時需要載入許多不同的函式庫，其中包括用於 HTTP 請求的httr，以及用於解析 JSON 數據的jsonlite。 httr：httr 庫是 R 語言中用於發送 HTTP 請求和處理 HTTP 響應的函式庫，它提供了一組簡單易用的函數，可以讓使用者方便地設置 HTTP 請求的各種參數，如 URL、HTTP 方法、HTTP 頭、HTTP 主體等，並處理 HTTP 響應的內容和狀態碼等。 jsonlite：jsonlite 庫是 R 語言中用於解析和生成 JSON 數據的函式庫，它提供了 fromJSON() 函數，可以將 JSON 字符串轉換為 R 物件，並提供 toJSON() 函數，可以將 R 物件轉換為 JSON 字符串。這個函式庫通常用於處理 API 回應數據中的 JSON 格式數據。 library(tidyverse) library(httr) library(jsonlite) # options(stringsAsFactors = F) all.df <- tibble() refer_url <- "https://www.104.com.tw" for(p in 1:10){ url <- str_c('https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E8%B3%87%E6%96%99%E7%A7%91%E5%AD%B8&order=12&asc=0&page=', p, "&mode=s&jobsource=2018indexpoc") print(p) res <- GET(url, add_headers("referer"=refer_url)) %>% content("text") %>% fromJSON() res$data$list$tags <- NULL res$data$list$link <- NULL all.df <- bind_rows(all.df, res$data$list) } all.df$jobNo %>% unique %>% length 16.2 Step-by-Step 16.2.1 Get the first pages 這段程式碼是用於爬取104人力銀行網站上與「資料科學」相關的職缺資訊，並將其存儲到名為df2的Data.Frame中。首先，我們嘗試點選104人力銀行網站上的第1頁、第2頁和第3頁的職缺搜尋結果，並將這三個網址儲存為三個URL變量，應該不難觀察到，這三個網址有何差別？僅有page=1、page=2、page=3有所差別。接下來，我們使用R語言中的httr套件中的GET()函數，將URL作為參數傳入，從網站中獲取對應的數據，並使用fromJSON()函數將該JSON格式的內容轉換為R中的Data.Frame格式。下面程式在獲取第2頁數據時，使用了add_headers()函數設置了一個HTTP header，用於識別HTTP請求的來源。 這段程式碼使用了add_headers函數添加了一個名為「Referer」的HTTP header。這個header的作用是告訴104人力銀行網站，訪問這個頁面的用戶是從哪個網頁轉跳過來的，也就是告訴網站當前HTTP請求的來源。具體來說，這裡設置的「Referer」值為https://www.104.com.tw/，代表我們偽裝這個請求是來自於104人力銀行首頁。如果沒有這個Referer，該網站會認為你是一個可疑的爬取，從沒根據和不當的頁面或用不當的方式（例如爬蟲）連過來。 對的！人家網站不歡迎你爬它，所以我們應止於測試。 url1 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=1&mode=s&jobsource=2018indexpoc" # Assigning the 2nd page data url to url2 url2 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E8%B3%87%E6%96%99%E7%A7%91%E5%AD%B8&order=14&asc=0&page=2&mode=s&jobsource=2018indexpoc" # Assigning the 3rd page data url to url3 url3 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=3&mode=s&jobsource=2018indexpoc" # Getting back the url1 data, assigning to result1 res <- GET(url2, config = add_headers("Referer" = "https://www.104.com.tw/")) res1 <- content(res, "text") %>% fromJSON() result2 <- fromJSON(content(GET(url2), "text")) # Tracing variable result2 and finding the data.frame, assigning to df2 df2 <- res1$data$list 16.2.2 Get the first page by modifying url # Guessing the 1st page data url to url1 url1 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=1&mode=s&jobsource=2018indexpoc" # Getting back the 1st page data url1 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=1&mode=s&jobsource=2018indexpoc" result1 <- fromJSON(content(GET(url1), "text")) df1 <- result1$data$list 16.2.3 Combine two data with the same variables # all.df <- bind_rows(df1, df2) # will raise error # Error in bind_rows_(x, .id) : # Argument 31 can't be a list containing data frames 16.2.4 Drop out hierarchical variables Preserving numeric or character, dropping list of data.frame by assigning NULL to the variable # Drop list and data.frame inside the data.frame df1$link <- NULL df1$tags <- NULL df2$link <- NULL df2$tags <- NULL # Re-binding two data.frame df1 and df2 all.df <- bind_rows(df1, df2) 16.2.5 Dropping hierarchical variables by dplyr way # Getting the 1st page data and dropping variable tags and link # Assigning to df1 df1 <- result1$data$list %>% select(-tags, -link) # Getting the 2nd page data and dropping variable tags and link # Assigning to df2 df2 <- result2$data$list %>% select(-tags, -link) # binding df1 and df2 all.df <- bind_rows(df1, df2) 16.2.6 Finding out the last page number # Tracing the number of pages in result1 last_page_num <- result1$data$totalPage # Checking the availability of the last page # Examining if the last page data available by re-composing URL with paste0() url.last_page <- paste0("https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=", last_page_num, "&mode=s&jobsource=2018indexpoc") # Getting back and parsing the last page data result.last_page <- fromJSON(content(GET(url.last_page), "text")) 16.2.7 Using for-loop to get all pages for(p in 1:last_page_num){ url <- paste0("https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=", p, "&mode=s&jobsource=2018indexpoc") result <- fromJSON(content(GET(url), "text")) temp.df <- select(result$data$list) print(paste(p, nrow(temp.df))) } 16.2.8 combine all data.frame # The 1st url of the query url1 <- "https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=1&mode=s&jobsource=2018indexpoc" # Getting back the 1st page data result1 <- fromJSON(content(GET(url1), "text")) # Tracing and getting total number of page last_page_num <- result1$data$totalPage # Truncating hierarchical variables: link and tags all.df <- select(result1$data$list, -link, -tags) # for-loop to getting back data and joining them for(p in 1:last_page_num){ url <- paste0("https://www.104.com.tw/jobs/search/list?ro=0&kwop=7&keyword=%E7%88%AC%E8%9F%B2&order=1&asc=0&page=", p, "&mode=s&jobsource=2018indexpoc") result <- fromJSON(content(GET(url), "text")) temp.df <- select(result$data$list) all.df <- bind_rows(all.df, temp.df) print(paste(p, nrow(all.df))) } "],["read_json.html", "Chapter 17 Read JSON 17.1 Reading JSON 17.2 Case 1: Air-Quality (well-formatted ) 17.3 Practices: traversing json data 17.4 Case 2: cnyes news (well-formatted) 17.5 Case 3: footRumor (ill-formatted) 17.6 Reviewing JSON 17.7 ", " Chapter 17 Read JSON jsonlite套件提供了處理 JSON 格式資料的功能。 # loading jsonlite package to parse a textual json file to an R object library(jsonlite) 17.1 Reading JSON 17.1.1 JSON as a string fromJSON('{\"a\":1, \"b\":2}')。 這是一個 JSON 物件，由一對大括號 {} 包圍。 該物件中有兩個鍵值對，用逗號 , 分隔。 第一個鍵值對中，鍵 a 對應的值為數字 1。 第二個鍵值對中，鍵 b 對應的值為數字 2。 fromJSON('[{\"a\":1, \"b\":2}, {\"a\":1, \"b\":3}]') 這是一個 JSON 陣列，由一對中括號 [] 包圍。 該陣列中有兩個元素，用逗號 , 分隔。 每個元素都是一個 JSON 物件，由一對大括號 {} 包圍。 第一個元素的 JSON 物件中，鍵 a 對應的值為數字 1，鍵 b 對應的值為數字 2。 第二個元素的 JSON 物件中，鍵 a 對應的值為數字 1，鍵 b 對應的值為數字 3。 library(jsonlite) lst <- fromJSON('{"a":1, "b":2}') class(lst) #list ## [1] "list" lst$a ## [1] 1 fromJSON('[{"a":1, "b":2}, {"a":1, "b":3}]') ## a b ## 1 1 2 ## 2 1 3 tbl <- fromJSON('[{"a":1, "b":2}, {"a":1, "b":3}, {"a":5, "b":7}]') class(tbl) # a data.frame ## [1] "data.frame" tbl$a[1] ## [1] 1 17.1.2 JSON as a local file 有時候JSON在編製的過程會記錄很多詮釋資料，所以不見得會把資料放在第一層，因此要嘗試去「trace」它才會知道資料在哪裡。例如以下範例是爬蟲爬回來的104職缺查詢結果，可猜想資料應放在如下結構中： { "data": { "list": [ ... ] } } library(jsonlite) raw <- read_json("data/url_104.json") raw$data$list[[1]] ## $jobType ## [1] "2" ## ## $jobNo ## [1] "10788904" ## ## $jobName ## [1] "約聘資料分析師(T45駐點食藥署)" ## ## $jobNameSnippet ## [1] "約聘<em class='b-txt--highlight'>資料分析</em>師(T45駐點食藥署)" ## ## $jobRole ## [1] "1" ## ## $jobRo ## [1] "1" ## ## $jobAddrNoDesc ## [1] "台北市南港區" ## ## $jobAddress ## [1] "" ## ## $description ## [1] "1.負責資料標準化、探勘及分析工作\\r\\n2.依客戶需求產出[[[資料分析]]]報告\\r\\n3.其他交辦工作" ## ## $optionEdu ## [1] "大學" ## ## $period ## [1] "00" ## ## $periodDesc ## [1] "經歷不拘" ## ## $applyCnt ## [1] "00005" ## ## $applyDesc ## [1] "0~5人應徵" ## ## $custNo ## [1] "97162640000" ## ## $custName ## [1] "關貿網路股份有限公司" ## ## $coIndustry ## [1] "1001001001" ## ## $coIndustryDesc ## [1] "電腦系統整合服務業" ## ## $salaryLow ## [1] "0033000" ## ## $salaryHigh ## [1] "0050000" ## ## $salaryDesc ## [1] "月薪 33,000~50,000元" ## ## $s10 ## [1] "50" ## ## $appearDate ## [1] "20191004" ## ## $appearDateDesc ## [1] "10/04" ## ## $optionZone ## [1] "9703424" ## ## $isApply ## [1] "0" ## ## $applyDate ## [1] "" ## ## $isSave ## [1] "0" ## ## $descSnippet ## [1] "1.負責資料標準化、探勘及分析工作\\r\\n2.依客戶需求產出<em class='b-txt--highlight'>資料分析</em>報告\\r\\n3.其他交辦工作" ## ## $tags ## $tags[[1]] ## [1] "上市上櫃" ## ## $tags[[2]] ## [1] "員工560人" ## ## ## $link ## $link$applyAnalyze ## [1] "//www.104.com.tw/jobs/apply/analysis?j=64404a2d3a4c445c3738406932343d208466649725c4c4627272727273e34402b826j52&channel=104rpt&jobsource=apply_analyze" ## ## $link$job ## [1] "//www.104.com.tw/job/6f8rs?jobsource=jolist_c_relevance" ## ## $link$cust ## [1] "//www.104.com.tw/company/18mw4ku8?jobsource=jolist_c_relevance" ## ## ## $jobsource ## [1] "jolist_c_relevance" ## ## $jobNameRaw ## [1] "約聘資料分析師(T45駐點食藥署)" ## ## $custNameRaw ## [1] "關貿網路股份有限公司" 17.1.3 JSON as a web file 當你使用手機上的 App 查看天氣、查詢公車路線、搜尋商品資訊時，你會注意到這些 App 看起來很不同，但它們都可以透過 Web API 來存取相同的資訊來源。簡單來說，Web API 就像是一種「資訊櫃檯」，提供存取資料的服務，它允許不同的應用程式通訊，以存取、分享、更新或刪除資料。透過 Web API，其他應用程式可以查詢、存取、下載、上傳、更新等操作資料，而不需要直接與資料庫或其他應用程式進行通訊。 舉例來說，一個網站可能有一個 Web API，它可以提供網站上所有文章的標題和內容。當其他網站或 App 需要獲取這些文章時，它們可以向該 Web API 發送請求，獲取所需資料。這樣就可以在不同的應用程式之間分享資料，提高效率和便利性。 Web API 和 JSON 之間的關係在於，Web API 通常會將回應資料以 JSON 的格式返回，以便接收方應用程式可以方便地解析和使用該資料。當一個應用程式需要從另一個應用程式獲取資料時，它可以透過 Web API 發送請求，並期望以 JSON 格式獲取回應。 如果該JSON是網頁伺服器所提供的Web API，以下程式碼示範了如何使用 R 語言中的 httr 和 jsonlite 套件，透過 HTTP GET() 請求獲取 Web API 所提供的 JSON 資料。以下是程式碼的解釋： GET(\"https://tcgbusfs.blob.core.windows.net/blobyoubike/YouBikeTP.json\") ：使用 httr 套件中的 GET 函數來發送 HTTP GET 請求，並取得 Web API 所提供的 JSON 資料。 %>% content(\"text\") ：content(\"text\") 表示將 HTTP 回應的資料轉換為純文字格式，便於後續處理。當我們把該純文字格式打開後，會發現他以JSON格式書寫。 %>% fromJSON() ：一旦確認回傳的訊息以JSON格式書寫，那麼就可以用jsonlite套件的fromJSON()將該文字字串轉為R的物件。 library(httr) library(jsonlite) raw <- GET("https://tcgbusfs.blob.core.windows.net/blobyoubike/YouBikeTP.json") %>% content("text") %>% fromJSON() write_json(raw, "data/opendata_ubike_202304261243.json") 你可以讀取本書預先爬取好的json檔來觀察前述程式所爬回的json檔轉成R物件後的結果。 raw <- fromJSON("data/opendata_ubike_202304261243.json") raw$retVal[["0001"]] ## $sno ## [1] "0001" ## ## $sna ## [1] "捷運市政府站(3號出口)" ## ## $tot ## [1] "84" ## ## $sbi ## [1] "72" ## ## $sarea ## [1] "信義區" ## ## $mday ## [1] "20221030161036" ## ## $lat ## [1] "25.0408578889" ## ## $lng ## [1] "121.567904444" ## ## $ar ## [1] "忠孝東路/松仁路(東南側)" ## ## $sareaen ## [1] "Xinyi Dist." ## ## $snaen ## [1] "MRT Taipei City Hall Stataion(Exit 3)-2" ## ## $aren ## [1] "The S.W. side of Road Zhongxiao East Road & Road Chung Yan." ## ## $bemp ## [1] "12" ## ## $act ## [1] "1" 17.1.4 Practice. Convert ubike json to data.frame 當你把ubike的資料給載回來並轉為R的物件後，你會發現該物件是一層又一層的named list，也就是每個list或每個值都有他的名字（name）。這是因為原本ubike的JSON格式是一層又一層的dict（Dictionary），全部是key-to-value的對應。這也是一種常見的Web API編法。 本練習希望你做的便是，希望你把這個好幾個階層的list，轉為一個以列（Rows）為每筆資料，欄（Columns）為變項的data.frame。 17.2 Case 1: Air-Quality (well-formatted ) 前往 https://data.gov.tw/dataset/40448對JSON 檔案按右鍵，然後複製連結，例如 “https://data.epa.gov.tw/api/v2/aqx_p_432?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=ImportDate%20desc&format=JSON”。 (但是，連結地址，特別是 api_key=9be7b239-557b-4c10-9775-78cadfc555e9，每次都會更改。所以你必須要自己嘗試)。 url <- "https://data.epa.gov.tw/api/v2/aqx_p_432?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=ImportDate%20desc&format=JSON" df <- fromJSON(content(GET(url), "text", encoding = "utf-8")) df %>% glimpse() df$records %>% head() %>% knitr::kable(format = "html") 17.2.1 Using knitr::kable() for better printing df$records %>% head() %>% knitr::kable(format = "html") 17.2.2 Step-by-step: Parse JSON format string to R objects fromJSON(content(GET(url), \"text\", encoding = \"utf-8\"))由內到外有三個函式。 * httr::GET()按照指定的url發出GET request把網頁抓回來，如果是個合乎規定存取，就會順利取回該伺服器發的response。 * hrrt::content(response, \"text\", encoding = \"utf-8\") 用?content查詢看看content(response, \"text\")的用途。其是把抓回來的檔案，轉為純文字的字串。content()是把抓回來的response解成純文字（JSON本身就是以純文字儲存，只是格式特別而已）。 jsonlite::fromJSON() 因為我們用眼睛看就知道他是個JSON格式的檔案，所以用fromJSON()這個函式，把用JSON格式編成的字串轉為R的物件，有可能是data.frame或list。fromJSON()預期會把JSON中[]的每一個項目轉為一筆筆的資料，然後把{}的pair當成column的變數名稱 17.2.2.1 Step 1. GET() 發送請求 向該URL的伺服器發送GET() request以取得該檔案。若成功取得，他會回覆一個HTML status code（你可上網查詢看看有哪些Status code）。如果成功的話就是2開頭的數字例如200 OK代表該伺服器接受該請求並開始傳回檔案。 # Getting url back by GET() response <- GET(url) # Inspecting returned data response class(response) (Tips) Using ?httr::GET to inspect the function 17.2.2.2 Step 2. httr::content() 將回應資料的轉純文字 回應的資料看他的class是一個response，但如果看Global Environment看來是個list，裡面裝載很多資料，而主要核心的內容在content這個欄位，但看來是用binary code裝起來的，而不是純文字。 因此，對於這個抓回來的檔案，我需要用httr::content()幫忙把純文字給解出來。經查詢help可得知content()後面的參數有三類，其中可以要轉為純文字的就是content(response, \"text\")。因此偵測轉出來的變數會是長度為1的character。 # Parsing to textual data by content() text <- content(response, "text", encoding = "utf-8") nchar(text) cat(text) class(text) length(text) (Tips) using ??httr::content to inspect the function 17.2.2.3 Step 3. fromJSON(): 將JSON格式文字轉為R物件 最後是將這個character轉為R的物件，也就是data.frame或list。注意，此時text是一個character，那是我們知道他是用JSON格式編寫的文字檔，就像我們知道.csv檔是用逗號分隔表示法依樣，JSON就是用層層疊疊的[]{}記號來表述資料的結構。 並要提醒初學者，.json或.csv都只是幫助程式初步篩選檔案的副檔名罷了，這兩種類型的檔案跟.txt檔一樣，都被歸屬為Win系統所謂的「純文字文件檔案」（就打開以後看得到文字的意思）。裡面的究竟是不是個完整的json檔這都要去看、去測。我自然也可以在.json的檔案裡偷偷亂用逗號分隔模式撰寫。 df <- fromJSON(text) dim(df) glimpse(df) ?fromJSON 17.2.3 Combining all UVI Open data: https://data.gov.tw/dataset/6076 https://data.epa.gov.tw/api/v2/uv_s_01?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=publishtime desc&format=JSON 17.2.3.1 Get from web api # specify data url url <- "https://data.epa.gov.tw/api/v2/uv_s_01?api_key=e8dd42e6-9b8b-43f8-991e-b3dee723a52d&limit=1000&sort=publishtime%20desc&format=JSON" # GET(), content(), then converting to R object by fromJSON() raw <- fromJSON(content(GET(url), "text", encoding = "utf-8")) 17.2.3.2 Read from pre-saved JSON 你可以讀取本書預先爬取好的json檔來觀察前述程式所爬回的json檔轉成R物件後的結果。 # You can read the pre-crawled JSON file to observe the R object. raw <- fromJSON("data/opendata_uvi_202304261215.json") raw$records %>% head %>% knitr::kable() sitename uvi publishagency county wgs84lon wgs84lat publishtime 宜蘭 0.00 中央氣象局 宜蘭縣 121,45,24 24,45,50 2023-04-26 00:00 大武 0.00 中央氣象局 臺東縣 120,54,14 22,21,20 2023-04-26 00:00 玉山 0.00 中央氣象局 南投縣 120,57,34 23,29,15 2023-04-26 00:00 臺南 0.00 中央氣象局 臺南市 120,12,17 22,59,36 2023-04-26 00:00 新竹 0.01 中央氣象局 新竹縣 121,00,51 24,49,40 2023-04-26 00:00 日月潭 0.00 中央氣象局 南投縣 120,54,29 23,52,53 2023-04-26 00:00 預期結果 sitename uvi publishagency county wgs84lon wgs84lat publishtime 宜蘭 0.00 中央氣象局 宜蘭縣 121,45,24 24,45,50 2023-04-26 00:00 大武 0.00 中央氣象局 臺東縣 120,54,14 22,21,20 2023-04-26 00:00 玉山 0.00 中央氣象局 南投縣 120,57,34 23,29,15 2023-04-26 00:00 臺南 0.00 中央氣象局 臺南市 120,12,17 22,59,36 2023-04-26 00:00 新竹 0.01 中央氣象局 新竹縣 121,00,51 24,49,40 2023-04-26 00:00 日月潭 0.00 中央氣象局 南投縣 120,54,29 23,52,53 2023-04-26 00:00 17.3 Practices: traversing json data 下列這些網路文件應該都是json檔，請在以下的練習中，一個一個把他帶入把他抓回來看看。並用str()或dplyr::glimpse()觀察資料的內容。注意，如果你用了View()會沒辦法knit成html檔。又，每個不同的Web API存放的核心資料階層都不一樣，你必須要嘗試找到該多筆資料所在的data.frame。例如url_cnyes的資料便放在raw$items$data這樣的階層底下。 如果你無法順利撈取，你可以運用本書所預備的url_cnyes.json來做觀察json結構的練習。 url_pchome <- "https://ecshweb.pchome.com.tw/search/v3.3/all/results?q=iphone&page=1&sort=rnk/dc" url_ubike <- "https://tcgbusfs.blob.core.windows.net/blobyoubike/YouBikeTP.json" url_cnyes <- "https://news.cnyes.com/api/v3/news/category/headline?startAt=1588262400&endAt=1589212799&limit=30" raw <- fromJSON(content(GET(url_cnyes), "text", encoding = "utf-8")) # raw <- fromJSON("data/url_cnyes.json") raw$items$data 17.4 Case 2: cnyes news (well-formatted) 第二類是最常會見到的例子，解出來的資料是個很多階層的list，通常一筆資料傳回來時多會附加一些metadata，比方說，一共幾筆資料、下一個資料區塊在哪裡，好讓使用者或者本地端的瀏覽器能夠繼續取得下一筆資料。因此，資料通常會在樹狀節點的某一個子節點。 url_cnyes <- "https://news.cnyes.com/api/v3/news/category/headline?startAt=1588262400&endAt=1589212799&limit=30" res <- fromJSON(content(GET(url_cnyes), "text", encoding = "utf-8")) glimpse(res) raw <- fromJSON("data/url_cnyes.json") df <- raw$items$data head(df) ## newsId title ## 1 4475846 〈財報〉疫情衝擊 Under Armour Q1營收大減23% ## 2 4475874 若一年內疫情未控制 避險基金大佬：美國將面臨第2次經濟大蕭條 ## 3 4475873 〈美股早盤〉市場憂經濟重啟條件不成熟 道瓊早盤跌逾200點 ## 4 4475465 挽救國家財政危機 沙烏地撙節支出266億美元 ## 5 4475875 長榮攜手海大開輪機工程專班 實習後正職月薪15萬元 ## 6 4475855 泰鼎-KY首季每股純益 1.5元 僅次健鼎 ## content ## 1 &lt;p&gt;美國運動用品大廠 Under Armour (UAA-US) 於週一 (11 日) 盤前公佈 2020 財年第一季財報，受到新冠肺炎 (COVID-19) 疫情影響，導致零售業者被迫關閉店面，該公司於 Q1 營收及獲利雙雙不如市場預期。&lt;/p&gt;\\n\\n&lt;p&gt;受到財報表現不佳的影響，Under Armour 股價應聲下跌，於週一 (11 日) 台北時間晚上 10 時許，該公司股價下跌 10.97%，報每股 8.85 美元。自今年以來，Under Armour 股價已下跌了 54%。&lt;/p&gt;\\n\\n\\n\\n&lt;p&gt;&lt;em&gt;基於 non GAAP 財報關鍵數據:&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;ul&gt;\\n&lt;li&gt;營收：9.302 億美元，較去年同期的 12 億美元衰退，且低於市場預估值 9.49 億美元&lt;/li&gt;\\n&lt;li&gt;稅後淨損：5.897 億美元，去年同期報稅後淨利 2250 萬美元&lt;/li&gt;\\n&lt;li&gt;每股虧損：0.34 美元，低於市場預估值每股虧損 0.19 美元，去年同期每股盈餘報 0.05 美元&lt;/li&gt;\\n&lt;/ul&gt;\\n\\n&lt;p&gt;由於疫情重創買氣，導致零售產業受到嚴重打擊，Under Armour CEO Patrik Frisk 表示，自 3 月中旬開始，疫情於北美地區快速蔓延，導致零售店面被迫關閉，並造成 Q1 營收大幅衰退 23%。&lt;/p&gt;\\n\\n&lt;p&gt;根據不同產品類別來看，Q1 服裝銷售下滑了 23%，報 5.98 億美元，鞋類銷售下滑 28%，報 2.1 億美元，配件銷售則下滑 17%，報 6800 萬美元。&lt;/p&gt;\\n\\n&lt;p&gt;根據不同銷售市場來看，Q1 北美營收下滑 28%，報 6.09 億美元，北美以外其他地區銷售則下滑 12%，報 2.87 億美元。北美地區的營收佔了 Under Armour 總營收的 65%。&lt;/p&gt;\\n\\n&lt;p&gt;此外，該公司表示，截至第一季為止，該公司帳上現金為 9.59 億美元。另外，預估今年的資本支出金額將達 1 億美元，低於較先前所預估的 1.6 億美元。&lt;/p&gt;\\n\\n&lt;p&gt;Under Armour 的營收成長，相當仰賴百貨公司等通路的銷售表現，但受到封鎖措施的影響，導致百貨公司被迫關閉。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;公司展望：&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;隨著美國宣佈實施經濟重啟計劃，包括梅西百貨 (M-US) 及 GAP(GPS-US) 皆規劃逐步重新恢復營業，但 Under Armour 卻於週一 (11 日) 表示，對於營業恢復的時程尚不確定。&lt;/p&gt;\\n\\n&lt;p&gt;此外，為了減輕疫情的衝擊，該公司計劃於 2020 年削減 3.25 億美元營運成本，包括暫時裁員部份零售店面的員工。由於疫情導致營運不確定性高，該公司已於上個月撤回了對於 2020 全年的財務預測。&lt;/p&gt;\\n ## 2 &lt;p&gt;美國知名避險基金經理人、Tudor Investment Corp. 創辦人 Paul Tudor Jones 週一 (11 日) 警告，若疫情在一年之內無法獲得控制，美國經濟將會陷入「第二次」經濟大蕭條。&lt;/p&gt;\\n\\n&lt;p&gt;Tudor Jones 表示：「若一年後我們依舊處於相同狀況，這將會形成第二次經濟大蕭條，這一切取決於封鎖措施是否解除。」&lt;/p&gt;\\n\\n&lt;p&gt;相較於中國、南韓等國在疫情控制及追蹤方面的努力，美國人對於自由的重視，正可能成為防疫過程中的一大阻礙，美國公衛專家即警告，若疫情尚未明顯趨緩即解封經濟，那麼可能帶來第二波的疫情蔓延。&lt;/p&gt;\\n\\n&lt;p&gt;Tudor Jones 說道：「與其他國家不同，我認為美國最大優勢在於個人主義，也就是對自由的熱愛，然而這在疫情之下卻是我們最大的弱點，看看在這方面取得成功的亞洲國家，他們的選擇顯示比起個人權利，他們更加重視社會價值觀。」&lt;/p&gt;\\n\\n&lt;p&gt;由於投資人認為經濟終將重啟，美股在今年 3 月創下史上最快步入熊市的紀錄後，正自低點迅速反彈，標普 500 指數已自疫情爆發後的底點反彈 30% 以上，且和紀錄高點僅相差 13.6%。&lt;/p&gt;\\n\\n\\n\\n&lt;p&gt;Tudor Jones 認為這波反彈相當容易預測，並強調未來走勢在很大程度上取決於疫情防控作業，重點將從流動性轉移到償債能力。&lt;/p&gt;\\n\\n&lt;p&gt;「若還是無法找到疫苗或治療方法，或者是更適合的大規模檢測方案，市場將會面臨更加艱難的時刻。」Tudor Jones 表示。&lt;/p&gt;\\n ## 3 &lt;p&gt;自上週以來，由於各國政府開始逐步放寬封鎖措施，並重新開放經濟活動，帶動美股呈現上揚的趨勢。但是，近日來部份國家傳出新冠疫情再度惡化的消息，除了南韓新增確診病例快速攀升之外，日本及新加坡的新增病例亦呈增加趨勢，顯示疫情的狀況仍不穩定，導致投資人不安情緒升溫，並衝擊了市場對於經濟重啟的信心。&lt;/p&gt;\\n\\n&lt;p&gt;由於擔憂若過早重啟經濟，將可能冒著第二波疫情感染的風險，美股於週一 (11 日) 開盤 4 大指數皆下跌，另外，與疫情關聯性較高的產業，包括航空、零售、郵輪及賭場等，股價亦呈現下跌的趨勢，道瓊早盤下跌超過 200 點。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;新冠肺炎疫情&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;英國首相強生 (Boris Johnson) 於上週日 (10) 宣佈了解除英國封鎖並重啟經濟的「首批謹慎步驟」，呼籲英國各地的人們重返工作崗位。強生強調，不會立即結束封鎖，但自週三 (13 日) 起，將放鬆對人們行動的限制，從戶外體育運動時間不再設限開始，例如高爾夫和網球，並允許人們開車前往公園和海灘。&lt;/p&gt;\\n\\n&lt;p&gt;新冠疫情於西歐國家呈現放緩的跡象，但於俄羅斯卻日益嚴重，不僅連續數日的單日新增確診病例皆突破 1 萬例，且累計確診病例數已突破 20 萬例，並超越德國及法國，成為全球疫情第五嚴重的國家。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;中美貿易協議&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;美國智庫戰略及國際研究中心 (CSIS) 上週五 (8 日) 發佈報告預計，新冠疫情將導致今年中國對美採購量遠低第一階段貿易協議的要求。&lt;/p&gt;\\n\\n&lt;p&gt;美中矛盾因疫情衝擊而逐漸加劇，使外界對於第一階段貿易協議的現況感到疑慮，儘管兩國最高官員上週同意持續落實貿易協議，同時保持溝通協調，美國總統川普仍在上週五 (8 日) 表示，疫情衝擊大大改變他對於協議的觀感，對於是否終止協議感到相當掙扎。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;截至台北時間週一 (11 日)22 時許：&amp;nbsp;&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;ul&gt;\\n&lt;li&gt;道瓊指數下跌 241.98 點或 -0.99%，暫報 24089.34 點&lt;/li&gt;\\n&lt;li&gt;那斯達克下跌 44.12 點或 -0.48%，暫報 9077.20 點&lt;/li&gt;\\n&lt;li&gt;標普 500 下跌 24 點或 -0.82%，暫報 2905.80 點&lt;/li&gt;\\n&lt;li&gt;費半下跌 15.59 點或 -0.88%，暫報 1760.02 點&lt;/li&gt;\\n&lt;li&gt;台積電 ADR 下跌 0.64% 至每股 52.53 美元&lt;/li&gt;\\n&lt;li&gt;十年期美債殖利率上漲至 0.686%&lt;/li&gt;\\n&lt;li&gt; 紐約輕原油上漲 0.97% 至每桶 24.98 美元&lt;/li&gt;\\n&lt;li&gt;布蘭特原油下跌 0.16% 至每桶 30.92 美元&lt;/li&gt;\\n&lt;li&gt;黃金下跌 0.41% 至每盎司 1706.85 美元&lt;/li&gt;\\n&lt;li&gt;美元指數上漲 0.31% 至 100.078 點 &amp;nbsp;&lt;/li&gt;\\n&lt;/ul&gt;\\n\\n\\n\\n&lt;p&gt;&lt;em&gt;焦點個股：&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;特斯拉 (TSLA-US)&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;特斯拉早盤下跌 3.46%，達 790.68 美元。&lt;/p&gt;\\n\\n&lt;p&gt;根據中國乘用車市場信息聯席會於週一 (11 日) 報告指出，儘管 4 月份中國整體電動車市場呈現成長的趨勢，但特斯拉平價車款 Model 3 的銷售，卻較 3 月份暴跌了 64%，由 10160 輛減少至 3635 輛。此外，特斯拉在今年 1 月至 4 月，於中國的 Model 3 車款累計銷售量則達 19705 輛。&lt;/p&gt;\\n\\n&lt;p&gt;特斯拉執行長馬斯克 (Elon Musk) 於日前表示，為了使中國消費者能夠獲得電動車補貼的資格，已調降了 Model 3 於中國的銷售價格。此外，特斯拉亦致力於降低生產成本，因此，即使調降了銷售價格，該公司仍舊可以維持穩定的毛利率。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;蘋果 (AAPL-US)&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;蘋果早盤下跌 0.80%，達 307.61 美元。&amp;nbsp;&lt;/p&gt;\\n\\n&lt;p&gt;據報導指出，蘋果正計劃將該公司近五分之一的產能從中國轉移到印度，並通過富士康和緯創資通等合作製造商，擴大印度當地的生產業務，未來五年內投資規模可能升至 400 億美元，也可能使印度成為蘋果商品最大出口國。&lt;/p&gt;\\n\\n&lt;p&gt;數據顯示，蘋果的產品中有 90% 以上的產能來自中國。其中，iPhone 的代工生產很大一部分來自富士康與和碩。在 2015 年時，蘋果代工廠富士康就曾與印度達成備忘錄，同意加大對印度製造業的投資，並有計劃於 2020 年在印度建立 10 至 12 家製造消費電子產品的工廠。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;Under Armour (UAA-US)&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;Under Armour 早盤下跌 7.95%，達 9.15 美元。&lt;/p&gt;\\n\\n&lt;p&gt;美國運動用品大廠 Under Armour 於週一 (11 日) 盤前公佈 2020 財年第一季財報，受到疫情影響，導致零售業者被迫關閉店面，該公司於 Q1 營收衰退 23% 至 9.3 億美元。其中，服裝銷售下跌了 23%，鞋類銷售下滑 28%，配件銷售則下滑 17%。&lt;/p&gt;\\n\\n&lt;p&gt;此外，疫情亦造成 Under Armour 獲利能力大幅下降，Q1 稅後淨損報 5.89 億美元，每股損失 0.34 美元。去年同期稅後淨利則為 2250 萬美元，每股盈餘為 0.05 美元。&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;今日關鍵經濟數據：&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;無&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;&lt;em&gt;華爾街分析：&lt;/em&gt;&lt;/p&gt;\\n\\n&lt;p&gt;Vital Knowledge 創辦人 Adam Crisafulli 表示，全球經濟呈現逐步重啟的態勢，預期在接下來幾週，開放的速度將會加速，但儘管如此，目前 S&amp;amp;P 500 的估值仍屬被高估的狀態。&lt;/p&gt;\\n\\n&lt;p&gt;Principal Global Investors 經濟學家 Bob Baur 亦表示，全球疫情逐漸好轉的消息、以及對於經濟成長的預期，目前皆已被反映在股價的估值上。&lt;/p&gt;\\n\\n&lt;p&gt;穆迪首席經濟學家 Mark Zandi 警告，各州過早重新開放企業是一次豪賭，如果因此出現第二波感染潮，將引發經濟蕭條。Zandi 表示，市場認為 V 型復甦的可能性很高，而隨著美國企業重新開放，就業有望從 5 月最後一週開始反彈，如果不出現第二波感染，就業增長將從夏季持續至秋季初。&lt;/p&gt;\\n ## 4 &lt;p&gt;為挽救低油價及疫情帶來的國家財政危機，沙烏地阿拉伯週一 (11 日) 宣布自 6 月起停發生活津貼，同時將加值稅上調三倍，撙節支出總計 266 億美元。&lt;/p&gt;\\n\\n&lt;p&gt;受外在因素衝擊，財政部長賈丹 (Mohammed Al-Jadaan) 認為沙國正處於財政危機邊緣，宣布縮減「願景 2030」(Vision 2030) 經濟改革計劃內的部分措施，國家將自 6 月 1 日起停發生活津貼，並自 7 月 1 日起將加值稅上調三倍至 15％，總計削減規模達 266 億美元。&lt;/p&gt;\\n\\n&lt;p&gt;賈丹稱道：「肺炎疫情導致政府收入下滑，對公共財政形成的壓力來到難以應付的水平，將衝擊國家中長期宏觀經濟及公共財政，因此我們必須削減開支，並採取相關措施來支撐非石油收入的穩定。」&lt;/p&gt;\\n\\n&lt;p&gt;賈丹上週警告，沙國已數十年沒有經歷這種嚴重危機，強調該國必須大幅削減支出。根據統計，今年第一季沙國預算赤字約達 91 億美元，光是石油收入就減少 350 億美元，非石油收入則減少 170 億美元。&lt;/p&gt;\\n\\n&lt;p&gt;由於各國政府相繼頒布旅遊及封鎖禁令，沙國已受到油價暴跌和原油減產的深刻影響。今年 3 月，國際原油基準布蘭特原油暴跌逾 50%，導致沙國央行的淨海外資產每月損失 270 億美元，創下歷史紀錄，3 月外匯存底以 20 年幾年來最快速度下滑。&lt;/p&gt;\\n\\n\\n\\n&lt;p&gt;儘管高盛預計第二季石油收入將持續下滑，高盛經濟學家 Farouk Soussa 仍表示，預計沙國外匯存底損耗速度將逐漸放緩。&lt;/p&gt;\\n ## 5 &lt;p&gt;為擴大培育國籍海事專業人才，長榮海運 (2603-TW) 今 (11) 日宣布，與國立台灣海洋大學再度合作開辦學士後多元專長培力方案(輪機工程學系專班)，希望透過產業與學術密切合作，培養有志投身海勤工作的學員，並可在畢業後隨即就業，長榮指出，一旦正式成為長榮的海勤人員，月薪約 15 萬元。&lt;/p&gt;\\n\\n&lt;p&gt;長榮說明，此專班的招生對象為非輪機科系畢業的學員，只要具備學士資格，役畢或免服兵役者皆可報考，通過遴選後開始就讀，修業時間為三學期，長榮海運將全額補助學雜費和部分住宿費用，自 5 月 12 日起開放報名，預計 9 月正式開學。&lt;/p&gt;\\n\\n&lt;p&gt;而此方案是為配合長榮永續發展的專業人才需求，透過不同的管道來擴大培育優秀的國籍海事尖兵，並不影響海事科系學生到長榮實習和工作的機會。&lt;/p&gt;\\n\\n&lt;p&gt;長榮於 2017 年開始與海洋大學開辦第一期學士後輪機技術人才專班，該期學員已於去年畢業，並有超過 90% 的學員通過交通部的航海人員一等管輪測驗，陸續上船實習；部分學員已依規定累積一年的實習資歷，取得管輪適任證書，正式成為長榮的海勤人員，月薪約 15 萬元，未來隨著海勤年資與經驗增加，並通過相關測驗，可逐級晉升為輪機長，月薪將達 28-30 萬元的水準。&lt;/p&gt;\\n\\n&lt;p&gt;除了優渥的薪資外，長榮強調，貨櫃船隊提供舒適的住艙環境，並有圖書室、健身房、三溫暖及影音娛樂等設施，以及無線網路。&lt;/p&gt;\\n ## 6 &lt;p&gt;PCB 廠泰鼎 - KY(4927-TW) 今 (11) 日公布日首季稅後純益達 2.85 億元，每股純益為 1.5 元，在已公布 2020 年第一季財報的 PCB 廠中，僅次健鼎 (3044-TW) 的每股純益 1.86 元，第三名則是臻鼎 (4958-TW) 的 0.97 元。&lt;/p&gt;\\n\\n&lt;p&gt;泰鼎 2020 年首季營收 26.05 億元，毛利率 21%，季增 6 個百分點，年增 2 個百分點，稅後純益 2.85 億元，季增 5.06 倍、年增 11.8%，為單季次高，每股純益&amp;nbsp;1.5 元，也優於去年同期&amp;nbsp;1.43 元。&lt;/p&gt;\\n\\n&lt;p&gt;泰鼎 4 月營收 10.14 億元，月增 23.2%、年增 28.4%，為 9 個月新高，也創單月歷年同期新高; 累計今年前 4 月營收 36.19 億元，年減 0.5%。&lt;/p&gt;\\n\\n&lt;p&gt;展望第二季，泰鼎在 PC、家電、汽車、通訊四大區塊接單順利，預估營收相對第一季 26.05 億元，將雙位數成長。&lt;/p&gt;\\n\\n&lt;p&gt;泰鼎目前在泰國擁有每月 500 萬平方呎 PCB 產能，第 3 廠已經動工，全部完工後每月將再增加 180 萬平方呎新產能。&lt;/p&gt;\\n ## hasCoverPhoto isIndex ## 1 0 1 ## 2 0 1 ## 3 0 1 ## 4 0 1 ## 5 1 1 ## 6 1 1 ## summary ## 1 Under Armour (UAA-US) 於週一 (11 日) 盤前公佈 2020 財年第一季財報，受到新冠肺炎 (COVID-19) 疫情影響，導致零售業者被迫關閉店面，該公司於 Q1 營收及獲利雙雙不如市場預期。 ## 2 美國知名避險基金經理人、Tudor Investment Corp. 創辦人 Paul Tudor Jones 週一 (11 日) 警告，若疫情在一年之內無法獲得控制，美國經濟將陷入「第二次」經濟大蕭條。 ## 3 由於擔憂若過早重啟經濟，將可能冒著第二波感染的風險，美股於週一 (11 日) 開盤 4 大指數皆下跌，另外，與疫情關聯性較高的產業，包括航空、零售、郵輪及賭場等，股價亦呈現下跌的趨勢。道瓊指數下跌超過 200 點。 ## 4 為挽救低油價及疫情帶來的國家財政危機，沙烏地阿拉伯週一 (11 日) 宣布自 6 月起停發生活津貼，同時將加值稅上調三倍，撙節支出總計 266 億美元。 ## 5 長榮攜手海大開輪機工程專班 實習後正職月薪 15 萬元 ## 6 PCB 廠泰鼎 - KY(4927-TW) 今 (11) 日公布日首季稅後純益達 2.85 億元，每股純益為 1.5 元，在已公布 2020 年第一季財報的 PCB 廠中，僅次於健鼎 (3044-TW) 的每股純益 1.86 元，而第三為臻鼎。 ## isCategoryHeadline video payment ## 1 1 0 ## 2 1 0 ## 3 1 0 ## 4 1 0 ## 5 1 0 ## 6 1 0 ## otherProduct ## 1 USS:UAA:STOCK:COMMON, USS:M:STOCK:COMMON, USS:GPS:STOCK:COMMON ## 2 ## 3 TWS:2330:STOCK:COMMON, USS:TSLA:STOCK:COMMON, USS:AAPL:STOCK:COMMON, USS:UAA:STOCK:COMMON, USS:TSM:STOCK:COMMON ## 4 ## 5 TWS:2603:STOCK:COMMON ## 6 TWS:4927:STOCK:COMMON, TWS:3044:STOCK:COMMON, TWS:4958:STOCK:COMMON ## isOutsource publishAt ## 1 0 1589211902 ## 2 0 1589209204 ## 3 0 1589205268 ## 4 0 1589204403 ## 5 0 1589203838 ## 6 0 1589203802 ## coverSrc.xs.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/xs/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/xs/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.xs.width coverSrc.xs.height ## 1 NA NA ## 2 NA NA ## 3 NA NA ## 4 NA NA ## 5 100 56 ## 6 100 56 ## coverSrc.s.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/s/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/s/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.s.width coverSrc.s.height ## 1 NA NA ## 2 NA NA ## 3 NA NA ## 4 NA NA ## 5 180 101 ## 6 180 101 ## coverSrc.m.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/m/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/m/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.m.width coverSrc.m.height ## 1 NA NA ## 2 NA NA ## 3 NA NA ## 4 NA NA ## 5 380 214 ## 6 380 214 ## coverSrc.l.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/l/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/l/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.l.width coverSrc.l.height ## 1 NA NA ## 2 NA NA ## 3 NA NA ## 4 NA NA ## 5 640 360 ## 6 640 360 ## coverSrc.xl.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/xl/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/xl/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.xl.width coverSrc.xl.height ## 1 NA NA ## 2 NA NA ## 3 NA NA ## 4 NA NA ## 5 960 539 ## 6 960 540 ## coverSrc.xxl.src ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 https://cimg.cnyes.cool/prod/news/4475875/xxl/8602ccaee38d54e5bb148e1cca3eb4bf.jpg ## 6 https://cimg.cnyes.cool/prod/news/4475855/xl/0e09778efa0a69a77710b8986c0d958a.jpg ## coverSrc.xxl.width coverSrc.xxl.height categoryId fundCategoryAbbr etf ## 1 NA NA 831 NULL NULL ## 2 NA NA 831 NULL NULL ## 3 NA NA 831 NULL NULL ## 4 NA NA 833 NULL NULL ## 5 1080 607 827 NULL NULL ## 6 960 540 827 NULL NULL ## fbShare fbComment fbCommentPluginCount ## 1 0 0 0 ## 2 0 0 0 ## 3 0 0 0 ## 4 0 0 0 ## 5 0 0 0 ## 6 0 0 0 ## market ## 1 NULL ## 2 NULL ## 3 2330, 台積電, TWS:2330:STOCK ## 4 NULL ## 5 2603, 長榮, TWS:2603:STOCK ## 6 4927, 3044, 4958, 泰鼎-KY, 健鼎, 臻鼎-KY, TWS:4927:STOCK, TWS:3044:STOCK, TWS:4958:STOCK ## source ## 1 <NA> ## 2 <NA> ## 3 <NA> ## 4 <NA> ## 5 ## 6 17.4.1 (option) 取回資料並寫在硬碟 有時候寫爬蟲尤其是在爬會即時更新的資料時，會需要反覆定時地抓資料，這時候通常會先通通抓回來再慢慢合併整理。此時要特別注意如何保持每次抓回來的資料都是獨特的一個資料。以下面的例子來講，因為每次檔名都是一樣的，他會一直覆蓋過去，所以再怎麼抓，都不會是歷時性資料。通常會自動讀取當下時間當成檔名的一部分，這樣就不會重複了。這將在日後youbike的例子中用到。 response <- GET(url_cnyes, write_disk("data/url_cnyes.json", overwrite=TRUE)) 17.5 Case 3: footRumor (ill-formatted) 食品闢謠的例子可能是個沒好好編過JSON的單位所編出來的案子，資料很簡單，但卻是一個list裡面有329個data.frame，且每個data.frame只有對腳現有資料，然後每一筆資料就一個data.frame。 url <- 'http://data.fda.gov.tw/cacheData/159_3.json' safefood <- fromJSON(content(GET(url),'text')) # write_json(safefood, "data/opendata_safefood_202304261256.json") 為了避免產製本書時出錯，本程式採用預備好的資料來練習。但仍建議你用前述方式自網路上爬取資料下來練習。 safefood <- fromJSON("data/opendata_safefood_202304261256.json") # str(safefood) class(safefood) ## [1] "list" class(safefood[[1]]) ## [1] "data.frame" dim(safefood[[1]]) ## [1] 5 5 # View(safefood[[1]]) # View(safefood) # print(content(GET(url), "text")) 17.5.1 處理非典型的JSON檔 但這時候也不難觀察到其規律性。既然每個data.frame是一筆資料，且資料都是照順序出現在對角線，那我就把data.frame給unlist()拆成vector後，把NA給移除了，那剩下的就是我們要的資料了。 但，由於對整筆資料unlist()，那整筆資料會變成一個很長的vector，不過我們知道每五個元素就是一筆資料。所以我可以嘗試用matrix()的指令，讓資料每五個就折成一筆資料。 程序大致上是 safefood.v <- unlist(safefood) 把資料unlist()。 safefood.v <- safefood.v[!is.na(safefood.v)]剔除NA值 safefood.m <- matrix(safefood.v, byrow = T, ncol = 5)照列來折，因為每五個就一筆資料，所以是照列折，然後用ncol = 5來指定五個一折。 # unlist data structure to a list safefood.v <- unlist(safefood) head(safefood.v) ## 分類1 分類2 分類3 分類4 分類5 標題1 ## "" NA NA NA NA NA # anyNA() to check if NAs still exist anyNA(safefood.v) ## [1] TRUE # (option) check if NAs exist sum(is.na(safefood.v)) ## [1] 10720 # remove NAs safefood.v <- safefood.v[!is.na(safefood.v)] # length(safefood.v) # double-check NAs anyNA(safefood.v) ## [1] FALSE # head(safefood.v) # convert vector to matrix safefood.m <- matrix(safefood.v, byrow = T, ncol = 5) # ?matrix # convert matrix to dataframe safefood.df <- as.data.frame(safefood.m) # delete the 4th column safefood.df <- safefood.df[-4] # naming the data.frame names(safefood.df) <- c('category', 'question', 'answer', 'timestamp') head(safefood.df) ## category question ## 1 使用含有acetaminophen成分藥品會傷腎，是真的嗎？ ## 2 使用退燒藥會延誤治療，是真的嗎？ ## 3 美國全面禁止2歲以下幼兒使用感冒藥及退燒藥嗎？ ## 4 凡士林(Petrolatum)會致癌，請問是真的嗎？ ## 5 市售護唇膏多含石蠟，長期使用可能致癌，是真的嗎？ ## 6 含藥化粧品比一般化粧品效果更好嗎？ ## answer ## 1 解答： Acetaminophen 是一種中樞作用型解熱鎮痛藥品，在正常健康狀況下，使用正常的建議劑量（成人每日不超過4000 毫克，兒童每日每公斤不超過50 毫克，分多次服用，每次至少間隔4 小時），並不會引起腎毒性。有少數報告顯示當急性過量使用時，會導致腎功能不良，但多為可逆性，如果慢性大量使用，才有嚴重腎臟傷害的可能性。 根據國外報告，成人長期持續使用1 年以上，而且累積劑量超過1 公斤（以一般每顆500 毫克的成人劑型而言，相當於2000 顆）時，可能導致嚴重腎臟傷害。此外，過量使用acetaminophen 或併服酒精性飲料時，具有肝臟損傷之風險。因此使用該成分藥品，應依照仿單或醫師指示使用，且避免長期持續使用或同時飲用酒精。 本文案為食藥署與臺灣兒科醫學會共同撰文 ## 2 解答： (1)發燒為一種症狀，並非病因，瞭解引起發燒之原因遠比退燒重要。因此，出現發燒症狀時，應立即就醫治療，以瞭解導致發燒的原因，切勿自行購買退燒藥使用，以免延誤疾病之治療。 (2)退燒藥之使用，主要目的是減緩因發燒出現之不適感。當發燒超過38.5° C且有不舒服的感覺，可適當給予退燒藥，但不一定要讓體溫降到正常範圍。 本文案為食藥署與臺灣兒科醫學會共同撰文 ## 3 解答： 美國食品藥物管理局並未完全禁止2 歲以下幼兒使用退燒藥或感冒藥，而是強調應在醫師指示下使用。美國分析兒童使用感冒藥產生的嚴重不良反應，主要是因為美國民眾可於藥局自行購買成藥，家長因為沒有劑量觀念，可能導致藥物過量而使幼兒發生危險。我國對於該類藥品之使用建議與國外一致，且中文仿單已註明「幼兒應洽醫師診治，不宜自行使用」，強調感冒藥必須經由專業醫師診治後，方能用於2 歲以下幼兒。 幼兒的生理發展尚未健全，必須特別注意藥物劑量。因此，無論中藥或西藥，幼兒使用藥品一定要經熟悉兒科專業的醫師評估其臨床效益及風險，並依幼兒之體重年齡處方適當劑量。家長依循專業醫師處方使用藥物，比較不會發生腎毒性等不良反應。 本文案為食藥署與臺灣兒科醫學會共同撰文 ## 4 解答： 凡士林(Petrolatum) 成分常被用於髮蠟、髮乳、潤膚霜、冷霜、唇膏、乳液等化粧品中，該成分安定性佳且歐盟、美國、日本等國的化粧品均未禁止使用凡士林成分，更可用於食品及口服藥品中，做為油性鎖水保濕劑使用。 提醒大家不要被謠言所誤導，選擇適合自己的產品，瞭解成分的用途與使用方式，才是保養身體的關鍵。 ## 5 解答： 石蠟是護唇膏、各種保濕保養化粧品的常見的成分，目前國際間均允許該成分可添加於化粧品中。化粧品中使用之石蠟已經精製，而精製過後的石蠟安定性佳，更可用於食品及口服藥品中。 食藥署提醒大家，不要被謠言所誤導，選擇標示完整及適合自己的產品，瞭解成分的用途與使用方式，才是保障自身權益的關鍵。 ## 6 解答： (1)我國所謂的「含藥化粧品」，實際上為含有衛生福利部公告的「化粧品含有醫療或毒劇藥品基準」成分之化粧品，主要針對添加前述基準成分之染髮劑、燙髮劑、止汗制臭劑等產品加強安全性管理，與化粧品的效果無關。 (2)目前含藥化粧品依規定需於進口或上市前辦理查驗登記，取得許可證後始得輸入、製造及販售。 (3)民眾在選購含藥化粧品前，可先上食藥署首頁>業務專區>化粧品>含藥化粧品許可證查詢作業，查詢該含藥化粧品是否已取得許可證，才可安心購買。 相關連結： 西藥、醫療器材、含藥化粧品許可證查詢作業http://www.fda.gov.tw/mlms/H0001.aspx (另開視窗) ## timestamp ## 1 06 25 2015 12:00AM ## 2 06 25 2015 12:00AM ## 3 06 25 2015 12:00AM ## 4 06 25 2015 12:00AM ## 5 06 25 2015 12:00AM ## 6 06 25 2015 12:00AM 17.6 Reviewing JSON 17.6.1 Type I: Well-formatted JSON: UVI, AQI, Hospital_revisits 這類的資料以典型的[{}, {}, {}]形式儲存，以以下方式就可直接轉為data.frame df <- fromJSON(content(GET(url), \"text\")) 17.6.2 Type II: hierarchical JSON: rent591, facebook graph api, google map 這類的json資料為well-formatted，但要的資料儲存在比較深的階層中，代表其並非簡單地二維表格，還有其他更多的詮釋資料被擺在同一個JSON檔案中。解決策略：通常fromJSON()轉完後為list，逐一就variable names查看資料在哪裡。View(res$data$data) 17.6.3 Type III: Ill-formatted JSON: food_rumors, ubike 這類的資料並非以典型的[{}, {}, {}]形式儲存，但仍是有序的二維數據。可將資料unlist()攤開，然後去除不必要的NA後，按欄位數目重建Matrix再轉回data.frame 解決策略：用as.data.frame()或unlist()硬轉成data.frame或vector來看資料的出現是否有所規律。 17.7 "],["html-parser.html", "Chapter 18 HTML Parser 18.1 HTML 18.2 Detecting Element Path", " Chapter 18 HTML Parser 本章已經介紹了如何讀取XLSX、CSV、JSON檔等常見的開放資料，也可以讀取來自各種網站的資料，例如104、信義房屋、Dcard、facebook、Google Map API、Flickr API、Twitter Rest API等等。但是有些網站不是以資料檔案的方式提供資料，而是直接由伺服器端傳回整個網頁，例如PTT網頁版、不動產實價登錄網站、政府標案決標資訊等等。對於這些網頁，我們需要使用HTML剖析器來解析網頁並獲取其中的資料。 大多數網頁都是由多個<div>、<table>或<li>等標籤層層巢套組成，包括導覽元件、廣告、標題、分類等等各種資訊，而我們需要的資料僅佔其中的一小部分，因此必須要撰寫HTML剖析器，找到目標的HTML標籤，將其獲取回來。 這些網站的HTML標籤通常會巢套很多層，甚至會動態更改巢套的階層以防止被爬取。但是如果仔細觀察，就會發現其中有一些規律性，例如新聞搜尋結果通常包括標題、簡要內文、時間和圖片等元素。瀏覽器發出搜尋請求後，伺服器會傳回一個HTML檔案，並且會傳回一些CSS或JavaScript來指示瀏覽器如何視覺化這個HTML檔案。因此，這個HTML和CSS是在傳回你的瀏覽器後視覺化成網頁的模樣，如果看起來有規律性，那就意味著有一套規律性是設計來讓程式知道如何視覺化這些標題或內容，以便使它們看起來具有一定的規則性。這套規則主要由HTML標籤和屬性組成，使我們可以使用CSS選取相同規則的元件，將之視覺化為相同的樣子。 因此，在進行網頁爬蟲時，我們需要了解HTML和CSS，並學習如何使用CSS Selector和XPath這兩種方法選取HTML元素。CSS Selector和XPath是兩種定義路徑的方法，它們可以通過選擇器（selector）定位HTML元素，以便選取一個或多個條件相同的元素。 CSS Selector是CSS中的一個語法，可以根據HTML元素的標籤名稱、屬性、類別、ID等條件選取對應的元素。舉例來說，可以使用以下CSS Selector選取所有標籤名稱為div的元素：div，或選取所有class屬性為test的元素： .test。 XPath則是XML Path Language的縮寫，是一種用於選擇XML文件中元素的語言，同樣可以用於HTML文件的選擇。XPath使用路徑表達式來定位元素，可以根據標籤名稱、屬性、位置等多種條件進行選擇。例如，以下XPath可以選擇所有標籤名稱為div的元素：//div，或選取所有class屬性為test的元素：//*[@class='test']。 掌握CSS Selector和XPath的使用，可以讓我們更加靈活地獲取網頁上的元素，並且能夠解析複雜的HTML結構，提取出需要的資料。 18.1 HTML HTML檔案的結構大致如下： 首先會有一個檔案類別的宣告<!DOCTYPE html>，用以告訴第三方瀏覽器或應用程式說這是一個HTML5檔案； 再來是成對標籤所組成的巢套結構，下例即有一對<html></html>包著一對<head></head>和一對<body></body>。 另外<!---->包著的內容為註解，瀏覽器或程式遇到該區段的內容會略過不處理。 下圖可用以說明HTML檔案的巢套（一層包一層）結構（圖片來源https://www.w3schools.com/html/html_intro.asp）。 18.2 Detecting Element Path Chrome DevTools的使用如下： 打開Chrome瀏覽器，進入要爬取的網站。 按下F12鍵或「右鍵」點擊網頁上的任意你感興趣的內容並選擇「檢查（Inspector）」來開啟DevTools。 在DevTools中，選擇「Elements」分頁。Elements分頁用於查看和修改網頁的HTML和CSS，以及網頁中的DOM元素。在Elements分頁中可以看到網頁中所有的HTML標籤和屬性，以及網頁中的DOM樹狀結構。程式寫作者可使用此功能來檢查和修改網頁元素，例如更改元素的文本、樣式或屬性，或者添加、刪除或重新排列元素。Elements分頁還提供了選擇元素和檢查元素屬性的工具，便於快速找到和解決網頁問題。此外，Elements分頁還具有許多有用的功能，例如網頁渲染性能分析、Box-Model、色彩選擇器等，可幫助使用者更好地理解和設計網頁。 在「Elements」分頁中找到你要查找的元素，例如一個按鈕或一個超連結。你可以輕點一下Elements中的任意元素，然後按「Ctrl/Cmd+F」就可以搜尋在Elements分頁中的內容。例如你感興趣的是網頁上的「下一頁」三個字，那你搜尋「下一頁」就可以找到相對應的元素。或者，你可以在「Elements」分頁開啟的狀況下，用右鍵輕點左側原始網頁中你感興趣的內容或元素，然後再次選擇「檢查（Inspector）」，此時「Elements」分頁就會自動跳到你感興趣的內容或元素。 在DevTools的選擇元素面板中，右鍵點擊選擇的元素，然後選擇「Copy」>「Copy XPath」或「Copy」>「Copy selector」。 將複製的XPath或CSS Selector粘貼到您的爬蟲程式中，以查找和提取相應的數據。 18.2.1 XPath XPath是一種用於定位和選擇XML文檔中元素的語言，也可以應用於HTML文檔。XPath使用路徑表達式來選擇文檔中的節點或節點集，這些路徑表達式可以是絕對的或相對的，可以根據元素名、屬性、節點位置等進行篩選。XPath提供了一種簡單而強大的方式來編寫網頁爬蟲，使得開發者能夠精確地定位需要提取的數據，進而進行數據清洗和分析。 以下是一個XPath的例子：考慮一個HTML文檔，其中有一個表格，表格中包含多個行和列，每一個單元格包含一些數據。如果我們想要提取表格中第一行第一列的數據，可使用//table/tr[1]/td[1]。這個XPath表達式由以下幾個部分組成： //table: 選擇文檔中的所有表格元素。 /tr[1]: 選擇表格中的第一行。 /td[1]: 選擇第一行中的第一列。 18.2.2 CSS Selector CSS Selector是一種用於定位和選擇HTML元素的語言，它可以根據元素的屬性、標籤名稱、類名稱等進行篩選和定位。CSS Selector同樣也是網頁爬蟲中經常使用的一種定位方式。和XPath相比，CSS Selector的寫法更加簡潔和直觀，因此在一些簡單的定位場景中，使用CSS Selector可以更加方便和快捷。但是，在一些複雜的定位場景中，XPath可能更加適合，因為它可以根據節點的位置等進行更加精確的篩選。 用CSS Selector如前面XPath的例子來選擇表格中第一行第一列：table tr:first-child td:first-child。這個CSS Selector由以下幾個部分組成： table: 選擇文檔中的所有表格元素。 tr:first-child: 選擇表格中的第一行。 td:first-child: 選擇第一行中的第一列。 "],["ptt-scrape.html", "Chapter 19 Scraping PTT 19.1 Step 1. 載入所需套件 19.2 Step 2. 取回並剖析HTML檔案 19.3 Step 3. 用for迴圈打撈多頁的連結 19.4 Step 4. 根據連結取回所有貼文 19.5 補充(1) 較好的寫法 19.6 補充(2) 最佳的寫法", " Chapter 19 Scraping PTT 在爬取HTML之前，你要先知道的是，資料如何被放在巢套元素的HTML檔案中，而Attribute（尤其是id和class和<a>的href）又如何提供線索給CSS Selector或XPath來選取我們所要的元素，最後要知道XPath和CSS Selector的用途是用來選取你所需要的HTML中的資料。 以下以ptt boy-girl版為例，展示如何以爬蟲擷取網頁上的資料，並整理成DataFrame。PTT的網頁分為兩種主要類型， 其一稱為鏈結頁或索引頁，為文章的超鏈結，例如https://www.ptt.cc/bbs/Boy-Girl/index.html。 其二為每一篇文章的內容頁https://www.ptt.cc/bbs/Boy-Girl/M.1523994970.A.71C.html。 對於這種網頁，要設計兩階段的爬蟲，第一階段是把所有所需鏈結撈回來，第二階段是根據撈回來的鏈結去打撈文章，並把裡面的內文整理出來。對於第一階段而言，概念大概如下面的示意圖，其實爬取HTML的概念都差不多是這樣，但以下示意圖說明了用XPath或CSS Selector「分別」選取出整個頁面中的標題、超鏈結、時間、和作者，然後用data.frame()組合成一個DataFrame；Page 2也如此炮製，然後把Page 2的DataFrame用bind_rows()附加在Page 1的DataFrame後面。 19.1 Step 1. 載入所需套件 在這個例子中，不僅要用httr來取得網頁頁面，還要用rvest套件（其實是呼叫xml2）來剖析網頁。網頁內容並不像json一樣可以直接轉為DataFrame或list。網頁內容可以是資料、視覺化元素、也可以是架構元素，相對於json而言複雜也冗贅許多。因此需要一個套件能夠剖析HTML標籤例如xml2，而rvest內則應用了xml2套件的內容來剖析網頁，另外，我會用bind_rows()將過程中所抓取的資料進行合併。 library(tidyverse) library(rvest) library(httr) 19.2 Step 2. 取回並剖析HTML檔案 在從HTML檔案中打撈出我們所要的資料有三個重要的rvest函式（步驟），分別為： read_html()依照網址將網頁取回並轉為xml_document。 html_nodes() 用CSS Selector或XPath選擇所需的資料節點，另外html_node()是只取滿足條件的第一個節點。 html_text()或html_attr()或html_table()、html_tags()取出所要抓的節點的目標資料，可能是一個表格、一個標籤內容、或者是一個屬性值。 19.2.1 Step 2-1. read_html() 將網頁取回並轉為xml_document read_html()內部包含了GET()與content()等的實作，其主要的功能是將取回來的回應（response）轉為xml_document。若以class(doc)觀察其型態，會是xml_document xml_node。 使用browseURL(url)可以用瀏覽器打開該網址並瀏覽。 url <- "https://www.ptt.cc/bbs/Boy-Girl/index.html" doc <- read_html(url) class(doc) ## [1] "xml_document" "xml_node" browseURL(url) 19.2.2 Step 2-2 以html_nodes() 以選擇所需的資料節點 html的檔案還包含了相當多其他視覺、互動、排版的標籤，因此通常只有少部分是資料，且存在層層的html元素中。因此，獲取到該網頁並轉為xml_document後，便要用html_nodes()或html_node()根據所給的CSS Selector或XPath來選擇所要取出的節點中的資料。要獲取該元素的CSS Selector可以利用Chrome DevTool或者是Firefox。用法是對著該網頁空白處按右鍵選擇檢查（insepect）。 以下用CSS Selector抽取： #指的是id、.指的是class。 #main-container意思是，某個id為main-container的元素。 .title指的是某個class為title的元素。 div.title指的是class為title的div（排版元素）。 Div.r-list-container.action-bar-margin.bbs-screen指的是同時具有r-list-container、action-bar-margin、bbs-scree三個class的div元素。 css <- "#main-container > div.r-list-container.action-bar-margin.bbs-screen > div > div.title > a" node.a <- html_nodes(doc, css) class(node.a) # "xml_nodeset" length(node.a) 用XPath抽取： path <- '//*[@id="main-container"]/div[2]//div/div[3]/a' node.a <- html_nodes(doc, xpath = path) links <- html_attr(node.a, "href") 19.2.3 Step 2-2 補充說明與XPath、CSS Selector的最佳化 用CSS Selector和XPath抽取有一些經驗法則，以PTT為案例來說的話，原本複製得來的CSS Selector和XPath分別為 CSS Selector：#main-container > div.r-list-container.action-bar-margin.bbs-screen > div:nth-child(3) > div.title > a XPath：//*[@id=\"main-container\"]/div[2]/div[3]/div[2]/a PTT貼文目錄頁面的HTML結構。 到html之間，有一個id為#main-container的div。所以從div#main-container開始取即可。通常確定有id後，我就會開始找重複項，這邊的重複項是class為r-ent的div，找到重複項後，我就會去找重複項後面到我要的資料的路徑，而我們要的<a>就在class為title的div中。所以一個簡化的路徑是div#main-container div.r-ent div.title a。 但在這邊，既然有id，就不在乎是什麼元素會有id，所以可以只寫#main-container，而也只有資料在的div才有.r-ent的class，所以也不用強調前面的div，至於.title前面一定是搭div的元素，所以我可以簡化到寫為#main-container .r-ent .title a。甚至，由於.r-ent一定在#main-container裡面，所以連前面的id我都可以省略掉。 如果用XPath來寫的話，照上面的邏輯應該要寫成//*[@id=\"main-container\"]//div[@class=\"r-ent\"]/div[@class=\"title\"]/a。注意到第二個div前有兩個斜線//，原因是#main-container和.r-ent之間還有一層div，兩個斜線代表前後兩者間還有其他層，如果沒有兩個斜線而只有一個斜線的話，那就是代表#main-container下面一層馬上就要是.r-ent，若你把它改成單斜線的話，就會發現取不到資料。 以政府招標為範例來解釋 最終要抓的資料節點為何？主要為<a href=\"...\">的href屬性值和<a>底下<div>中的內容。 觀察資料在哪個節點「逐筆」出現?這邊是<tr>（table row），<td>則是資料欄位 利用id和class來辨識：遇到有id就從id開始取就好，例如#searchResult。 中間的節點多可以忽略：例如這個CSS selector可省略寫為#searchResult tr a 政府招標網站的HTML結構 19.2.4 Step 2-3 html_text()或html_attr()轉出所要的資料 我們所要的資料為<a href=\"/bbs/Boy-Girl/M.1523983903.A.71E.html\">[心情] 看到自己喜歡女生跟別的男生走很近好難過</a>中的超鏈結和標題文字。 html_text(): 在<a>與</a>之間的[心情] 看到自己喜歡女生跟別的男生走很近好難過稱為<a>的元素內容，要用html_text(node.a)來抽取。 html_attr(): 在<a>內的href=\"/bbs/Boy-Girl/M.1523983903.A.71E.html\"稱為<a>的屬性，該屬性名稱為href(Hyper Reference的意思)，屬性值為/bbs/Boy-Girl/M.1523983903.A.71E.html。要用html_attr(node.a, \"href\")來抽取（相當於指定某個元素的href屬性的內容）。 取出元素節點的內容，相當於取出<a></a>間所夾的內容。 texts <- html_text(node.a) length(texts) 取出元素節點某個屬性的值，這邊是取出href這個屬性的值，也就是超鏈結。 links <- html_attr(node.a, "href") class(links) # character links[1] # "/bbs/Boy-Girl/M.1555188846.A.D5F.html" 但這些超鏈結只有後半段，點開一篇文章觀察其網址，發現我們所抓到的網址少了前面那一段，因此用paste0()黏上前綴的網址前段，便可得到完整網址，可用browseURL(links[1])觀察。 pre <- "https://www.ptt.cc" links <- paste0(pre, links) links[1] # [1] "https://www.ptt.cc/bbs/Boy-Girl/M.1555188846.A.D5F.html" 重組上列程式碼如下： pre <- "https://www.ptt.cc" url <- "https://www.ptt.cc/bbs/Boy-Girl/index.html" doc <- read_html(url) css <- "#main-container div.r-ent div.title a" node.a <- html_nodes(doc, css) 題外話，因為rvest與httr均支援tidyverse的程式寫作，因此可改為以下pipeline的形式。但我不見得會這麼寫，比如說<a>這個元素我可能不僅會取出其超鏈結，還打算取出標題文字，為了避免重複操作，我不見得會用tidyverse來寫。 pre <- "https://www.ptt.cc" url <- "https://www.ptt.cc/bbs/Boy-Girl/index.html" links <- url %>% read_html %>% html_nodes("#main-container div.r-ent div.title a") %>% html_attr("href") %>% paste0(pre, .) 19.3 Step 3. 用for迴圈打撈多頁的連結 我們可以觀察到PTT該版的鏈結頁的網址規則如下 最新頁：https://www.ptt.cc/bbs/Boy-Girl/index.html 倒數第二頁：https://www.ptt.cc/bbs/Boy-Girl/index3902.html 倒數第三頁：https://www.ptt.cc/bbs/Boy-Girl/index3901.html 倒數第四頁：https://www.ptt.cc/bbs/Boy-Girl/index3900.html 最新一頁因此可類推出為https://www.ptt.cc/bbs/Boy-Girl/index3903.html 因此，我打算寫一個for迴圈，讓他幫我（先）抓最後10頁，那就是3894到3903頁。並且，把頁數當成網址的參數，用sprintf()或paste0()組合出網址，以下分別提供兩種版本。你可以把它印出來且點選看看是否是你所要的網頁。 for(p in 3894:3903){ url <- sprintf("https://www.ptt.cc/bbs/Boy-Girl/index%s.html", p) # url <- paste0("https://www.ptt.cc/bbs/Boy-Girl/index", p, ".html") } 接下來，我要用一個all_links變數來存放所有的網址，並且把每一個頁面抓到的網址們都用vector的concatenation，也就是c()黏在一起 all_links <- c(all_links, links)。 all_links <- c() for(p in 3894:3903){ url <- sprintf("https://www.ptt.cc/bbs/Boy-Girl/index%s.html", p) all_links <- c(all_links, links) } 最後，我就將上述抓到網址的方法填入這個for迴圈中，並把抓到的網址存為links，就會隨著每回合的for迴圈逐漸把抓到的網址整理在一起。 pre <- "https://www.ptt.cc" all_links <- c() for(p in 3894:3903){ url <- sprintf("https://www.ptt.cc/bbs/Boy-Girl/index%s.html", p) print(url) doc <- read_html(url) # Get and parse the url css <- "#main-container div.r-ent div.title a" node.a <- html_nodes(doc, css) links <- html_attr(node.a, "href") links <- paste0(pre, links) # Recover links all_links <- c(all_links, links) } length(all_links) 19.4 Step 4. 根據連結取回所有貼文 前面是針對每一個頁面的網址取回該頁面中所有的貼文鏈結，所以我現在all_links中是所有的貼文鏈結。我可以仿照前面的做法，就每一個貼文鏈結，取回貼文內容，貼文內容可能包含作者、時間、標題、版別、內文等資料欄位 不失一般性地，用第一篇貼文的鏈結來做資料抓取實驗，之後再抓第二篇、第三篇即可。 首先，對於這每篇文章，我要爬取作者（author）、標題（title）、時間（time）、看板（board）和內容（content）五個欄位，包含原本文章的連結url一共六個欄位。 從以下的圖發現，每篇文章的內容放置在div#main-content中，之後一連跟著四個div.article-metaline，裡面分別有作者、看板、標題與時間，但從class名稱看不出來哪個，但我們要的值會是在span.article-meta-value中。所以我的規劃是，一次把所有的.article-meta-value給抓回來，然後再去分別指定哪個是作者、看板、標題或時間。所以我用 link <- all_links[1] doc <- read_html(link) meta.css <- "#main-content div.article-metaline span.article-meta-value" metadata <- html_text(html_nodes(doc, meta.css)) PTT貼文的HTML結構 另外，從上面的文字中可發現，主文的部分被包含在div#main-content中，但在上述的作者、標題等後面，若這時候我們用CSS Selector搭配html_node()和html_text()把div#main-content的內容都給取出來，會連上述的作者、標題等都一起取出來。最好的方法是用XPath的text()來只取出文字的部分，而不取出有tag的部分。 而且這樣取出來會是每個paragraph都是一個character vector中的值，所以要把他們合併成一篇文章，此時要用paste()指令，paste()指令可以指定把一個character vector給串接成一個string，輸入的變數是一個character vector，然後設定參數collapse = ““，代表串接起這些character時中間不要有空白。 post.xpath <- '//*[@id="main-content"]/text()' post.paragraph <- html_text(html_nodes(doc, xpath = post.xpath)) post <- paste(post.paragraph, collapse = "") 最後，我們知道metadata變數的第一個是作者、第二個是標題、第三個是時間、便依序指派給個別的變數後，組成DataFrame如下，這樣所組成的DataFrame是為只有一筆資料的DataFrame，但有五個變項。 link <- all_links[1] doc <- read_html(link) meta.css <- "#main-content div.article-metaline span.article-meta-value" metadata <- html_text(html_nodes(doc, meta.css)) post.xpath <- '//*[@id="main-content"]/text()' post.paragraph <- html_text(html_nodes(doc, xpath = post.xpath)) post <- paste(post.paragraph, collapse = "") post.df <- data.frame(post, uid = metadata[1], title = metadata[2], timestamp = metadata[3], url = link ) 這樣我們取得的第一篇文章存放在post.df中，之後，我稍微修改一下上述的程式，就可以用for迴圈抓取第2至n篇文章，每一篇都存在名為temp.df的DataFrame中，然後用bind_rows()依序和post.df銜接在一起，除了黃色的部分是新增的之外，都跟前面的程式幾乎一模一樣。 for(link in all_links[2:10]){ doc <- read_html(link) meta.css <- "#main-content .article-metaline .article-meta-value" metadata <- html_text(html_nodes(doc, meta.css)) post.xpath <- '//*[@id="main-content"]/text()' post.paragraph <- html_text(html_nodes(doc, xpath = post.xpath)) post <- paste(post.paragraph, collapse = "") temp.df <- data.frame(post, uid = metadata[1], title = metadata[2], timestamp = metadata[3], url = link ) post.df <- bind_rows(post.df, temp.df) } 打撈回來的HTTP資料 19.5 補充(1) 較好的寫法 一個比較好的寫法是，不用先讀第一篇文章，而是用data.frame()初始化一個空的DataFrame，之後可以利用bind_rows()可自動增添缺少的變數的特性，自然就會補上所需要的變數。因此，只要改寫黃色的部分。 但這樣的寫法仍會有一個缺點，也就是當文章數越來越多時會越跑越慢。原因是，假設現在你已經抓了9999篇文章，你這次的for迴圈要抓第10000篇，然後用bind_rows()合併第10000篇，此時，post.df已經有9999篇非常肥大，等號右邊的bind_rows()跑完後會變成10000篇，此時又要把原本很肥大的post.df覆蓋掉，所以會非常費時。 post.df <- data.frame() for(link in all_links[1:10]){ doc <- read_html(link) meta.css <- "#main-content .article-metaline .article-meta-value" metadata <- html_text(html_nodes(doc, meta.css)) post.xpath <- '//*[@id="main-content"]/text()' post.paragraph <- html_text(html_nodes(doc, xpath = post.xpath)) post <- paste(post.paragraph, collapse = "") temp.df <- data.frame(post, uid = metadata[1], title = metadata[2], timestamp = metadata[3], url = link ) post.df <- bind_rows(post.df, temp.df) } 19.6 補充(2) 最佳的寫法 採用list先將每一個DataFrame存放起來，然後跑完所有的for迴圈後才用bind_rows()將所有資料合併為DataFrame。此時，p指的是第幾個連結，而前例的link就相當於下方的all_link[p]。 post.list <- list() for(p in 1:length(all_links)){ doc <- read_html(all_links[p]) meta.css <- "#main-content .article-metaline .article-meta-value" metadata <- html_text(html_nodes(doc, meta.css)) post.xpath <- '//*[@id="main-content"]/text()' post.paragraph <- html_text(html_nodes(doc, xpath = post.xpath)) post <- paste(post.paragraph, collapse = "") post.list[[p]] <- data.frame(post, uid = metadata[1], title = metadata[2], timestamp = metadata[3], url = all_links[p] ) } post.df <- bind_rows(post.list) "],["lebron.html", "Chapter 20 NYT: LeBron James Achievement 20.1 Get top250 players 20.2 Scraping live scores 20.3 Cleaning data 20.4 Visualization 20.5 Scraping and cleaning 20.6 (More) Scraping all players", " Chapter 20 NYT: LeBron James Achievement 這個案例的靈感來自於紐約時報於2023年2月7日所發布的一篇新聞「How LeBron James Outscored Kareem Abdul-Jabbar and All the N.B.A. Greats」。該篇新聞的破題點在於LeBron James 打破 Kareem Abdul-Jabbar 的紀錄，成為 NBA 歷史上得分王，這是許多人認為無法達成的成就。今年 38 歲的 James，本季平均每場比賽可以攻下 30.2 分，以 38,390 分超越了 Abdul-Jabbar 的 38,387 分。Abdul-Jabbar 以 sky hook 聞名，而 James 則透過多種得分方式積累分數，包括近年來在聯盟中日益盛行的三分球。James 的長壽、創意、天賦和能力讓他達成了這個成就。但實際上，這篇新聞同時也凸顯了 NBA 在過去50年的演變。 這篇新聞中運用了NBA球員與球賽資料庫中250名頂尖球員的資料來繪製視覺圖表，頂尖球員援引該網站的定義，為歷年的每場平均得分（PTS）。其用了折線圖、長條圖、散佈圖等多種視覺呈現方法，並採用了多項指標來凸顯LeBron James的成就，包含年齡、累積得分數、場均得分數、三分球與二分球的比例等。 除了資料視覺化外，這個案例也是相當好的爬蟲練習，可用R語言的rvest套件來爬取https://www.basketball-reference.com/網站的球員資料，包含每個球季的比分，甚至著名球員每場的得分和進球數等等。該網站的網頁多為具有id的HTML表格，相對來說爬取難度較低，但如果要仿照該篇新聞來製作視覺圖表，需要爬取多個頁面的資料，反而是訓練學生從篩檢資料到產生新聞的一個好範例。 20.1 Get top250 players 事實上我是知道有NBA球員比分網站的，看到這則新聞時我就去線上查找了相關的網站https://www.basketball-reference.com。而且該網站的球員資料是表格形式，代表我們可以用一些比較方便的函式（html_table()）直接將該表格的內容轉為data.frame。 但目前（2023/04/01）的球員數共有五千多人，我們不可能將所有的球員通通繪製在圖上，反而會影響我們看到重要的訊息，因此要有效且有意義地減少要視覺化的資料量。這有幾種策略，一種是根據目的取出想要比較的球員、一種是直接設一個閥值（例如職涯超過15年的約90人），一種是看看該資料網站上有沒有列出一些頂尖球員名單。（猜想）紐約時報用的是該網站上的Top 250，因此第一個步驟要做的就是先把要分析的這250名球員的名冊爬取下來，之後再逐一爬取每個球員的資料紀錄。 這段程式碼的目的是從網站 “https://www.basketball-reference.com%22 中提取出排名前幾位的籃球員生涯表現數據，以及每個球員的個人資料頁面連結。Top 250球員的頁面網址為https://www.basketball-reference.com/leaders/per_career.html。 現在，我們可以使用rvest套件中的read_html()函數讀取網頁的 HTML 內容，該。接著傳遞給下一個函數html_node()，並指定要選取的 HTML 元素 ID 為nba。這個 ID 代表了包含球員表現數據的表格。最後，使用html_table() 函數提取表格資料並將結果存入top_players變數中。 read_html(url) 函數是 rvest 套件中的一個函數，它可讀取指定網址的 HTML 內容，以轉換為R的物件。 html_node() 函數則可用於選擇 HTML 內容中的指定元素。指定元素的方法是使用XPath或CSS Selector，本範例採用的是CSS Selector。若所要選取的同類型元素大於一個，那就要使用html_nodes()，所取得的結果會存入一個由1開始編號的List。 如果前一個步驟所指定的元素恰巧是一個表格的話，那我們就可以使用html_table()直接將表格轉換為一個R的data.frame，但如果不是表格的話，就必須要搭配使用html_text()或html_attr()來取出指定元素中的所需內容。 做完html_table()後的dataframe存於top_players，該dataframe共有三個變項：Rk（Rank）、PER（每場平均得分）、Player（球員名）。但該dataframe中缺少球員資料頁面的連結，所以需要另外再爬取一次球員名中的連結。取得的方式還是那三個步驟 read_html()：取得該url的網頁內容並轉為R的物件。 html_node()/html_nodes()：選取所需的HTML元素。此時我們要娶的是#nba這個表格中每一列<tr>的第二欄<td>中的超鏈結<a>。 html_text()/html_attr()/html_table()：抽取所選取的HTML元素內容。此時要抽取的是<a>中的超鏈結，也就是<a>的href屬性（Attribute），所以要用html_attr(\"href\")。 抽取出來的連結往往是相對於主要連結的後半段，因此，最後要將所取得的連結黏接在主頁連結的後方，如str_c(url.base, .)。 url.base <- "https://www.basketball-reference.com" url <- "https://www.basketball-reference.com/leaders/per_career.html" top_players <- read_html(url) %>% html_node("#nba") %>% html_table() top_players$plink <- read_html(url) %>% html_node("#nba") %>% html_nodes("tr td:nth-child(2) a") %>% html_attr("href") %>% str_c(url.base, .) top_players 20.2 Scraping live scores https://www.basketball-reference.com/players/c/chambto01.html 20.2.1 Testing: Scrape one url <- "https://www.basketball-reference.com/players/c/chambto01.html" table2 <- read_html(url) %>% html_node("#per_game") %>% html_table(convert=T) 20.2.2 Scrape life time scores of all top-250 players # pinks <- long_players$plink plinks <- top_players$plink totals <- tibble() for(i in 1:length(plinks)){ plink <- plinks[i] message(sprintf("[%s] ", i), plink) table <- read_html(plink) %>% html_node("#totals") %>% html_table() table$plink <- plink totals <- bind_rows(totals, table) Sys.sleep(sample(1:2, 1)) } 20.3 Cleaning data top250 <- totals %>% filter(str_detect(Season, "\\\\d{4}-\\\\d{2}")) %>% left_join(top_players, by="plink") %>% select(-(34:53)) %>% select(-31) %>% mutate(year = year(paste0(str_sub(Season, 1, 4), "-01-01"))) %>% mutate(PERyear = PTS/G) %>% group_by(plink) %>% arrange(Age) %>% mutate(cumPTS = cumsum(PTS)) %>% ungroup() 20.4 Visualization Load pre-save data load("data/nba_players.rda") 20.4.1 Line: Age x cumPTS library(gghighlight) selected_players <- c("Michael Jordan*", "LeBron James", "Kobe Bryant*", "Wilt Chamberlain*", "Kareem Abdul-Jabbar*", "Stephen Curry") top250 %>% ggplot() + aes(Age, cumPTS, group=Player) + geom_line() + gghighlight(Player %in% selected_players) + theme_bw() + theme(legend.position = "none") 20.4.2 Line: year x cumPTS top250 %>% ggplot() + aes(year, cumPTS, group=Player) + geom_line() + gghighlight(Player %in% selected_players) + theme_bw() + theme(legend.position = "none") 20.4.3 Line: Age x PER_by_year top250 %>% ggplot() + aes(Age, PERyear, group=Player) + geom_line() + gghighlight(Player %in% selected_players) + theme_bw() + theme(legend.position = "none") 20.4.4 Comparing LeBron James and Jabbar 20.5 Scraping and cleaning # plink <- "https://www.basketball-reference.com/players/j/jamesle01.html" plink <- "https://www.basketball-reference.com/players/a/abdulka01.html" loglinks <- read_html(plink) %>% html_node("#totals") %>% html_nodes("tr th a") %>% html_attr("href") %>% paste0(url.base, .) logtable <- tibble() for(link in loglinks){ table <- read_html(link) %>% html_node("#pgl_basic") %>% html_table() logtable <- bind_rows(logtable, table) message(nrow(logtable), link) } jabbar.log <- logtable %>% select(Rk, G, Date, FG, `3P`, FT, PTS) %>% mutate(Rk = as.numeric(Rk), FG = as.numeric(FG), `3P` = as.numeric(`3P`), FT = as.numeric(FT), PTS = as.numeric(PTS)) %>% filter(!is.na(PTS)) %>% replace(is.na(.), 0) %>% mutate(try = FG + `3P` + FT) %>% mutate(FGperc = FG/try, P3perc = `3P`/try, FTperc = FT/try) %>% mutate(gid = row_number()) 20.5.1 VIS LJames and jabbar james.log %>% pivot_longer(names_to = "type", cols = c("FGperc", "P3perc", "FTperc"), values_to = "perc") %>% ggplot() + aes(gid, perc, fill = type) + geom_area() + theme_bw() jabbar.log %>% pivot_longer(names_to = "type", cols = c("FGperc", "P3perc", "FTperc"), values_to = "perc") %>% ggplot() + aes(gid, perc, fill = type) + geom_area() + theme_bw() top250 %>% group_by(Player) %>% summarize(FGsum = sum(FG), FTsum = sum(FT), P3sum = sum(`3P`)) %>% ungroup() %>% replace(is.na(.), 0) %>% mutate(trials = FGsum + FTsum + P3sum) %>% mutate(FGperc = FGsum/trials, FTperc = FTsum/trials, P3perc = P3sum/trials) %>% ggplot() + aes(FGperc, P3perc) + geom_point() + geom_text(aes(label = Player), hjust = -0.1) + gghighlight(Player %in% selected_players) + theme_bw() + theme(aspect.ratio = 2/3) save(jabbar.log, james.log, top_players, top250, totals, file="../data/nba_players.rda") 20.6 (More) Scraping all players 20.6.1 Testing url <- "https://www.basketball-reference.com/players/x/" table.path <- read_html(url) %>% html_node("#players") table <- table.path %>% html_table() table$pid <- table.path %>% html_nodes("tbody th") %>% html_attr("data-append-csv") table$plink <- table.path %>% html_nodes("tbody th a") %>% html_attr("href") %>% str_c("https://www.basketball-reference.com",.) 20.6.2 Scrape from a-z except x(no x) # letters[c(1:23, 25:26)] players <- tibble() for(letter in letters[c(1:23, 25:26)]){ url <- str_c("https://www.basketball-reference.com/players/", letter, "/") print(url) table.path <- read_html(url) %>% html_node("#players") table <- table.path %>% html_table() table$pid <- table.path %>% html_nodes("tbody th") %>% html_attr("data-append-csv") table$plink <- table.path %>% html_nodes("tbody th a") %>% html_attr("href") %>% str_c("https://www.basketball-reference.com",.) players <- bind_rows(players, table) } "],["visualization-1.html", "Chapter 21 Visualization 21.1 ggplot2 21.2 VIS packages 21.3 Case Gallery", " Chapter 21 Visualization 21.1 ggplot2 ggplot2和Python的matplotlib都是常用的視覺化套件，但在設計上有一些主要的差異。首先，ggplot2是基於grammar of graphics的設計原則，而matplotlib則是基於pyplot-style的設計風格。這意味著ggplot2更加著重於資料和視覺化之間的關係，並且提供了一個統一的語法來描述這些關係，而matplotlib則更加注重對於底層圖形物件的控制。其次，ggplot2支持更多的圖形屬性，例如數值變數、類別變數、時間序列等等，並且可以輕鬆地進行層疊圖、面積圖等高級視覺化技巧，而matplotlib則需要手動設置較多的屬性來達到類似的效果。此外，ggplot2在設計上更加注重美學和可讀性，因此預設的圖形風格更加美觀且易於閱讀，而matplotlib的預設風格則比較簡單，需要進行額外的設置才能達到類似的效果。 21.2 VIS packages 除了ggplot2本身之外，尚有相當多基於ggplot或tidyverse風格的視覺化套件，如： ggraph：ggraph是一個基於ggplot2的視覺化套件，專門用於網絡和關係圖的繪製，提供了多種佈局和美學風格的選擇。 ggmap：ggmap是一個基於ggplot2的地圖繪製套件，可以將Google Maps、OpenStreetMap等地圖數據與ggplot2圖形整合起來，方便進行地理位置相關的資料視覺化。 ggridge：ggridge是一個基於ggplot2的視覺化套件，專門用於繪製ridge plots，也就是密度圖的一種變形。它可以幫助使用者更好地展示數據的分佈和趨勢。Introduction to ggridges (r-project.org) ggthemes：ggthemes是一個基於ggplot2的視覺化套件，提供了多種高質量的主題風格和顏色調色板，可以讓使用者快速改善圖表的外觀和可讀性。 ggnatimate：ggnatimate用於將ggplot所產製的圖表多增加一個變量以轉製為動態圖表，支持多種動畫效果。 ggally：ggally是一個基於ggplot2的視覺化套件，提供了多種高級散點圖和數據矩陣的繪製方式，方便使用者進行多變量分析和資料探索。 ggrepel：ggrepel是一個基於ggplot2的視覺化套件，用於解決文字標籤重疊的問題，可以自動調整文字標籤的位置，使其更加易讀和美觀。 21.3 Case Gallery 21.3.1 WP: Paid Maternity Leave (產假支薪): barplot 原始新聞來源：The world is getting better at paid maternity leave. The U.S. is not. - The Washington Post。該篇報導提及，美國因為目前的政策不保障帶薪產假，許多女性感到必須在工作和照顧家庭之間做出選擇，這種性別不平等破壞了她們在工作機會上的平等機會。同時，世界各地的婦女待遇正在逐漸改善。至少190個國家對嬰兒的母親規定了某種形式的帶薪假期，產假待遇在56個國家有所提高。專家表示，現在美國城市和州正通過不同形式的帶薪家庭假法案，這顯示美國雇主正在展示有競爭力的福利不會影響員工表現。特別是科技公司，如Twitter、Facebook和Google等，處於提供員工帶薪產假福利的前沿，美國可能有望追趕其他國家。 21.3.2 NYT: Population Changes Over More Than 20,000 Years: Coordinate, lineplot 紐時這篇報導「When Did the Anthropocene Start? Scientists Closer to Saying When. - The New York Times (nytimes.com)」討論了人類活動對地球所產生的深遠影響，並探討人類是否已經進入了一個新的地質時期，被稱為「人新世」。報導指出，人類的經濟活動、能源消耗和人口增長是人新世的主要因素，並且這些因素已經在地球上留下了不可磨滅的痕跡。報導也提到，地質學家已經發現了人新世的證據，包括核爆炸中的鈽同位素、肥料中的氮和發電廠的灰燼等。然而，報導也問道，人新世是否真的已經開始，以及它的開始點是否應該是農業革命、工業革命、核彈（77年前）或其他發展。 21.3.3 NYT: LeBron James’ Achievement: Coordinate, lineplot 這個案例的靈感來自於紐約時報於2023年2月7日所發布的一篇新聞「How LeBron James Outscored Kareem Abdul-Jabbar and All the N.B.A. Greats」。該篇新聞的破題點在於LeBron James 打破 Kareem Abdul-Jabbar 的紀錄，成為 NBA 歷史上得分王，這是許多人認為無法達成的成就。今年 38 歲的 James，本季平均每場比賽可以攻下 30.2 分，以 38,390 分超越了 Abdul-Jabbar 的 38,387 分。Abdul-Jabbar 以 sky hook 聞名，而 James 則透過多種得分方式積累分數，包括近年來在聯盟中日益盛行的三分球。James 的長壽、創意、天賦和能力讓他達成了這個成就。但實際上，這篇新聞同時也凸顯了 NBA 在過去50年的演變。 21.3.4 Taiwan Village Population Distribution: Coordinate, lineplot 以下我打算繪製出每個村里在15歲以上的人口數，來呈現台灣有些村里人口相當稀少，尤其是花蓮縣、澎湖縣、南投縣和宜蘭縣的幾個聚落。並標記出幾個人口數最高的里。如果我的目的是呈現村里人口數的統計分佈，我會用geom_density()來繪圖（如下），但實際上沒辦法從這樣的密度函式圖來說故事，指出那些人口數過高或過低的村里。 21.3.5 NYT: Net Worth by Age Group: Coordinate, barplot 這個教學案例來自紐約時報的「What’s going on in this gragh」系列資料視覺化教學之Teach About Inequality With These 28 New York Times Graphs - The New York Times (nytimes.com) 。該圖表呈現在不同年代、不同年齡層的人所擁有的淨資產（包含土地、存款、投資等減去債務）。該圖表的結果指出，在不同年代的老年人是越來越有錢，但年輕人卻越來越窮 21.3.6 NYT: Optimistic of different generation: Association, scatter 這個練習為紐約時報的一則報導「Where Are Young People Most Optimistic? In Poorer Nations. - The New York Times (nytimes.com)」。該報導乃根據一項涵蓋 21 個國家的大型調查，這項調查比較了不同國家和年齡層（年輕人對成年人）對於下一代的生活是否會比現在更好的看法。該調查還比較了不同國家（富裕與貧窮）和年齡層（年輕人對成年人）對於當今兒童在基本方面的狀況，以及對於社會和環境問題的看法。此外，調查還比較了不同國家和年齡層對於現代科技對年輕人生活的影響看法，以及對於焦慮和壓力等方面的看法。 21.3.7 Vaccinating Proportion by countries: Amount, heatmap 這個例子參考(Wilke 2019)在視覺化數量（Amount）時的熱圖範例（Heatmap），但改用為視覺化各國每百人完整注射COVID-19疫苗人數歷時資料。 21.3.8 Taiwan salary distribution: Distribution, boxmap 箱形圖（Box plot）是一種用於展示數據分佈情況的統計圖表。它通常顯示數據的中位數、四分位數、極值和異常值等統計量。箱形圖的中間線表示數據的中位數，箱子的上下邊界則分別表示數據的上四分位數和下四分位數。箱子的高度表示數據的變異程度，而箱子外的線段則表示數據的最大值和最小值。如果數據中存在異常值，則通常使用圓圈或星號等符號來標記。箱形圖可以用來比較不同數據集之間的分佈情況，以及檢查數據是否存在異常值。 Inspired by Six Myths About Choosing a College Major - The New York Times (nytimes.com) and What’s Going On in This Graph? | Jan. 9, 2018 - The New York Times (nytimes.com) 21.3.9 Taiwan income distribution by each town: Distribution, boxmap 本案例用BoxPlot來呈現某個行政區（鄉鎮市區）各村里的所得中位數、平均數、四分位數的分佈。如果在箱型圖中，平均數高於第三分位數，這代表數據集呈現右偏分佈。也就是說，數據中的大部分觀測值都分佈在第一、二分位數之間，但存在一些較大的極端值，使平均值被往右偏移。從這樣的分佈中可以察覺某些里因為有少數極端高收入住戶，而使得平均高於四分位數。 21.3.10 NYT: Carbon by countries: Proportion, Treemap 本案例取自紐時所報導之Who Has The Most Historical Responsibility for Climate Change? - The New York Times (nytimes.com)。該新聞報導了聯合國氣候峰會在格拉斯哥舉行期間的一個重要議題：世界上最富裕的國家，即那些對全球暖化負責任的不成比例的國家，應如何賠償因全球氣溫上升所造成的貧困國家的損失。報導指出，現今全球人口中，包括美國、加拿大、日本以及西歐大部分國家在內的富裕國家僅佔12％，但是在過去的170年中，這些國家卻負責了50％的溫室氣體排放。 21.3.11 Taiwan Annual Expenditure: Proportion, Treemap 本案例將就台灣中央預算的資料，以TreeMap階層化地顯示不同機構層級（大類、一級部會）等的預算佔比。例如衛福部、財政部與勞動部的預算均屬於社會福利支出。 References "],["ggplot.html", "Chapter 22 ggplot 22.1 Essentials of ggplot 22.2 NYT: Inequality 22.3 Adjusting Chart 22.4 Highlighting & Storytelling", " Chapter 22 ggplot 本節著重在介紹ggplot的基本概念與設定。 小訣竅：可在一開始便透過knitr::opts_chunk$set(echo = TRUE, fig.width = 2, fig.asp = 0.4)來一次設定所有圖片。fig.width = 8與fig.height = 6 是以英吋（inches）為單位，或用fig.dim = c(8, 6)一次設定長寬1。echo = TRUE是設定knit出輸出格式（如html）時，也要包含程式碼。如果echo = FALSE的話，就只會輸出文字和圖形。 22.1 Essentials of ggplot 用ggplot來繪製圖形有三個基本函式ggplot() + aes() + geom_圖表類型。 指定要進行繪圖ggplot()：用%>%將資料（dataframe）pipe給ggplot()後，底下各增添的繪圖選項都用+的符號，類似不斷修正繪圖結果的意思。 指定X／Y軸與群組因子aes()：指定圖表的X/Y軸分別是什麼變數，有些圖表只需要單一個變數（例如Density-chart和Histogram），有些需要X/Y兩個變數（例如Scatter-chart）什麼的變數要做視覺化，Boxplot甚至可以直接指定最大、最小、Q1、Q3和Median等多個變數。 指定要繪製的圖表類型。例如Line-chart為geom_line()、Scatter-chart為geom_point()、Bar-chart為geom_col()或geom_bar()。查閱ggplot cheat sheet可以快速翻閱有哪些圖表類型（如截圖）。 ggplot-cheat-sheet 22.1.1 (1) ggplot() 秀出預備要繪製的繪圖區 tibble(a=1:5, b=5:1) %>% ggplot() 22.1.2 (2) aes() 指定X／Y軸與群組因子 aes()會在繪圖區上繪製X與Y軸 tibble(a=1:5, b=5:1) %>% ggplot() + aes(x=a, y=b) 22.1.3 (3) geom_???() 指定要繪製的圖表類型。 例如折線圖為為geom_line()、X/Y散佈圖為geom_point()、長條圖我多會使用geom_col()。ggplot繪圖種類除了可以參照前面的ggplot cheat sheet之外，可以詢問ChatGPT有哪些常見的類別，甚至可以請他舉例給你測試該繪圖方法。 tibble(a=1:5, b=5:1) %>% ggplot() + aes(x=a, y=b) + geom_line() 亦可同時繪製兩種類型的圖表於同一張圖上。例如以下同時繪製了geom_line()與geom_plot()。 tibble(a=1:5, b=5:1) %>% ggplot() + aes(x=a, y=b) + geom_line() + geom_point() 注意：ggplot是以變數為基礎的視覺化套件，也就是說，當準備好dataframe後，就可以在ggplot中指定要用哪些變數來繪圖。也因此，務必把dataframe整理為tidy型態，也就是長表格（long-form）的型態。整理完資料後，我會習慣地用names(plot)或glimpse(plot)來看一下該資料所有的變項，好可以在下一階段的繪圖做參考。 22.2 NYT: Inequality 以下將以紐時的這個Teach About Inequality With These 28 New York Times Graphs 案例來做繪圖教學。該教學引用了Opinion | America Will Struggle After Coronavirus. These Charts Show Why.這篇新聞中的圖表，我們拿來做範例的這張圖，主要是在說財富趨勢對年輕人而言尤其艱難。35歲以下美國人的凈資產中位數 - 他們平均比年長的美國人差得多 - 比2004年35歲以下美國人的凈資產低40%。相比之下，65歲以上美國人的凈資產在同一時期增長了9%。簡而言之，嬰兒潮一代比他們的前輩更富有，而千禧一代和X世代比他們的前輩更窮；或者說，年輕人拿自己和10年前的年輕人相比，現在的年輕人更窮；而現在的老年人拿自己和10年前的老年人比，現在的老年人更富有。 22.2.1 (1) Loading data 仔細觀察一下資料，你會怎樣描述這個資料？ 這個Dataframe包含三個變數（Category, year, Net_Worth），共66個觀測值。變數「Category」描述的是年齡範圍，包含六個類別（Level）。變數「year」代表年份，從1989年到2019年，以三年為一個週期觀察，共有11個Levels。變數「Net_Worth」則表示在該年齡範圍內的淨資產。從資料可以觀察到，在不同的時間點，不同年齡範圍的人群的財富狀況看似有明顯差異。例如，比較1989年和2019年，45-54歲的年齡組在這段期間內的淨值似乎較35-44歲組要高，這可能反映了隨著年齡增長，個人或家庭的財富累積增加的趨勢。 NW <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(Category, year, Net_Worth) %>% group_by(Category) %>% arrange(year) %>% ungroup() ## Rows: 66 Columns: 37 ## ── Column specification ──────────────────────────────────────────────────────── ## Delimiter: "," ## chr (1): Category ## dbl (36): year, Before_Tax_Income, Net_Worth, Assets, Financial_Assets, Tran... ## ## ℹ Use `spec()` to retrieve the full column specification for this data. ## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message. NW %>% head(12) ## # A tibble: 12 × 3 ## Category year Net_Worth ## <chr> <dbl> <dbl> ## 1 Less than 35 1989 16.2 ## 2 35-44 1989 112. ## 3 45-54 1989 195. ## 4 55-64 1989 195. ## 5 65-74 1989 154. ## 6 75 or older 1989 144. ## 7 Less than 35 1992 16.6 ## 8 35-44 1992 79.9 ## 9 45-54 1992 140. ## 10 55-64 1992 203. ## 11 65-74 1992 176. ## 12 75 or older 1992 155. 22.2.1.1 (1.1) group_by()的概念 在提供的程式碼中，group_by(Category)是一個關鍵步驟，它影響了數據處理的方式，尤其是在隨後的操作中。以下是有和沒有group_by(Category)時的主要差異： 有group_by(Category)：當在程式碼中使用group_by(Category)時，這意味著接下來的操作將在每個Category類別的子集上單獨進行。這對於需要按類別分析或操作數據時非常有用。在此程式碼中，arrange(year)將會在每個Category內部對year進行排序。這意味著每個類別內的年份會從最小到最大排序，但這種排序是獨立於其他類別的。 沒有group_by(Category)：如果省略group_by(Category)，則後續的操作將考慮所有的數據作為一個整體來進行。 省略group_by(Category)後，arrange(year)會對整個數據集按year進行全局排序，而不會考慮Category的界限。由於year是一個類別變項，出現在多個Category組中，因此，會有多個相同year的列排在一起。 22.2.2 (2) Visualizing 這是預期視覺化的結果。 22.2.2.1 (2.1) Plot without group 先將year和Net_worth分別繪製在X與Y軸上，並用geom_line()繪製為折線圖。結果圖表中呈現鋸齒狀的折線，看似有問題，但其實是合理的。因為year是一個離散變數，而我們希望每個年齡層一條線的話，那就要照年齡層來分組。也因此，每一年都有有每個年齡層的資料，當我們把「年」作為X軸時，自然同一年就會有數筆不同年齡層的資料，因此才會是鋸齒狀的。 NW %>% ggplot() + aes(x=year, y=Net_Worth) + geom_line() 不同的圖表類型是可以疊加在同一張圖上的。我們也可以把geom_point() 另一種圖表型態加入，也是可以的，兩者的X與Y不相衝突。geom_line()、geom_point()、geom_text()三者會經常伴隨出現。 NW %>% ggplot() + aes(x=year, y=Net_Worth) + geom_line() + geom_point() 22.2.2.2 (2.2) Grouping 上圖是我們把多個年齡層的逐年資料畫在同一條折線上，所以會呈現鋸齒狀折現的狀況。但這些年齡層並非在同一條線上呀？因此，我們要根據Category這個變數來做分組。 NW %>% ggplot() + aes(x=year, y=Net_Worth, group=Category) + geom_line() + geom_point(stat="identity") 如希望不同線條上不一樣的色彩，應指定color=Category。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() 用color、fill或group來做分組？ 在使用geom_line()函數時，顏色的設定是針對線條本身，而非填充面積。當我們希望指定點（透過geom_point()）或線條（使用geom_line()）的顏色時，我們會使用color參數來定義顏色。 相對地，當使用`geom_area()`函數進行視覺化時，由於它涉及的是面積的填充，因此我們應該使用`fill`參數來指定填充色。在某些情況下，我們可能會同時使用`color=Category`和`fill=Category`來對`geom_area()`進行設定，這樣做能夠同時定義邊線顏色和填充顏色。然而，當利用`geom_area()`來展示折線圖時，建議限制使用的顏色種類不超過兩種，以避免顏色層疊導致的視覺混淆，即便是設定了`alpha=0.2`以降低透明度。 `geom_area()`函數默認展示的是累積分佈圖，即不同群組的數值會在Y軸方向上疊加。若目的是比較兩個群組之間的差異，而非觀察整體趨勢，則可以通過添加`position="dodge"`參數來調整分佈方式，並將`alpha`設定為小於1的值以增加圖形的透明度，從而更清晰地分辨不同群組之間的差異。 NW %>% ggplot() + aes(year, Net_Worth, color=Category, fill=Category) + geom_area(position="dodge", alpha=0.2) 22.3 Adjusting Chart 22.3.1 Type of Points and Lines 下面的例子同時用了geom_line()和geom_point()，且分別設定了線寬（size=1）、點的大小(size=2)，折線型態（linetype=\"dashed\"）、半透明程度（alpha）。 ggplot2 line types : How to change line types of a graph in R software? - Easy Guides - Wiki - STHDA NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line(size=1, linetype = "dashed", alpha=0.5) + geom_point(size=2, color="dimgrey", alpha=0.5) ## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0. ## ℹ Please use `linewidth` instead. ## This warning is displayed once every 8 hours. ## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was ## generated. 22.3.2 Line Types See more from ggthemes https://github.com/BTJ01/ggthemes/tree/master/inst/examples library(ggthemes) rescale01 <- function(x) { (x - min(x)) / diff(range(x)) } gather(economics, variable, value, -date) %>% group_by(variable) %>% mutate(value = rescale01(value)) %>% ggplot(aes(x = date, y = value, linetype = variable)) + geom_line() + scale_linetype_stata() + theme_minimal() 22.3.3 Title, Labels and Legends Titles, labels, and legend 設定標題與X／Y軸標題（法一）：以下設定了圖表的圖表標題、和X軸與Y軸的軸標題（xlab與ylab）。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + xlab("Year") + ylab("Net Worth") + ggtitle("Net Worth by year grouped by age groups") 設定標題與X／Y軸標題（法二）：這是一次設定圖表標題（title）、次標題（suttitle）、X軸與Y軸標題的方法。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", subtitle = "Source from: ...", x = "Year", y = "Net Worth") 調整X軸與Y軸標題位置的：必須要透過theme()來設定axis.title.x = element_text(hjust=1)。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", x = "Year", y = "Net Worth") + theme(axis.title.x = element_text(hjust=1), axis.title.y = element_text(hjust=1)) 去除X／Y軸標題（不佳）：直接將空字串Assign給title、x、與y即可。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + labs(title = "", x = "", y = "") 去除X／Y軸標題（較佳）：透過設定theme()來調整。可發現透過這種設定方法，原本標題和X／Y軸標題的邊界空間就會被釋放出來。 # No extra space for xlab, ylab and title NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line(show.legend = F) + theme_minimal() + theme(plot.title = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank()) 22.3.4 Font 調整字型會建議都從theme()來做調整，所有圖面上看得到的字都有相對應的變數可以調整字型。例如以下的例子中，把標題的字型大小調整為14粗體、X與Y軸的字型則調整了向右對齊、10粗斜體、顏色為dimgrey。 NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", x = "Year", y = "Net Worth") + theme(plot.title = element_text(size=14, face="bold"), axis.title.x = element_text(hjust=1, size=10, color="dimgrey", face="bold.italic"), axis.title.y = element_text(hjust=1, size=10, color="dimgrey", face="bold.italic") ) 22.3.5 Color Themes ggplot也有其圖表主題色調。之前範例的灰色圖表背景就是預設的主題，ggplot中還有好幾個預設圖表主題可以選，例如theme_minimal()或theme_tw()等等。 Modify components of a theme — theme • ggplot2 (tidyverse.org) bbplot/bbc_style.R at master · bbc/bbplot (github.com) NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() 22.3.6 Set-up Default Theme 如果希望所有的圖表都有一致的顏色和排版的調性，可以在一開始編輯Rmd的時候就設計好一套theme()並指給一個變數（例如以下的th）。 th <- theme(plot.title = element_text(size=14, face="bold"), axis.title.x = element_text(hjust=1, size=10, color="dimgrey", face="bold.italic"), axis.title.y = element_text(hjust=1, size=10, color="dimgrey", face="bold.italic") ) NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line(linetype = "dashed", alpha=0.5) + geom_point(size=2, color="dimgrey", alpha=0.5) + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", x = "Year", y = "Net Worth") + th 22.3.7 Show Chinese Text Python和R這些程式語言的預設視覺化套件都沒辦法顯示中文，所以如果要顯示中文的話，就要指定圖表標題、X、Y軸標籤、圖說和各個部件的字型。因為我在Mac上繪圖，所以我將字型指定為Heiti TC Light。如果想知道自己的電腦上有什麼可以用，可以到電腦的字體簿上查找中文字體名稱，或者上網google「ggplot 中文字型選擇」。 county <- read_csv("data/tw_population_opendata110N010.csv") %>% slice(-1, -(370:375)) %>% type_convert() %>% mutate(county = str_sub(site_id, 1, 3)) %>% group_by(county) %>% summarize( area = sum(area), people_total = sum(people_total) ) %>% ungroup() ## Rows: 375 Columns: 5 ## ── Column specification ──────────────────────────────────────────────────────── ## Delimiter: "," ## chr (5): statistic_yyy, site_id, people_total, area, population_density ## ## ℹ Use `spec()` to retrieve the full column specification for this data. ## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message. ## ## ── Column specification ──────────────────────────────────────────────────────── ## cols( ## statistic_yyy = col_double(), ## site_id = col_character(), ## people_total = col_double(), ## area = col_double(), ## population_density = col_double() ## ) 下面這是一個長條圖的範例（barplot，不是histogram）。Barplot可以直接指定X軸為縣市（county）和Y軸為總人口數（people_total），但是要用geom_col()而非geom_bar()。除此之外，Bar的顏色有「面」的特徵，所以若要自訂整條bar的顏色，要用fill而非color，color只會是每條Bar的外框。 county %>% arrange(desc(people_total)) %>% ggplot() + aes(county, people_total) %>% geom_col(fill="lightgrey", color="black") + theme_minimal() + theme(axis.text.x = element_text(family="Heiti TC Light")) 舉例來說，中文字型可以是標楷體（BiauKai）、宋體（Songti TC）、黑體（Heiti TC Light）、蘋方（PingFang TC）、Noto（Noto Sans CJK TC） th <- theme(title = element_text(family="Heiti TC Light"), text = element_text(family="Heiti TC Light"), axis.text.y = element_text(family="PingFang TC"), axis.text.x = element_text(family="Heiti TC Light"), legend.text = element_text(family="Heiti TC Light"), plot.title = element_text(family="Heiti TC Light") ) county %>% ggplot() + aes(county, people_total) %>% geom_col(fill="skyblue") + theme_minimal() + th + theme(axis.text.x = element_text(angle = 45)) 22.3.8 X/Y axis 調整圖表方向 county %>% ggplot() + aes(county, people_total) %>% geom_col(fill="skyblue") + coord_flip() + theme_minimal() + th + theme(axis.text.x = element_text(angle = 45)) 通常coord_flip()後往往會希望這些bar會是由上而下排序好的，但用arrange(desc(people_total)是無法解決問題的，因為Y軸原本會是照Y軸的刻度排列，而不是Y軸的數值。所以，要被排序的應該是Y軸的「文字」也就是那些縣市。因此，我們需要將該縣市轉為factor（1~n），並且讓這些縣市被安排的factor數值照people_total排列，因此要用mutate(county = reorder(county, people_total))。reorder()是一個將文字轉factor的函式，但在此特別指定照people_total的編排。 county %>% # arrange(desc(people_total) %>% mutate(county = reorder(county, people_total)) %>% ggplot() + aes(county, people_total) %>% geom_col(fill="skyblue") + coord_flip() + theme_minimal() + th 22.4 Highlighting & Storytelling 「說故事」才是整則資料新聞的核心，在運用圖表來輔助敘事時，應搭配說理說服的內容來突顯（highlight）圖面上的特徵，而不是留待讀者自己觀察。以下有三種highlight圖表部分資料的方法。第一個方法是在繪圖時用+ scale_color_manual()或+ scale_fill_manual()指定顏色給不同群組；方法二是利用gghighlight這個套件來指定要上色的群組，而且gghighlight可以和fill與color相互搭配，仍然可以用scale_fill_manual和scale_color_manual來指定顏色。但會有個狀況是，如果原本沒群組那怎麼辦？就自己用mutate()打造群組就好。方法各有利弊與使用時機。 22.4.1 依群組指定顏色 scale_color_manual() 與scale_fill_manual() NW %>% ggplot() + aes(year, Net_Worth, color = Category) + geom_line() + scale_color_manual( limits=c("65-74", "35-44"), # original chart group values=c("gold", "skyblue"), # map to color name="Age group", # legend title breaks=c("65-74", "35-44"), # original legend group labels labels=c("elder(65-74)","younger(35-44)"), # map to new labels na.value = "lightgrey" # color for other groups ) + theme_minimal() 22.4.2 使用gghighlight套件 library(gghighlight) NW %>% ggplot() + aes(year, Net_Worth, color = Category) + geom_line() + gghighlight(Category %in% c("65-74", "35-44")) + theme_minimal() + scale_x_continuous(breaks = NULL) + theme(panel.background = element_rect(fill = "whitesmoke", colour = "whitesmoke", size = 0.5, linetype = "solid")) 使用gghighlight仍能自己使用scale_color_manual()來指定顏色 NW %>% ggplot() + aes(year, Net_Worth, color = Category) + geom_line() + gghighlight(Category %in% c("65-74", "35-44")) + scale_color_manual( limits=c("65-74", "35-44"), # original chart group values=c("gold", "skyblue")) + # map to color theme_minimal() ## Warning: Tried to calculate with group_by(), but the calculation failed. ## Falling back to ungrouped filter operation... ## label_key: Category 22.4.3 為視覺化建立群組 這個方法是在原本的資料並沒有可以作為color或fill的因子，所以自行創建一個要突顯的群組。 county %>% mutate(group = if_else(county %in% c("新竹縣", "新竹市"), "highlight", "other")) %>% mutate(county = reorder(county, people_total)) %>% ggplot() + aes(county, people_total, fill=group) %>% geom_col() + scale_fill_manual(values=c("highlight"="Khaki", "other"="lightgrey")) + guides(fill="none") + coord_flip() + theme_minimal() + th 但事實上也可以用gghighlight直接達成 county %>% mutate(county = reorder(county, people_total)) %>% ggplot() + aes(county, people_total) %>% geom_col(fill="deeppink") + gghighlight(county %in% c("新竹縣", "新竹市")) + guides(fill="none") + coord_flip() + theme_minimal() + th 參考資料：5.4 Control the size of plots/images | R Markdown Cookbook (bookdown.org)↩︎ "],["coordinate.html", "Chapter 23 Coordinate 23.1 NYT: Population Growth 23.2 Order as axis 23.3 Log-scale 23.4 23.5 Square-root scale 23.6 Increasing percentage as Y 23.7 X/Y aspect ratio", " Chapter 23 Coordinate 本章節談論的是視覺化圖表的座標軸，本章節所涵蓋的概念可參考Claus O. Wilke所著之Fundamentals of Data Visualization的Chap3 Coordination & Axis與Chapter 8 Visualizing distributions: Empirical cumulative distribution functions and q-q plots。 23.1 NYT: Population Growth 紐時這篇報導「When Did the Anthropocene Start? Scientists Closer to Saying When. - The New York Times (nytimes.com)」討論了人類活動對地球所產生的深遠影響，並探討人類是否已經進入了一個新的地質時期，被稱為「人新世」。報導指出，人類的經濟活動、能源消耗和人口增長是人新世的主要因素，並且這些因素已經在地球上留下了不可磨滅的痕跡。報導也提到，地質學家已經發現了人新世的證據，包括核爆炸中的鈽同位素、肥料中的氮和發電廠的灰燼等。然而，報導也問道，人新世是否真的已經開始，以及它的開始點是否應該是農業革命、工業革命、核彈（77年前）或其他發展。 23.1.1 Parsing table from pdf 至R4CSS/data可以下載到本範例所用的資料（是一個pdf檔案）https://github.com/p4css/R4CSS/raw/master/data/world_population_change.pdf。 我們可使用tabulizer這個套件來萃取PDF文件中的表格，官方雖然提供cran可以直接安裝，但有可能會遇到R的版本不符要求而安裝不起來的情形。此時可用第二種方法，直接從github上安裝該套件。 程式碼使用 extract_tables() 函數從指定的PDF文件中提取表格數據，並將其存儲在 tables 變量中。在這個函數中，我們指定了要從第1頁中提取表格數據。 # Method 1 # install.packages("tabulizer") # Method 2 # if (!require("remotes")) { # install.packages("remotes") # } # remotes::install_github(c("ropensci/tabulizerjars", "ropensci/tabulizer")) library(tidyverse) library(tabulizer) # Extract the table tables <- extract_tables('data/world_population_change.pdf', pages = 1) # Extract the first element of the variable raw <- as.data.frame(tables[[1]]) population_by_year <- raw %>% select(1, 2) %>% slice(-c(1:4)) %>% rename(years_to_2020 = V1, population = V2) # select(years_to_2020 = v1, population = v2) # mutate(years_to_2020 = v1, population = v2) 23.1.2 X and Y with log-scale 通常情況下，當數據範圍很大，且存在極端值或者偏離值時，使用對數轉換可以更好地展示數據的分佈情況。在這種情況下，你可以使用 scale_x_log10() 或 scale_y_log10() 函數將 x 軸或 y 軸轉換為對數刻度。 例如，如果你有一個數據集，其中一個變量的數值範圍從1到100000，且大多數數據會集中在較小的值上，那麼使用線性刻度將導致數據在圖形中的分佈不平衡，而較大的值會集中在圖形的邊緣或者消失在圖形之外。在這種情況下，使用對數刻度可以更好地展示數據的分佈情況，並且可以更好地顯示較大值之間的差異。而上述資料便有這樣的特色，尤其是在Y軸方向，一開始人口增加量不多，後來指數成長，此時若使用線性尺度，會看不清楚一開始的人口增加量。 library(cowplot) load("data/world_population_change.rda") population_by_year ## years_to_2020 population ## 1 11,720 4 ## 2 10,020 5 ## 3 8220 8 ## 4 7020 11 ## 5 6020 7 ## 6 5020 14 ## 7 4220 27 ## 8 3020 50 ## 9 2520 100 ## 10 2020 268 ## 11 1020 289 ## 12 720 397 ## 13 520 471 ## 14 420 561 ## 15 320 629 ## 16 270 772 ## 17 220 951 ## 18 170 1247 ## 19 120 1643 ## 20 70 2499 ## 21 65 2769 ## 22 60 3042 ## 23 55 3333 ## 24 50 3691 ## 25 45 4071 ## 26 40 4440 ## 27 35 4838 ## 28 30 5269 ## 29 25 5735 ## 30 20 6076 ## 31 15 6463 ## 32 10 6930 ## 33 5 7349 ## 34 0 7717 toplot <- population_by_year %>% mutate(years_to_2020 = map(years_to_2020, ~(str_remove(., ",")))) %>% mutate(years_to_2020 = as.numeric(years_to_2020), population = as.numeric(population)) toplot %>% head ## years_to_2020 population ## 1 11720 4 ## 2 10020 5 ## 3 8220 8 ## 4 7020 11 ## 5 6020 7 ## 6 5020 14 p1 <- toplot %>% ggplot() + aes(x=years_to_2020, y=population) + geom_point() + theme_bw() p2 <- toplot %>% ggplot() + aes(x=years_to_2020, y=population) + geom_point() + scale_x_log10() + scale_y_log10() + scale_x_reverse() + theme_bw() cowplot::plot_grid( p1, NULL, p2, labels = c("(a) Original Scale", "", "(b) Low-Scale"), nrow = 1, rel_widths = c(1, 0.1, 1) ) 23.2 Order as axis 學術論文若要呈現一群數據的分佈時，最常用的是密度（分佈）函數、累積分佈函數，最常視覺化的方法是密度分佈圖（geom_density()）或直方圖（geom_histogram())。然而，對新聞等強調「說故事」的文體而言，說故事的技巧往往不是「那一群資源多或資源少的對象」，而經常要直指「那個對象」，要能夠看得見所敘述的對象在圖中的位置。此時，用密度分佈來呈現的話，只能看出，該對象在分佈的某個位置；但可以改用將資料對象根據某個數據來排序後，繪製折現圖的方式來表現。例如，若要繪製一個班級的成績分佈，通常X軸是分數（組），Y軸是獲得該分數（組）的人數；但其實可以將個體依照分數來做排序，Y軸不是某個分數（組）的個數，而是每個排序後的個體，而且以排序後的序號（Ranking）來表示。用折線圖繪製後，一樣可以看出分數的分佈，但卻能夠直接標記敘事中的某個對象是Y軸中得哪個點。 Figure 3.5: Population numbers of Texas counties relative to their median value. Select counties are highlighted by name. The dashed line indicates a ratio of 1, corresponding to a county with median population number. The most populous counties have approximately 100 times more inhabitants than the median county, and the least populous counties have approximately 100 times fewer inhabitants than the median county. Data source: 2010 Decennial U.S. Census. See What’s Going On in This Graph? | Vaccination by Country fromWhat Data Shows About Vaccine Supply and Demand in the Most Vulnerable Places - The New York Times (nytimes.com) The original chart is animated along the timeline.What Data Shows About Vaccine Supply and Demand in the Most Vulnerable Places - The New York Times (nytimes.com) 23.3 Log-scale 以下我打算繪製出每個村里在15歲以上的人口數，來呈現台灣有些村里人口相當稀少，尤其是花蓮縣、澎湖縣、南投縣和宜蘭縣的幾個聚落。並標記出幾個人口數最高的里。如果我的目的是呈現村里人口數的統計分佈，我會用geom_density()來繪圖（如下），但實際上沒辦法從這樣的密度函式圖來說故事，指出那些人口數過高或過低的村里。 raw <- read_csv("data/opendata107Y020.csv", show_col_types = FALSE) %>% slice(-1) %>% type_convert() raw %>% ggplot() + aes(edu_age_15up_total) + geom_density() 因此，一個比較好的策略是，把各村里的人口數由小到大或由大到小排序好，編好Rank比序的代號，然後讓X軸做為比序，逐一在Y軸打出每一個村里的數據。 但這邊值得注意的是，如果沒有放大尾端（也就是村里人口數最少的那部分），實際上也很難繪圖。所以對Y軸取log，就可以看清楚Y軸的資料點。 toplot <- raw %>% select(site_id, village, edu_age_15up_total) %>% arrange(desc(edu_age_15up_total)) %>% mutate(index = row_number()) %>% mutate(label = ifelse(index <= 5 | index > n()-5, paste0(site_id, village), "")) library(ggrepel) p2 <- toplot %>% ggplot() + aes(index, edu_age_15up_total) + geom_point(alpha=0.5, color="royalblue") + geom_text_repel(aes(label = label), point.padding = .4, color = "black", min.segment.length = 0, family = "Heiti TC Light") + theme(axis.text.x=element_blank()) + scale_y_log10(breaks = c(0, 1, 10, 100, 1000, 10000)) + theme_minimal() p1 <- toplot %>% ggplot() + aes(index, edu_age_15up_total) + geom_point(alpha=0.5, color="royalblue") + theme(axis.text.x=element_blank()) + theme_minimal() cowplot::plot_grid( p2, NULL, p1, labels = c("a", "", "b"), nrow = 1, rel_widths = c(1, 0.1, 1) ) library(tidyverse) library(gghighlight) 23.4 23.5 Square-root scale Chap3 Coordination & Axis Fundamentals of Data Visualization (clauswilke.com) Figure 3.8: Areas of Northeastern U.S. states. (a) Areas shown on a linear scale. (b) Areas shown on a square-root scale. Data source: Google. 前面是視覺化了各村里大於十五歲以上人口的人口數分佈，採用對數尺度（log-scale）可以觀察到比較小的村里。那有什麼是適合用平方根尺度（sqrt-scale）的呢？是土地嗎？密度嗎？還是人口數？是村里等級嗎？鄉鎮市區等級嗎？還是縣市等級？ town <- read_csv("data/tw_population_opendata110N010.csv") %>% slice(-1, -(370:375)) %>% type_convert() town %>% arrange(desc(area)) %>% mutate(index = row_number()) %>% ggplot() + aes(index, area) %>% geom_col(fill="skyblue") + scale_y_sqrt() + theme_minimal() Figure 23.1: (ref:population-area) county <- town %>% mutate(county = str_sub(site_id, 1, 3)) %>% group_by(county) %>% summarize( area = sum(area), people_total = sum(people_total) ) %>% ungroup() p1 <- county %>% arrange(desc(people_total)) %>% mutate(index = row_number()) %>% ggplot() + aes(index, people_total) %>% geom_col(fill="lightgrey") + # scale_y_sqrt() + theme_minimal() p2 <- county %>% arrange(desc(people_total)) %>% mutate(index = row_number()) %>% ggplot() + aes(index, people_total) %>% geom_col(fill="khaki") + scale_y_sqrt(breaks=c(0, 250000, 500000, 1000000, 2000000, 4000000)) + theme_minimal() cowplot::plot_grid( p1, p2, labels = c("a", "b"), nrow = 1 ) Figure 23.2: (ref:population-area) 23.6 Increasing percentage as Y 23.6.1 NYT: Net Worth by Age Group LEARNING NOTES Median for Inequality 這個教學案例來自紐約時報的「What’s going on in this gragh」系列資料視覺化教學之Teach About Inequality With These 28 New York Times Graphs - The New York Times (nytimes.com) 。該圖表呈現在不同年代、不同年齡層的人所擁有的淨資產（包含土地、存款、投資等減去債務）。該圖表的結果指出，在不同年代的老年人是越來越有錢，但年輕人卻越來越窮（該曲線為減去1989年 23.6.2 Read and sort data Sorted by arrange() function. p1 <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(year, Category, Net_Worth) %>% group_by(Category) %>% arrange(year) %>% ungroup() p1 %>% filter(year <= 1992) %>% knitr::kable() year Category Net_Worth 1989 Less than 35 16.17019 1989 35-44 112.47530 1989 45-54 195.11630 1989 55-64 195.25554 1989 65-74 154.34277 1989 75 or older 144.29855 1992 Less than 35 16.60780 1992 35-44 79.91050 1992 45-54 139.97745 1992 55-64 203.44104 1992 65-74 176.44667 1992 75 or older 155.35173 library(gghighlight) p1 %>% ggplot() + aes(year, Net_Worth, color = Category) + geom_line() + geom_point() + gghighlight(Category %in% c("65-74", "35-44")) + theme_minimal() + scale_x_continuous(breaks = NULL) + theme(panel.background = element_rect(fill = "white", colour = "white", size = 0.5, linetype = "solid")) p2 <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(year, Category, NW = Net_Worth) %>% group_by(Category) %>% arrange(year) %>% mutate(increase = (NW-first(NW))/first(NW)) %>% ungroup() p2 %>% filter(year <= 1992) %>% knitr::kable() year Category NW increase 1989 Less than 35 16.17019 0.0000000 1989 35-44 112.47530 0.0000000 1989 45-54 195.11630 0.0000000 1989 55-64 195.25554 0.0000000 1989 65-74 154.34277 0.0000000 1989 75 or older 144.29855 0.0000000 1992 Less than 35 16.60780 0.0270627 1992 35-44 79.91050 -0.2895285 1992 45-54 139.97745 -0.2825948 1992 55-64 203.44104 0.0419220 1992 65-74 176.44667 0.1432131 1992 75 or older 155.35173 0.0765994 美國35歲以下的年輕人的中位淨資產比起年長的美國人來說，一開始平均貧窮得多。從「Less than 35」這條線看來，現在的年輕世代比起2004年的年輕世代所擁有的淨資產低了40%。相比之下，65歲以上的美國人現在的淨資產，相較於2004年增加了9%。隨著時代變化，可想像會有一群人的淨資產越來越多，只是現在從這個圖表看來，年輕人所擁有的淨資產相較於過去是越來越低的，多半流入了成年人和老年人手中。 p2 %>% ggplot() + aes(year, increase, color = Category) + geom_line() + geom_point() + gghighlight(Category %in% c("65-74", "Less than 35")) + theme_minimal() + scale_y_continuous(labels=scales::parse_format()) + scale_x_continuous(breaks = NULL) + theme(panel.background = element_rect(fill = "white", colour = "white", size = 0.5, linetype = "solid")) 23.7 X/Y aspect ratio 23.7.1 UNICEF-Optimistic (WGOITH) https://www.nytimes.com/2021/11/17/upshot/global-survey-optimism.html https://changingchildhood.unicef.org/about plot.opt <- read_csv("data/unicef-changing-childhood-data.csv") %>% select(country = WP5, age = WP22140, bw = WP22092) %>% mutate(country = ordered(country, levels=c(1, 3, 4, 10, 11, 12, 13, 14, 17, 29, 31, 33, 35, 36, 60, 61, 77, 79, 81, 87, 165), labels=c("USA", "Morocco", "Lebanon", "Indonesia", "Bangladesh", "UK", "France", "Germany", "Spain", "Japan", "India", "Brazil", "Nigeria", "Kenya", "Ethiopia", "Mali", "Ukraine", "Cameroon", "Zimbabwe", "Argentina", "Peru"))) %>% count(country, age, bw) %>% group_by(country, age) %>% mutate(perc = n/sum(n)) %>% ungroup() %>% filter(bw == 1) %>% select(country, age, perc) %>% spread(age, perc) %>% rename(`15-24y` = `1`, `40+y` = `2`) plot.opt %>% head(10) %>% knitr::kable() country 15-24y 40+y USA 0.6679842 0.4611465 Morocco 0.4365079 0.4735812 Lebanon 0.5467197 0.4435798 Indonesia 0.7920605 0.8027344 Bangladesh 0.4624506 0.4319527 UK 0.5040000 0.4140000 France 0.3900000 0.2640000 Germany 0.5900000 0.3860000 Spain 0.5160000 0.3340000 Japan 0.6367265 0.2586873 plot.opt %>% ggplot() + aes(`40+y`, `15-24y`, label = country) + geom_point(color = "skyblue", size = 2) + xlim(0, 1) + ylim(0,1) + geom_text(hjust = -0.1, vjust = -0.5) + geom_abline(intercept = 0, slop = 1, color="lightgrey", alpha=0.5, linetype="dashed") + theme_minimal() + theme(aspect.ratio=1) "],["amount.html", "Chapter 24 AMOUNT 24.1 Bar chart 24.2 Heatmap: Vaccination", " Chapter 24 AMOUNT 24.1 Bar chart 24.2 Heatmap: Vaccination 這個例子參考(Wilke 2019)在視覺化數量（Amount）時的熱圖範例（Heatmap），但改用為視覺化各國每百人完整注射COVID-19疫苗人數歷時資料。 - https://ourworldindata.org/covid-vaccinations - https://github.com/owid/covid-19-data/tree/master/public/data/vaccinations 在R語言中，我們可以使用ggplot2套件來創建熱圖。熱圖通常使用顏色來表示數據的強度或值，通常是從淺色到深色或從冷色到暖色的漸變。ggplot2套件提供了geom_tile()函數來繪製熱圖。熱圖主要有以下幾個作用： 顯示數據的分布情況：熱圖可以將數據的分布情況一目了然地呈現出來，讓觀察者可以快速了解數據的分布情況。 發現數據之間的相關性：熱圖可以將數據之間的相關性直觀地呈現出來，這對於探索數據之間的關係非常有用。 篩選數據：熱圖可以幫助我們快速地篩選出數據中的關鍵部分，從而更好地理解數據。 使用ggplot2繪製熱圖的過程中，我們可以使用scale_fill_gradient()函數設置顏色的漸變方式和範圍，使用coord_equal()函數使x和y軸的尺度相同，從而保持正方形。 24.2.1 The case: Vaccinating coverage by month 本例子的資料前處理難度較高（OS：惡魔級）。困難來自於每個國家登記資料的時間不同，因此會產生大量NA值。但在這樣的狀況下，又要找到以月為時間單位的共同數值，就會更挑戰程式編寫者的資料清理技術。除此之外，如何偵測「每個國家超過每百人有二十人完整注射疫苗的時間點」，更是技巧中的技巧。是個磨練NA值處理和高難度資料前處理的好例子。這個例子同時也是大量在長表格、寬表格間轉換，多次運用spread()/pivot_wider()與gather()/pivot_longer()，搭配group_by()來達到資料整理目的的困難例子。 24.2.2 Data cleaning library(lubridate) raw <- read_csv("data/vaccinations.csv") fullvaccinated <- raw %>% select(country = location, date, people_fully_vaccinated_per_hundred) %>% drop_na(people_fully_vaccinated_per_hundred) %>% mutate(m = floor_date(date, unit = "month")) %>% group_by(country, m) %>% arrange(date) %>% slice(1) %>% ungroup() %>% select(-date) vperc_by_month <- fullvaccinated %>% spread(m, people_fully_vaccinated_per_hundred, fill=NA) %>% gather(month, perc, -country) %>% arrange(country, month) %>% group_by(country) %>% arrange(month) %>% mutate(perc = zoo::na.locf(perc, na.rm = F)) %>% ungroup() %>% arrange(country, month) %>% replace_na(list(perc=0)) 24.2.3 Visualization https://clauswilke.com/dataviz/visualizing-amounts.html 這個案例使用了三個維度的資料，分別為X軸的時間（月）、Y軸的國家、以及用顏色來呈現各國疫苗注射量（每百人）。並使用geom_tile()來製作熱圖。然而，Y軸的排序卻會影響讀圖。例如，在第一個例子中，Y軸的順序是用最後一個時間點的疫苗注射比例來排序。但每個國家政策和疫苗可獲量均不同，故開始注射和覆蓋速度也差很多，最終覆蓋量也會差很多。所以如果以最終覆蓋量來排序的話，反而不易觀察過程的變化，且「顏色」並不容易用來比較最終覆蓋量的大小，因而會產生很多讀圖上的困擾。 另一種繪圖策略是該書上的做法，其Y軸的排序是依照疫苗覆蓋率達到某個數值（例如每百人中有20人完整注射二劑疫苗）的時間早晚來排序。有此作為基準，每個國家在後續時間點的覆蓋速度的比較便比較容易。 另外需要注意到，顏色的取捨、以及相對於尺度的漸層設計也會影響讀圖。 24.2.3.1 Heatmap 01: Sorted by coverage of the last month watched <- c("United Arab Emirates", "Japan", "Singapore", "South Korea", "Taiwan", "Malaysia", "Hong Kong", "New Zealand", "Thailand", "Netherlands", "United States", "Israel", "United Kingdom", "Indonesia", "Thailand", "Philippines") vperc_by_month %>% spread(month, perc) %>% filter(country %in% watched) %>% mutate(country = reorder(country, -`2022-05-01`)) %>% gather(month, perc, -country) %>% ggplot() + aes(month, country, fill=perc) + geom_tile() + theme_minimal() + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) 24.2.3.2 Heatmap 02: Sorted by the time of specific coverage rate Sort by the time when the vaccine coverage rate exceeds 20% for all countries on the Y-axis. https://clauswilke.com/dataviz/visualizing-amounts.html vperc_by_month %>% filter(country %in% watched) %>% mutate(month = lubridate::as_date(month)) %>% group_by(country) %>% mutate(month1 = min((month[perc > 20]))) %>% ungroup() %>% spread(month, perc) %>% mutate(country = reorder(country, -as.numeric(month1))) %>% select(-month1) %>% gather(month, perc, -country) %>% ggplot() + aes(month, country, fill=perc) + geom_tile() + theme_minimal() + theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) References "],["distribution-histogram-density.html", "Chapter 25 DISTRIBUTION: Histogram & Density 25.1 Density plot 25.2 Histogram 25.3 Pyramid Plot 25.4 Box plot: Muitiple Distrubution 25.5 Likert plot", " Chapter 25 DISTRIBUTION: Histogram & Density 本章節將介紹與資料分布相關的視覺化方法。資料分布是指數據中每個值出現的頻率或概率。在統計學中，了解資料分布是非常重要的，因為它可以幫助我們判斷數據是否為正態分佈，或者是否存在異常值或極端值。本章節將涵蓋常見的資料分布視覺化方法，包括直方圖、密度圖、箱形圖和金字塔圖等。 以下是R語言ggplot2套件中，用於資料分布視覺化的一些常用函式： geom_histogram()：用於創建直方圖。 geom_density()：用於創建密度圖。 geom_boxplot()：用於創建箱形圖。 geom_bar()：用於創建柱狀圖。 geom_freqpoly()：用於創建頻率多邊形圖。 註：本節的設計概念不少是參考 Claus O. Wilke 所著的「Foundations of Data Visualization」一書的章節，同時也參考臺灣和資料新聞的案例進行了改編。 接下來我們將使用Histogram和Density Plot這兩種資料視覺化方法來探索台灣村里長的年齡和性別分布情況。我們所使用的資料來源包括內政部和中選會的投票資料，這些資料能夠提供具有代表性的統計樣本，幫助我們更好地了解村里長的整體特徵。在進行資料視覺化的過程中，我們將會運用R語言中的ggplot2套件，並根據不同的視覺化需求進行相應的設置和調整。 https://www.moi.gov.tw/LocalOfficial.aspx?n=577&TYP=KND0007。 vilmaster <- readr::read_csv("data/tw_vil2018_elccand.csv") %>% drop_na(當選註記) 25.1 Density plot 密度圖（Density Plot)是一種展示數據集分佈情況的圖表，它可以幫助我們更好地理解數據集中數值出現的概率。圖表的 X 軸代表數據集的數值範圍，Y 軸則代表每個數值的出現概率。與直方圖不同，密度圖的曲線是光滑的，因為它是通過連續的數值範圍估算出的概率密度函數。通過比較不同數據集的密度圖，我們可以更好地了解它們之間的差異。在ggplot2中，可以用geom_density()函數來創建密度圖。 p1 <- vilmaster %>% ggplot() + aes(年齡) + geom_density() + th p2 <- vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_density(alpha=0.5) + th + scale_fill_manual( limits=c('1', '2'), # original chart group values=c("gold", "skyblue"), # map to color name="性別", # legend title breaks=c(1, 2), # original legend group labels labels=c("Male","Female"), # map to new labels na.value = "lightgrey" # color for other groups ) cowplot::plot_grid( p1, p2, labels = c("(a) Overall", "(b) Group by gender"), nrow = 1, rel_widths = c(1, 1) ) 25.1.1 Density with different bandwidth 參數bw指的是bnadwidth，為繪製histogram時的bar所涵蓋的資料寬度。以step-plot來說，bw越大，則梯距越寬；以density-plot來說，若bw越大則越是平滑。 library(ggridges) # for geom_density_line() p.b05 <- vilmaster %>% ggplot() + aes(年齡) + geom_density_line(fill='gold', bw=0.5, kernel='gaussian') + th p.b1 <- vilmaster %>% ggplot() + aes(年齡) + geom_density_line(fill='gold', bw=1, kernel='gaussian') + th p.b5 <- vilmaster %>% ggplot() + aes(年齡) + geom_density_line(fill='gold', bw=5, kernel='gaussian') + th p.rect <- vilmaster %>% ggplot() + aes(年齡) + geom_density_line(fill='gold', bw=10, kernel='rectangular') + th cowplot::plot_grid( p.b05, p.b1, p.b5, p.rect, labels = c("(a) bw=.5", "(b) bw=1", "(c) bw=2", "(b) rect"), nrow = 2, rel_widths = c(1, 1) ) 25.2 Histogram 直方圖（Histogram）是一種用於展示數據集分佈的圖表。它通過將數據範圍分成若干個區間（稱為 “bins” 或 “buckets”），然後計算落在每個區間內的數據的數量（稱為 “frequency”），來展示數據集的分佈情況。直方圖的 X 軸表示數據範圍，Y 軸表示每個區間中的頻數。直方圖可以幫助我們快速了解數據的分佈情況，特別是數據的中心趨勢、數據的離散程度和是否存在異常值等。 25.2.1 Histogram with different number of bins p10 <- vilmaster %>% ggplot() + aes(年齡) + geom_histogram(bins=10, fill='royalblue') + th p20 <- vilmaster %>% ggplot() + aes(年齡) + geom_histogram(bins=20, fill='royalblue') + th p30 <- vilmaster %>% ggplot() + aes(年齡) + geom_histogram(bins=30, fill='royalblue') + th p40 <- vilmaster %>% ggplot() + aes(年齡) + geom_histogram(bins=40, fill='royalblue') + th cowplot::plot_grid( p10, p20, p30, p40, labels = c("(a) bins=10", "(b) bins=20", "(c) bins=30", "(b) bins=40"), nrow = 2, rel_widths = c(1, 1) ) 25.2.2 Density vs histogram Histogram通常用來顯示數據的分佈情況，它會把數據區間分成若干個等寬的區間，然後計算每個區間內數據的頻率，再將這些頻率表示在y軸上。因此，histogram顯示的是數據的頻率，而不是數據的密度。 Density plot則是用來顯示數據的概率密度函數，它會通過核密度估計（Kernel Density Estimation, KDE）方法，將數據點周圍的密度估計出來，然後將這些估計值表示在y軸上。因此，density plot顯示的是數據的密度，而不是數據的頻率。 pd <- vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_density(alpha=0.5) + th + scale_fill_manual( values=c("1"='gold', '2'="skyblue"), labels=c('1'="Male",'2'="Female"), name='Sex' ) ph <- vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_histogram(bins=20, position="dodge") + th + scale_fill_manual(values=c("1"='gold', '2'="skyblue ")) + theme(legend.position="none") cowplot::plot_grid( pd, ph, labels = c("(a) geom_density()", "(b) geom_histogram()"), nrow = 1, rel_widths = c(6, 4) ) 25.2.3 Positions of bar chart p.hist.dodge <- vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_histogram(bins=20, position="dodge") + th + scale_fill_manual( values=c("1"='gold', '2'="skyblue "), labels=c('1'="Male",'2'="Female"), name='Sex' ) p.hist.stack <- vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_histogram(bins=20, position="stack") + th + scale_fill_manual(values=c("1"='gold', '2'="skyblue ")) + theme(legend.position="none") cowplot::plot_grid( p.hist.dodge, p.hist.stack, labels = c("(a) position:dodge", "(b) position:stack"), nrow = 1, rel_widths = c(6, 4) ) 25.2.4 Display two groups histogram by facet_wrap() geom_histogram(bins=20, position=\"dodge\") 用於繪製直方圖， bins=20表示將數據分成20個區間， position=\"dodge\"表示將不同性別的數據分開顯示。 th 是本範例在最早先所建立的ggplot主題，用於設置圖表的樣式（例如背景顏色、字體等）。 scale_fill_manual() 用於手動設置填充顏色， values=c(\"1\"='gold', '2'=\"skyblue\") 表示性別為1時填充金色，性別為2時填充天藍色。 labels=c('1'=\"Male\",'2'=\"Female\") 表示將性別1標記為Male，性別2標記為Female。 name='Sex' 表示設置顏色圖例的標題為Sex。 facet_wrap(.~性別, nrow=1) 表示將不同性別的數據分開顯示，每直行顯示一個性別。.~性別 表示將數據按性別分組。 vilmaster %>% ggplot() + aes(年齡, fill=factor(性別)) + geom_histogram(bins=20, position="dodge") + th + scale_fill_manual( values=c("1"='gold', '2'="skyblue "), labels=c('1'="Male",'2'="Female"), name='Sex' ) + facet_wrap(.~性別, nrow=1) 25.3 Pyramid Plot 金字塔圖（Pyramid plot）是一種用於比較兩個群體的統計圖表。它的形狀像一座金字塔，通常用於展示男女或年齡分佈等相關的數據。金字塔圖以垂直線為軸線，其中一側代表一個群體（如男性），另一側代表另一個群體（如女性）。圖表的左右兩側是對稱的，並以一條中心線分開。圖表中的每一行表示一個年齡段，而每一列則表示一個群體的比例或頻數。金字塔圖的高度表示總人數或總比例，並且可以用不同的顏色區分不同的群體。金字塔圖可以直觀地顯示兩個群體之間的差異，特別是在不同年齡段之間。 25.3.1 Modify geom_col() to pyramid plot vilmaster %>% group_by(性別) %>% mutate(age_group = cut(年齡, 0:20*5+.01)) %>% count(age_group) %>% ungroup() %>% ggplot() + aes(x=age_group, y=ifelse(性別=='1', -1, 1)*n, fill=factor(性別)) + geom_col() + scale_y_continuous(name = "Count", breaks = 250*(-6:2), labels = c("1500", "1250", "1000", "750", "500", "250", "0", "250", "500")) + coord_flip() + scale_fill_manual( values=c("1"='gold', '2'="skyblue "), labels=c('1'="Male",'2'="Female"), name='Sex' ) + th + labs(y="Count", x="Age Group") 25.4 Box plot: Muitiple Distrubution 箱形圖（Box plot）是一種用於展示數據分佈情況的統計圖表。它通常顯示數據的中位數、四分位數、極值和異常值等統計量。箱形圖的中間線表示數據的中位數，箱子的上下邊界則分別表示數據的上四分位數和下四分位數。箱子的高度表示數據的變異程度，而箱子外的線段則表示數據的最大值和最小值。如果數據中存在異常值，則通常使用圓圈或星號等符號來標記。箱形圖可以用來比較不同數據集之間的分佈情況，以及檢查數據是否存在異常值。 25.4.1 TW-Salary (boxplot) Inspired by Six Myths About Choosing a College Major - The New York Times (nytimes.com) and What’s Going On in This Graph? | Jan. 9, 2018 - The New York Times (nytimes.com) library(readxl) raw <- read_excel("data/tw_salary109.xlsx", sheet=1, trim_ws = T) raw Category Q1 Median Q3 Mean 男 39.0 53.2 82.3 70.7 女 35.1 46.8 67.6 58.6 未滿25歲 28.1 35.8 45.1 37.7 25-29歲 36.6 47.8 61.7 53.0 30-39歲 39.2 53.3 77.0 64.1 40-49歲 39.9 56.9 91.8 74.8 50-64歲 37.8 53.3 88.4 75.5 65歲以上 30.6 40.9 63.1 62.6 國中及以下 32.7 40.5 52.0 45.4 高中（職） 34.5 44.7 59.8 51.9 大專 38.6 53.7 80.2 67.0 研究所 60.9 96.0 139.3 116.4 礦業及土石採取業 34.2 57.2 91.7 68.5 製造業 38.7 50.4 73.2 64.8 電力及燃氣供應業 73.9 110.7 139.9 113.2 用水供應及污染整治業 31.9 45.7 63.9 54.6 營建工程業 34.1 46.1 64.0 54.7 批發及零售業 36.6 49.5 71.7 62.7 運輸及倉儲業 40.3 58.3 81.4 66.1 住宿及餐飲業 30.1 36.7 49.3 42.0 出版﹑影音製作﹑傳播及 資通訊服務業 53.0 71.5 111.2 88.8 金融及保險業 65.6 96.9 140.1 113.4 不動產業 36.8 52.2 76.6 65.0 專業科學及技術服務業 41.9 61.3 95.0 77.5 支援服務業 33.1 42.1 49.3 45.3 教育業-不含小學以上各級 學校 28.4 33.7 42.7 37.2 醫療保健及社會工作服務業 41.3 60.1 88.1 77.1 藝術娛樂及休閒服務業 28.8 39.2 57.2 48.8 其他服務業 30.6 35.8 49.1 43.6 raw %>% slice(-(1:12)) %>% mutate(Category = reorder(Category, desc(Median))) %>% ggplot() + aes(y = Category, xlower=Q1, xmiddle=Median, xupper=Q3, xmin=0, xmax=150) + geom_boxplot(stat = "identity", color="white", fill="skyblue") + geom_point(aes(x = Mean)) + th + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank()) 25.4.2 TW-Income (boxplot) 本案例用BoxPlot來呈現某個行政區（鄉鎮市區）各村里的所得中位數、平均數、四分位數的分佈。如果在箱型圖中，平均數高於第三分位數，這代表數據集呈現右偏分佈。也就是說，數據中的大部分觀測值都分佈在第一、二分位數之間，但存在一些較大的極端值，使平均值被往右偏移。從這樣的分佈中可以察覺某些里因為有少數極端高收入住戶，而使得平均高於四分位數。 library(gghighlight) toplot <- read_csv("data/tw_income_107.csv", ) %>% filter(!`村里` %in% c("合計", "其他", "福住里")) %>% filter(鄉鎮市區 %in% c("信義區")) %>% mutate(村里 = reorder(村里, desc(中位數))) toplot %>% mutate(group = if_else((平均數>第三分位數), "highlight", "none")) %>% ggplot() + aes(y = 村里, xlower=第一分位數, xmiddle=中位數, xupper=第三分位數, xmin= min(第一分位數), xmax=max(第三分位數), fill=group) + geom_boxplot(stat = "identity", color="white") + scale_fill_manual(values = c("highlight"="orangered", "none"="skyblue")) + guides(fill=FALSE) + geom_point(aes(x = 平均數)) + xlab("年所得（單位：千元）") + th + theme(panel.grid.minor = element_blank(), panel.grid.major = element_blank()) 25.5 Likert plot raw <- read_rds("data/tfc_survey.rds") dt <- raw %>% mutate(QA3_lv = ordered(QA3, levels=c("20-24", "25-29", "30-34", "35-39", "40-44", "45-49", "50-54", "55-59", "60-64", "65-69", "70及以上"), labels = c("青年", "青年", "壯年", "壯年", "壯年", "中年", "中年", "中年", "中年", "老年", "老年"))) %>% mutate(Q7 = ordered(Q7, levels=c("一點也不會", "不會", "會", "絕對會"))) %>% mutate(Q8 = ordered(Q8, levels=c("一點也不會", "不會", "會", "絕對會"))) 25.5.1 Stacked or dodged bar 要比較不同年齡層在某個題項的填答結果時，最常見的是用Stacked或Dodged長條圖。Stacked是便於看到各組的總數大小但難以比較各組之間回應的比例，而Dodged是便於比較各組之間每個項目的比例，而不容易觀察總數大小。但這兩種呈現方法，以上面這個例子來說，從視覺化上均難以閱讀出來，哪個年齡層的填答比較靠近「會或絕對會」，又哪個年齡層比較靠近「絕對不會或不會」。 這時候我們可以用一種繪製方法來表達這類Likert問卷的結果，這種圖表稱為Likert Plot（Graph）。 p1 <- dt %>% count(QA3_lv, Q7) %>% ggplot() + aes(QA3_lv, n, fill=Q7) + geom_col(position = position_stack(reverse = TRUE)) + coord_flip() + th p2 <- dt %>% count(QA3_lv, Q7) %>% ggplot() + aes(QA3_lv, n, fill=Q7) + geom_col(position="dodge") + th cowplot::plot_grid( p1, NULL, p2, labels = c("(a) Stacked", "", "(b) Dodged"), ncol = 1, rel_heights = c(1, 0.1, 1) ) 25.5.2 Likert Graph Likert Graph繪製重點有幾個： 要轉用比例來繪製。例如下圖就是用絕對的數值來繪製，因為年齡層人數的不同，例如壯年人數比較多，而老年人數少非常多，反而難以跨組比較。 ggstats的套件有gglikert()可以用（請見Plot Likert-type items with `gglikert()` • ggstats (larmarange.github.io)）的說明，但也可以用geom_segment()來自己刻。 用geom_segment()時在aes()多了幾個參數，為該資料在X軸的起始點與終點（x, xend）與Y軸的起始點與終點（y, yend）。要自己運算。 color <- c("#9393C6", "#A8A8A8","#FFA166", "#FF6200") dt %>% count(QA3_lv, Q7) %>% mutate(y_acc = cumsum(n)) %>% group_by(QA3_lv) %>% mutate(y_end = y_acc - min(y_acc) - n[[2]]) %>% mutate(y_start = y_end - n) %>% ungroup() %>% ggplot() + aes(x = QA3_lv, xend = QA3_lv, y = y_start, yend = y_end, , color=Q7) + geom_segment(linewidth = 18) + coord_flip() + theme_bw() + scale_color_manual("", labels = c("一點也不會", "不會", "會", "絕對會"), values = color, guide = "legend") + th 正確用比例繪製的結果如下。Likert Graph和本節所提到的Pyramid Graph在數位敘事上的效果很類似，都是對應到一般的Stacked或Dodged長條圖不易做組間比較。Pyramid Graph適於做兩組間的數值左右對照，Likert Graph則有助於快速看出不同題項或不同組別間的填答差異。 library(scales) dt %>% count(QA3_lv, Q7) %>% group_by(QA3_lv) %>% mutate(perc = n/sum(n)) %>% mutate(y_acc = cumsum(perc)) %>% mutate(y_end = y_acc - y_acc[[2]]) %>% # mutate(y_end = y_acc - perc[[1]] - perc[[2]]) %>% # mutate(y_end = y_acc - min(y_acc) - perc[[2]]) %>% mutate(y_start = y_end - perc) %>% ungroup() %>% ggplot() + aes(x = QA3_lv, xend = QA3_lv, y = y_start, yend = y_end, , color=Q7) + geom_segment(linewidth = 18) + scale_y_continuous(labels = percent_format()) + coord_flip() + scale_color_manual("", labels = c("一點也不會", "不會", "會", "絕對會"), values = color, guide = "legend") + ylab("Perc(%)") + xlab("Age group") + th "],["proportion.html", "Chapter 26 PROPORTION 26.1 Pie Chart 26.2 Dodged Bar Chart 26.3 Treemap: Nested Proportion", " Chapter 26 PROPORTION 26.1 Pie Chart 26.2 Dodged Bar Chart 26.3 Treemap: Nested Proportion Treemap是一種資料視覺化工具，用於呈現層級式結構的數據。它通常使用矩形或正方形區域來表示不同的數據單元，並將它們分層排列以形成層次樹狀結構。Treemap的特點包括： 易於理解：Treemap以直觀的方式呈現數據，讓使用者能夠輕鬆地了解各個數據單元之間的比例關係。 節省空間：Treemap使用矩形或正方形區域排列數據，能夠更有效地利用空間，呈現更多的數據。 可互動性：Treemap通常支持互動式操作，使用者可以通過縮放、懸停等方式，進一步了解數據。 Treemap適用於以下情況： 層級式數據：Treemap適用於層級式數據，例如組織架構、檔案系統等。 大量數據：Treemap能夠有效地呈現大量數據，並在縮放時保持清晰度。 比例關係：Treemap適用於呈現不同數據單元之間的比例關係，例如市場份額、支出等。 26.3.1 NYT: Carbon by countries 本案例取自紐時所報導之Who Has The Most Historical Responsibility for Climate Change? - The New York Times (nytimes.com)。該新聞報導了聯合國氣候峰會在格拉斯哥舉行期間的一個重要議題：世界上最富裕的國家，即那些對全球暖化負責任的不成比例的國家，應如何賠償因全球氣溫上升所造成的貧困國家的損失。報導指出，現今全球人口中，包括美國、加拿大、日本以及西歐大部分國家在內的富裕國家僅佔12％，但是在過去的170年中，這些國家卻負責了50％的溫室氣體排放。貧困國家要求富裕國家提供更多資金以應對全球暖化所帶來的風險。在峰會上，來自最不發達國家聯盟的Sonam P. Wangdi指出，他的祖國不丹對全球暖化的責任較小，因為該國目前吸收的二氧化碳比汽車和房屋排放的少。然而，不丹仍然面臨著由氣溫上升所帶來的嚴重風險，喜馬拉雅山脈融化的冰川已經導致了洪水和泥石流，摧毀了村莊。報導指出，最不發達國家需要更多的資金和支持，以應對全球暖化所帶來的影響。 本案例的Treemap以面積顯示了各國的碳排放所佔比例，並用顏色視覺化各國的人均GDP。Per Capita是拉丁語，通常用來表示某種統計數據與人口數量之間的關係。它是指將某一特定數量的總量除以人口數目，以得出每個人所擁有的平均數量。例如，國家的人均GDP（Gross Domestic Product，國內生產總值）是指該國的總GDP除以該國的人口數，以反映一個人在該國經濟中所創造的平均貢獻。Per Capita常用於比較不同國家或地區之間的平均水平，以及分析人均收入、人均支出、人均消費等數據。 totreemap <- read_csv("data/GCB2021v34_MtCO2_flat.csv") %>% drop_na(`Total`) %>% filter(!Country %in% c("Global", "International Transport")) %>% filter(Year==2020) %>% arrange(desc(`Total`)) %>% mutate(perc = Total/sum(Total)) %>% slice(1:20) library(treemapify) totreemap %>% ggplot() + aes(area = perc, fill=`Per Capita`, label=Country) + geom_treemap() + geom_treemap_text(color="white", place="centre", grow=TRUE ) 26.3.2 TW: Taiwan Annual Expenditure 上述案例未能突顯出Treemap能夠呈現階層式資料的特色。因此本案例將使用台灣中央預算，階層化地顯示不同機構層級（大類、一級部會）等的預算佔比。例如衛福部、財政部與勞動部的預算均屬於社會福利支出。 這段程式碼中，使用了 zoo 套件中的 na.locf() 函數。此函數用於將 raw 資料框中的 款 欄位的缺失值 (NA) 以最近已知的值 (向前填補) 進行填補。 library(zoo) # raw <- readxl::read_excel("data/111B歲出政事別預算總表.xls") raw <- readxl::read_excel("data/111B歲出政事別預算表.xls", skip=3, col_names = F) names(raw) <- c("款", "科", "目", "節", "機構", "本年度預算", "上年度預算", "上年度決算", "預算差") # raw$款 <- na.locf(raw$款) cleand <- raw %>% filter(!is.na(款) | !is.na(科)) %>% slice(-(1:2)) %>% select(-目, -節) %>% mutate(org = purrr::map(機構, function(x){str_split(x, "\\n")[[1]][2]})) %>% mutate(款 = ifelse(!is.na(款), unlist(org), unlist(款))) %>% mutate(款 = zoo::na.locf(款)) %>% filter(!is.na(科)) %>% select(-科) %>% type_convert() %>% mutate(上年度預算 = as.numeric(上年度預算), 上年度決算 = as.integer(上年度決算), 預算差 = as.numeric(預算差)) %>% replace_na(list(上年度預算 = 0, 上年度決算 = 0)) %>% mutate(預算差 = 本年度預算 - 上年度預算) cleand %>% filter(款 %in% c("科學支出")) %>% ggplot() + aes(area = 本年度預算, fill=`本年度預算`, label=org) + geom_treemap() + geom_treemap_text(color="white", place="centre", grow=TRUE, family = "Heiti TC Light" ) + theme(title = element_text(family = "Heiti TC Light"), text = element_text(family = "Heiti TC Light")) library(treemapify) cleand %>% # filter(款 %in% c("科學支出", "教育支出", "國防支出", "司法支出")) %>% ggplot() + aes(area = 本年度預算, fill=`本年度預算`, label=org, subgroup = 款) + geom_treemap() + geom_treemap_subgroup_border(color="gold") + geom_treemap_subgroup_text(place = "centre", grow = T, alpha = 0.5, colour = "gold", min.size = 0, family = "Heiti TC Light") + geom_treemap_text(color="white", place="centre", grow=F, family = "Heiti TC Light" ) + theme(title = element_text(family = "Heiti TC Light"), text = element_text(family = "Heiti TC Light"), legend.position = "none") "],["association.html", "Chapter 27 ASSOCIATION 27.1 等比例座標軸", " Chapter 27 ASSOCIATION 27.1 等比例座標軸 27.1.1 UNICEF-Optimistic (WGOITH) https://www.nytimes.com/2021/11/17/upshot/global-survey-optimism.html https://changingchildhood.unicef.org/about plot.opt <- read_csv("data/unicef-changing-childhood-data.csv") %>% select(country = WP5, age = WP22140, bw = WP22092) %>% mutate(country = ordered(country, levels=c(1, 3, 4, 10, 11, 12, 13, 14, 17, 29, 31, 33, 35, 36, 60, 61, 77, 79, 81, 87, 165), labels=c("USA", "Morocco", "Lebanon", "Indonesia", "Bangladesh", "UK", "France", "Germany", "Spain", "Japan", "India", "Brazil", "Nigeria", "Kenya", "Ethiopia", "Mali", "Ukraine", "Cameroon", "Zimbabwe", "Argentina", "Peru"))) %>% count(country, age, bw) %>% group_by(country, age) %>% mutate(perc = n/sum(n)) %>% ungroup() %>% filter(bw == 1) %>% select(country, age, perc) %>% spread(age, perc) %>% rename(`15-24y` = `1`, `40+y` = `2`) plot.opt %>% head(10) %>% knitr::kable() country 15-24y 40+y USA 0.6679842 0.4611465 Morocco 0.4365079 0.4735812 Lebanon 0.5467197 0.4435798 Indonesia 0.7920605 0.8027344 Bangladesh 0.4624506 0.4319527 UK 0.5040000 0.4140000 France 0.3900000 0.2640000 Germany 0.5900000 0.3860000 Spain 0.5160000 0.3340000 Japan 0.6367265 0.2586873 plot.opt %>% ggplot() + aes(`40+y`, `15-24y`, label = country) + geom_point(color = "skyblue", size = 2) + xlim(0, 1) + ylim(0,1) + geom_text(hjust = -0.1, vjust = -0.5) + geom_abline(intercept = 0, slop = 1, color="lightgrey", alpha=0.5, linetype="dashed") + theme_minimal() + theme(aspect.ratio=1) "],["time-trends.html", "Chapter 28 TIME & TRENDS 28.1 Highlighting: Unemployed Population 28.2 Smoothing: Unemployed", " Chapter 28 TIME & TRENDS 28.1 Highlighting: Unemployed Population This example is referenced from Datacamp’s Introduction to data visualization with ggplot2。 28.1.1 The econimics data 這是一個包含美國經濟時間序列資料的資料集，資料來源為https://fred.stlouisfed.org/。economics是以「寬」表格方式儲存，而economics_long 資料框則以「長」表格方式儲存。每一列之date為資料收集的月份。 pce：個人消費支出，以十億美元為單位，資料來源為 https://fred.stlouisfed.org/series/PCE pop：總人口數，以千人為單位，資料來源為 https://fred.stlouisfed.org/series/POP psavert：個人儲蓄率，資料來源為 https://fred.stlouisfed.org/series/PSAVERT/ uempmed：失業中位數持續時間，以週為單位，資料來源為 https://fred.stlouisfed.org/series/UEMPMED unemploy：失業人數，以千人為單位，資料來源為 https://fred.stlouisfed.org/series/UNEMPLOY economics %>% head() ## # A tibble: 6 × 6 ## date pce pop psavert uempmed unemploy ## <date> <dbl> <dbl> <dbl> <dbl> <dbl> ## 1 1967-07-01 507. 198712 12.6 4.5 2944 ## 2 1967-08-01 510. 198911 12.6 4.7 2945 ## 3 1967-09-01 516. 199113 11.9 4.6 2958 ## 4 1967-10-01 512. 199311 12.9 4.9 3143 ## 5 1967-11-01 517. 199498 12.8 4.7 3066 ## 6 1967-12-01 525. 199657 11.8 4.8 3018 28.1.2 Setting marking area recess <- data.frame( begin = c("1969-12-01","1973-11-01","1980-01-01","1981-07-01","1990-07-01","2001-03-01", "2007-12-01"), end = c("1970-11-01","1975-03-01","1980-07-01","1982-11-01","1991-03-01","2001-11-01", "2009-07-30"), event = c("Fiscal & Monetary\\ntightening", "1973 Oil crisis", "Double dip I","Double dip II", "Oil price shock", "Dot-com bubble", "Sub-prime\\nmortgage crisis"), y = c(.01415981, 0.02067402, 0.02951190, 0.03419201, 0.02767339, 0.02159662, 0.02520715) ) library(lubridate) recess <- recess %>% mutate(begin = ymd(begin), end = ymd(end)) economics %>% ggplot() + aes(x = date, y = unemploy/pop) + ggtitle(c("The percentage of unemployed Americans \\n increases sharply during recessions")) + geom_line() + geom_rect(data = recess, aes(xmin = begin, xmax = end, ymin = -Inf, ymax = +Inf, fill = "Recession"), inherit.aes = FALSE, alpha = 0.2) + geom_label(data = recess, aes(x = end, y = y, label=event), size = 3) + scale_fill_manual(name = "", values="red", label="Recessions") 28.2 Smoothing: Unemployed Smooth by bin smoothing fit <- with(economics, ksmooth(date, unemploy, kernel = "box", bandwidth=210)) economics %>% mutate(smooth = fit$y) %>% ggplot() + aes(date, unemploy) + geom_point(alpha = 5, color = "skyblue") + geom_line(aes(date, smooth), color="red") + theme_minimal() 28.2.1 Polls_2008 Second Example comes from Rafael’s online book library(dslabs) span <- 7 polls_2008 ## # A tibble: 131 × 2 ## day margin ## <dbl> <dbl> ## 1 -155 0.0200 ## 2 -153 0.0300 ## 3 -152 0.065 ## 4 -151 0.06 ## 5 -150 0.07 ## 6 -149 0.05 ## 7 -147 0.035 ## 8 -146 0.06 ## 9 -145 0.0267 ## 10 -144 0.0300 ## # ℹ 121 more rows fit <- with(polls_2008, ksmooth(day, margin, kernel = "box", bandwidth = span)) polls_2008 %>% mutate(smooth = fit$y) %>% ggplot(aes(day, margin)) + geom_point(size = 3, alpha = .5, color = "grey") + geom_line(aes(day, smooth), color="red") + theme_minimal() "],["geospatial.html", "Chapter 29 GEOSPATIAL 29.1 World Map 29.2 Read Spatial Data from SEGIS 29.3 Town-level: Taipei income 29.4 Voting map - County level 29.5 Mapping data with grid", " Chapter 29 GEOSPATIAL 地圖是一種用來展示地理空間信息的視覺化工具，可以幫助我們更好地了解和分析地理現象。常見的地圖種類通常可以分為兩類：區域圖和點位圖。 區域圖（Choropleth Map）是通過將地理區域劃分為幾個區域，然後用不同的顏色、陰影或圖案等方式來表示這些區域的某種屬性或數量。這種地圖通常用於展示國家、省份、城市等區域的人口、經濟、地形、氣候等相關數據。區域圖能夠直觀地展示地理現象在不同區域之間的差異和變化，並有助於我們進行比較和分析。 點位圖（Dot Density Map）則是通過在地圖上用點或符號來表示某種地理空間現象的分布或密度。例如，可以用紅點表示城市、綠點表示森林、藍點表示湖泊等等。這種地圖通常用於展示地理現象在空間上的分布和密度，並能夠直觀地展示相對密度和稀疏程度。 區域圖的數據形式：有兩種基本數據模型：向量（Vector）和網格（Raster）。 向量數據模型使用點、線、多邊形等基本要素來描述地理空間現象。例如，可以用一個線段來表示一條河流，用一個多邊形來表示一個國家或城市的邊界等。向量數據模型具有比較強的邏輯性和表達能力，特別適合描述較簡單的地理現象。 網格數據模型則是將地理空間區域劃分為一個個大小相等的格子，每個格子都有一個固定的數值，用來表示這個區域的某種屬性，例如溫度、濕度、高程等等。網格數據模型適合描述分布比較連續和具有變化的地理現象。 通常繪製地理資訊地圖的時候，會需要因應你要繪製的地域去下載地圖空間數據檔案（例如.shape或geojson檔等）。如台灣的就可以去社會經濟資料服務平台 (moi.gov.tw)下載。但也有一些套件內部就包含這些地理空間數據，例如下一節的例子rworldmap套件本身就有世界地圖。或者可以嘗試ggmap或rgooglemap等第三方服務（參考簡介：Map Visualization in R · Data Science and R） 29.1 World Map library(readxl) library(rworldmap) # for drawing rworldmap rawdata <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) mapdata <- rawdata[,c(3, 6:24)] 29.1.1 Bind data to map data 這段程式碼是在將自己的數據mapdata與rworldmap世界地圖數據進行結合。 首先，使用 joinCountryData2Map() 函數，將自己的數據和世界地圖數據按照國家的 ISO3 代碼進行連接，生成一張新的地圖。其中， mapdata 是指世界地圖數據， joinCode 參數指定連接時使用的 ISO3 代碼（亦即你預先知道你自己的資料中有ISO3國家代碼）。 nameJoinColumn 參數則用於指定自己數據中與國家對應的欄位名稱為iso3。 還有其他的joinCode如「“ISO2”,“ISO3”,“FIPS”,“NAME”, “UN” = numeric codes」等可參見該套件的說明rworldmap package - RDocumentation。 # join your data with the world map data myMap <- joinCountryData2Map(mapdata, joinCode = "ISO3", nameJoinColumn = "iso3") ## 196 codes from your data successfully matched countries in the map ## 1 codes from your data failed to match with a country code in the map ## 47 codes from the map weren't represented in your data myMap$matleave_13 ## [1] 2 2 5 2 2 5 NA NA 3 5 5 2 4 3 3 3 5 2 5 5 3 2 3 3 2 ## [26] 2 3 4 3 4 3 3 3 3 3 3 3 5 NA 3 5 5 3 5 2 3 2 2 2 3 ## [51] 5 2 5 2 NA 4 3 4 3 2 3 4 2 2 4 NA 2 2 2 5 2 5 2 2 4 ## [76] 4 2 4 3 4 2 2 5 3 2 3 2 5 NA 2 2 2 2 3 2 2 5 4 5 3 ## [101] 5 3 2 4 3 2 5 5 2 3 2 2 2 NA 3 2 2 3 4 2 3 2 2 3 2 ## [126] 2 1 5 NA 2 4 2 2 5 5 2 NA 2 2 2 3 2 2 2 3 5 1 5 5 5 ## [151] 2 3 3 3 2 5 3 2 3 2 3 NA 2 2 5 2 1 5 4 4 2 NA 2 3 3 ## [176] 3 NA NA NA 3 NA NA 2 2 NA NA 2 2 3 2 NA NA 2 NA 1 NA NA 2 NA NA ## [201] NA NA NA NA NA NA 2 2 2 3 NA NA 3 2 1 3 NA NA 2 NA 1 1 NA 1 NA ## [226] 3 NA NA 5 NA 2 NA 3 NA 1 5 2 NA NA NA 2 2 NA 29.1.2 Drawing Map mapCountryData() 函數用於將數據繪製在地圖上。其中， myMap 是已經連接過的世界地圖數據和自己的數據，包含了各國的地理空間信息和相關的數據資訊。 nameColumnToPlot 指定要顯示在地圖上的數據欄位為matleave_13，也就是 2013 年的產假長度。 catMethod 參數是決定視覺化時的數據分類是類別或連續，categorical表示將數據分成幾個等級來展示在地圖上。 mapCountryData(myMap , nameColumnToPlot="matleave_13" , catMethod = "categorical" ) 29.1.3 Drawing map by specific colors # self-defined colors colors <- c("#FF8000", "#A9D0F5", "#58ACFA", "#0080FF", "#084B8A") mapCountryData(myMap , nameColumnToPlot="matleave_13" , catMethod = "categorical" , colourPalette = colors , addLegend="FALSE" ) 29.1.4 Practice. Drawing map for every years 繪製自1995至2013年每年的地圖並觀察其上的變化。 繪製的時候請嘗試使用par()來把每年的地圖繪製在同一張圖上，怎麼做？ 你能觀察出變化來嗎？可否透過顏色的調整來凸顯變化？你的策略是什麼？ 29.2 Read Spatial Data from SEGIS 要繪製地理地圖會要先下載地圖檔，可以查詢「直轄市、縣市界線(TWD97經緯度)」和鄉鎮市區界線(TWD97經緯度) | 政府資料開放平臺 (data.gov.tw)。 接下來是取得要繪製在地圖上的資料。前面的rworldmap是已知地圖檔和資料檔中都有每個國家的ISO3代碼，所以可以用ISO3代碼來連結地圖檔和資料檔。如果是臺灣的資料，可能就要用縣市名稱來做連結。或者，某些圖資本身就有經緯度，甚至它並非區域圖，而是有經緯度的點位圖。這類的圖資檔案可以到社會經濟資料服務平台 (moi.gov.tw)查找並下載。 通常地理圖資檔有兩種格式：一種是geojson，一種是shapefile。 shapefile 是一種老舊的地理圖資檔案格式，通常由 shp, shx, dbf, prj 等檔案組成。其中，shp 檔案包含了地理空間範圍和形狀的點與邊（邊通常是由點依序所構成，不會特別把邊標出來），shx 檔案是其索引文件，dbf 檔案則儲存了相關的屬性資訊，例如幾何特徵的名稱或變數，prj 檔案則是儲存了投影信息。shapefile 格式的優點是廣泛的應用性和支援程式豐富，可以在許多地理信息系統（GIS）和軟件中使用，是許多組織和機構最常用的地理圖資格式之一。 geojson 則是一種基於 JSON 格式的地理圖資檔案格式，內容包含了地理空間範圍和屬性。geojson 的優點是格式簡單、容易理解和易於編輯，支援性也比較好。由於 geojson 使用的是文本格式，因此可以直接在許多文本編輯器中編輯和查看，也可以輕易地轉換成其他格式的地理圖資檔案。 這邊我們所要用的套件是sf，sf 是一個在 R 環境下進行地理圖資處理和分析的套件，他不僅支援多種檔案格式，包括 shapefile、GeoJSON、KML 等，並且可以直接將這些檔案轉換為 R 中的空間資料框架，方便進行進一步的處理和分析。更方便的特色是在於，它可以用tidyverse的風格來寫作，方便對地理圖資和其他數據進行整合和分析，甚至在使用View()的時候，把圖資當成一個變項。 library(sf) 29.2.1 The case: Population and Density of Taipei 這個資料下載自社會經濟資料服務平台 (moi.gov.tw)的111年9月行政區人口統計_鄉鎮市區_臺北市，實際上內部的資料包含368個鄉鎮的依性別分人口數、家戶數等。 資料變項包含每個區的家戶數（H_CNT）、總人口數（P_CNT）、男性人口數（M_CNT）、女性人口數（F_CNT）。等一下要計算每平方公里的家戶數或人口數時，你會疑惑為何沒有面積資料。 sf_tpe <- st_read(dsn = "data/111年9月行政區人口統計_鄉鎮市區_臺北市_SHP/", layer = "111年9月行政區人口統計_鄉鎮市區", quiet = T) %>% mutate(across(where(is.character), ~iconv(., from = "BIG5", to = "UTF8"))) %>% # mutate(across(where(is.double), ~if_else(is.na(.),as.double(0),.))) %>% # st_set_crs(3826) %>% st_transform(4326) %>% # filter(COUNTY == "臺北市") filter(str_detect(COUNTY, "臺北市")) sf_tpe %>% head() ## Simple feature collection with 6 features and 9 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 300874.7 ymin: 2766756 xmax: 309745.8 ymax: 2776127 ## CRS: NA ## TOWN_ID TOWN COUNTY_ID COUNTY H_CNT P_CNT M_CNT F_CNT INFO_TIME ## 1 63000010 松山區 63000 臺北市 78977 187552 87625 99927 111Y09M ## 2 63000020 信義區 63000 臺北市 87407 201951 95884 106067 111Y09M ## 3 63000030 大安區 63000 臺北市 117243 280332 130596 149736 111Y09M ## 4 63000040 中山區 63000 臺北市 98825 210156 97114 113042 111Y09M ## 5 63000050 中正區 63000 臺北市 64491 146628 69663 76965 111Y09M ## 6 63000060 大同區 63000 臺北市 51988 118065 57003 61062 111Y09M ## geometry ## 1 MULTIPOLYGON (((307703.1 27... ## 2 MULTIPOLYGON (((307788.7 27... ## 3 MULTIPOLYGON (((304591.5 27... ## 4 MULTIPOLYGON (((305699 2776... ## 5 MULTIPOLYGON (((302203.6 27... ## 6 MULTIPOLYGON (((302217.9 27... 試著畫畫看。你會發現它的座標系是一個我們看不懂的數字，而不是想像中的經緯度。 sf_tpe %>% ggplot() + geom_sf() 29.2.2 Projection 投影的概念 投影是指將地球表面的三維空間坐標轉換為二維平面坐標的過程，這是因為在實際應用中需要將地球表面的訊息表示在平面上，方便分析和可視化。然而，由於地球是一個球體，不同的投影方式會導致在不同位置和距離上的形狀、面積和方向出現差異，因此在使用地理空間數據進行分析和視覺化時需要注意投影的選擇和轉換。 除了投影之外，每個地理區域還有適合的參考橢球體和大地基準面。橢球體是指地球表面的形狀，大地基準面則是指地球表面的平均高程面。這些概念的選擇取決於具體的地理區域和應用場景，並且可能會對數據分析結果產生影響。基準點（Datum）則是用來定義地球表面上的某個點，從而將地球表面的形狀和大小轉換為平面坐標系中的數值。基準點分為區域性的（local）和全球的（global）。區域性的基準點通常是針對某個特定的地理區域進行定義，而全球的基準點則是針對整個地球進行定義。全球最常用的基準點是WGS84，它以地球質心為中心；而台灣常用的區域性基準點是TWD97，舊版則是用TWD67。基準點的選擇也可能會對數據分析結果產生影響。 投影法有對應的代號稱為 EPSG（歐洲石油探勘組織），他們制定了空間參考識別系統（SRID）。可以記兩個重要的: WGS84 = 4326 TWD97 = 3826 參考：https://gis.stackexchange.com/questions/48949/epsg-3857-or-4326-for-googlemaps-openstreetmap-and-leaflet Google Earth採用WGS84坐標系統的地理坐標系統。(EPSG：4326) Google Maps採用以WGS84為基礎的投影坐標系統。(EPSG 3857) Open Street Map數據庫中的數據以WGS84坐標系統的十進制度為單位進行儲存。(EPSG：4326) Open Street Map瓦片和WMS服務採用以WGS84為基礎的投影坐標系統。(EPSG 3857) https://epsg.io/3825 是台灣的坐標系統（3826、3827等也是，你可以打開看看） 用得到投影的情境 研究區域，想轉換座標（changing projections）：修改 EPSG code 或是改掉 proj4string 的內容 原始資料缺投影方法：加上 EPSG code 或是加上 proj4string 的內容 如果需要進行投影轉換，可以使用 R 中的相關函數和方法。例如， 使用 st_crs() 函數可以取得地理空間數據的投影系統； 使用 st_transform() 函數可以進行地理空間數據的投影變換； 使用 st_set_crs() 函數可以設定地理空間數據的投影系統等等。 就下載的這個資料來說，他並沒有設定他的投影座標。 st_crs(sf_tpe)$proj4string ## [1] NA st_crs(sf_tpe) ## Coordinate Reference System: NA 我們會希望在讀取資料的時候，設定他的投影座標。例如以下的例子是設定為TWD96（3826）然後轉換為全球座標WGS84（4326）。 sf_tpe <- st_read(dsn = "data/111年9月行政區人口統計_鄉鎮市區_臺北市_SHP/", layer = "111年9月行政區人口統計_鄉鎮市區", quiet = T) %>% mutate(across(where(is.character), ~iconv(., from = "BIG5", to = "UTF8"))) %>% st_set_crs(3826) %>% # st_transform(4326) %>% filter(str_detect(COUNTY, "臺北市")) st_crs(sf_tpe)$proj4string ## [1] "+proj=tmerc +lat_0=0 +lon_0=121 +k=0.9999 +x_0=250000 +y_0=0 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs" st_crs(sf_tpe) ## Coordinate Reference System: ## User input: EPSG:3826 ## wkt: ## PROJCRS["TWD97 / TM2 zone 121", ## BASEGEOGCRS["TWD97", ## DATUM["Taiwan Datum 1997", ## ELLIPSOID["GRS 1980",6378137,298.257222101, ## LENGTHUNIT["metre",1]]], ## PRIMEM["Greenwich",0, ## ANGLEUNIT["degree",0.0174532925199433]], ## ID["EPSG",3824]], ## CONVERSION["Taiwan 2-degree TM zone 121", ## METHOD["Transverse Mercator", ## ID["EPSG",9807]], ## PARAMETER["Latitude of natural origin",0, ## ANGLEUNIT["degree",0.0174532925199433], ## ID["EPSG",8801]], ## PARAMETER["Longitude of natural origin",121, ## ANGLEUNIT["degree",0.0174532925199433], ## ID["EPSG",8802]], ## PARAMETER["Scale factor at natural origin",0.9999, ## SCALEUNIT["unity",1], ## ID["EPSG",8805]], ## PARAMETER["False easting",250000, ## LENGTHUNIT["metre",1], ## ID["EPSG",8806]], ## PARAMETER["False northing",0, ## LENGTHUNIT["metre",1], ## ID["EPSG",8807]]], ## CS[Cartesian,2], ## AXIS["easting (X)",east, ## ORDER[1], ## LENGTHUNIT["metre",1]], ## AXIS["northing (Y)",north, ## ORDER[2], ## LENGTHUNIT["metre",1]], ## USAGE[ ## SCOPE["Engineering survey, topographic mapping."], ## AREA["Taiwan, Republic of China - between 120°E and 122°E, onshore and offshore - Taiwan Island."], ## BBOX[20.41,119.99,26.72,122.06]], ## ID["EPSG",3826]] sf_tpe %>% ggplot() + geom_sf() sf_tpe %>% ggplot() + aes(fill = P_CNT) + geom_sf(color = NA) + scale_fill_gradient(low = "white", high = "purple") 面積資料可以用st_area()這個函式求得。st_area() 是 R 中一個與地理空間數據相關的函數，用於計算地理多邊形的面積。具體而言，st_area() 函數接受一個 Spatial* 或是 sf 的資料物件，可以計算其包含的每個多邊形的面積，並以相應的單位返回結果。其中 as.double(st_area(.))/1000000 的作用是將地理多邊形的面積從平方公尺轉換為平方公里。因為面積的單位是平方公尺，而人口密度的常用單位是人口數/平方公里，因此需要進行單位換算，將面積轉換為平方公里。 st_area() 函數的計算方式基於多邊形的投影，因此在使用該函數時需要注意地理空間數據的投影選擇和轉換。通常情況下，st_area() 函數可以自動識別多邊形的投影系統，並返回相應的面積值。如果需要在不同的投影系統間進行面積的轉換，則需要使用 st_transform() 函數進行投影變換。 需要注意的是，由於地球是一個球體，因此在計算面積時需要考慮到地球的曲率效應。st_area() 函數默認使用的是橢球面積計算公式（ellipsoidal area formula），可以更準確地計算地理多邊形的面積。如果需要更精確的面積計算結果，也可以使用球面面積計算公式（spherical area formula）或是進行局部的面積校正。 sf_tpe %>% mutate(p_density = P_CNT/(as.double(st_area(.))/1000000)) %>% ggplot() + aes(fill = p_density) + geom_sf(color = NA) + scale_fill_gradient(low = "white", high = "purple") 29.3 Town-level: Taipei income 有時候我們所希望繪製的資料並非來自SEGIS這類有圖資的平台（例如下面所用的台北各區每人平均所得），那我們就會需要先取得另一份圖資資料（例如下例的鄉鎮市區界圖資），再透過一些索引（Index）來結合這兩方的資料。而下面這個例子，還為了要將鄉鎮市區名稱打在各區的中央，結合了另一份資料，一共結合了三方的資料。 29.3.1 Reading income data taipei_income <- readxl::read_xlsx('data/台北各區每人所得.xlsx') taipei_income %>% head() ## # A tibble: 6 × 2 ## district income ## <chr> <dbl> ## 1 松山區 1012678 ## 2 信義區 909336 ## 3 大安區 1038921 ## 4 中山區 861415 ## 5 中正區 1022438 ## 6 大同區 814439 29.3.2 Read Taipei zip code 等一下我打算把每區的名稱打在各區上，但是我沒有各區的名稱應該打在哪裡的經緯度，恰好Zip Code這份資料裡面有台北市各區的經緯度中心，因此先把它讀進來合併用。 library(jsonlite) twzipcode_json <- fromJSON("data/twzipcode.json")[[1]] taipei_zipcode <- twzipcode_json %>% filter(city == "台北市") taipei_zipcode %>% head() ## zip_code district city lat lng ## 1 100 中正區 台北市 25.0324 121.520 ## 2 103 大同區 台北市 25.0634 121.513 ## 3 104 中山區 台北市 25.0697 121.538 ## 4 105 松山區 台北市 25.0600 121.558 ## 5 106 大安區 台北市 25.0268 121.543 ## 6 108 萬華區 台北市 25.0286 121.498 # install.packages("rmapshaper") st_read("data/shapefiles/TOWN_MOI_1100415.shp") %>% filter(COUNTYNAME == "臺北市") %>% # st_transform(3825) %>% #3857 # rmapshaper::ms_simplify(keep=0.05) %>% left_join(taipei_income, by = c("TOWNNAME" = "district")) %>% left_join(taipei_zipcode, by= c("TOWNNAME" = "district")) %>% ggplot() + aes(fill = income) + geom_sf() + scale_fill_gradient2(low = "#FF8888", high = "#0000AA", midpoint = median(taipei_income$income)) + geom_text(aes(x = lng, y = lat, label = TOWNNAME), family = "Heiti TC Light", color = "black", size = 2.5) ## Reading layer `TOWN_MOI_1100415' from data source ## `/Users/jirlong/Library/CloudStorage/Dropbox/Programming/JOUR5014/data/shapefiles/TOWN_MOI_1100415.shp' ## using driver `ESRI Shapefile' ## Simple feature collection with 368 features and 7 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 114.3593 ymin: 10.37135 xmax: 124.5611 ymax: 26.38528 ## Geodetic CRS: TWD97 29.4 Voting map - County level 本練習將以2016年總統選舉為例，比較朱立倫、宋楚瑜、蔡英文在不同縣市的得票率，並繪製為地圖。該地圖比較有趣的是，因為台灣的地圖實際上是由很多點連成的，在這麼大的規模如果把全部的點全部繪製上去，會繪製非常久，而讀者也不盡然能夠看清楚這個差別，所以可以降低點的數量。 29.4.1 Loading county-level president voting rate president_vote <- readxl::read_xlsx('data/president.xlsx') %>% mutate(total = chu + tsai + song) %>% mutate(chu_ratio = chu / total, tsai_ratio = tsai / total, song_ratio = song / total, tsai_chu_ratio = tsai / chu) 29.4.2 sf to load county level shp https://fidanalytics.co.uk/blog/simplifying-polygons-r county_sf <- st_read("data/shapefiles/COUNTY_MOI_1090820.shp") ## Reading layer `COUNTY_MOI_1090820' from data source ## `/Users/jirlong/Library/CloudStorage/Dropbox/Programming/JOUR5014/data/shapefiles/COUNTY_MOI_1090820.shp' ## using driver `ESRI Shapefile' ## Simple feature collection with 22 features and 4 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 114.3593 ymin: 10.37135 xmax: 124.5611 ymax: 26.38528 ## Geodetic CRS: TWD97 # plot(county_sf) # Taking very long time 29.4.3 Simplfying map polygon county_ms_simp <- st_read("data/shapefiles/COUNTY_MOI_1090820.shp") %>% # rmapshaper::ms_simplify(county_sf, keep=0.001) st_simplify(dTolerance = 100) ## Reading layer `COUNTY_MOI_1090820' from data source ## `/Users/jirlong/Library/CloudStorage/Dropbox/Programming/JOUR5014/data/shapefiles/COUNTY_MOI_1090820.shp' ## using driver `ESRI Shapefile' ## Simple feature collection with 22 features and 4 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 114.3593 ymin: 10.37135 xmax: 124.5611 ymax: 26.38528 ## Geodetic CRS: TWD97 plot(county_ms_simp) # install.packages("rmapshaper") plot_chu <- st_read("data/shapefiles/COUNTY_MOI_1090820.shp") %>% # st_transform(3825) %>% #3857 st_simplify(dTolerance = 10) %>% # rmapshaper::ms_simplify(keep=0.01) %>% right_join(president_vote, by=c("COUNTYNAME"="county")) ## Reading layer `COUNTY_MOI_1090820' from data source ## `/Users/jirlong/Library/CloudStorage/Dropbox/Programming/JOUR5014/data/shapefiles/COUNTY_MOI_1090820.shp' ## using driver `ESRI Shapefile' ## Simple feature collection with 22 features and 4 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 114.3593 ymin: 10.37135 xmax: 124.5611 ymax: 26.38528 ## Geodetic CRS: TWD97 plot_chu %>% ggplot(aes(fill = chu_ratio)) + geom_sf(color="white", size=0.2) + scale_fill_gradient(low = "#FFFFFF", high = "#0000FF") 29.4.4 Practice. Drawing Taiwan county-scale map from SEGIS data 這個練習希望你從SEGIS下載一個縣市層級的資料，並測試以下函式的結果： 運用st_transform()和st_set_crs()等函式測試用3826或4326座標系有何不同？ 在用st_area()計算面積時會不會有何不同？ 在視覺化的時候可否看出來有何不同？請寫程式測試看看。 st_simplify()這個函式可以降低點的數量，但運用st_simplify(dTolerance = 100)，dTolerance的設定是如何影響點的數量？100所指的是什麼？公尺嗎？ 用st_bbox()可以得知上下界為何，請試用這個函式看看？ 如何運用st_crop()切出台灣本島（不包含澎湖、金門、馬祖）得地圖？ 29.5 Mapping data with grid library(sf) 29.5.1 Loading Taiwan map TW.island <- st_read("data/shapefiles/COUNTY_MOI_1090820.shp") %>% st_transform(3826) %>% mutate(id = row_number()) ## Reading layer `COUNTY_MOI_1090820' from data source ## `/Users/jirlong/Library/CloudStorage/Dropbox/Programming/JOUR5014/data/shapefiles/COUNTY_MOI_1090820.shp' ## using driver `ESRI Shapefile' ## Simple feature collection with 22 features and 4 fields ## Geometry type: MULTIPOLYGON ## Dimension: XY ## Bounding box: xmin: 114.3593 ymin: 10.37135 xmax: 124.5611 ymax: 26.38528 ## Geodetic CRS: TWD97 29.5.2 Building grid # Defining grid size grid.extent <- matrix(c(-50000, 2920000, # (Xmin, Ymax) 610000, 2920000, # (Xmax, Ymax) 610000, 2420000, # (Xmax, Ymin) -50000, 2420000, # (Xmin, Ymin) -50000, 2920000), # (Xmin, Ymax) byrow = TRUE, ncol = 2) %>% list() %>% # convert to list for st_polygon() st_polygon() %>% # generate polygon st_sfc(crs = 3826) # convert format and crs # plot(grid.extent) # Generating grid Grid.sys <- st_make_grid(grid.extent, n = c(132, 100), # Resolution of grids crs = 3826, # crs: TWD97 121 what = 'polygons') %>% # output format: polygon st_sf('geometry' = ., data.frame('ID' = 1:length(.))) # convert to sf with id # st_transform(3826) # assigning crs again ? plot(Grid.sys) Grid.TW <- Grid.sys[subset(TW.island),] plot(Grid.TW) 29.5.3 loading data president_vote <- readxl::read_xlsx('data/president.xlsx') %>% mutate(total = chu + tsai + song) %>% mutate(chu_ratio = chu / total, tsai_ratio = tsai / total, song_ratio = song / total, tsai_chu_ratio = tsai / chu) 29.5.4 Merging data tw_info <- TW.island %>% st_set_geometry(NULL) %>% left_join(president_vote, by=c("COUNTYNAME"="county")) # TW_info <- sf::st_intersects(Grid.TW, TW.island) # creat a data.frame of IDs in IBA for 1km grid grid_id <- sapply(st_intersects(Grid.TW, TW.island), function(z) if (length(z)==0) NA_integer_ else z[1]) Grid.TW <- Grid.TW %>% mutate(grid_id = grid_id) %>% left_join(tw_info, by=c("grid_id"="id")) Grid.TW %>% ggplot(aes(fill = tsai_ratio)) + geom_sf(lwd = 0.1, color="black") + scale_fill_continuous(high="#2EFF71", low="blue") + theme_void() "],["network-vis.html", "Chapter 30 NETWORK VIS 30.1 Generating networks 30.2 Retrieve Top3 Components 30.3 Motif visualization and analysis", " Chapter 30 NETWORK VIS 網絡視覺化其實已經有非常好的簡介和指南。但在此補充一些常用的網絡視覺化參數 library(igraph) 30.1 Generating networks 30.1.1 Random network g <- barabasi.game(500, directed = T) message("\\n(V, E, Reciprocity, nComponent)\\n", length(V(g)), "\\t", length(E(g)), "\\t", sprintf("%.3f\\t", reciprocity(g)), count_components(g, mode = "weak") ) l <- layout.fruchterman.reingold(g) # l <- layout_with_kk(g) # l <- layout_in_circle(g) par(mar = c(0,0,0,0) + 0.1) plot(g, layout = l, vertex.color = rgb(1, 1, 0, 0.2), # vertex.color = factor(V(g)$blocked), vertex.size = 3, # vertex.size = sqrt(V(g)$degree)*3, vertex.frame.color= rgb(0, 0, 0, 0.5), # vertex.label = V(g)$display, # vertex.label = str_sub(V(g)$name, 1, 10), vertex.label.cex = 0.6, vertex.label.color = rgb(0, 0, 0, 0.7), vertex.label.family = 'Heiti TC Light', edge.curved = 0.1, edge.arrow.size = 0.1, # edge.width = sqrt(E(g)$weight), # edge.color = E(g)$year, # edge.color = E(g)$weight, edge.color = "#4169E1", # edge.color = E(g)$color, # edge.label = E(g)$weight, # edge.label = E(g)$year, edge.label.cex = 0.4, edge.label.color = rgb(1, 0, 0) ) 30.1.2 Random network rg <- sample_gnm(length(V(g)), length(E(g)), directed=T) message("\\n(V, E, Reciprocity, nComponent)\\n", length(V(rg)), "\\t", length(E(rg)), "\\t", sprintf("%.3f\\t", reciprocity(rg)), count_components(rg, mode = "weak") ) l <- layout.fruchterman.reingold(rg) par(mar = c(0,0,0,0) + 0.1) plot(rg, layout = l, vertex.color = rgb(1, 1, 0, 0.2), vertex.size = 3, vertex.frame.color= rgb(0, 0, 0, 0.5), vertex.label.cex = 0.6, vertex.label.color = rgb(0, 0, 0, 0.7), vertex.label.family = 'Heiti TC Light', edge.curved = 0.1, edge.arrow.size = 0.1, edge.color = "#4169E1", edge.label.cex = 0.4, edge.label.color = rgb(1, 0, 0) ) 30.2 Retrieve Top3 Components components <- igraph::clusters(rg, mode="weak") biggest_cluster_id <- which.max(components$csize) # which.max(components$csize) # components$csize # biggest_cluster_id top3_break <- sort(unique(components$csize), decreasing = T)[3] biggest_cluster_id <- which(components$csize >= top3_break) vert_ids <- V(rg)[components$membership %in% biggest_cluster_id] rg <- igraph::induced_subgraph(rg, vert_ids) message("\\n(V, E, Reciprocity, nComponent)\\n", length(V(rg)), "\\t", length(E(rg)), "\\t", sprintf("%.3f", reciprocity(rg)) ) 30.2.1 Visualize again l <- layout.fruchterman.reingold(rg) par(mar = c(0,0,0,0) + 0.1) plot(rg, layout = l, vertex.color = rgb(1, 1, 0, 0.2), vertex.size = 3, vertex.frame.color= rgb(0, 0, 0, 0.5), vertex.label.cex = 0.6, vertex.label.color = rgb(0, 0, 0, 0.7), vertex.label.family = 'Heiti TC Light', edge.curved = 0.1, edge.arrow.size = 0.1, edge.color = "#4169E1", edge.label.cex = 0.4, edge.label.color = rgb(1, 0, 0) ) 30.3 Motif visualization and analysis 30.3.1 Motif type library(igraph) par(mfrow=c(4,4), mai= rep(0.2, 4)) for(i in 0:15){ g1 <- graph_from_isomorphism_class(3, i) plot(g1, vertex.color = "gold", vertex.size = 20, # vertex.size = (V(g)$nTweets)^(1/3)+1, vertex.frame.color= "black", vertex.label = NA, edge.color = "black", edge.arrow.size = 0.5) title(i, line=-3, adj=0.4 ,col.main="royalblue") } 30.3.2 Motif analysis 30.3.2.1 Generate network res <- motifs(g, 3) res ## [1] NA NA 4085 NA 419 0 0 0 0 0 0 0 0 0 0 ## [16] 0 writeLines(as.character(res), sep = "\\t") ## NA NA 4085 NA 419 0 0 0 0 0 0 0 0 0 0 0 30.3.3 Generate motives barabas_motif <- function(e){ g <- barabasi.game(e, directed = T) vec <- motifs(g, 3) %>% replace_na(0) for(i in 1:99){ g <- barabasi.game(e, directed = T) tmp <- motifs(g, 3) %>% replace_na(0) vec <- vec + tmp } vec <- vec / 100 writeLines(as.character(vec), sep = "\\t") } random_net_motif <- function(v, e){ g <- sample_gnm(v, e, directed=T) vec <- motifs(g, 3) %>% replace_na(0) for(i in 1:99){ g <- sample_gnm(v, e, directed=T) tmp <- motifs(g, 3) %>% replace_na(0) vec <- vec + tmp } vec <- vec / 100 writeLines(as.character(vec), sep = "\\t") } random_net_motif(length(V(g)), length(E(g))) ## 0 0 245.78 0 490.12 0.87 247.04 0.77 0 0.78 0 0.36 0.01 0 0 0 barabas_motif(length(E(g))) ## 0 0 2517.01 0 459.54 0 0 0 0 0 0 0 0 0 0 0 "],["interactivity.html", "Chapter 31 Interactivity 31.1 ggplotly 31.2 產製圖表動畫", " Chapter 31 Interactivity 31.1 ggplotly Scatter plots with ggplot2 (plotly.com) 31.1.1 LINE CHART Line plots with R (plotly.com) NW <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(Category, year, Net_Worth) %>% group_by(Category) %>% arrange(year) %>% ungroup() 如果希望滑鼠在移到折線上時就會有浮出的資訊（tips）顯示該資料點的屬性特徵，可以採用plotly()這個套件。這個套件原本就是做線上互動圖表的，但他開發了R client讓R的使用者可以很輕易地把ggplot2的結果轉為互動圖表。但這所謂的互動也僅限於滑鼠移過去所浮出的資訊罷了，不過已經能夠達到吸引部分讀者目光、提供訊息的效果。 而plotly的設計非常簡單，就是把ggplot的結果指給一個變數後，然後用ggplotly(NW.plot)將其轉為plotly即可。但要注意的是，並不是每一個圖都可以順利轉換。例如本節最後一個例子Treemap便無法成功轉換。 設定：原本plotly會帶一個操控列，可以在ggplotly()指令後加入config()便可將其隱藏。 NW.plot <- NW %>% ggplot() + aes(year, Net_Worth, color=Category) + geom_line() + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", x = "Year", y = "Net Worth") + th library(plotly) ggplotly(NW.plot) %>% config(displayModeBar = FALSE) 可以在aes()設定要帶入圖的變數時，新增一個text變數，手動設定要呈現的動態呈現方塊。但要注意的是，要多加入一個group=1才能夠作用（WHY？）。但前例浮出視窗的原始內容所顯示的是原本的變數名稱和值，往往不易觀察。比較好的方式是在下ggplot() + aes()指令時，在aes()中指定text來作為後續浮出視窗內容。指定方法如下。要注意的是，該浮出視窗的語法是HTML，所以如果要改寫浮出視窗內容，要用paste0()將變數和HTML的標籤給銜接起來。以下例子中的<b>代表粗體的意思，<br>則是換行符號。 NW.plot <- NW %>% ggplot() + aes(year, Net_Worth, color=Category, text = paste0("<b>年(X): </b>", year, "<br>", "<b>淨資產(Y): </b>", Net_Worth,"<br>", "<b>年齡組: </b>", Category), group=1) + geom_line() + theme_minimal() + labs(title = "Net Worth by year grouped by age groups", x = "Year", y = "Net Worth") + th ggplotly(NW.plot, tooltip = "text") %>% config(displayModeBar = FALSE) 其他例子中使用ggplotly()都是直接照前面的方法套用即可。唯獨在Treemap中無法用這樣的方法來做互動的視覺化。想想這也正常，畢竟Treemap是用非ggplot的第三方套件（library(treemapify)）。 除此之外，可以把R Markdown中Code Cell的的設定加入include=FALSE，這樣可以讓RMD在編製為HTML檔時，不要顯示程式碼，而直接顯示互動的視覺化介面。 31.1.2 SCATTER bw <- read_csv("data/unicef-changing-childhood-data.csv") %>% select(country = WP5, age = WP22140, bw = WP22092) %>% mutate(country = ordered(country, levels=c(1, 3, 4, 10, 11, 12, 13, 14, 17, 29, 31, 33, 35, 36, 60, 61, 77, 79, 81, 87, 165), labels=c("USA", "Morocco", "Lebanon", "Indonesia","Bangladesh", "UK", "France", "Germany", "Spain", "Japan", "India", "Brazil", "Nigeria", "Kenya", "Ethiopia", "Mali", "Ukraine", "Cameroon", "Zimbabwe","Argentina", "Peru"))) %>% count(country, age, bw) %>% group_by(country, age) %>% mutate(perc = n/sum(n)) %>% ungroup() %>% filter(bw == 1) %>% select(country, age, perc) %>% spread(age, perc) %>% rename(`15-24y` = `1`, `40+y` = `2`) bw.p <- bw %>% ggplot() + aes(`40+y`, `15-24y`, label = country) + geom_point(color = "skyblue", size = 2) + xlim(0.2, 0.85) + ylim(0.2, 0.85) + geom_text(hjust = -0.1, vjust = -0.5) + geom_abline(intercept = 0, slop = 1, color="lightgrey", alpha=0.5, linetype="dashed") + th + theme(aspect.ratio=1) bw.p %>% ggplotly() 31.1.3 Barplot Bar charts with R (plotly.com) county <- read_csv("data/tw_population_opendata110N010.csv") %>% slice(-1, -(370:375)) %>% type_convert() %>% mutate(county = str_sub(site_id, 1, 3)) %>% group_by(county) %>% summarize( area = sum(area), people_total = sum(people_total) ) %>% ungroup() population.p <- county %>% mutate(county = reorder(county, people_total)) %>% ggplot() + aes(county, people_total) %>% geom_col(fill="skyblue") + coord_flip() + th population.p %>% ggplotly() 31.1.4 Boxplot Box plots with ggplot2 (plotly.com) aqi.toplot <- read_rds("https://github.com/p4css/R4CSS/raw/master/data/AQI_Chaozhou.rds") %>% arrange(日期)%>% filter(測項=="PM2.5") %>% gather("hour", "PM25", 4:28) %>% mutate(PM25 = as.numeric(PM25)) %>% drop_na() %>% mutate(year = lubridate::year(日期), month = lubridate::month(日期)) %>% filter(month %in% c(11, 12, 1, 2, 3)) aqi.plot <- aqi.toplot %>% mutate(year = as.character(year)) %>% ggplot() + aes(x=year, y=PM25) + geom_boxplot(fill="skyblue", alpha=0.2) + ylim(0, 200) + coord_flip() + theme_minimal() aqi.plot %>% ggplotly 31.1.5 Treemap (Global Carbon) 其他例子中使用ggplotly()都是直接照前面的方法套用即可。唯獨在Treemap中無法用這樣的方法來做互動的視覺化。想想這也正常，畢竟Treemap是用非ggplot的第三方套件（library(treemapify)）。 totreemap <- read_csv("data/GCB2021v34_MtCO2_flat.csv") %>% drop_na(`Total`) %>% filter(!Country %in% c("Global", "International Transport")) %>% filter(Year==2020) %>% arrange(desc(`Total`)) %>% mutate(perc = Total/sum(Total)) %>% slice(1:20) library(treemapify) carbon.p <- totreemap %>% ggplot() + aes(area = perc, fill=`Per Capita`, label=Country) + geom_treemap() + geom_treemap_text(color="white", place="centre", grow=TRUE ) # carbon.p %>% ggplotly 31.2 產製圖表動畫 https://gist.github.com/rafapereirabr/0d68f7ccfc3af1680c4c8353cf9ab345 R也有套工具可以產製圖表動畫，概念上就是沿著一條資料維度，把多張圖給疊在一起變成一個gif動畫。本例子即是把產假之薪的範例沿著時間軸做動畫。每個時間點都是當年各國產假支薪給付程度的地圖，但由於有19年的資料，所以可以把年代當成動畫的時間軸。 以下是清理資料的步驟，會彙整出國名、國家代碼（ISO3）、年、和給付等級四個變項。預期利用國名、國家代碼和給付等級就可以畫出每年的圖。然後將年作為動畫的時間軸，便可產生地圖動畫。 pml <- read_excel("data/WORLD-MACHE_Gender_6.8.15.xls", "Sheet1", col_names=T) %>% select(country, iso3, contains("matleave"), -contains("wrr")) %>% gather("year", "degree", 3:21) %>% replace_na(list(degree=0)) %>% mutate(year2=as.POSIXct(strptime(year, "matleave_%y"))) %>% mutate(year3 = strftime(year2, "%Y")) %>% select(country, ISO3=iso3, year=year3, degree) 31.2.1 地圖下載與轉換投影方法 此為下載地圖並處理地圖成為可以用geom_polygom()繪圖的多邊形資料點。 library(rworldmap) wmap <- getMap(resolution="low") wmap <- spTransform(wmap, CRS("+proj=robin")) # reproject wmap <- fortify(wmap) wmap %>% filter(!duplicated(id)) %>% head(10) ## long lat order hole piece id ## 1 -6558139.1 1331765.9 1 FALSE 1 Aruba ## 2 6607120.5 3981587.8 1 FALSE 1 Afghanistan ## 3 1357824.3 -630231.6 1 FALSE 1 Angola ## 4 -5863722.7 1948851.8 1 FALSE 1 Anguilla ## 5 1723246.7 4546403.9 1 FALSE 1 Albania ## 6 1506389.0 6371182.0 1 FALSE 1 Aland ## 7 146562.7 4541753.0 1 FALSE 1 Andorra ## 8 5174600.6 2734691.9 1 FALSE 1 United Arab Emirates ## 9 -6057672.4 -2363055.4 1 FALSE 1 Argentina ## 10 3911094.7 4398155.0 1 FALSE 1 Armenia ## group ## 1 Aruba.1 ## 2 Afghanistan.1 ## 3 Angola.1 ## 4 Anguilla.1 ## 5 Albania.1 ## 6 Aland.1 ## 7 Andorra.1 ## 8 United Arab Emirates.1 ## 9 Argentina.1 ## 10 Armenia.1 pml_map <- wmap %>% left_join(pml, by=c("id"="country")) %>% filter(!is.na(ISO3)) %>% mutate(year = as.integer(year)) # devtools::install_github("thomasp85/transformr") pml_map %>% select(id) %>% filter(!duplicated(.)) %>% head(10) ## id ## 1 Afghanistan ## 2 Angola ## 3 Albania ## 4 Andorra ## 5 United Arab Emirates ## 6 Argentina ## 7 Armenia ## 8 Antigua and Barbuda ## 9 Australia ## 10 Austria 31.2.2 靜態繪圖測試 pml_map %>% filter(year==1995) %>% ggplot() + aes(x = long, y = lat, group=group, fill=factor(degree)) + geom_polygon(color="grey") + theme_void() + scale_fill_manual(values=c("1"="red", "2"="LightCyan", "3"="lightskyblue", "4"="DodgerBlue", "5"="MediumBlue")) + coord_cartesian(xlim = c(-11807982, 14807978)) 在採用gganimate繪圖時，僅需要多加一個動畫繪圖函式+ transition_time(year)即可，其他繪圖部分並無修改。最後才用animate()函式把這整個繪圖指令轉製為動畫，包含指定fps（frame per second）和長寬等參數。 library(gganimate) pml.ani <- pml_map %>% ggplot() + aes(x = long, y = lat, group=group, fill=factor(degree)) + geom_polygon(color="grey") + theme_void() + scale_fill_manual(values=c("1"="red", "2"="LightCyan", "3"="lightskyblue", "4"="DodgerBlue", "5"="MediumBlue")) + coord_cartesian(xlim = c(-11807982, 14807978)) + transition_time(year) # + # ease_aes("linear") + # enter_fade() + # exit_fade() animate(pml.ani, fps = 10, end_pause = 30, width = 750, height = 450, renderer = gifski_renderer()) anim_save("jour5014/pml2.gif", animation = last_animation()) knitr::include_graphics("jour5014/pml2.gif") "],["wgoitg.html", "Chapter 32 WGOITG of NyTimes", " Chapter 32 WGOITG of NyTimes 紐約時報提供的what’s going on in the graph 系列教學旨在幫助讀者更好地理解和解讀圖表，特別是在時事和政治等敏感領域中的圖表。這些教學以實際的新聞圖表為例，介紹了如何分析和評估圖表的質量、有效性和可靠性，並提供了一些技巧和策略，幫助讀者從圖表中獲取準確和全面的資訊。 具體來說，what’s going on in the graph系列教學的目的包括以下幾點： 提高讀者對圖表的識讀能力和分析能力，讓讀者能夠更加自信和準確地理解和評估圖表。 幫助讀者識別和處理常見的資訊偏差和誤導，如選擇性展示數據、扭曲比例、誤導標籤等。 強調圖表應該為讀者服務，而不是為了強調某個立場或觀點而有意歪曲事實。 提供了一些有效的技巧和策略，如注意圖表的標題、軸標籤和單位、比較數據的趨勢和範圍、理解圖表的背景和上下文等。 "],["inequality-net-worth-by-age-group.html", "Chapter 33 Inequality: Net Worth by Age Group", " Chapter 33 Inequality: Net Worth by Age Group LEARNING NOTES 座標軸從數值到增加值 這個教學案例來自紐約時報的「What’s going on in this gragh」系列資料視覺化教學之Teach About Inequality With These 28 New York Times Graphs - The New York Times (nytimes.com) 。該圖表呈現在不同年代、不同年齡層的人所擁有的淨資產（包含土地、存款、投資等減去債務）。該圖表的結果指出，在不同年代的老年人是越來越有錢，但年輕人卻越來越窮（該曲線為減去1989年 淨資產（Net worth）是一個財務術語，指的是一個人或機構的總資產減去總負債後剩餘的價值。換言之，Net worth是一個人或機構在財務上的價值或實力。如果一個人或機構的總資產超過了總負債，那麼其net worth為正值，反之則為負值。在個人財務上，Net worth通常用來評估一個人的財務健康狀況。一個人的Net worth越高，通常代表其擁有更多的財富和投資，並能夠更好地應對突發事件和生活變數。因此，許多投資者和財務顧問都會建議人們注重提高自己的net worth。 Sorted by arrange() function. p1 <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(year, Category, Net_Worth) %>% group_by(Category) %>% arrange(year) %>% ungroup() p1 %>% filter(year <= 1992) %>% knitr::kable() year Category Net_Worth 1989 Less than 35 16.17019 1989 35-44 112.47530 1989 45-54 195.11630 1989 55-64 195.25554 1989 65-74 154.34277 1989 75 or older 144.29855 1992 Less than 35 16.60780 1992 35-44 79.91050 1992 45-54 139.97745 1992 55-64 203.44104 1992 65-74 176.44667 1992 75 or older 155.35173 library(gghighlight) p1 %>% ggplot() + aes(year, Net_Worth, color = Category) + geom_line(linetype="dotted") + geom_point() + gghighlight(Category %in% c("65-74", "35-44")) + theme_minimal() + scale_x_continuous(breaks = NULL) + theme(panel.background = element_rect(fill = "white", colour = "white", size = 0.5, linetype = "solid")) p2 <- read_csv("data/interactive_bulletin_charts_agecl_median.csv") %>% select(year, Category, NW = Net_Worth) %>% group_by(Category) %>% arrange(year) %>% mutate(increase = (NW-first(NW))/first(NW)) %>% ungroup() p2 %>% filter(year <= 1992) %>% knitr::kable() year Category NW increase 1989 Less than 35 16.17019 0.0000000 1989 35-44 112.47530 0.0000000 1989 45-54 195.11630 0.0000000 1989 55-64 195.25554 0.0000000 1989 65-74 154.34277 0.0000000 1989 75 or older 144.29855 0.0000000 1992 Less than 35 16.60780 0.0270627 1992 35-44 79.91050 -0.2895285 1992 45-54 139.97745 -0.2825948 1992 55-64 203.44104 0.0419220 1992 65-74 176.44667 0.1432131 1992 75 or older 155.35173 0.0765994 p2 %>% ggplot() + aes(year, increase, color = Category) + geom_line(linetype="dotted") + geom_point() + gghighlight(Category %in% c("65-74", "35-44")) + theme_minimal() + scale_y_continuous(labels=scales::parse_format()) + scale_x_continuous(breaks = NULL) + theme(panel.background = element_rect(fill = "white", colour = "white", size = 0.5, linetype = "solid")) "],["optimism-survey-by-countries.html", "Chapter 34 Optimism Survey by Countries", " Chapter 34 Optimism Survey by Countries 這個練習為紐約時報的一則報導「Where Are Young People Most Optimistic? In Poorer Nations. - The New York Times (nytimes.com)」。該報導乃根據一項涵蓋 21 個國家的大型調查，這項調查比較了不同國家和年齡層（年輕人對成年人）對於下一代的生活是否會比現在更好的看法。該調查還比較了不同國家（富裕與貧窮）和年齡層（年輕人對成年人）對於當今兒童在基本方面的狀況，以及對於社會和環境問題的看法。此外，調查還比較了不同國家和年齡層對於現代科技對年輕人生活的影響看法，以及對於焦慮和壓力等方面的看法。 聯合國兒童基金會與 Gallup 共同進行了這項調查，該調查共有 21,000 名受訪者，分為兩個年齡組別——15 至 24 歲和 40 歲以上，並包括來自世界各地的代表性樣本。年輕組表示，當今兒童在教育、醫療保健和身體安全等基本方面都比他們的父母更好。在中位數國家中，有 57％ 的年輕人表示，隨著每一代的到來，世界正在變得越來越美好，而這一比例在老年人中僅有 39％。然而，在富裕國家，56％ 的年輕人和 64％ 的老年人表示，當今兒童在經濟方面將比他們的父母更加困難——這種觀點與近年來許多人的經濟現實相符。 視覺化的重點是等比例之座標軸的運用 plot.opt <- read_csv("data/unicef-changing-childhood-data.csv") %>% select(country = WP5, age = WP22140, bw = WP22092) %>% mutate(country = ordered(country, levels=c(1, 3, 4, 10, 11, 12, 13, 14, 17, 29, 31, 33, 35, 36, 60, 61, 77, 79, 81, 87, 165), labels=c("USA", "Morocco", "Lebanon", "Indonesia", "Bangladesh", "UK", "France", "Germany", "Spain", "Japan", "India", "Brazil", "Nigeria", "Kenya", "Ethiopia", "Mali", "Ukraine", "Cameroon", "Zimbabwe", "Argentina", "Peru"))) %>% count(country, age, bw) %>% group_by(country, age) %>% mutate(perc = n/sum(n)) %>% ungroup() %>% filter(bw == 1) %>% select(country, age, perc) %>% spread(age, perc) %>% rename(`15-24y` = `1`, `40+y` = `2`) plot.opt %>% head(10) %>% knitr::kable() country 15-24y 40+y USA 0.6679842 0.4611465 Morocco 0.4365079 0.4735812 Lebanon 0.5467197 0.4435798 Indonesia 0.7920605 0.8027344 Bangladesh 0.4624506 0.4319527 UK 0.5040000 0.4140000 France 0.3900000 0.2640000 Germany 0.5900000 0.3860000 Spain 0.5160000 0.3340000 Japan 0.6367265 0.2586873 plot.opt %>% ggplot() + aes(`40+y`, `15-24y`, label = country) + geom_point(color = "skyblue", size = 2) + xlim(0, 1) + ylim(0,1) + geom_text(hjust = -0.1, vjust = -0.5) + geom_abline(intercept = 0, slop = 1, color="lightgrey", alpha=0.5, linetype="dashed") + theme_minimal() + theme(aspect.ratio=1) "],["taiwan.html", "Chapter 35 Case Studies (Taiwan) 35.1 TW AQI Visual Studies", " Chapter 35 Case Studies (Taiwan) 35.1 TW AQI Visual Studies library(tidyverse) ## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ── ## ✔ dplyr 1.1.4 ✔ readr 2.1.5 ## ✔ forcats 1.0.0 ✔ stringr 1.5.1 ## ✔ ggplot2 3.5.0 ✔ tibble 3.2.1 ## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1 ## ✔ purrr 1.0.2 ## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ── ## ✖ dplyr::filter() masks stats::filter() ## ✖ dplyr::lag() masks stats::lag() ## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors library(readxl) # options(stringsAsFactors = F) 35.1.1 eda-load-data-from-github # aqi_data <- read_rds("https://github.com/p4css/R4CSS/raw/master/data/AQI_Chaozhou.rds") aqi_data <- read_rds("data/AQI_Chaozhou.rds") 35.1.2 Trending: Central tendency toplot <- aqi_data %>% arrange(日期)%>% filter(測項=="PM2.5") %>% gather("hour", "PM25", 4:28) %>% mutate(PM25 = as.numeric(PM25)) %>% drop_na() %>% group_by(日期) %>% summarize(avg = mean(PM25)) %>% ungroup() %>% mutate(year = lubridate::year(日期), month = lubridate::month(日期)) %>% group_by(year, month) %>% summarize(avg = mean(avg)) %>% ungroup() ## Warning: There was 1 warning in `mutate()`. ## ℹ In argument: `PM25 = as.numeric(PM25)`. ## Caused by warning: ## ! NAs introduced by coercion ## `summarise()` has grouped output by 'year'. You can override using the ## `.groups` argument. Counting data by month and plotting to ensure the degree of data loss. aqi_data %>% filter(測項=="PM2.5") %>% arrange(日期)%>% gather("hour", "PM25", 4:28) %>% mutate(PM25 = as.numeric(PM25)) %>% drop_na() %>% group_by(日期) %>% summarize(avg = mean(PM25)) %>% ungroup() %>% arrange(日期) %>% mutate(year = lubridate::year(日期), month = lubridate::month(日期)) %>% count(year, month) %>% mutate(rn = row_number()) %>% ggplot() + aes(rn, n) + geom_line() + theme_minimal() ## Warning: There was 1 warning in `mutate()`. ## ℹ In argument: `PM25 = as.numeric(PM25)`. ## Caused by warning: ## ! NAs introduced by coercion 科普小學堂-空氣中的懸浮粒子 台灣PM2.5三大面向：空汙現況多嚴重？要怪中國還是怪自己？ - 第 1 頁 - The News Lens 關鍵評論網 library(gghighlight) toplot %>% mutate(month = as.character(month)) %>% group_by(month) %>% arrange(year) %>% # mutate(diff = avg -first(avg), # month = as.character(month)) %>% # ungroup() %>% ggplot() + aes(year, avg, color = month) + geom_line() + # geom_point() + gghighlight(month %in% c("11", "12", "1", "2", "3")) + theme_minimal() ## Warning: Tried to calculate with group_by(), but the calculation failed. ## Falling back to ungrouped filter operation... ## label_key: month 35.1.3 Trending: Extreme value toplot2 <- aqi_data %>% arrange(日期)%>% filter(測項=="PM2.5") %>% gather("hour", "PM25", 4:28) %>% mutate(PM25 = as.numeric(PM25)) %>% drop_na() %>% group_by(日期) %>% summarize(avg = sum(PM25)/24) %>% ungroup() %>% mutate(year = lubridate::year(日期), month = lubridate::month(日期)) %>% group_by(year, month) %>% summarize(purple = sum(avg>150), red = sum(avg>54), orange = sum(avg>35)) %>% ungroup() ## Warning: There was 1 warning in `mutate()`. ## ℹ In argument: `PM25 = as.numeric(PM25)`. ## Caused by warning: ## ! NAs introduced by coercion ## `summarise()` has grouped output by 'year'. You can override using the ## `.groups` argument. toplot2 %>% mutate(month = as.character(month)) %>% group_by(month) %>% arrange(year) %>% ggplot() + aes(year, orange, color = month) + geom_line() + # geom_point() + gghighlight(month %in% c("11", "12", "1", "2", "3")) + ylab("Days (PM25 > 35) in one month") + theme_minimal() ## Warning: Tried to calculate with group_by(), but the calculation failed. ## Falling back to ungrouped filter operation... ## label_key: month toplot3 <- aqi_data %>% arrange(日期)%>% filter(測項=="PM2.5") %>% gather("hour", "PM25", 4:28) %>% mutate(PM25 = as.numeric(PM25)) %>% drop_na() %>% mutate(year = lubridate::year(日期), month = lubridate::month(日期)) %>% filter(month %in% c(11, 12, 1, 2, 3)) ## Warning: There was 1 warning in `mutate()`. ## ℹ In argument: `PM25 = as.numeric(PM25)`. ## Caused by warning: ## ! NAs introduced by coercion toplot3 %>% mutate(year = as.character(year)) %>% ggplot() + aes(y=year, x=PM25) + geom_boxplot(fill="skyblue", alpha=0.2) + xlim(0, 200) + theme_minimal() "],["appendix.html", "Chapter 36 Appendix 36.1 Dataset", " Chapter 36 Appendix 36.1 Dataset 111B歲出政事別預算表.xls - 111B歲出政事別預算總表.xls 臺北市住宅竊盜點位資訊-UTF8-BOM-1.csv opendata107Y020.csv opendata110Y060.csv tptheft.csv tw_income_107.csv tw_population_opendata110N010.csv tw_salary109.xlsx villmast_excel.xls WORLD-MACHE_Gender_6.8.15.xls "],["404.html", "Page not found", " Page not found The page you requested cannot be found (perhaps it was moved or renamed). You may want to try searching to find the page's new location, or use the table of contents to find the page you are looking for. "]] diff --git a/taiwan.html b/taiwan.html index e63737a..b666194 100644 --- a/taiwan.html +++ b/taiwan.html @@ -23,7 +23,7 @@ - + diff --git a/time-trends.html b/time-trends.html index 6e1c5dc..6b1ff35 100644 --- a/time-trends.html +++ b/time-trends.html @@ -23,7 +23,7 @@ - + diff --git a/timeline.html b/timeline.html index 181a259..c53bac5 100644 --- a/timeline.html +++ b/timeline.html @@ -23,7 +23,7 @@ - + @@ -827,8 +827,16 @@

9.2.1 Char-to-Time## [1] "character" 
?strptime
 t1 <- strptime(t, "%Y-%m-%dT%H:%M:%SZ")
-raw %>% glimpse()
-
## function (length = 0L)
+clean %>% head # %>% View +
## # A tibble: 6 × 7
+##   plink                  board pcontent poster ptitle ptime               ipaddr
+##   <chr>                  <chr> <chr>    <chr>  <chr>  <dttm>              <chr> 
+## 1 https://www.ptt.cc/bb… Hate… "\n\n韓… loveb… Re: [… 2019-04-12 02:21:14 83.22…
+## 2 https://www.ptt.cc/bb… Hate… "\n\n\n… ikr36… Re: [… 2019-04-12 02:13:45 114.4…
+## 3 https://www.ptt.cc/bb… Hate… "\n\n正… sunye… Re: [… 2019-04-12 02:10:18 118.1…
+## 4 https://www.ptt.cc/bb… Hate… "\n:\n\… rock7… Re: [… 2019-04-12 02:03:14 118.1…
+## 5 https://www.ptt.cc/bb… Hate… "\n\n我… btm97… Re: [… 2019-04-12 02:01:12 101.1…
+## 6 https://www.ptt.cc/bb… Hate… "\n\n\n… cblade [討論… 2019-04-12 01:55:06 180.2…

9.2.2 Density plot along time

diff --git a/tm.html b/tm.html index b99c8c6..3345221 100644 --- a/tm.html +++ b/tm.html @@ -23,7 +23,7 @@ - + diff --git a/tmchi.html b/tmchi.html index af2f68f..0acbd22 100644 --- a/tmchi.html +++ b/tmchi.html @@ -23,7 +23,7 @@ - + diff --git a/trump.html b/trump.html index 222cff5..17410ee 100644 --- a/trump.html +++ b/trump.html @@ -23,7 +23,7 @@ - + diff --git a/visualization-1.html b/visualization-1.html index 334f55b..b6a0244 100644 --- a/visualization-1.html +++ b/visualization-1.html @@ -23,7 +23,7 @@ - + diff --git a/wgoitg.html b/wgoitg.html index 3420c15..4790b57 100644 --- a/wgoitg.html +++ b/wgoitg.html @@ -23,7 +23,7 @@ - +