Mining articles from PTT HatePolitics and Boy-Girl Boards

library(jiebaR)
library(stringr)
library(future.apply)
library(PTTmineR)
library(tidytext)
library(quanteda)
library(dplyr)
library(future)
library(readr)

seg <- worker()
plan(multiprocess(workers = 8, gc = TRUE))

HP_miner <- PTTmineR$new(task.name = 'Hate_Politics')
HP_miner %>% 
  mine_ptt(board = "HatePolitics", last.n.page = 200)

HP_miner %>% 
  export_ptt(export.type = 'tbl', obj.name = 'HP_tbl_result')
HP_post <- HP_tbl_result$post_info_tbl

posts_HP <- vector()
for (i in 1:nrow(HP_post)) {
  p <- HP_post$post_content[i]
  segged_p <- segment(p, seg)
  posts_HP[i] <- paste0(segged_p, collapse = ' ')
}

HP_df <- tibble::tibble(看板 = '政黑',
                          編號 = 1:nrow(HP_post),
                          作者 = HP_post$post_author, 
                          標題 = HP_post$post_title, 
                          內容 = posts_HP)

write_csv(HP_df, path = 'PTT_HP.csv')

BG_miner <- PTTmineR$new(task.name = 'Boy-Girl')
BG_miner %>% 
  mine_ptt(board = "Boy-Girl", last.n.page = 200)

BG_miner %>% 
  export_ptt(export.type = 'tbl', obj.name = 'BG_tbl_result')
BG_post <- BG_tbl_result$post_info_tbl

posts_BG <- vector()
for (i in 1:nrow(BG_post)) {
  q <- BG_post$post_content[i]
  segged_q <- segment(q, seg)
  posts_BG[i] <- paste0(segged_q, collapse = ' ')
}

BG_df <- tibble::tibble(看板 = '男女', 
                          編號 = 1:nrow(BG_post),
                          作者 = BG_post$post_author, 
                          標題 = BG_post$post_title, 
                          內容 = posts_BG)

write_csv(BG_df, path = 'PTT_BG.csv')

head(HP_df)

## # A tibble: 6 x 5
##   看板   編號 作者     標題                 內容                           
##   <chr> <int> <chr>    <chr>                <chr>                          
## 1 政黑      1 yuxds    Re: 館長自爆：北市官員說為了讓我開… 引述 sunyeah 湯元 嗎 之 銘 言 打電話 給 幕僚…
## 2 政黑      2 GV13     回應譚德塞 要鬥志不鬥氣… 1. 轉錄 標題 ︰ 回 應 譚 德塞 要 鬥志 不 鬥氣 …
## 3 政黑      3 platinu… 覺青請小心 你擁護的可能是五毛！！… https reurl cc kdEgqd 抓到了 攻擊 彈…
## 4 政黑      4 huanglo… 韓國瑜談外商投資高雄 可望今年底定案… 日商 台灣 三井 不動產 集團 拜訪 高雄 市長 韓國 瑜 …
## 5 政黑      5 wiwi0526 韓導該怎麼下台才漂亮 看見 2 階段 還有 10 幾萬 份 沒 送 但 審議 就 …
## 6 政黑      6 sunyeah  Re: 館長自爆：北市官員說為了讓我開… 打電話 給 幕僚 抱怨 嗆 聲 幹 拎 娘 2022 以後 …

head(BG_df)

## # A tibble: 6 x 5
##   看板   編號 作者     標題                內容                            
##   <chr> <int> <chr>    <chr>               <chr>                           
## 1 男女      1 bb255052 Re: 為什麼男生都喜歡看起來笨的女… 我 很 認真 的 回 你 然後 也 說 一下 天然 呆 是 真…
## 2 男女      2 asususer 如何與飲料店妹子閒聊 超級新手… 本人 是 超級 少話 的 男生 句點 王 很多 時候 不 知道…
## 3 男女      3 sumade   Re: 我與iouuoi小姐爭執，請… 引述 NSDC 隨風而逝 之 銘 言 我 相信 公道 自在 人…
## 4 男女      4 coolrr   Re: 澳洲台勞女能碰嗎！？… 引述 alexhsu0909 之 銘 言 本魯 朋友 碰到 了…
## 5 男女      5 stan766… Re: 我與iouuoi小姐爭執，請… 先說 結論 老子 付錢 怎能不 愛上 我 想 吃 沒 吃 到 …
## 6 男女      6 puretru… 天秤座露股溝道歉具有法律效力嗎？… 試管嬰兒 小孩 比較 有 實驗 精神 情緒 勒索 妹 哭腔 走…

Statistics

boards <- c('政黑', '男女')

HP_npost <- nrow(HP_df)
BG_npost <- nrow(BG_df)

HP_nchar <- HP_df$內容 %>% nchar %>% sum
BG_nchar <- BG_df$內容 %>% nchar %>% sum

tidy_HP <- HP_df %>% unnest_tokens('word', '內容', token = 'words')
tidy_BG <- BG_df %>% unnest_tokens('word', '內容', token = 'words')

HP_ntok <- tidy_HP %>% nrow()
BG_ntok <- tidy_BG %>% nrow()

HP_nword <- tidy_HP %>% count(word) %>% nrow()
BG_nword <- tidy_BG %>% count(word) %>% nrow()

tibble::tibble(看板 = boards,
                 篇數 = c(HP_npost, BG_npost),
                 字數 = c(HP_nchar, BG_nchar),
                 tokens = c(HP_ntok, BG_ntok),
                 words = c(HP_nword, BG_nword))

## # A tibble: 2 x 5
##   看板   篇數    字數  tokens words
##   <chr> <int>   <int>   <int> <int>
## 1 政黑   3894 2250498  858224 33493
## 2 男女   3919 3577966 1431892 28448

‘Missing’ Verbs

corpus_HP <- corpus(HP_df,
                    docid_field = '編號',
                    text_field = '內容')

kwic(corpus_HP, '[思想懷掛]念', valuetype = 'regex') %>% head(10) %>% knitr::kable(align = 'c')

corpus_BG <- corpus(BG_df,
                    docid_field = '編號',
                    text_field = '內容')

kwic(corpus_BG, '[思想懷掛]念', valuetype = 'regex') %>% head(10) %>% knitr::kable(align = 'c') 

HP_freq <- tidy_HP %>% count(word)
BG_freq <- tidy_BG %>% count(word)

count_freq <- function (x, y) {
  if (y %in% x$word) {
    number <- filter(x, word == y)$n
  }
  else {number <- 0}
}


tibble::tibble(看板 = boards,
                 思念 = c(count_freq(HP_freq, '思念'), count_freq(BG_freq, '思念')),
                 想念 = c(count_freq(HP_freq, '想念'), count_freq(BG_freq, '想念')),
                 懷念 = c(count_freq(HP_freq, '懷念'), count_freq(BG_freq, '懷念')),
                 掛念 = c(count_freq(HP_freq, '掛念'), count_freq(BG_freq, '掛念')))

## # A tibble: 2 x 5
##   看板   思念  想念  懷念  掛念
##   <chr> <dbl> <int> <int> <dbl>
## 1 政黑      0     3    21     0
## 2 男女     18    28    26     3