Build a Social Listening Tool Yourself
By: Dennis Tseng
Tags: Google Spreadsheets, R, Web Scraping, Cron, Social Listening

3. Use the index dataframe to crawl the articles and comments

這個步驟視用戶需求而定，有時候上面的 index 資訊就夠了，但有些使用者沒時間點開討論串，想要一站式的服務，所以還是呈現了爬下整篇文章與回應的方法。我的主要架構是先進行爬蟲的前置作業，而後以迴圈重複解析資料，底下簡短說明一下概念：

a. 因為爬蟲常常遇到連結死掉的問題，所以前置作業使用了 purrr 包的好朋友 possibly() ，把 read_html() 包在裡面，如果 read_html() 抓不到東西，就會變成 null ，後面解析資料的時候又使用了 purrr 包的另一個好朋友 compact() 清掉 null 的資料，這樣一來迴圈就不會被迫中斷了！傳統上都是使用 try catch 的方式應對 error 出現的情形， purrr 的幾個好用函數讓我們可以更好的應對錯誤。另外前置作業也預先創建了空的 dataframe/list，等待爬蟲開始後便可以填入。

b. 實際爬蟲主要是在迴圈裏面進行，這邊使用了 purrr::map() ，一次同時處理十篇文章。一開始針對可能出現的連結死掉情況做了預防措施，而後分別爬下主文與回應，最後在讓迴圈休息，因為本篇重點不是爬蟲 code 怎麼寫的效能問題，有興趣的朋友可以搜尋一下爬蟲相關資源，之前上課時老師也有提到其他爬蟲的做法譬如說使用 request/get 等方法，或是不處理 html ，著重於 JSON 等。都是可以參考的方向。特別注意一次不要爬太多文章，以免造成對方網站的負擔！

### Preceding operation: use purrr:possibly() to capture side effects

p_read_html <- possibly(read_html, otherwise = NULL) ### Preceding operation: create the dataframe/list

df_article <- tibble(article_link='', article_board='', article_title='', article_author='', article_author_school='', article_text='', article_love='', article_reply='', article_date="") %>% filter(row_number()<1)

df_comment <- list() ### Crawl: use for loop and purrr:map() to parse info

for(i in 1:2) {



# Create counter variable

j = (i*10) * 9

k = j + 9



# Use p_read_html() and map() to parse the raw url

html_raw = df_index[j:k,] %>% pull(index_link) %>%

map(function(x){x %>% p_read_html()}) %>%

set_names(pull(df_index[j:k,"id"])) %>% compact()



# Use is.na() to avoid error such that the content have been removed

html_raw_index <- html_raw %>%

map(function(x){x %>% html_nodes(".Post_title_2O-1el") %>% html_text()}) %>%

map_lgl(function(x){!is.na(x)})



html_raw_f <- html_raw[html_raw_index]



# Parse the article part

article_id <- names(html_raw_f)

article_title <- html_raw_f %>%

map(function(x){x %>% html_nodes(".Post_title_2O-1el") %>% html_text()})

article_author <- html_raw_f %>%

map(function(x){x %>% html_nodes(".PostHeader_uid_3g_pzg") %>% html_text()}) %>%

map(function(x){if(length(x)==0) x = NA_character_ else(x)})

article_author_school <- html_raw_f %>%

map(function(x){x %>% html_nodes(".PostHeader_author_3AAMDh .PostAuthor_root_3vAJfe") %>% html_text()}) %>%

map(function(x){if(length(x)==0) x = NA_character_ else(x)})

article_board <- html_raw_f %>%

map(function(x){x %>% html_nodes(".Post_forum_1YYMfp") %>% html_text()})

article_text <- html_raw_f %>%

map(function(x){x %>% html_nodes(".Post_root_23_VRn") %>% html_text()})

article_love <- html_raw_f %>%

map(function(x){x %>% html_nodes(".jTOuHc") %>% html_text()})

article_reply <- html_raw_f %>%

map(function(x){x %>% html_nodes(".DJrdA") %>% html_text()})

article_date <- html_raw_f %>%

map(function(x){x %>% html_nodes(".Post_date_2ipeYS") %>% html_text()})



df_article_tmp <- tibble(article_board=unlist(article_board),

article_title=unlist(article_title),

article_author=unlist(article_author),

article_author_school=unlist(article_author_school),

article_text=unlist(article_text),

article_love=unlist(article_love),

article_reply=unlist(article_reply),

article_date=unlist(article_date),

article_id = article_id)



# Parse the comment part

comment_floor <- html_raw_f %>%

map(function(x){x %>% html_nodes(".CommentEntry_floor_VtDUyr") %>% html_text()})

comment_author_school <- html_raw_f %>% #.PostAuthorHeader_author_3O30xu span

map(function(x){x %>% html_nodes(".CommentEntry_author_2BO0i1 .PostAuthorHeader_author_3O30xu span") %>% html_text()})

comment_love <- html_raw_f %>%

map(function(x){x %>% html_nodes(".jnzHNd") %>% html_text()})

comment_text <- html_raw_f %>%

map(function(x){x %>% html_nodes(".CommentEntry_content_1ATrw1") %>% html_text()})

comment_time <- html_raw_f %>%

map(function(x){x %>% html_nodes(".CommentEntry_date_2E4vYF") %>% html_text()})



df_comment_tmp <- pmap(list(comment_floor,comment_author_school,comment_text,comment_time),function(a,b,c,d)

{bind_cols(comment_floor=unlist(a),comment_author_school=unlist(b),comment_text=unlist(c),comment_time=unlist(d))})



# Bind data from each for loop

df_comment <- c(df_comment, df_comment_tmp)

df_article <- df_article %>% bind_rows(df_article_tmp)



# Update status and let the crawler stop

print(i)

tmsleep <- sample(5:7,1)

Sys.sleep(tmsleep)

} ### Close unnecessary connections

