系統參數設定

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

安裝需要的packages

# echo = T,results = 'hide'
packages = c("dplyr", "tidytext", "stringr", "wordcloud2", "ggplot2",'readr','data.table','reshape2','wordcloud','tidyr','scales')
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)

讀進library

library(dplyr)
library(stringr)
library(tidytext)
library(wordcloud2)
library(data.table)
library(ggplot2)
library(reshape2)
library(wordcloud)
library(tidyr)
library(readr)
library(scales)
require(jiebaR)

資料基本介紹

  • 資料來源: 文字平台收集PTT Gossip版2021-01-30 ~ 2021-02-05 所有文章
  • 關鍵字：雞排妹、鄭家純
  • 資料時間：2021-01-30 ~ 2021-02-05

以前陣子發生的雞排妹性騷擾事件，主要分析ptt上網友的相關討論。本次主要針對以下方向分析：

1.雞排妹被性騷擾的貼文出現後討論熱度持續了多久，在甚麼時間點討論度是最高？
2.大家主要對於這起事件所持有的態度為何?不同的態度衍伸出的看法又是甚麼？
3.是甚麼原因導致這件事情正面情緒>負面情緒OR負面情緒>正面情緒？

ptt有些文章雖然是在討論雞排妹但是和主題不相關，篩選文章必須要有「性騷擾」和其他關鍵字。

# 把文章和留言讀進來
MetaData = fread('../harass/data/ptt_articleMetaData.csv',encoding = 'UTF-8')
Reviews  = fread('../harass/data/ptt_articleReviews.csv',encoding = 'UTF-8')

# 再篩一次文章 826 篇
keywords = c('性騷擾','性騷','提告')
toMatch = paste(keywords,collapse="|")
MetaData = with(MetaData, MetaData[grepl(toMatch,sentence)|grepl(toMatch,artTitle),])

# 挑選文章對應的留言
Reviews = left_join(MetaData, Reviews[,c("artUrl", "cmtContent")], by = "artUrl")

1. 資料前處理

(1). 文章斷詞

設定斷詞引擎

# 加入自定義的字典
jieba_tokenizer <- worker(user="../harass/dict/user_dict.txt", stop_word = "../harass/dict/stop_words.txt")

# 設定斷詞function
customized_tokenizer <- function(t) {
  lapply(t, function(x) {
    tokens <- segment(x, jieba_tokenizer)
    return(tokens)
  })
}
# 把文章和留言的斷詞結果併在一起
MToken <- MetaData %>% unnest_tokens(word, sentence, token=customized_tokenizer)
RToken <- Reviews %>% unnest_tokens(word, cmtContent, token=customized_tokenizer)

# 把資料併在一起
data <- rbind(MToken[,c("artDate","artUrl", "word")],RToken[,c("artDate","artUrl", "word")])

(2). 資料基本清理

  • 日期格式化
  • 去除特殊字元、詞頻太低的字
# 格式化日期欄位
data$artDate= data$artDate %>% as.Date("%Y/%m/%d")

# 過濾特殊字元
data_select = data %>% 
  filter(!grepl('[[:punct:]]',word)) %>% # 去標點符號
  filter(!grepl("['^0-9a-z']",word)) %>% # 去英文、數字
  filter(nchar(.$word)>1) 
  
# 算每天不同字的詞頻
# word_count:artDate,word,count
word_count <- data_select %>%
  select(artDate,word) %>%
  group_by(artDate,word) %>%
  summarise(count=n()) %>%  # 算字詞單篇總數用summarise
  filter(count>3) %>%  # 過濾出現太少次的字
  arrange(desc(count))
## `summarise()` has grouped output by 'artDate'. You can override using the `.groups` argument.
word_count
## # A tibble: 9,444 x 3
## # Groups:   artDate [10]
##    artDate    word   count
##    <date>     <chr>  <int>
##  1 2021-02-05 雞排妹   809
##  2 2021-02-05 性騷擾   794
##  3 2021-02-03 雞排妹   746
##  4 2021-02-05 道歉     642
##  5 2021-02-06 雞排妹   638
##  6 2021-02-03 性騷擾   637
##  7 2021-02-03 飛機杯   562
##  8 2021-02-04 雞排妹   558
##  9 2021-02-04 性騷擾   556
## 10 2021-02-03 證據     544
## # ... with 9,434 more rows

