Week 2, day 2

hw2: text-mining

Hao-Chien Wang
In this assignment, I want to analyze the terms that are used on the HatePolitics forum at ptt. I separate the whole assignments into several files and save the results from every Rscripts so I don’t have to run everything everytime.

Crawler

First, I use a crawler to grab all texts from the website. The first step is to get all links to the pages that contain the target text, and the second step is to save the text into files and separate them by year posted.

library(bitops)
library(httr)
library(RCurl)
library(XML)
library(bitops)
library(tm)
library(NLP)
library(tmcn)
library(jiebaRD)
library(jiebaR)
library(dplyr)

#crawler to grab the links
setwd("/home/fhcwcsy/Documents/summerproj/data_science_programming/week_2/day2")
prefix = "https://www.ptt.cc/bbs/HatePolitics/index"
link = list()
for (id in c(1:500)) {
    url = paste0( prefix, as.character(id), ".html" )
    html = htmlParse( GET(url) )
    url.list = xpathSApply( html, "//div[@class='title']/a[@href]", xmlAttrs )
    link = rbind( link, as.matrix(paste('https://www.ptt.cc', url.list, sep='')) )
}
link <- unlist(link)
head(link)
# write.csv( data, file = "./link.csv" )

# crawler to get the actual text
getdoc = function(url)
{
    html = GET( url ) %>%
        htmlParse()
    doc = xpathSApply( html, "//div[@id='main-content']", xmlValue )
    time = xpathSApply( html, "//*[@id='main-content']/div[4]/span[2]", xmlValue )
    temp = gsub( "  ", " 0", time )
    try({
    part = strsplit( temp, split=" ", fixed=T )[[1]]
    # month = part[[1]][2]
    # day = as.numeric(part[[1]][3])
    year = part[5]
    fileName <- paste0('./data/', year, ".txt")
    write(doc, fileName, append = TRUE)
    })
}

sapply(link, getdoc)

Note: I actually ran 9 crawlers at a time because it is found that running many crawlers simutaneously does not slow down individual progress. I crawl every single posts on the forum. The code above is actually only the first crawler. A part of the result is shown below:

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

readChar("./data/2016.txt", file.info("./data/2016.txt")$size) %>%
  str(nchar.max = 2000)

##  chr "作者ChenDotQ (好人好事代表 no.4440337)看板HatePolitics標題[黑特] 一些五四三的廢話時間Fri Jan  1 22:36:34 2016\n\n\n\n        KMT真的很智障，聲勢已經低到不能再低了\n\n然後弄一個「換柱大會」  秀了一次下限\n\n接著整個政黨好像以KMT為恥一樣，候選人的文宣連黨徽也不敢秀\n\n真的很可笑。 我認為一個政黨一定有他做得好與做不好的地方\n\n如果連最基本的自我認同就辦不到了，這樣誰敢投呀?  見鬼了......\n\n\n\n       朱立倫也真是白痴，選不贏還出來選，不能因為為阿嬤的一句話就自已跳火坑呀\n\n你不知道阿嬤是世界上最話講客套話的生物嗎? 前腳說支持你，後腳投票就蓋2號了\n\n傯傯的.......更蠢的是配那豬一樣的隊友 (王如玄) 自已弄臭了 2020還是吃屎吧\n\n真的沒有下限耶......\n\n\n\n     過去我是很討厭民進黨啦，是從陳水扁與當時DPP的特產「三寶」那時候開始的\n\n我生在比較保守的本省家庭、三代藍領比較務實些，家境也算不上小康(偏貧)\n\n     當時DPP 的台獨我認為只是玩假的，為啥? 獨立誰不想?\n\n就是流血上戰場呀! 很難嗎?    但辦得到嗎? 辦不到! 所以不是玩假的難道玩真的?\n\n阿扁那時候還是609許多人心中的英雄吧\n\n因為他很敢講話，但適得其反的是，我認為國家元首是代表全體國人，而不是代表\n\n只投你選票的那群人，所以他那時候把兩岸和美國的關係搞得很糟時\n\n我對他是很感冒的，加上一連串的醜聞出來後，這個人從此就被我鄙視的很徹底\n\n(不過現在也很可憐了，被關到漏尿，綠色的應恨死689了吧.....所以還是放他出來吧)\n\n但漸漸的2008慘敗後，這八年民進黨也收斂多了\n\n其餘兩黨的紛紛擾擾，立法院亂七八糟那就當沒看見吧，反正都是作秀\n\n最後面兩黨房間門關起來喬一喬法案就浠瀝呼嚕的過了......\n\n「政治就是不斷的妥協再妥協」\n\n\n\n      這八年對DPP的觀察，DPP的確修正了許多方向，但這陣子的學運潮\n\n讓我不禁納悶，為何當初引領人們上街頭的政黨，在執政八年後又回到在野時\n\n卻是跟在人民後面走，而不是引領人民?\n\n在野的確是代表人民監督政府最好的力量，但也不能太「鄉愿」\n\n民意是很複雜的，社會的利益也是多面向的，只能求出社會最大的公約數\n\n而不是人民喊衝，自已也喊衝...... 畢竟你們當過執政黨，接下來也準備重新上台\n\n這樣子以後上台後，只會自相矛盾落入換個位置換個腦袋的巢臼\n\n講白點，這樣子不會有進步，但最近小英也說了，上位後會概括"| __truncated__