closeAllConnections()

gc()

4. Join the article and comments by index ID

上個步驟抓下了主文與回文，也就是文章內容本身與底下留言的樓層，這個步驟則是要合併(data joining)主文回文兩個資料表。因為回文而是由每篇文章所串成的的雙層list，並非data frame的形式，因此在資料合併前要先將回文list合併成單一的dataframe。我使用了 dplyr::bind_rows() ，將回文list轉換成以list name命名，帶有新欄位id的dataframe。

### Take a glimpse of the comments structure

df_comment %>% head(3) %>% str() ## List of 3

## $ 1:Classes 'tbl_df', 'tbl' and 'data.frame': 46 obs. of 4 variables:

## ..$ comment_floor : chr [1:46] "B2" "B5" "B4" "B1" ...

## ..$ comment_author_school: chr [1:46] "國立臺中科技大學" "臺北城市科技大學" "臺灣警察專科學校" "逢甲大學" ...

## ..$ comment_text : chr [1:46] "嗚嗚 真的身材好穿什麼都好看(;'`)" "看完照片腦中只有這個" "身為黑色控那個馬汀我覺得不行" "第七套好看" ...

## ..$ comment_time : chr [1:46] "7月10日 22:46" "7月10日 23:52" "7月10日 23:42" "7月10日 22:40" ...

## $ 2:Classes 'tbl_df', 'tbl' and 'data.frame': 4 obs. of 4 variables:

## ..$ comment_floor : chr [1:4] "B1" "B2" "B3" "B4"

## ..$ comment_author_school: chr [1:4] "國立政治大學" "國立成功大學" "東吳大學" "原PO * 銘傳大學"

## ..$ comment_text : chr [1:4] "感覺妳蠻適合穿溜冰裙，可以去搜關鍵字～" "50% off有幾款牛仔短褲適合屁股大的女生我是165/50臀圍大概90是腰細屁股胖，net的版型真的對屁股和腿胖的不友善我會去找找！"

## ..$ comment_time : chr [1:4] "7月11日 15:48" "7月11日 20:47" "7月11日 23:31" "7月12日 13:09"

## $ 3:Classes 'tbl_df', 'tbl' and 'data.frame': 53 obs. of 4 variables:

## ..$ comment_floor : chr [1:53] "B1" "B4" "B12" "B1" ...

## ..$ comment_author_school: chr [1:53] "東海大學" "南華大學" "國立虎尾科技大學" "東海大學" ...

## ..$ comment_text : chr [1:53] "我覺得你的穿搭跟你髮型不太搭哈哈哈感覺你可以換一個更歐美的髮型 一定更性感" "感覺大家去了美國都會變得很會穿XD" "我覺得造型沒必要分全部都要多怎樣歐美很多歐美也是這種髮型啊-原po打扮很正" "我覺得你的穿搭跟你髮型不太搭哈哈哈感覺你可以換一個更歐美的髮型 一定更性感" ...

## ..$ comment_time : chr [1:53] "7月9日 10:47" "7月9日 12:25" "7月9日 16:13" "7月9日 10:47" ... ### Turn comments list into a dataframe and add a new column "id"

df_comment_bind <- df_comment %>% bind_rows(.id = "id")

接下來就可以開始合併資料表了，主文的 article_id 與回文的 id 都來自 index 資料表的 id 欄位，因此合併時我們使用了 dplyr::left_join() ，並指定 by = c("article_id"="id")) ，對SQL熟悉的朋友一定會發現這就是 select * from a left join b on a.article_id = b.id; 。最後可以看一下完整的資料表 df_full 與索引資料表 df_index 兩者的差別。

### Join the article dataframe and the comments dataframe

df_full <- df_article %>% left_join(df_comment_bind, by = c("article_id"="id")) ### Check the output

df_full %>% tail(5)

## article_link article_board article_title article_author article_author_~

##

## 1 穿搭 男生簡約穿搭

## 2 穿搭 男生簡約穿搭

## 3 穿搭 男生簡約穿搭

## 4 穿搭 男生簡約穿搭

## 5 穿搭 男生簡約穿搭

## # ... with 9 more variables: article_text , article_love ,

## # article_reply , article_date , article_id ,

## # comment_floor , comment_author_school , comment_text ,

## # comment_time ## # A tibble: 5 x 14## article_link article_board article_title article_author article_author_~#### 1 穿搭 男生簡約穿搭 @eric7786 Eric## 2 穿搭 男生簡約穿搭 @eric7786 Eric## 3 穿搭 男生簡約穿搭 @eric7786 Eric## 4 穿搭 男生簡約穿搭 @eric7786 Eric## 5 穿搭 男生簡約穿搭 @eric7786 Eric## # ... with 9 more variables: article_text , article_love ,## # article_reply , article_date , article_id ,## # comment_floor , comment_author_school , comment_text ,## # comment_time ### Compare with the index dataframe

df_index %>% tail(5) ## # A tibble: 5 x 9

## index_date index_board index_title index_excerpt index_author

##

## 1 2019-02-27 22:07:00 美妝 被驚豔到的 ange~ angelariel絲絨~ ☆↗煞氣※a●網友卍↙~

## 2 2019-02-27 15:17:00 美妝 Penhaligon~ 近年來香氛蠟燭市場越來越~ "Johnny\U00~

## 3 2019-02-27 11:22:00 穿搭 ZARA網路付款~ 因為門市找不到官網上面的~ 中華科技大學 航空機械~

## 4 2019-02-24 22:11:00 美妝 "香港\U0001f~ "//i.imgur.c~ 卡稱卡稱

## 5 2019-02-20 20:23:00 工作 ZARA H&M服飾~ 的感覺比較好都會認真問你~ 世新大學

## # ... with 4 more variables: index_meta , index_link ,

## # index_wday , id

文章與留言合併後資料表 / 圖片來源: 我截圖的

5. Upload data from local files to google spreadsheet