2. 準備LIWC字典

全名Linguistic Inquiry and Word Counts，由心理學家Pennebaker於2001出版 分為正向情緒與負向情緒

讀檔，字詞間以“,”將字分隔

P <- read_file("../harass/dict/liwc/positive.txt") # 正向字典txt檔
N <- read_file("../harass/dict/liwc/negative.txt") # 負向字典txt檔

#字典txt檔讀進來是一整個字串
typeof(P)
## [1] "character"

分割字詞，並將兩個情緒字典併在一起

# 將字串依,分割
# strsplit回傳list , 我們取出list中的第一個元素
P = strsplit(P, ",")[[1]]
N = strsplit(N, ",")[[1]]

# 建立dataframe 有兩個欄位word,sentiments，word欄位內容是字典向量
P = data.frame(word = P, sentiment = "positive") 
N = data.frame(word = N, sentiment = "negative") 

# 把兩個字典拼在一起
LIWC = rbind(P, N)

# 檢視字典
head(LIWC)
##       word sentiment
## 1     一流  positive
## 2 下定決心  positive
## 3 不拘小節  positive
## 4   不費力  positive
## 5     不錯  positive
## 6     主動  positive

3. 將文章和與LIWC情緒字典做join

正負情緒發文直方圖

MetaData$artDate= MetaData$artDate %>% as.Date("%Y/%m/%d")
MetaData %>%
  group_by(artDate) %>%
  summarise(count = n()) %>%
  ggplot(aes(x= artDate,y=count))+
  geom_bar(stat = 'identity', fill='darkgreen') +
    scale_x_date(labels = date_format("%m/%d"))

在畫出情緒之前，先看看每天的發文情形，大約在02-01之後才有較多的討論。

接著檢視每一天當中文章的正負面數量

# 依據情緒值的正負比例歸類文章
article_type = 
  data_select %>%
  filter(!(word %in% c("性騷擾", '騷擾'))) %>%
  inner_join(LIWC) %>% 
  group_by(artUrl,sentiment) %>%
  summarise(count=n()) %>%
  spread(sentiment,count,fill = 0) %>% #把正負面情緒展開，缺值補0
  mutate(type = case_when(positive > negative ~ "positive", 
                             TRUE ~ "negative")) %>%
  data.frame()
## Joining, by = "word"
## `summarise()` has grouped output by 'artUrl'. You can override using the `.groups` argument.
# 看一下正負比例的文章各有幾篇
article_type %>%
  group_by(type) %>%
  summarise(count = n())
## # A tibble: 2 x 2
##   type     count
##   <chr>    <int>
## 1 negative   309
## 2 positive   215

可以看到其實負面文章的數量是多於正面文章的。

# 
article_type_date = left_join(article_type[,c("artUrl", "type")], MetaData[,c("artUrl", "artDate")], by = "artUrl")


article_type_date %>%
  group_by(artDate,type) %>%
  summarise(count = n()) %>%
  ggplot(aes(x = artDate, y = count, fill = type)) + 
  geom_bar(stat = "identity", position = "dodge")+
  scale_x_date(labels = date_format("%m/%d"),
               limits = as.Date(c('2021-01-30','2021-02-08'))
               )
## `summarise()` has grouped output by 'artDate'. You can override using the `.groups` argument.
## Warning: Removed 2 rows containing missing values (geom_bar).

這是每一天文章被判定為正面或是負面的數量，可以看到除了02/02外基本上幾乎每一天都是負面文章數高於正面文章數的。

找出文集中，對於LIWC字典是positive和negative的字

算出每天情緒總和(sentiment_count)

#因為我們主要是探討性騷擾這一件事情，所以系統會將性騷擾也納入正負面詞的判斷，因此這裡將他捨棄
sentiment_count_filter = data_select %>%
  filter(!(word %in% c("性騷擾", '騷擾'))) %>%
  select(artDate,word) %>%
  inner_join(LIWC) %>% 
  group_by(artDate,sentiment) %>%
  summarise(count=n())
## Joining, by = "word"
## `summarise()` has grouped output by 'artDate'. You can override using the `.groups` argument.

正負情緒分數折線圖

