Facebook New York Times Chinese

Facebook New York Times Chinese 分析

載入所需的套件包

library(Rfacebook)

## Loading required package: httr

## Loading required package: rjson

## Loading required package: httpuv

## 
## Attaching package: 'Rfacebook'

## The following object is masked from 'package:methods':
## 
##     getGroup

library(tm)

## Loading required package: NLP

## 
## Attaching package: 'NLP'

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

library(SnowballC)
library(wordcloud2)
library(RColorBrewer)
library(jiebaR)

## Loading required package: jiebaRD

library(bitops)
library(httr)
library(RCurl)
library(XML)
library(NLP)
library(tmcn)

## # tmcn Version: 0.2-12

library(jiebaRD)
library(knitr)

網路爬蟲抓出設定的每一篇文章，並進行一些文字清洗預處理

token  = "EAACEdEose0cBAMfPInlxN2Co77cjiQjadh0KWvhLB4dLJX6qZC8IlU6EECrook6FPZAgfvOZCM3qquyODqAGPLq8NBSdznki1tJWCe9CQkcAWVWzjmsGnBZCZBFGrEoJj96wzqC1ZArgYRwyyei7o3iiBCcNNKCBajGAZBdOG3xfWQu9Ppod2D4V7XwgAeVQtofD6KhGB0tnQZDZD"
page.id <- "1504603339831430"
page <- getPage(page.id, token, n = 200)

## 25 posts 50 posts 75 posts 100 posts 125 posts 150 posts 175 posts 200 posts

posts <- page$message
posts <- gsub("[[:punct:]]", replacement = " ", posts)
posts <- gsub("\n", replacement = " ", posts)
head(posts)

## [1] " 你是庄烈宏嗎  電話那頭 一個陌生的聲音問 在庄烈宏回答 是 之後 傳來了他父親的聲音  兒子 別再幹那些事了 那樣對你的家人不好    庄烈宏曾在Facebook上記錄警方對老家烏坎一系列抗議活動的鎮壓 後來 他逃到了紐約 他覺得這個電話暗示著一場交易  用沉默換取父親的自由   隨著國內鎮壓行動的繼續 中國共產黨已經開始擴大自己的影響範圍 尋求加強審查 監視 遏制境外的異見 他們的目標包括學者 流亡的商界精英 前法官 以及庄烈宏這樣的活動人士    本文發表於時報觀點與評論版面 作者Lauren Hilgers是一名記者  "
## [2] "在博鰲論壇上 習近平表示一定要遏止給世界貿易製造壁壘的行為 稱 中國開放的大門不會關閉 只會越開越大    這是中國為將自己定位為自由貿易和穩定增長倡導者所做的最新努力 這種論調與中國長期以來被指違反貿易規則和知識產權的名聲背道而馳 而與此同時 習近平正在加強對中國的政治 社會和經濟生活的控制   習近平的講話與川普總統形成鮮明對比 後者正提出加徵關稅 限制與中國的貿易 "                                                                                                                       
## [3] " 窮人是我的人民    這番話來自救世軍的創始人卜威廉 他於1829年的今天出生於英格蘭諾丁漢 他的組織今日在世界各地執行使命   在美國的一次旅途中 他說他想 接觸酒館主人和不良從業者 給他們賜福  然而 卜威廉的行事方式受到了爭議 他的一些孩子離開了這個組織 "                                                                                                                                                                                                                                         
## [4] "在川普威脅要對中國商品再徵收1000億美元的關稅後 歐洲領導人基本保持沉默 但歐洲並不能選擇站在安全距離外遙看中美相爭 是選擇近來不太穩定的老朋友 還是儘管有持存的猜疑 但更加有利可圖 更可靠的商業夥伴 歐洲面臨兩難的困境    想要置身於這次交火之外 他們能做什麼  牛津經濟研究院經濟學家斯萊特說  沒什麼能做的    一些歐洲領導人明確表達了對川普破壞WTO作為貿易衝突仲裁者角色的不滿 即使歐洲仍然對中國的意圖持警惕態度 但貿易戰可能會把歐洲推向中國 "                                             
## [5] "上週日 約400名來自全球各地的跑步者參加了在平壤舉行的年度馬拉松比賽 朝鮮半島的緊張局勢最近才開始緩和 而對美國公民前往朝鮮的禁令仍在生效 本屆比賽參賽人數相比去年減少了一半 "                                                                                                                                                                                                                                                                                                                 
## [6] "自中美貿易爭端不斷升級以來 週二 習近平首次公開發表講話 他暗指川普政府不是一個安全可靠的合作夥伴 並表示中國 不搞以鄰為壑 恃強凌弱的強權霸道  他還承諾要堅決抵制為世界貿易設置障礙的做法    我們要相互尊重 平等相待 尊重彼此的核心利益和重大關切 走對話而不對抗 結伴而不結盟的國與國交往新路  習近平說  當今世界 開放融通的潮流滾滾向前    這是中國為將自己定位為自由貿易和穩定增長倡導者所做的最新努力 而與此同時 習近平正在加強對中國的政治 社會和經濟生活的控制 "

建立文本資料結構與文字清洗處理

docs <- Corpus(VectorSource(posts))
docs <- tm_map(docs, removeNumbers)
docs <- tm_map(docs, function(word) {
  gsub("[A-Za-z0-9]", "", word)
})
head(docs)

## <<SimpleCorpus>>
## Metadata:  corpus specific: 1, document level (indexed): 0
## Content:  documents: 6