將資料清理並合併後，下一步要將資料輸出。除了 google spreadsheet 以外，視需求也可輸出成 csv/excel/txt 檔案，這裡著重在容易共享並直接更改的 google drive。將資料從本地端上傳到雲端有三個常用的套件，分別是 googlesheet , googlesheet4 以及 googledrive ， googlesheet 專門針對 google spreadsheet 所設計，有很多實用的函數，譬如說將資料表上傳到特定分頁，或者更改某個儲存格的內容，操作上可以非常精細，但因為開發套件的作者現在致力於開發新版更好用的套件 googlesheet4 ，所以 googlesheet 就沒在維護了。

也因為如此，我現在都使用 googledrive ，它的亮點是可以靈活的處理 google drive 裡面的資料，包含搜尋、 創建檔案、更動檔案位置等等。我會用到的功能是把輸出到本地硬碟的 csv 檔案上傳到 google spreadsheet當中。

因為小翔希望每天早上十點可以看到 Dcard 上的新內容，所以我們結合了 dplyr::mutate() 與常見的 if_else() ，把發文時間晚於前一天早上十點的文章都貼上"new"的標籤。貼標後再上傳至 google drive上，小翔若點進 google spreadsheet，可以優先查看標示為"new"的文章。在上傳前要先建立好空的資料夾與 google spreadsheet，接著利用 googledrive::drive_get() 讀取 google spreadsheet，再以 googledrive::drive_get() 更新。

library(googledrive) ### Label "new" if the articles were posted later than 22:00 yesterday

df_index_newtag <- df_index %>%

mutate(new_tag = if_else(index_date >= as.POSIXct(ymd_hms(str_c(ymd(Sys.Date()-1), "10:00:00")), tz="Asia/Taipei"), "new", "old")) %>%

mutate(hyperlink = str_c('=HYPERLINK("',index_link,'","',index_title,'")')) %>%

select(-id)

df_index_newtag %>%