Generate TDM

Before generating TDM, I wrote another crawler to grab the names of popular political figures from here:

library(dplyr)
library(rvest)

## Loading required package: xml2

setwd("/home/fhcwcsy/Documents/summerproj/data_science_programming/week_2/day2")
name = c()
for (i in c(1:20)) {
    newName = paste0("https://dailyview.tw/top100/topic/9?volumn=1&page=", i) %>%
        read_html %>%
        html_nodes("#volume_rank .text-left") %>%
        html_text
    name = c( name, newName)
}

head( name, n = 20)

##  [1] "韓國瑜" "蔡英文" "柯文哲" "郭台銘" "賴清德" "陳水扁" "蘇貞昌"
##  [8] "朱立倫" "陳菊"   "王金平" "馬英九" "吳敦義" "陳其邁" "黃國昌"
## [15] "盧秀燕" "王世堅" "羅智強" "鄭麗君" "黃捷"   "余天"

write.csv( name, file = "./name.csv" )

Also I downloaded a csv containing names of towns in Taiwan. After some rearrangements, I can add those terms to the cutter.

library(dplyr)

setwd("/home/fhcwcsy/Documents/summerproj/data_science_programming/week_2/day2")
#read downloaded csv file
rawPlaces = read.csv( file = "./town.csv", head = TRUE )

#combine county names and town names into a vector
nameOfPlaces = c( levels(rawPlaces[,1]), levels(rawPlaces[,2]) )

#add the names without suffixes as new elements 
nameOfPlaces = c(nameOfPlaces, gsub("鄉", "", nameOfPlaces), gsub("鎮", "", nameOfPlaces), gsub("市", "", nameOfPlaces), gsub("縣", "", nameOfPlaces), gsub("區", "", nameOfPlaces) )

#character variations
nameOfPlaces = c( nameOfPlaces, gsub("臺", "台", nameOfPlaces))

#remove redundancy
nameOfPlaces = levels( factor( nameOfPlaces))

#result
head(nameOfPlaces, 20)

##  [1] "七堵"     "七堵區"   "七美"     "七美鄉"   "七股"     "七股區"  
##  [7] "三地門"   "三地門鄉" "三峽"     "三峽區"   "三星"     "三星鄉"  
## [13] "三灣"     "三灣鄉"   "三義"     "三義鄉"   "三芝"     "三芝區"  
## [19] "三重"     "三重區"

#write result
write.csv( nameOfPlaces, file = "./name_of_places.csv" )

Now, I can use jieba to cut the files into words and generate TDM.

library(bitops)
library(httr)
library(RCurl)
library(XML)

## 
## Attaching package: 'XML'