進行斷詞

cc = worker()
jieba_tokenizer = function(d){
  unlist( segment(d[[1]], cc) )
}
seg = lapply(docs, jieba_tokenizer)

count_token = function(d){
  as.data.frame(table(d))
}
tokens = lapply(seg, count_token)

n = length(seg)
TDM = tokens[[1]]
colNames <- c(1:n)
for( id in c(2:n) ){
  TDM = merge(TDM, tokens[[id]], by = "d", all = TRUE)
  names(TDM) = c("d", colNames[1:id])
}
TDM[is.na(TDM)] <- 0
kable(head(TDM))

d	1	9	10	11	13	16	18	19	24	25	31	35	40	42	45	51	53	54	56	66	74	77	84	85	86	94	96	104	106	116	122	123	132	137	140	141	143	150	154	156	157	159	162	165	170	175	178	181	183	188	194	195	197	198
暗示	1	0	0	0	0	0	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	1	0	0	0	0	0	0	0
版面	1	0	0	0	0	0	0	0	1	1	0	0	0	1	0	0	0	0	0	0	0	0	0	1	1	0	1	0	0	0	1	0	0	1	0	0	0	1	0	0	1	1	1	0	0	0	0	1	1	0	0	1	0	1
包括	1	1	0	0	1	1	0	1	0	0	1	1	0	0	1	2	1	1	1	0	1	1	1	0	0	1	0	1	2	1	0	0	1	0	1	1	1	0	1	1	0	0	0	1	1	1	0	0	0	2	1	0	0	0
本文	1	0	1	1	0	0	0	0	1	1	0	0	1	1	0	0	0	0	0	1	0	0	0	1	1	0	1	0	0	0	1	1	0	1	0	0	0	1	0	1	1	1	1	0	0	0	0	1	1	0	0	1	1	1
別	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0
不好	1	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0	0

kable(tail(TDM))

	d	200
4994	不要	1
4995	紛紛	1
4996	舉著	1
4997	牌子	1
4998	芝加哥	1
4999	中學生	1

將已建好的 TDM 轉成 TF-IDF

tf <- apply(as.matrix(TDM[,2:(n+1)]), 2, sum)

library(Matrix)
idfCal <- function(word_doc)
{ 
  log2( n / nnzero(word_doc) ) 
}
idf <- apply(as.matrix(TDM[,2:(n+1)]), 1, idfCal)

doc.tfidf <- TDM
for(x in 1:nrow(TDM)){
  for(y in 2:ncol(TDM)){
     doc.tfidf[x,y] <- (doc.tfidf[x,y] / tf[y]) * idf[x]
  }
}

TF-IDF Post 文章取得的重要關鍵字

TopWords = data.frame()
for( id in c(1:n) ){
  dayMax = order(doc.tfidf[,id+1], decreasing = TRUE)
  showResult = t(as.data.frame(doc.tfidf[dayMax[1:5],1]))
  TopWords = rbind(TopWords, showResult)
}
rownames(TopWords) = colnames(doc.tfidf)[2:(n+1)]
TopWords = droplevels(TopWords)
kable(head(TopWords))

V1	V2	V3	V4	V5
庄烈宏	電話	聲音	鎮壓	父親
貿易	習近平	背道而馳	壁壘	遏止
卜	威廉	組織	他	不良
歐洲	選擇	猜疑	持存	交火
比賽	本屆	參賽	馬拉松	跑步
習近平	安全可靠	暗指	霸道	彼此

TDM$d = as.character(TDM$d)
AllTop = as.data.frame( table(as.matrix(TopWords)) )
AllTop = AllTop[order(AllTop$Freq, decreasing = TRUE),]

kable(head(AllTop))

	Var1	Freq
717	習近平	10
667	她	9
426	金正恩	7
325	關稅	5
510	貿易	5
664	他	5

7.TF-IDF Post 文章取得的重要關鍵字 TDM merge 視覺化

TopNo = 6
tempGraph = data.frame()
for( t in c(1:TopNo) ){
  word = matrix( rep(c(as.matrix(AllTop$Var1[t])), each = n), nrow = n )
  temp = cbind( colnames(doc.tfidf)[2:(n+1)], t(TDM[which(TDM$d == AllTop$Var1[t]), 2:(n+1)]), word )
  colnames(temp) = c("post", "freq", "words")
  tempGraph = rbind(tempGraph, temp)
  names(tempGraph) = c("post", "freq", "words")
}

library(ggplot2)

## 
## Attaching package: 'ggplot2'

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

library(varhandle)
tempGraph$freq = unfactor(tempGraph$freq)
ggplot(tempGraph, aes(post, freq)) + 
  geom_point(aes(color = words, shape = words), size = 5) +
  geom_line(aes(group = words, linetype = words)) +
  theme(text=element_text(family="黑體-繁 中黑", size=14))

後記

從最後視覺化的圖看來，近期的話題圍繞著中韓領導人和貿易關稅為主，且因為是紐約時報中文版，主要是中國的話題，所以應是講述中國的貿易。

洞察

1.“他”和“她”字並沒有被TF-IDF給過濾掉實在有點可惜。
2.最後的圖原本中文字是無法顯示的，需要加上{r}theme(text=element_text(family="黑體-繁中黑", size=14)才能正常顯示。

Facebook New York Times Chinese

JeffreyChen

2018/4/10

Facebook New York Times Chinese 分析

後記

洞察