add_row(index_date = ymd_hms(str_c(ymd(Sys.Date()), "10:00:01")),index_board = "=now()", index_title ='=IMPORTRANGE("

arrange(desc(index_date)) %>%

select(-index_wday) %>%

write_csv("df_article.csv") ### Export data to the local diskdf_index_newtag %>%add_row(index_date = ymd_hms(str_c(ymd(Sys.Date()), "10:00:01")),index_board = "=now()", index_title ='=IMPORTRANGE(" https://docs.google.com/spreadsheets/OOO/ ","dcard_new!A2")') %>%arrange(desc(index_date)) %>%select(-index_wday) %>%write_csv("df_article.csv") ### Pre create a file "cralwer" and a empty gsheet "crawler_dcard"

### Get gsheet from gdrive and update new csv

gd_crawler_dcard <- drive_get("~/crawler/crawler_dcard")

## Auto-refreshing stale OAuth token. gd_crawler_dcard %>% drive_update(media = "df_article.csv")

## File updated:

## * crawler_dcard: 87qiomfKIn8mfsbk1yp9q75647nPANk5x0l9QoP

6. Write E-mail to the user as a notification for new articles

這邊我使用的是 gmailr 套件，具體操作可以參考這篇教學。在R裡面寫信不只是為了潮而已， gmailr 厲害之處在於可以一次發送大量客製化信件給不同人。想像你是一位常常需要批改大量作業並告訴同學分數的老師，或者是需要寄送大量客製化邀請的 EDM 給不同廠商的公關專員，這些需求都可以在 R 中做到！ 實際寄信前需要參考教學，先在 Google Developers Console 申請 API 權限後才能得到信箱的存取權，但過程並不會很難，建議可以將 chrome 語言設定成英文版本，方便對照。

library(gmailr)

library(glue)

library(tableHTML) ### Below is a demo code since it needs credentials to run

### Read the credentials

use_secret_file("gmailr-zara.json") ### Filter "new" articles

df_index_email <- df_index_newtag %>%

filter(new_tag == "new") %>%

select(-c(new_tag, index_wday)) %>%

mutate(hyperlink = str_sub(index_link, 1, str_locate(index_link, "-")[,1]-1)) ### Turn the articles dataframe into a html table

msg = tableHTML(df_index_email)

html_bod <- str_c("<p> Good Morning! There are ",dim(df_index_email)[1], " articles total. </p>", msg)

mime() %>%

to("

from("

subject(str_c("ZARA_morning_monitor_", ymd(Sys.Date()))) %>%

html_body(html_bod) %>%

send_message() ### Send the emailmime() %>%to(" MKT_HYHsiang@gmail.com ") %>%from(" BOSS_HYHsiang@gmail.com ") %>%subject(str_c("ZARA_morning_monitor_", ymd(Sys.Date()))) %>%html_body(html_bod) %>%send_message()

收到從 R 裡面自動寄出的 gmail，我用黃底標示關鍵字 / 圖片來源: 我截圖的

7. Update the results on a daily basis

因為工作原因暫時使用蘋果電腦，所以我使用的排程套件是 cronR ，可以參考套件官方網站， cronR 的好處是提供 Rtudio 當中的 add in，不用把函數背起來。

R studio add in 當中 cronR 套件的位置 / 圖片來源: 我截圖的

如下圖所示， cronR 的圖形化介面中分為兩部分，一部分是創建新的任務，一部分是管理現存的任務。使用者在創建新任務時需要填入待執行的 R script 檔案位置、開始時間、排程週期等，其中排程週期最為重要，可以設定一次性的工作，或是每分鐘/每小時/每日執行，若要以更複雜的方式排程，譬如說每周一三五定期執行程式碼，可以參考 cronR::cron_add() ，這個函數可以提升使用者排程的自由度。

cronR 套件的介面分為創建新的任務以及管理既有任務 / 圖片來源: 我截圖的

有另一個值得一提的案例，因為公關業的 agency 要幫 in-house 做每日新聞監測，可能會有早報與午報的需求，譬如說早上十點跑一次下午五點又跑一次，這時候要做的不是研究函數要怎麼實現這麼複雜的需求，最簡單的做法就是設定兩個任務，分別在對應的時間執行就好。

在使用 cronR 之前，需要先安裝下列幾個套件才能順利運作： shiny , miniUI , shinyFiles ，如果擔心不夠熟悉的話，可以參考這個影片。另外我自己在蘋果電腦上執行的時候，遇到了一段錯誤碼：“crontab: tmp/tmp.X: Operation not permitted”，後來在這裡找到了答案，基本上就是要開權限給 terminal，如果還是不行的話可以再開權限給 R 以及 Rstudio。若是windows系統，則是使用 task scheduler，可以參考教學。

Conclusion

1. Additional work for future

前面有提到，對老闆小翔來說，還有許多待解決的需求，我在底下列出未來可以改進的方向，以及動手前確定可以實踐的具體方法。

有些品牌不只有一個關鍵詞，像 UQ 就有 uniqlo, UQ, 優衣褲等

現在只有看一個品牌，但其他競爭的品牌討論也很重要

除了 Dcard 以外，還想看 Ptt, mobile01 等網站的相關討論

不想限於服飾，想看到宏觀趨勢

針對上述需求，底下提出對應的解方。

不只一個關鍵詞：以 Dcard 為例，可以在搜尋頁面打不同關鍵詞，抓下來後再將資料表合併，若擔心重複可以活用 dplyr::distinct()

多看幾個品牌：這個也很簡單，多設其他品牌關鍵字，合併時可以增加品牌的欄位

多看幾個網站：mobile01 本身也有提供站內搜尋的功能，所以可以用跟 Dcard 一樣的方法爬下資料。Ptt 比較麻煩，沒有全站通用的搜尋，這時候可以考慮抓取有搜尋功能的 Ptt 備份網站，或者是先鎖定特定幾個相關版面再寫爬蟲。

宏觀趨勢：這時候不需要使用關鍵字，而是改抓每個版面或全站的熱門文章，只有目標改變但方法不變。

2. A short review and thanks

在這篇文章當中，我依照品牌端使用者小翔的需求，使用 R 語言打造了一個能夠做到社群聆聽、資料自動上傳、每天更新的小工具，若有什麼建議或是希望增加的功能都可以留言跟我說，希望你會喜歡！特別感謝 Samuel 和 jilung 告訴我排程的相關資訊，以及 WB 給我的靈感。