# 檢視資料的日期區間
range(sentiment_count_filter$artDate) #"2021-01-30" "2021-02-08"
## [1] "2021-01-30" "2021-02-08"
sentiment_count_filter %>%
  ggplot()+
  geom_line(aes(x=artDate,y=count,colour=sentiment))+
  scale_x_date(labels = date_format("%m/%d"),
               limits = as.Date(c('2021-01-30','2021-02-08'))
               )+
  # 加上標示日期的線
  geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count_filter$artDate == as.Date('2021-02-05'))
[1]])),colour = "yellow")

畫出每天的情緒總分數，可以看到在02/01-02/04正負面情緒其實是差不多的，但是在的幾天，情緒轉為以負面為主。約在8號之後討論度逐漸下降。

從以下表格我們可以看到每天的情緒數量總和

# 查看每天的情緒分數排名
sentiment_count_filter %>%
  select(count,artDate) %>%
  group_by(artDate) %>%
  summarise(sum = sum(count)) %>%
  arrange(desc(sum))
## # A tibble: 10 x 2
##    artDate      sum
##    <date>     <int>
##  1 2021-02-05  4186
##  2 2021-02-03  3757
##  3 2021-02-04  2713
##  4 2021-02-06  2398
##  5 2021-02-02  1795
##  6 2021-02-07  1510
##  7 2021-02-08   688
##  8 2021-02-01    62
##  9 2021-01-31    43
## 10 2021-01-30     5

正負情緒比例折線圖

sentiment_count_filter %>% 
  # 標準化的部分
  group_by(artDate) %>%
  mutate(ratio = count/sum(count)) %>%
  # 畫圖的部分
  ggplot()+
  geom_line(aes(x=artDate,y=ratio,colour=sentiment))+
  scale_x_date(labels = date_format("%m/%d"),
               limits = as.Date(c('2021-01-30','2021-02-08'))
               )+
  # 加上標示日期的線
  geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count_filter$artDate == as.Date('2021-02-02'))
[1]])),colour = "yellow") +
  geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count_filter$artDate == as.Date('2021-02-05'))
[1]])),colour = "yellow")

將情緒分數標準化後再畫一次圖，挑選正面情緒大於負面情緒的02/02與負面情緒大於正面情緒的02/05兩天來看他們的文字雲。

4. 畫出文字雲

挑出02/02與02/05，畫出文字雲看看都在討論甚麼主題。

2021-02-02 文字雲

# 畫出文字雲

word_count %>% 
  filter(!(word %in% c("性騷擾", '雞排', '雞排妹', '騷擾'))) %>%
  filter(artDate == as.Date('2021-02-02')) %>% 
  select(word,count) %>% 
  group_by(word) %>% 
  summarise(count = sum(count)) %>%
  arrange(desc(count)) %>%
  filter(count>50) %>%   # 過濾出現太少次的字
  wordcloud2()
## Adding missing grouping variables: `artDate`

先從2021-02-02正面>負面的文字雲看起，主要出現的正面字眼為「相信」、「支持」等詞彙，推測是表達對雞排妹的支持。而另外也出現了一些負面的字眼像是「雙標」、「炒新聞」等詞彙，表示部分民眾對雞排妹負面的看法，而另外還有像「證據」應該就是比較偏中間的，很難斷定他想表達的是正面還是負面詞。

2021-02-5 文字雲

# 畫出文字雲
  word_count %>% 
  filter(!(word %in% c("覺得", '真的', '性騷擾', '雞排妹'))) %>%
  filter(artDate == as.Date('2021-02-05')) %>% 
  select(word,count) %>% 
  group_by(word) %>% 
  summarise(count = sum(count)) %>%
  arrange(desc(count)) %>%
  filter(count>100) %>%   # 過濾出現太少次的字
  wordcloud2()
## Adding missing grouping variables: `artDate`

接著看2021-02-05負面>正面的文字雲，主要出現的字眼為「道歉」、「記者會」等詞彙，比較偏中性不確定是否為正面或負面詞彙。而另外也出現了一些負面的字眼像是「噁心」、「垃圾」等詞彙，這邊推測有可能是部分對於雞排妹或是當時在對立方的翁立友的感覺，而另外還有像「飛機杯」就可以根據新聞內容推測應該是雞排妹出席記者會等都隨身攜帶他販賣的飛機杯造成民眾對於他出席活動還在偷偷行銷的負面想法。