## The following object is masked from 'package:rvest':
## 
##     xml

library(bitops)
library(tm)

## Loading required package: NLP

## 
## Attaching package: 'NLP'

## The following object is masked from 'package:httr':
## 
##     content

library(NLP)
library(tmcn)

## # tmcn Version: 0.2-12

library(jiebaRD)
library(jiebaR)
library(dplyr)


setwd("/home/fhcwcsy/Documents/summerproj/data_science_programming/week_2/day2")
#load word data by files into a list
d.corpus = Corpus( DirSource("./data") )
#remove punctuation and numbers
d.corpus = tm_map(d.corpus, removePunctuation)
d.corpus = tm_map(d.corpus, removeNumbers)
d.corpus = tm_map(d.corpus, function(word) 
{
    gsub("[A-Za-z0-9]", "", word)
})

#generate text matrix
cutter = worker()

myName = rbind(read.csv("./name_of_places.csv", skip = 1, header = FALSE), read.csv("./name.csv", skip = 1, header = FALSE) )
myName = myName[,2] %>%
    levels
new_user_word( cutter, myName )

## [1] TRUE

#define custom cutter
jieba_tokenizer = function(d)
{
    unlist( segment( d[[1]], cutter ) )
}

#cut, return a list
seg = lapply(d.corpus, jieba_tokenizer)

#use `table` to count the words then transform it into a df
count_token = function(d)
{
    as.data.frame(table(d))
}
tokens = lapply( seg, count_token )

n = length(seg)
tdm = tokens[[1]]
colNames = names(seg)
colNames = gsub(".txt", "", colNames)

for( id in c(2:n) )
{
  # d: the words
  tdm = merge(tdm, tokens[[id]], by="d", all = TRUE)
  names(tdm) = c('d', colNames[1:id])
}
# use is.na to pick up NAs and assign value 0 to all NAs
tdm[is.na(tdm)] <- 0
library(knitr)
# result output
kable(tail(tdm))

	d	2006	2007	2008	2009	2010	2011	2012	2013	2014	2015	2016	2017	2018	2019
522998		0	0	0	0	0	0	0	0	0	0	0	0	0	1
522999		0	0	0	0	0	0	0	0	0	0	0	0	0	1
523000		0	0	0	0	0	0	0	0	0	0	0	0	0	2
523001		0	0	0	0	0	0	0	0	0	0	0	0	0	1
523002		0	0	0	0	0	0	0	0	0	0	0	0	0	1
523003	﬊	0	0	0	0	0	0	0	0	0	0	0	0	0	1

kable(head(tdm))

d	2006	2007	2008	2009	2010	2011	2012	2013	2014	2015	2016	2017	2018	2019
	3338	6127	2723	37	70	325	123	942	6158	1349	1589	727	1206	41345
﹌	2	5	0	0	2	0	0	2	7	1	0	0	0	67
﹋	2	3	0	0	0	0	0	2	3	1	0	0	0	163
﹏	17	6	11	0	5	0	0	4	5	2	3	0	0	82
︳	17	2	0	0	1	0	0	0	0	0	0	0	0	12
︱	16	83	13	0	1	5	1	0	2	0	1	0	0	258

write.csv(tdm, file = "./tdm.csv")

Calculate TF_IDF

library(bitops)
library(httr)
library(RCurl)
library(XML)
library(bitops)
library(tm)
library(NLP)
library(tmcn)
library(jiebaRD)
library(jiebaR)
library(dplyr)
library(knitr)

setwd("/home/fhcwcsy/Documents/summerproj/data_science_programming/week_2/day2")
tdm_raw = read.csv( file = "./tdm.csv", header = TRUE )
tdm = tdm_raw
n = length(tdm)
tf = apply(as.matrix(tdm[,3:n]), 2, sum) #total number of words in every documents
idfCal = function(doc) #calculate idf
{
    log2( (length(doc) ) / Matrix::nnzero(doc) )
}
idf = apply(as.matrix(tdm[,3:n]), 1, idfCal)

