《精通机器学习：基于R 第二版》学习笔记
1、数据理解与数据准备
在这个案例中，我们研究美国前总统奥巴马的国会演讲。有两个主要的分析目标，首先使用7篇国会演讲建立一个主题模型，然后对比2010年的第一篇演讲和2016年1月的最后一篇演讲。
> library(pacman)
> p_load(tm, wordcloud2, magrittr)
>
> # 设置文件所在目录
> name <- file.path("./data_set/data-master")
>
> # 查看文件名
> dir(name, pattern = "*.txt")
## [1] "sou2010.txt" "sou2011.txt" "sou2012.txt" "sou2013.txt" "sou2014.txt"
## [6] "sou2015.txt" "sou2016.txt"
> # 查看有多少个txt文件
> length(dir(name, pattern = "*.txt"))
## [1] 7
> # 建立语料库，不包括corpus和document level元数据
> docs <- Corpus(DirSource(name, pattern = "*.txt"))
> docs
## <<SimpleCorpus>>
## Metadata: corpus specific: 1, document level (indexed): 0
## Content: documents: 7
文本整理
> # 字母全部转换为小写
> docs <- tm_map(docs, tolower) %>%
# 剔除数字
+ tm_map(removeNumbers) %>%
# 剔除标点符号
+ tm_map(removePunctuation) %>%
# 剔除停用词
+ tm_map(removeWords, stopwords("english")) %>%
# 剔除空白字符
+ tm_map(stripWhitespace) %>%
# 删除那些不必要的词
+ tm_map(removeWords, c("applause", "can", "cant", "will", "that", "weve", "dont",
+ "wont", "youll", "youre"))
>
> # 确认文本还是纯文本形式（会报错）
> # docs <- tm_map(docs,PlainTextDocument)
>
> # 创建DTM矩阵
> dtm <- DocumentTermMatrix(docs)
> dtm
## <<DocumentTermMatrix (documents: 7, terms: 4753)>>
## Non-/sparse entries: 10913/22358
## Sparsity : 67%
## Maximal term length: 17
## Weighting : term frequency (tf)
> dim(dtm)
## [1] 7 4753
这7篇演讲稿包含4753个词。可以通过 removeSparseTerms() 函数删除稀疏项，但这一步不是必需的。需要指定一个0和1之间的数，这个数值越大，表示矩阵的稀疏度越高。稀疏度表示一个名词在文档中的相对频率，所以如果你的稀疏度阈值是0.75，那么就只删除那些稀疏度大于0.75的名词。在这个例子中，(1 - 0.75) * 7 = 1.75，因此，对于任何一个名词，如果包含它的文档少于2个，它就会被删除：
> dtm <- removeSparseTerms(dtm, 0.75)
> dim(dtm)
## [1] 7 2256
因为没有文档元数据，所以应该命名矩阵中的行，这样才能知道每行代表的文档：
> rownames(dtm) <- dir(name, pattern = "*.txt") %>%
+ stringr::str_extract_all("\\d+") %>% unlist()
查看所有7行中的前5列数据：
> inspect(dtm[1:7, 1:5])
## <<DocumentTermMatrix (documents: 7, terms: 5)>>
## Non-/sparse entries: 22/13
## Sparsity : 37%
## Maximal term length: 10
## Weighting : term frequency (tf)
## Sample :
## Terms
## Docs ability able abroad absolutely accept
## 2010 1 1 2 2 1
## 2011 0 4 3 0 0
## 2012 0 3 1 1 0
## 2013 3 3 2 1 1
## 2014 0 1 4 0 0
## 2015 0 1 1 0 1
## 2016 0 1 0 0 1
2、模型构建与模型评价
2.1 词频分析与主题模型
> # 计算每列词频总和，并降序排列
> freq <- colSums(as.matrix(dtm))
> ord <- order(freq, decreasing = T)
> freq[head(ord)]
## new america people jobs now years
## 193 174 169 163 157 148
找出至少出现125次的词：
> findFreqTerms(dtm, 125)
## [1] "america" "american" "americans" "jobs" "make" "new"
## [7] "now" "people" "thats" "work" "year" "years"
找出与“job”词相关性大于0.85的词：
> findAssocs(dtm, "jobs", corlimit = 0.85)
## $jobs
## colleges serve market shouldnt defense put tax came
## 0.97 0.91 0.89 0.88 0.87 0.87 0.87 0.86
生成词云图：
> tibble::tibble(word = names(freq), freq = freq) %>% wordcloud2(size = 1, color = "random-dark",
+ backgroundColor = "white", minRotation = -pi/4, maxRotation = pi/4)
词云图
生成柱状图：
> tibble::tibble(word = names(freq), freq = freq) %>% dplyr::arrange(freq) %>% dplyr::top_n(10) %>%
+ ggplot2::ggplot(aes(reorder(word, -freq), freq)) + geom_bar(stat = "identity") +
+ labs(title = "Word Frequency", y = "", x = "") + theme_bw()
词频柱状图
建立主题模型，7篇文章建立3个主题：
> p_load(topicmodels)
> set.seed(124)
> lda <- LDA(dtm, k = 3, method = "Gibbs")
> topics(lda)
## 2010 2011 2012 2013 2014 2015 2016
## 1 3 3 3 2 2 1
第一篇和最后一篇演讲具有同样的主题分组，看来奥巴马以同样的方式开始和结束了自己的任期。
查看每个主题中的前25个词：
> terms(lda, 25)
## Topic 1 Topic 2 Topic 3
## [1,] "americans" "new" "jobs"
## [2,] "year" "make" "now"
## [3,] "one" "like" "thats"
## [4,] "know" "world" "american"
## [5,] "right" "work" "people"
## [6,] "time" "help" "tonight"
## [7,] "economy" "america" "lets"
## [8,] "businesses" "congress" "america"
## [9,] "people" "every" "energy"
## [10,] "families" "want" "tax"
## [11,] "years" "need" "government"
## [12,] "even" "years" "well"
## [13,] "take" "job" "also"
## [14,] "security" "future" "nation"
## [15,] "give" "first" "last"
## [16,] "many" "country" "business"
## [17,] "still" "better" "education"
## [18,] "work" "home" "put"
## [19,] "get" "american" "get"
## [20,] "change" "today" "good"
## [21,] "care" "back" "reform"
## [22,] "just" "way" "companies"
## [23,] "next" "hard" "deficit"
## [24,] "health" "sure" "must"
## [25,] "support" "college" "small"
2.2 其他定量分析
比较2010年和2016年的演讲：
> p_load(qdap)
> speech.16 <- readLines("./data_set/data-master/sou2016.txt") %>% paste(collapse = " ") %>%
+ # 将文本编码设为ASCⅡ
+ iconv("latin1", "ASCII", "")
qdap包中的 qprep() 函数打包的函数如下所示:
bracketX() ：去掉括号
replace_abbreviation() ：替换缩略语
replace_number() ：将数字替换为单词，例如，可以将100替换为one hundred
replace_symbol() ：将符号替换为单词，例如，可以将@替换为at
> prep16 <- qprep(speech.16) %>%
# 替换缩写，如can't替换为connot
+ replace_contraction() %>%
# 剔除前100个常用的停用词
+ rm_stopwords(Top100Words, separate = F) %>%
# 剔除句号和问号之外的所有字符
+ strip(char.keep = c(".", "?"))
将文档分割成句子：
> sent16 <- data.frame(speech = prep16) %>% sentSplit("speech") %>% dplyr::mutate(year = "2016")
> str(sent16)
## 'data.frame': 299 obs. of 3 variables:
## $ tot : chr "1.1" "2.2" "3.3" "4.4" ...
## $ speech: chr "mister speaker mister vice president members congress fellow americans tonight marks eighth year ive here report state union." "final im going try shorter." "know antsy back iowa." "also understand because election season expectations well achieve year low." ...
## $ year : chr "2016" "2016" "2016" "2016" ...
数据框包括三个变量，tot的意思是谈话的顺序（Turn of Talk），作为表示句子顺序的指标；speech是将文本拆分为句子；year作为分组变量的演讲年份。
对2010年的演讲重复上面的步骤：
> speech.10 <- readLines("./data_set/data-master/sou2010.txt") %>%
+ paste(collapse = " ") %>% iconv("latin1", "ASCII", "") %>%
+ gsub("Applause.", "", .) %>% qprep() %>%
+ replace_contraction() %>%
+ rm_stopwords(Top100Words, separate = F) %>%
+ strip(char.keep = c(".", "?"))
>
> sent10 <- data.frame(speech = speech.10) %>%
+ sentSplit("speech") %>% dplyr::mutate(year = "2010")
将两个独立年份的数据合成一个数据框：
> sentences <- rbind(sent10, sent16)
再看看词频：
> freq_terms(sentences$speech) %>% dplyr::top_n(15) %>% ggplot2::ggplot(aes(FREQ,
+ reorder(WORD, FREQ))) + geom_bar(stat = "identity") + labs(x = "", y = "") +
+ theme_bw()
词云图
建立一个词频矩阵，表示每篇演讲中每个单词的数量：
> word.mat <- wfm(sentences$speech, sentences$year)
> head(word.mat)
## 2010 2016
## abide 1 0
## ability 1 0
## able 1 1
## abroad 2 0
## absolutely 2 0
## abuse 0 1
> # 将矩阵按词频排序
> word.mat <- word.mat[order(word.mat[, 1], word.mat[, 2], decreasing = T), ]
> head(word.mat)
## 2010 2016
## our 120 85
## us 33 33
## year 29 17
## americans 28 15
## why 27 10
## jobs 23 8
为每年建立一个词云：
> trans_cloud(sentences$speech, sentences$year, min.freq = 10)
2010
2016
对两篇文档进行综合统计：
> ws <- word_stats(sentences$speech, sentences$year, rm.incomplete = T)
> plot(ws, label = T, lab.digits = 2)
综合统计
2016年的演讲要比2010年的短很多，少100多个句子和差不多1000个单词。还有，2016年（10个问句）相对于2010年（4个问句），更多地使用了问句这种修辞手法。
比较两篇文档的极性（情感评分）：
> pol <- polarity(sentences$speech, sentences$year)
> pol
## year total.sentences total.words ave.polarity sd.polarity stan.mean.polarity
## 1 2010 435 3900 0.052 0.432 0.121
## 2 2016 299 2982 0.105 0.395 0.267
stan.mean.polarity 表示标准化后的极性均值，就是用极性均值除以标准差。可以看到2016年的标准化极性均值（0.267）要比2010年（0.121）稍高一些。
> plot(pol)
情感评分
2010年的演讲以非常悲观的情感开始，而且整体上比2016年悲观。通过pol对象中的数据框，可以找出最悲观的句子。
> pol.all <- pol$all
>
> pol.all$text.var[which.min(pol.all$polarity)]
## [1] "year ago took office amid wars economy rocked severe recession financial system verge collapse government deeply debt."
总结：
文本定量分析包括：
1.极性分析通常称为情感分析，它可以告诉你文本的情感有多么积极或者多么消极； polarity() 函数;
2.自动易读性指数是衡量文本复杂度和读者理解能力的一个指标；automated_readability_index()函数；
3.正式度可以表示文本和读者之间或者演讲者与听众之间的相关程度；formality()函数；
4.多样性表示文本中使用的不同词数和全部词数的比值；diversity()函数；
5.分散度，或称词汇分散度。它是一种可以帮助你理解词在整篇文本中的分布的有用工具，也是探索文本并识别模式的极好方法；dispersion_plot()函数。