5.找出情緒字典代表字

算出所有字詞的詞頻(sentiment_sum)，找出情緒代表字

正負情緒代表字

# sentiment_sum:word,sentiment,sum
sentiment_sum <- 
  word_count %>% 
  filter(!(word %in% c('性騷擾', '雞排妹', '騷擾'))) %>%
    inner_join(LIWC) %>%
    group_by(word,sentiment) %>%
  summarise(
    sum = sum(count)
  ) %>% 
  arrange(desc(sum)) %>%
  data.frame() 
## Joining, by = "word"
## `summarise()` has grouped output by 'word'. You can override using the `.groups` argument.
sentiment_sum %>%
  top_n(30,wt = sum) %>%
  mutate(word = reorder(word, sum)) %>%
  ggplot(aes(word, sum, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~sentiment, scales = "free_y") +
  labs(y = "Contribution to sentiment",
       x = NULL) +
  theme(text=element_text(size=14))+
  coord_flip()

另外，也可以依據不同日期觀察情緒代表字的變化

2021-02-02 正負情緒代表字

sentiment_sum_select <- 
word_count %>% 
  filter(!(word %in% c('性騷擾', '雞排妹', '騷擾'))) %>%
  filter(artDate == as.Date('2021-02-02')) %>% 
    inner_join(LIWC) %>%
    group_by(word,sentiment) %>%
  summarise(
    sum = sum(count)
  ) %>% 
  arrange(desc(sum)) %>%
  data.frame() 
## Joining, by = "word"
## `summarise()` has grouped output by 'word'. You can override using the `.groups` argument.
sentiment_sum_select   %>%
  top_n(30,wt = sum) %>%
  ungroup() %>% 
  mutate(word = reorder(word, sum)) %>%
  ggplot(aes(word, sum, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~sentiment, scales = "free_y") +
  labs(y = "Contribution to sentiment 0202",
       x = NULL) +
  theme(text=element_text(size=14))+
  coord_flip()

2021-02-05 正負情緒代表字

sentiment_sum_select <- 
word_count %>% 
  filter(!(word %in% c('性騷擾', '雞排妹', '騷擾'))) %>%
  filter(artDate == as.Date('2021-02-05')) %>% 
    inner_join(LIWC) %>%
    group_by(word,sentiment) %>%
  summarise(
    sum = sum(count)
  ) %>% 
  arrange(desc(sum)) %>%
  data.frame() 
## Joining, by = "word"
## `summarise()` has grouped output by 'word'. You can override using the `.groups` argument.
sentiment_sum_select   %>%
  top_n(30,wt = sum) %>%
  ungroup() %>% 
  mutate(word = reorder(word, sum)) %>%
  ggplot(aes(word, sum, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~sentiment, scales = "free_y") +
  labs(y = "Contribution to sentiment 0205",
       x = NULL) +
  theme(text=element_text(size=14))+
  coord_flip()

總結

最後總結一下之前提出的問題:

1.雞排妹被性騷擾的貼文出現後討論熱度持續了多久，在甚麼時間點討論度是最高？

雞排妹被性騷擾的貼文是在01/30號公布的，而討論的熱度則是從02/01 - 02/08才漸漸平息，而其中的高點是在02/05的時候。

2.大家主要對於這起事件所持有的態度為何?不同的態度衍伸出的看法又是甚麼？

從01/30 - 02/04正負面討論基本上持平，而在02/05 - 02/08負面評論不斷增加，仔細檢視過後這邊認為因為這起事件主要是雞排妹、尾牙老闆還有翁立友的事件，那裏面的負面情緒也不全然是針對雞排妹，所以這邊不能斷定這起事件史機排妹變得更加多人討厭，不過像剛剛看到的雙標、炒新聞之類等等的字眼就可以很明確是針對雞排妹負面的想法而回應的。

3.是甚麼原因導致這件事情正面情緒>負面情緒OR負面情緒>正面情緒？

從以上的結果還有承接上一題的看法，這邊的部分因為已經斷詞過了，所以較無法去判斷說這些正面或負面評論到底是針對誰去做評論，不過其中也有一些很明顯的字眼可以根據自身對於這一個議題的認知程度去推斷說某些字眼他到底是針對哪一個人去給予評論的。