tfidfMat = as.matrix(tdm[,2:n])
# tf-idf = elements * idf / tf(it's value is now the total number of words in every documents)
# define functions to calculate tf-idf (two steps)
tfidfCal1 = function(col)
{
  as.numeric(col) * idf
}
tfidfCal2 = function(row)
{
  row / tf
}
# save the word column since they will be lost later
wordscol = tfidfMat[, 1]
# calculate with two applys
tfidfMat = apply(tfidfMat[, 2:ncol(tfidfMat)], 2, tfidfCal1)
tfidfMat = apply(tfidfMat, 1, tfidfCal2)
tfidfMat = t(tfidfMat)
# restore the words
rownames( tfidfMat) = wordscol
#step result
str(tfidfMat)

##  num [1:523003, 1:14] 0.00 7.89e-06 9.64e-06 4.27e-05 1.21e-04 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : chr [1:523003] "　" "﹌" "﹋" "﹏" ...
##   ..$ : chr [1:14] "X2006" "X2007" "X2008" "X2009" ...

# remove trash words  
stopLine = rowSums(tfidfMat)
delId = which(stopLine == 0) # adjust the condition if the result is not satisfying
tdm = tdm[-delId,]
tfidfMat = tfidfMat[-delId,]
colnames(tfidfMat) = gsub("X", "", colnames(tfidfMat))
colnames(tdm) = gsub("X", "", colnames(tdm))

# rank
rank = function(col) {rownames(tfidfMat)[order(-col)][1:30]}
rank = apply( tfidfMat, 2, rank )
str(rank)

##  chr [1:30, 1:14] "明禁黨" "蔡起方" "天賜" "國務" "粘貼" "機要" "甲君" ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:14] "2006" "2007" "2008" "2009" ...

#save progress
write.csv(rank, file = "./rank.csv")
write.csv(tdm, file = "./tdm_new.csv")
write.csv(tfidfMat, file = "./tfidf.csv")

Plot

I plot the number of posts (estimated by the size of files) and found that the number of posts rocketed during this year. Therefore, I have to normalize the count of each words when I plot the most popular words. In the second plot, we can see that some terms became popular recently while others have already been discussed for years. Note that the words that equally appear in every posts have been removed during the TF_IDF process.

library(ggplot2)

## 
## Attaching package: 'ggplot2'

## The following object is masked from 'package:NLP':
## 
##     annotate

library(dplyr)

setwd("/home/fhcwcsy/Documents/summerproj/data_science_programming/week_2/day2")

tdm_raw = read.csv( file = "./tdm_new.csv")
rank_raw = read.csv( file = "./rank.csv")
tfidf_raw = read.csv( file = "./tfidf.csv")

#total amount of posts by year
year = gsub( "X", "", colnames(rank_raw)[2:(ncol(rank)+1)] )
fileName = paste0( "./data/", year, ".txt")
size_MB = sapply(fileName, file.size) /(1024^2)
sizedf = data.frame(year, size_MB)
ggplot(sizedf, aes(x = year, y = size_MB)) + geom_bar(stat="identity")

#find the trends of the top words this year
tdm = select(tdm_raw, 3:ncol(tdm_raw))
colnames(tdm) = c("word", year)
tdm = arrange(tdm, desc(tdm[,'2019'])) %>%
  filter( nchar(as.character(word)) != 1 & as.character(word) != "網址")
str(tdm)

