情緒分析ptt-movie版你的名字

系統參數設定

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 movie版2016-08-01 ~ 2017-08-01 所有文章
資料集： PTT_movie_articleMetaData.csv
關鍵字：你的名字
資料時間：2016-08-01 ~ 2017-08-01
其他資訊：台灣上映日期2016年10月21日 , 日本首映在2016年8月26日

# 把文章和留言讀進來
MetaData = fread('../data/PTT_movie_articleMetaData.csv',encoding = 'UTF-8')
Reviews  = fread('../data/PTT_movie_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="../dict/user_dict_movie.txt", stop_word = "../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: 7,786 x 3
## # Groups:   artDate [100]
##    artDate    word     count
##    <date>     <chr>    <int>
##  1 2016-10-27 三葉       247
##  2 2016-11-05 忍無可忍   220
##  3 2016-11-05 一刷       208
##  4 2016-11-05 我斯       204
##  5 2016-10-15 三葉       179
##  6 2016-10-25 你的名字   166
##  7 2016-10-25 三葉       163
##  8 2016-10-14 三葉       136
##  9 2016-10-29 你的名字   126
## 10 2016-11-05 三葉       110
## # ... with 7,776 more rows

2. 準備LIWC字典

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

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

P <- read_file("../dict/liwc/positive.txt") # 正向字典txt檔
N <- read_file("../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") #664
N = data.frame(word = N, sentiment = "negative") #1047

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

# 檢視字典
head(LIWC)

##       word sentiment
## 1     一流  positive
## 2 下定決心  positive
## 3 不拘小節  positive
## 4   不費力  positive
## 5     不錯  positive
## 6     主動  positive

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

在畫出情緒之前，先看看熱門發文情形，大約在2016年10月1號->2017月1月1號之前之才有較多的討論。

正負情緒發文折線圖

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

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

算出每天情緒總和(sentiment_count)

# sentiment_count:artDate,sentiment,count
sentiment_count = data_select %>%
  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.

畫出每天的情緒總分數，可以看到大概在10/1後至12/31，這幾個月內，情緒從正面為主，但負面總體來說也不少。約在11月之後討論度逐漸下降。

正負情緒分數折線圖

# 檢視資料的日期區間
range(sentiment_count$artDate) #"2021-03-03" "2021-03-21"

## [1] "2016-09-11" "2017-07-07"

sentiment_count %>%
  ggplot()+
  geom_line(aes(x=artDate,y=count,colour=sentiment))+
  scale_x_date(labels = date_format("%m/%d"),
               limits = as.Date(c('2016-10-01','2016-12-31'))
               )+
  # 加上標示日期的線
  geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2016-11-01'))
[1]])),colour = "red")

## Warning: Removed 65 row(s) containing missing values (geom_path).

畫出每天的情緒總分數，以10月21上映日期前後3天來看，可以說是好評不斷，正面評價逐漸上升，但後期正面評價有降低的趨勢，而負面評價有增多的趨勢。

# 檢視資料的日期區間
range(sentiment_count$artDate) #"2021-03-03" "2021-03-21"

## [1] "2016-09-11" "2017-07-07"

sentiment_count %>%
  ggplot()+
  geom_line(aes(x=artDate,y=count,colour=sentiment))+
  scale_x_date(labels = date_format("%m/%d"),
               limits = as.Date(c('2016-10-18','2016-10-24'))
               )+
  # 加上標示日期的線
  geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2016-10-21'))
[1]])),colour = "red")

## Warning: Removed 189 row(s) containing missing values (geom_path).

將情緒分數標準化後再畫一次圖，可以發現雖然正負面情緒都有波動，而正面情緒有降低的情形，負面情緒有增多的趨勢，不過總體來說，正面情緒還是來的高。(轉擇點，電影上映後，期待感並沒有滿足所有人，負面的情緒有稍稍增加)

正負情緒比例折線圖

sentiment_count %>% 
  # 標準化的部分
  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('2016-10-18','2016-10-24'))
               )+
  # 加上標示日期的線
  geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2016-10-21'))
[1]])),colour = "red")

## Warning: Removed 189 row(s) containing missing values (geom_path).

畫出每天的情緒總分數，加大時間來看，以10月21上映日期後30天來看，總體來看，正面評價還是蠻高的，負面情緒則不惶多讓，尤其是在11月5號的時候，正負面評價相差不多。

# 檢視資料的日期區間
range(sentiment_count$artDate) #"2021-03-03" "2021-03-21"

## [1] "2016-09-11" "2017-07-07"

sentiment_count %>%
  ggplot()+
  geom_line(aes(x=artDate,y=count,colour=sentiment))+
  scale_x_date(labels = date_format("%m/%d"),
               limits = as.Date(c('2016-10-21','2016-11-21'))
               )+
  # 加上標示日期的線
  geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2016-11-5'))
[1]])),colour = "red")

## Warning: Removed 139 row(s) containing missing values (geom_path).

將情緒分數標準化後再畫一次圖，可以發現正負面情緒都有波動，負面情緒一度超過正面情緒，而後又與正面情緒打平，之後則以正面情緒為高。

正負情緒比例折線圖

sentiment_count %>% 
  # 標準化的部分
  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('2016-10-21','2016-11-21'))
               )+
  # 加上標示日期的線
  geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2016-11-5'))
[1]])),colour = "red")

## Warning: Removed 139 row(s) containing missing values (geom_path).

我們挑出幾個情緒高點的日期觀察每日情緒分數，約從10月14號(電影上映前)開始議題被大量討論，10月29號達到議題高峰，之後就慢慢下降。

