台灣搬家產業情緒分析（ptt）/ Sentiment Analysis of Moving Industry in Taiwan

Data Source: ptt

Period: 2013/01/01 - 2018/12/31

Encoding to UTF-8

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"

Install essential package

packages = c("dplyr", "tidytext", "stringr", "wordcloud2", "ggplot2",'readr','data.table','reshape2','wordcloud','tidyr','scales','rvest','magrittr','RCurl','XML')
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)

Loading library

library(dplyr)
library(magrittr)
library(ggplot2)
library(wordcloud)

Loading data (ptt, 2013-2018)

MH = read.csv("MoveHouse_artWordFreq_2013_2018.csv",encoding = 'UTF-8')
MH$artDate = MH$artDate %>% as.Date("%Y/%m/%d")
str(MH)

'data.frame':   5997 obs. of  6 variables:
 $ artTitle: Factor w/ 1141 levels "《17》播性愛 黃立成遭境管",..: 617 617 617 762 762 762 431 431 431 147 ...
 $ artDate : Date, format: "2013-04-05" "2013-04-05" "2013-04-05" ...
 $ artTime : Factor w/ 1 level "16:00:00": 1 1 1 1 1 1 1 1 1 1 ...
 $ artUrl  : Factor w/ 1202 levels "http://home.appledaily.com.tw/article/index/20130406/34935067/news/",..: 454 454 454 455 455 455 456 456 456 457 ...
 $ word    : Factor w/ 2658 levels "阿畢","阿伯",..: 1350 552 1321 442 1687 1330 1584 2361 1175 463 ...
 $ count   : int  19 8 5 18 7 5 8 8 7 7 ...

Select artDate, artUrl column

data = MH %>% select(artDate, artUrl) %>% 
  distinct()

Change format

data$artDate= data$artDate %>% as.Date("%Y/%m/%d")

Grouping date

data <- data %>% 
  group_by(artDate) %>% 
  summarise(count = n())

Line graph of articles

plot_date <- data %>% ggplot(aes(x = artDate, y = count)) +
  geom_line(color = "#00AFBB", size = 2) + 
  scale_x_date(labels = date_format("%Y")) +
  ggtitle("搬家 討論文章數") + 
  xlab("Year") + 
  ylab("Count") + 
  theme(text = element_text(family = "Heiti TC Light")) 
plot_date

Word Cloud

data <- MH %>% 
  group_by(word) %>% 
  summarise(sum = sum(count)) %>% 
  arrange(desc(sum)) %>% 
  filter(word!='萬元')
head(data)

require(wordcloud2)
data %>% wordcloud2()

LIWC dict (positive, negative)

p <- read_file("/Volumes/GoogleDrive/Team\ Drives/THESIS/案例構思/巨力搬家/Data\ Collection/爬蟲資料/ptt/dict/game_company_positive.txt")
n <- read_file("/Volumes/GoogleDrive/Team\ Drives/THESIS/案例構思/巨力搬家/Data\ Collection/爬蟲資料/ptt/dict/game_company_negative.txt")
positive <- strsplit(p, "[,]")[[1]] 
negative <- strsplit(n, "[,]")[[1]]
positive <- data.frame(word = positive, sentiments = "positive")
negative <- data.frame(word = negative, sentiemtns = "negative")
colnames(negative) = c("word","sentiment")
colnames(positive) = c("word","sentiment")
LIWC_ch <- rbind(positive, negative) %>% distinct()
LIWC_ch

Count for the amount of words in corpus

word_count <- MH %>%
  select(word, count) %>% 
  group_by(word) %>% 
  summarise(count = sum(count)) %>%
  filter(count > 3)
word_count

Join corpus with LIWC (ot make sure the word is belongs to positive or negative)

word_count %>% inner_join(LIWC_ch)

Joining, by = "word"
Column `word` joining factors with different levels, coercing to character vector

data %>% 
  select(word) %>%
  inner_join(LIWC_ch)

Joining, by = "word"
Column `word` joining factors with different levels, coercing to character vector

Find out date in all time period

all_dates <- 
  expand.grid(seq(as.Date(min(MH$artDate)), as.Date(max(MH$artDate)), by="day"), c("positive", "negative"))
plot_table <- MH %>%
  select(artDate,word,count) %>%
  inner_join(LIWC_ch) %>% 
  group_by(artDate,sentiment) %>%
  summarise(count = sum(count))  

Joining, by = "word"
Column `word` joining factors with different levels, coercing to character vector

Line chart of sentiment (positive, negative)

plot_table %>%
  ggplot() +
  geom_line(aes(x = artDate, y = count, colour = sentiment)) +
  scale_x_date(labels = date_format("20%y")) +
  xlab("Year") + ylab("Count")

Histogram of sentiment (positive, negative)

senti_by_date_LIWC <- MH %>% 
  inner_join(LIWC_ch) %>%
  group_by(artDate, sentiment) %>%
  summarise(n=sum(count)) %>%
  spread(sentiment, n, fill = 0) %>%
  mutate(sentiment = positive - negative) %>%
  mutate(method='LIWC') 

Joining, by = "word"
Column `word` joining factors with different levels, coercing to character vector

senti_by_date_LIWC %>%
  ggplot(aes(x = artDate,y=sentiment,fill = method)) +
  geom_col(show.legend = FALSE) +
  scale_x_date(labels = date_format("20%y")) +
  facet_wrap(~method, ncol = 1, scales = "fixed") +
  geom_text(aes(label = sentiment))

Common sentiment words in LIWC dict (positive, negative)

word_count %>% 
  inner_join(LIWC_ch) %>%
  group_by(sentiment) %>%
  top_n(10, wt = count) %>%
  ungroup() %>% 
  mutate(word = reorder(word, count)) %>%
  ggplot(aes(word, count, 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() + 
  theme(text = element_text(family = "Heiti TC Light")) 

Joining, by = "word"
Column `word` joining factors with different levels, coercing to character vector

Delete unrelated words

word_count <- word_count %>% filter(word!='投資')

Revised sentiment words in LIWC dict (positive, negative)

word_count %>% 
  inner_join(LIWC_ch) %>%
  group_by(sentiment) %>%
  top_n(10, wt = count) %>%
  ungroup() %>% 
  mutate(word = reorder(word, count)) %>%
  ggplot(aes(word, count, 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() + 
  theme(text = element_text(family = "Heiti TC Light")) 

Joining, by = "word"
Column `word` joining factors with different levels, coercing to character vector