PTT 上關於理科太太的文章情緒分析

系統參數設定

Sys.setlocale(category = "LC_ALL", locale = "zh_TW.UTF-8") # 避免中文亂碼

[1] "zh_TW.UTF-8/zh_TW.UTF-8/zh_TW.UTF-8/C/zh_TW.UTF-8/zh_TW.UTF-8"

載入套件

require(dplyr)
require(tidytext)
require(jiebaR)
library(stringr)
library(wordcloud2)
library(ggplot2)
library(tidyr)
library(scales)

# 讀入事先抓下來的PTT 資料
like_data = fread('data/ptt_LiKeTaiTai.csv',encoding = 'UTF-8')
# 設定資料清理函式
# 觀察抓下來的討論內容(artContent) 存在貼圖網址及_
clean = function(txt) {
  txt = gsub("(http|https)://.*", "", txt) # 去除網址
  txt = gsub("_", " ", txt) # 底線換成空白  
  txt } 
# 針對分析的欄位進行資料清理
like_data$artDate = like_data$artDate %>% as.Date("%Y/%m/%d")
like_data$artContent = clean(like_data$artContent)
like_data = like_data %>%
  filter(nchar(artContent) > 0) # 去除空字串(有的只貼了一張圖)
like_data

透過jiebar 進行斷詞

# 採用jieba 預設的字典，斷詞後的結果會將部份詞拆開("理科太太" => "理科"，"太太")
# 故加入自定義的詞彙字典進行調整
jieba_tokenizer <- worker(user="dict/liketaitai.dict")
# 設定斷詞function
like_tokenizer <- function(t) {
  lapply(t, function(x) {
    tokens <- segment(x, jieba_tokenizer)
    return(tokens)
  })
}
# 進行斷詞
tokens = like_data %>% 
  unnest_tokens(word, artContent, token=like_tokenizer)
# 統計字頻
tokens = tokens %>%
  select(artDate, word) %>%
  group_by(artDate, word) %>%
  mutate(count = n()) %>%
  ungroup() %>%
  distinct() # 己經統計過數量；去除重複資料
  
tokens

透過文字雲查看斷詞結果

# 文字雲部份，想看的是詞在整個內容出現的數量
# 故需排除日期
tokens %>%
  count(word, sort = TRUE) %>%
  wordcloud2()

繪製討論數量時序圖 (每天有多少的討論文章)

# 計算要顯示的圖形資料
like_date.plotdata = 
  like_data %>% 
  group_by(artDate) %>% 
  summarise(count = n()) # 計算每天討論數量
# 計算要標示的前n 筆資料
like_data.labels = 
  like_date.plotdata %>% 
  mutate(label = format(artDate, "%m-%d")) %>%
  arrange(-count) %>% # 倒序排列
  top_n(3, count) # 只顯示前n筆資料
  
# 繪製時序圖
like_date.plotdata %>% 
  ggplot(aes(x = artDate, y=count)) +
  geom_col() + 
  ggtitle("時間數量序列") + 
  xlab("日期") + 
  ylab("數量") +
  theme(text = element_text(family = "Heiti TC Light")) + 
  scale_x_date(date_breaks = "15 day", date_labels = "%m-%d") + # 每15天顯示一個時間
  geom_text(data = like_data.labels, aes(x = artDate, y = count, label = label), colour="blue") # 在圖上標示日期

理科太太於2018年6月7日創立YouTube頻道並以「理科太太」為名拍攝影片，號稱擁有170高智商的《理科太太》上傳的第一支影片是2018/06/12，年底則是理科太太人氣大爆發(10月底就有20萬訂閱)，於是ppt上第一篇文章落在9/29發文的主題是「理科太太在紅什麼??」 2019/01/08出現高峰是因為與聖結石合作，1/20的高峰是因為理科太太近日時常邀請藝人參加自己的Youtube節目，且發布影片頻率快使曝光率提升(去年12月1日至今年1月20日這51天內她就上傳了23支影片)，因此談論文章數增加。3月份因涉及違反藥事法，可惜PPT爬文只能抓到1/20

建立情緒字典

# 採用0319 助教提供的情緒字典
p <- read_file("dict/liwc/positive.txt")
n <- read_file("dict/liwc/negative.txt")
positive <- strsplit(p, ",")[[1]] # strplit 回傳list; 透過[[1]] 取回list 內第一個變量的值
negative <- strsplit(n, ",")[[1]]
positive <- data.frame(word = positive, sentiments = "positive", stringsAsFactors = FALSE) # 轉成dataframe 物件
negative <- data.frame(word = negative, sentiemtns = "negative", stringsAsFactors = FALSE)
colnames(negative) = c("word","sentiment")
colnames(positive) = c("word","sentiment")
LIWC_ch <- rbind(positive, negative) # 結合兩個dataframe
# 進行情緒標�註
tokens = tokens %>%
  inner_join(LIWC_ch, by = "word") # 與情緒字典合併，僅保留情緒字典中有的文字
#tokens %>%
#  select(artDate, word, count, sentiment.x, sentiment.y) %>%
#  distinct(artDate, word)
tokens

繪制每日討論中，positive/negative 的數量

# 準備繪製用的資料（每日的positive, negative 數量）
plot_table_line = tokens %>%
  group_by(artDate, sentiment) %>% # 依據artDate, sentiment 作群組化
  summarise(count=sum(count)) # 針對群組內的count，進行加總
# 繪製圖形
plot_table_line %>%
  ggplot() +
  geom_line(aes(x=artDate, y=count, colour=sentiment)) +
  scale_x_date(labels = date_format("%m/%d"))

由於曲線型的圖，不易看出確切的數量；

繪製長條圖進行查看

# 基本上與plot_table_bar 相同
# 但由於不想看沒有資料的日期，故先將日期轉成factor
plot_table_bar = tokens %>%
  mutate(artDate = factor(format(artDate, format = '%Y-%m-%d'))) %>% # 將日期轉成factor. 不顯示中間無資料的日期
  group_by(artDate, sentiment) %>% # 依據artDate, sentiment 作群組化
  mutate(count=sum(count)) # 計算每天正負情緒各有多少筆
# 繪製圖形
plot_table_bar %>%
  ggplot(aes(x = artDate)) +
  geom_bar(aes(fill = sentiment)) +
  theme(text = element_text(family = "Heiti TC Light")) + 
  theme(axis.text.x=element_text(angle = 90)) # 旋轉x 軸文字. 避免都連在一起看不見

由上圖看來，在有討論的發言中，正負評是差不多的狀況 但有數個負評較高的可能事推測如下 《理科太太》網路負面口碑的上一個高點出現在網友爆料曾悔婚，當時引來網友群起批評，但事後被發現是胡亂造謠。 1月19日部落客發表五大理由打臉文章，《理科太太》僅在IG上簡短回應「我的智商應該是沒有問題」，並無正面回應，文章持續在> 網路上發酵後，1月20日創下PPT負面聲量最高峰

觀察pasitive and negative 中較常出現的詞

tokens %>%
  count(word, sentiment, sort = TRUE) %>%
  group_by(sentiment) %>%
  top_n(10, n) %>% # 保留前10筆資料 (若有相同的值，則會一起保留)
  ungroup() %>%
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~sentiment, scales = "free_y") +
  labs(y = "Contribution to sentiment",
       x = NULL) +
  coord_flip() +
  theme(text = element_text(family = "Heiti TC Light"))