# 查看每天的情緒分數排名
sentiment_count %>%
  select(count,artDate) %>%
  group_by(artDate) %>%
  summarise(sum = sum(count)) %>%
  arrange(desc(sum))

## # A tibble: 103 x 2
##    artDate      sum
##    <date>     <int>
##  1 2016-10-29   745
##  2 2016-10-30   589
##  3 2016-10-27   582
##  4 2016-10-14   547
##  5 2016-10-25   510
##  6 2016-10-28   501
##  7 2016-10-17   485
##  8 2016-10-15   476
##  9 2016-10-31   459
## 10 2016-10-23   432
## # ... with 93 more rows

4. 畫出文字雲

挑出有興趣的日期，畫出文字雲看看都在討論甚麼主題。

先從2016-10-29的情緒高點看起。

2016-10-29 文字雲

# 畫出文字雲

word_count %>% 
  filter(!(word %in% c("你的名字","覺得"))) %>%
  filter(artDate == as.Date('2016-10-29')) %>% 
  select(word,count) %>% 
  group_by(word) %>% 
  summarise(count = sum(count)) %>%
  arrange(desc(count)) %>%
  filter(count>10) %>%   # 過濾出現太少次的字
  wordcloud2()

## Adding missing grouping variables: `artDate`

看點影上映前的討論情況

以2016-10-14的文字雲來看。

2016-10-14 文字雲

# 畫出文字雲
plot_10_14 = word_count %>% 
  filter(!(word %in% c("真的","覺得"))) %>%
  filter(artDate == as.Date('2016-10-14')) %>% 
  select(word,count) %>% 
  group_by(word) %>% 
  summarise(count = sum(count)) %>%
  arrange(desc(count)) %>%
  filter(count>12) %>%   # 過濾出現太少次的字
  wordcloud2()

## Adding missing grouping variables: `artDate`

 #plot_10_14

最後看一下，正負名論差不多的日期，2016-11-05的文字雲

2016-11-05 文字雲

# 畫出文字雲
plot_1105 = word_count %>% 
  filter(!(word %in% c(""))) %>%
  filter(artDate == as.Date('2016-11-05')) %>% 
  select(word,count) %>% 
  group_by(word) %>% 
  summarise(count = sum(count)) %>%
  arrange(desc(count)) %>%
  filter(count>10) %>%   # 過濾出現太少次的字
  wordcloud2()
#plot_1105

## 5.找出情緒字典代表字

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

正負情緒代表字

# sentiment_sum:word,sentiment,sum
sentiment_sum <- 
  word_count %>%
    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()

### 正負情緒文字雲

sentiment_sum %>%
  acast(word ~ sentiment, value.var = "sum", fill = 0) %>%
  comparison.cloud(
    colors = c("salmon", "#72bcd4"), # positive negative
                   max.words = 50)

6.歸類正負面文章

正面：299 負面：62 可以看出非常的正面

# 依據情緒值的正負比例歸類文章
article_type = 
  data_select %>%
  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    62
## 2 positive   299

可以看到負面的文章不多。

正負情緒文章數量統計圖

# 
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('2016-10-14','2016-11-05'))
               )

## `summarise()` has grouped output by 'artDate'. You can override using the `.groups` argument.

## Warning: Removed 95 rows containing missing values (geom_bar).

把正面和負面的文章挑出來，並和斷詞結果合併。

# negative_article:artUrl,word
negative_article <-
article_type %>%
  filter(type=="negative")%>%
  select(artUrl) %>%
  left_join(data_select[,c("artUrl", "word")], by = "artUrl")

# positive_article:artUrl,word
positive_article <-
article_type %>%
  filter(type=="positive")%>%
  select(artUrl) %>%
  left_join(data_select[,c("artUrl", "word")], by = "artUrl")

畫出正負面文章情緒貢獻度較高的關鍵字

情緒關鍵字:負面情緒文章

# 負面情緒關鍵字貢獻圖
negative_article %>%
inner_join(LIWC) %>%
    group_by(word,sentiment) %>%
  summarise(
    sum = n()
    )%>% 
  arrange(desc(sum)) %>%
  data.frame() %>%
  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 negative sentiment",
       x = NULL) +
  theme(text=element_text(size=14))+
  coord_flip()

## Joining, by = "word"

## `summarise()` has grouped output by 'word'. You can override using the `.groups` argument.

### 情緒關鍵字:正面情緒文章

# 正面情緒關鍵字貢獻圖
positive_article %>%
inner_join(LIWC) %>%
    group_by(word,sentiment) %>%
  summarise(
    sum = n()
    )%>% 
  arrange(desc(sum)) %>%
  data.frame() %>%
  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 positive sentiment",
       x = NULL) +
  theme(text=element_text(size=14))+
  coord_flip()

## Joining, by = "word"

## `summarise()` has grouped output by 'word'. You can override using the `.groups` argument.

7.加入其他資料來源比較

無，文字平台無資料

情緒分析ptt-movie版 你的名字

紀玥綺

資料基本介紹

1. 資料前處理

2. 準備LIWC字典

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

正負情緒發文折線圖

正負情緒分數折線圖

正負情緒比例折線圖

正負情緒比例折線圖

4. 畫出文字雲

2016-10-29 文字雲

2016-10-14 文字雲

2016-11-05 文字雲

正負情緒代表字

6.歸類正負面文章

正負情緒文章數量統計圖

情緒關鍵字:負面情緒文章

7.加入其他資料來源比較

情緒分析ptt-movie版你的名字