## 'data.frame':    514617 obs. of  15 variables:
##  $ word: Factor w/ 521516 levels "﹌","﹋","﹉",..: 497998 501552 257201 394491 276175 258220 470834 498411 472246 430199 ...
##  $ 2006: int  1 3 0 0 46 0 1 2 0 0 ...
##  $ 2007: int  1 2 0 0 76 1 4 0 2 7 ...
##  $ 2008: int  0 0 0 10 29 0 0 0 0 8 ...
##  $ 2009: int  0 0 0 15 7 0 0 0 0 1 ...
##  $ 2010: int  0 0 0 26 0 0 3 0 1 3 ...
##  $ 2011: int  0 0 0 73 27 0 0 0 0 2 ...
##  $ 2012: int  0 0 0 32 3 0 0 0 1 1 ...
##  $ 2013: int  0 0 10 32 108 0 2 0 0 11 ...
##  $ 2014: int  1 0 339 184 218 1 9 0 13 45 ...
##  $ 2015: int  0 0 178 646 635 4 3 0 0 84 ...
##  $ 2016: int  0 1 158 339 308 14 4 0 3 31 ...
##  $ 2017: int  21 0 66 175 72 11 9 0 1 18 ...
##  $ 2018: int  391 52 285 134 414 107 0 17 2 102 ...
##  $ 2019: int  115854 88007 72667 60924 59519 39326 28254 27934 24081 22894 ...

#normalize/rescale
normalize = function(row)
{
  row / size_MB * 1000
}
word_tmp = tdm[,1]
tdm_normalized = t(apply(tdm[,2:(ncol(tdm))], 1, normalize))
rownames(tdm_normalized) = word_tmp
str(tdm_normalized)

##  num [1:514617, 1:14] 588 1763 0 0 27028 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : chr [1:514617] "韓國瑜" "韓粉" "柯文哲" "蔡英文" ...
##   ..$ : chr [1:14] "2006" "2007" "2008" "2009" ...

#plot the popularity of the most popular words in 2019
topten = tdm_normalized[1:10,]
kable(topten)

	2006	2007	2008	2009	2010	2011	2012	2013	2014	2015	2016	2017	2018	2019
韓國瑜	587.5666	518.4872	0.000	0.000	0.00	0.000	0.000	0.000	169.8116	0.0000	0.0000	18749.6507	200280.112	377306.09
韓粉	1762.6997	1036.9743	0.000	0.000	0.00	0.000	0.000	0.000	0.0000	0.0000	298.9513	0.0000	26635.718	286615.72
柯文哲	0.0000	0.0000	0.000	0.000	0.00	0.000	0.000	7114.165	57566.1361	36733.0691	47234.3113	58927.4736	145984.225	236657.36
蔡英文	0.0000	0.0000	7480.713	120274.369	92973.13	114566.910	75255.582	22765.328	31245.3364	133312.1497	101344.5033	156247.0890	68638.197	198413.49
民調	27028.0622	39405.0246	21694.067	56128.039	0.00	42374.063	7055.211	76832.983	37018.9312	131042.1286	92077.0118	64284.5166	212061.295	193837.77
柯粉	0.0000	518.4872	0.000	0.000	0.00	0.000	0.000	0.000	169.8116	825.4622	4185.3187	9821.2456	54808.112	128074.47
郭台銘	587.5666	2073.9487	0.000	0.000	10727.67	0.000	0.000	1422.833	1528.3045	619.0967	1195.8053	8035.5646	0.000	92015.87
韓導	1175.1331	0.0000	0.000	0.000	0.00	0.000	0.000	0.000	0.0000	0.0000	0.0000	0.0000	8707.831	90973.71
郭董	0.0000	1036.9743	0.000	0.000	3575.89	0.000	2351.737	0.000	2207.5509	0.0000	896.8540	892.8405	1024.451	78425.50
賴清德	0.0000	3629.4102	5984.570	8018.291	10727.67	3138.819	2351.737	7825.582	7641.5225	17334.7068	9267.4914	16071.1292	52246.986	74559.75

library(reshape2)
#melt the df so that ggplot can read the data
topten_melted = melt(t(topten))
colnames(topten_melted) = c("year", "word", "normalized_frequency")
head(topten_melted)

##   year   word normalized_frequency
## 1 2006 韓國瑜             587.5666
## 2 2007 韓國瑜             518.4872
## 3 2008 韓國瑜               0.0000
## 4 2009 韓國瑜               0.0000
## 5 2010 韓國瑜               0.0000
## 6 2011 韓國瑜               0.0000

ggplot(topten_melted, aes( year, normalized_frequency)) + geom_line(aes(color = word))