跳至主要内容

使用 R 的机器学习与 NLP:主题建模与音乐分类

在本教程中,您将使用潜在狄利克雷分配(LDA)和 K-Means 聚类等机器学习算法构建四个模型。
· 15分钟 阅读

使用 AI 探索

使用 R、NLP 与机器学习中的前沿技术来建模文本主题,并构建您自己的音乐推荐系统!

本教程是三部曲中的第二部分(Part Two-B)。您将继续使用 R,在传奇艺术家 Prince 及其他艺术家与作者的歌词与文本案例上,完成一系列分析任务。三篇教程涵盖如下内容:

想象一下,您是一名在 NASA 工作的数据科学家。您被要求监测两艘用于环月轨道的航天器,它们将研究月球与太阳的相互作用。与任何航天器一样,测试或发射后都会捕获到问题。这些异常以自然语言记录在近 2 万份问题报告中。您的工作是识别报告语料库中最常见的话题与趋势主题,并为工程师和项目负责人提供具有指导意义的分析结果,从而影响太空探索的未来。

这是一个真实场景的例子。学习使用诸如基于机器学习的主题建模、自然语言处理(NLP)与 R 编程等前沿技术后,您将真正拥有“手中有剑”的力量。幸运的是,您无需在 NASA 工作也能做出同样富有创造性的事情。在本教程中,若您愿意接下这个任务,您的使命是:学习主题建模,并基于音乐歌词与非虚构类图书构建一个简易的推荐系统(又称 Recommender)。

Just for Fun!

这与主题建模无关,但为了好玩,我们将使用一个很棒的软件包 circlize(已在前一教程中介绍),来点亮您的视锥细胞,欣赏一下本教程将用到的所有来源构成的圆形图。

 library(jpeg)
library(circlize) #you'll use this package later
#read in the list of jpg files of album/book covers
files = list.files("jpg\\", full.names = TRUE)
#clean up the file names so we can use them in the diagram
removeSpecialChars <- function(x) gsub("[^a-zA-Z]", " ", x)
names <- lapply(files, removeSpecialChars)
names <- gsub("jpg","", names )

#read up on the circlize package for details
#but there will be comments in later sections
circos.clear()
circos.par("points.overflow.warning" = FALSE)
circos.initialize(names, xlim = c(0, 2))
circos.track(ylim = c(0, 1), panel.fun = function(x, y) {
  image = as.raster(readJPEG(files[CELL_META$sector.numeric.index]))
  circos.text(CELL_META$xcenter, CELL_META$cell.ylim[1] - uy(1.5, "mm"),
              CELL_META$sector.index,
              CELL_META$sector.index, facing = "clockwise", niceFacing = TRUE,
              adj = c(1, 0.5), cex = 0.9)
  circos.raster(image, CELL_META$xcenter, CELL_META$ycenter, width = "1.5cm",
        facing = "downward")
}, bg.border = 1, track.height = .4)
专辑封面圆盘图

结构

在之前的教程中,您使用词频、tf-idf 统计量与情感分析来研究 Prince 的歌词。通过主题建模的概念,您可以对歌词与其他文本获得更深入的洞察。

在本教程中,您将使用潜在狄利克雷分配(LDA)和 K-Means 聚类两种机器学习算法构建四个模型。我会在教程后面解释这些算法。

模型一使用 Prince 的歌词文本并结合两本非虚构类书籍。该模型的目标是为您提供一个使用 LDA(无监督算法)来生成词集合的简单示例,这些词组合在一起暗示主题。这些主题没有标签,需要人工解释。当您确定了预设数量的主题后,您将把模型的结果用于将每首歌或图书页面归类到各个类别中。一首歌可能包含您生成的所有主题,但可能更明显地属于其中某一类。这被称为文档分类,但因为您知道文档的作者,实质上是将作者按主题分组。

模型二使用模型一的数据集,通过另一种算法 k-means 快速一瞥如何生成主题,以及它为何可能不是主题建模的最佳选择。

再次使用 LDA,模型三采用了更大的数据集,包含来自不同流派的多位艺术家与更多图书作者。当您将某位作者/艺术家的大多数文档归入其最可能的主题时,您就具备了按相似主题构成对作者进行分组的能力。一个扎实的模型应能在同一主题分组中看到相似的流派。例如,说唱歌手会出现在一个主题中,而两本相似主题的书应该一起出现在另一个主题中。这样,您就有可能推荐相似的作者!显然,作者及其流派是有标签的,但主题并没有,因此这是无监督的。

模型四仅对 Prince 的歌词使用 LDA。这一次,您将使用一个在本教程之外生成的标注数据集,其中每个词都带有词性(如名词、动词等)标签以及词的原型(词形还原)。您还将考察主题如何随时间变化。

Introduction

NLP 与机器学习是人工智能的子领域。近期已有尝试使用AI 来创作歌曲。这并非本教程的目标,但它展示了 AI 作为艺术的一个例子。毕竟,Artificial Intelligence 的前三个字母正是 A-R-T!不妨短暂地将 AI 与歌曲创作类比:您可以轻松遵循模式并创建结构(主歌、副歌、主歌等),但使一首歌伟大的,是作者将创意注入其中。在本教程中,您需要发挥技术能力来构建模型,同时也需要调动艺术创造力,培养解读与解释结果的能力。

不妨这样想:如果主题建模是一门艺术,那么歌词就是代码,写歌就是algo-rhythm(算法节奏),而歌曲就是模型!您的类比会是什么?

典型的推荐系统并不完全基于文本。例如,Netflix 会基于过往选择与相关元数据来推荐电影。Pandora 的方法不同,它依赖于由 400 个音乐属性构成的音乐基因组,包括旋律、节奏、作曲与歌词摘要;不过,这个基因组开发始于 2000 年,耗时五年并由30 位音乐理论专家完成。已有大量研究论文探讨基于剧情摘要的电影推荐。而基于真实歌词内容的音乐推荐系统示例则较难找到。想试一试吗?

先决条件

本系列教程的第二部分 B 需要您对整洁数据有基本理解——尤其是像 dplyr 与 ggplot2 这样的包。建议您也练习通过 tidytext 进行文本挖掘,因为这在之前的教程中已覆盖。您还需要熟悉 R 的函数,因为您会用到一些函数来在各个模型之间复用代码。为了将重点放在获取洞察上,我提供了可用于您自有数据集的代码,但其中细节解释可能需要您进一步自行探索。

准备您的问题

您能用主题建模做什么?或许您手头就有包含对业务至关重要信息的文档,可供挖掘。也许您可以抓取 Twitter 数据来了解人们对公司产品的看法。或者,您可以构建自有的分类系统,把特定文档分送到正确的部门进行分析。眼前有一个等待您探索的可能性世界!行动起来吧!

主题建模为何有用?

以下是主题建模的若干应用:

  • 文档摘要:用主题模型理解并概括科学论文,从而加速研发。历史文献、报纸、博客乃至小说同样适用。
  • 文本分类:主题建模可通过将相似词汇归入主题来提升分类效果,而不是把每个词当作独立特征。
  • 推荐系统:利用基于相似度的概率,您可以构建推荐系统。比如,向读者推荐与其已读文章拥有类似主题结构的文章。
  • 您还有其他想法吗?

准备工作

库与函数

本教程中相较于第一部分或第二部分 A唯一新增的包是 topicmodels、tm 与 plotly。您将使用 topicmodels 包中的 LDA() 函数,让模型学会区分不同文档。tm 包用于文本挖掘,您只会用到一次 inspect() 函数来查看文档-词项矩阵的内部(稍后解释)。plotly 也只会用一次,用于创建 ggplot2 图形的交互式版本。

 library(tidytext) #text mining, unnesting
library(topicmodels) #the LDA algorithm
library(tidyr) #gather()
library(dplyr) #awesome tools
library(ggplot2) #visualization
library(kableExtra) #create attractive tables
library(knitr) #simple table generator
library(ggrepel) #text and label geoms for ggplot2
library(gridExtra)
library(formattable) #color tile and color bar in `kables`
library(tm) #text mining
library(circlize) #already loaded, but just being comprehensive
library(plotly) #interactive ggplot graphs

以下函数均在之前的教程中定义,word_chart() 除外;不过,word_chart() 的内容与说明也可在第二部分 B 中找到。主要需要知道的是,它以一种独特方式使用 ggplot(),基于“词”而非点来创建可视化。

 #define some colors to use throughout
my_colors <- c("#E69F00", "#56B4E9", "#009E73", "#CC79A7", "#D55E00", "#D65E00")

#customize ggplot2's default theme settings
#this tutorial doesn't actually pass any parameters, but you may use it again in future tutorials so it's nice to have the options
theme_lyrics <- function(aticks = element_blank(),
                         pgminor = element_blank(),
                         lt = element_blank(),
                         lp = "none")
{
  theme(plot.title = element_text(hjust = 0.5), #center the title
        axis.ticks = aticks, #set axis ticks to on or off
        panel.grid.minor = pgminor, #turn on or off the minor grid lines
        legend.title = lt, #turn on or off the legend title
        legend.position = lp) #turn on or off the legend
}

#customize the text tables for consistency using HTML formatting
my_kable_styling <- function(dat, caption) {
  kable(dat, "html", escape = FALSE, caption = caption) %>%
  kable_styling(bootstrap_options = c("striped", "condensed", "bordered"),
                full_width = FALSE)
}

word_chart <- function(data, input, title) {
  data %>%
  #set y = 1 to just plot one variable and use word as the label
  ggplot(aes(as.factor(row), 1, label = input, fill = factor(topic) )) +
  #you want the words, not the points
  geom_point(color = "transparent") +
  #make sure the labels don't overlap
  geom_label_repel(nudge_x = .2,  
                   direction = "y",
                   box.padding = 0.1,
                   segment.color = "transparent",
                   size = 3) +
  facet_grid(~topic) +
  theme_lyrics() +
  theme(axis.text.y = element_blank(), axis.text.x = element_blank(),
        #axis.title.x = element_text(size = 9),
        panel.grid = element_blank(), panel.background = element_blank(),
        panel.border = element_rect("lightgray", fill = NA),
        strip.text.x = element_text(size = 9)) +
  labs(x = NULL, y = NULL, title = title) +
    #xlab(NULL) + ylab(NULL) +
  #ggtitle(title) +
  coord_flip()
}

音乐与图书

为了真正看到主题建模与分类的威力,您不仅会像先前教程那样使用 Prince 的歌词,还会用到 Billboard 榜单上来自不同流派的几位其他艺术家的作品。此外,我还加入了几本主题各异的书,比如运动营养、冰山,甚至还有机器学习!借助多样化的数据集,您可以将文档分类到相关主题,并区分相似的艺术家/作者。

提示:我将把歌曲与图书的页面称为文档,把音乐人/作者称为写作者。在代码中,您会看到 source 一词,它仅表示数据引用的是哪位写作者。我会用genre 一词来同时指代音乐流派与图书类别。为更清晰,我使用了图书书名而非作者姓名。随着教程推进,这些指代都会变得清晰。

获取数据

为了专注建模,我在本教程之外完成了数据清洗,并在以下三个文件中为您提供了所需的全部数据,且已应用如下处理:

  • 从网络抓取了八位艺术家的歌词
  • 使用 pdftools 包中的 pdf_text() 函数收集了四本书的内容(每一页代表一个独立文档)
  • 清洗了所有数据,移除了停用词,并使用 tidytext 包(见第一部分)创建了整洁版本
  • 对数据进行了合并与平衡,使每位写作者(source)拥有相同数量的词

本教程中您将使用三个独立的数据集:

  • three_sources_tidy_balanced:包含 Prince 歌词与两本书
  • all_sources_tidy_balanced:包含八位艺术家的歌词与四本书
  • prince_tidy:仅包含 Prince 的歌词

我还包含了一个 Prince 歌词的标注数据集。将到模型四时再解释“标注”的含义。

 #Get Tidy Prince Dataset and Balanced Tidy Dataset of All Sources and 3 Sources

three_sources_tidy_balanced <- read.csv("three_sources_tidy_balanced.csv",
                                        stringsAsFactors = FALSE)

all_sources_tidy_balanced <- read.csv("all_sources_tidy_balanced.csv",
                                      stringsAsFactors = FALSE)

prince_tidy <- read.csv("prince_tidy.csv",
                        stringsAsFactors = FALSE)

用 LDA 构建模型

主题建模的主要目标是在非结构化文本数据中,发现以词共现模式衡量的、具有意义的语义相关词(主题)。主题模型的基本要素是文档、词项与主题。潜在狄利克雷分配(LDA)是一种无监督学习方法,可在文档集合中发现潜在的不同主题,而每个文档是词的集合。LDA 做出如下假设:

  • 每个文档是一个或多个主题的组合
  • 每个主题是多个词的混合

LDA 旨在发现相关词的分组。它是一个迭代的生成式算法。主要有两步:

  • 初始化时,为每个词随机分配一个主题
  • 算法逐词迭代,基于以下考量重新将词分配给某个主题:
    • 该词属于某主题的概率
    • 该文档由某主题生成的概率

LDA 主题模型背后的理念是:属于同一主题的词会在文档中共同出现。它试图将每个文档建模为主题的混合体,将每个主题建模为词的混合体(常称为混合成员模型)。随后,您可以利用某文档属于特定主题的概率来进行相应分类。在您的场景中,因为您从原始数据中知道文档的写作者,您就可以基于相似的主题结构来推荐艺术家/作者。现在,让我们通过一个示例来看看。

模型一:三位写作者的 LDA

检查数据

在该模型中,您将使用三个不同写作者(即 source)组合的数据集,来寻找隐藏主题。为帮助理解主题建模的威力,这三位来源彼此差异很大,直觉上您知道它们涵盖三种不同主题。因此,您将告知模型创建三个主题,看看它是否够“聪明”。首先,您将利用 my_kable_styling() 函数配合 formattable 包中的 color_bar() 与 color_tile() 来检查数据集。

 #group the dataset by writer (source) and count the words
three_sources_tidy_balanced %>%
  group_by(source) %>%
  mutate(word_count = n()) %>%
  select(source, genre, word_count) %>% #only need these fields
  distinct() %>%
  ungroup() %>%
  #assign color bar for word_count that varies according to size
  #create static color for source and genre
  mutate(word_count = color_bar("lightpink")(word_count),  
         source = color_tile("lightblue","lightblue")(source),
         genre = color_tile("lightgreen","lightgreen")(genre)) %>%
  my_kable_styling("Three Sources Stats")

这里您将使用 Prince 的歌词,一本名为“Machine Learning For Dummies” 的书,以及另一本名为“Why Icebergs Float” 的书,它们各自都包含 3 万多个(非去重)词。

三种来源统计

创建文档-词项矩阵

由于您目前拥有包含 Prince 歌词与两本书的平衡整洁数据集,首先需要创建文档-词项矩阵(DTM),其中每一行是一个文档,每一列是一个词项。此格式是 LDA 算法所需。歌词中的文档指一首歌,书中的文档指一个页码。首先,您将对整洁数据按文档计数词频,然后将其传入 tidytext 的 cast_dtm() 函数,其中 document 是文档名字段名,word 是词项字段名。还有其他可传参数,但这两个是必需的。

 three_sources_dtm_balanced <- three_sources_tidy_balanced %>%
  #get word count per document to pass to cast_dtm
  count(document, word, sort = TRUE) %>%
  ungroup() %>%
  #create a DTM with docs as rows and words as columns
  cast_dtm(document, word, n)
#examine the structure of the DTM
three_sources_dtm_balanced

<<DocumentTermMatrix (documents: 1449, terms: 13608)>>
Non-/sparse entries: 71386/19646606
Sparsity           : 100%
Maximal term length: 27
Weighting          : term frequency (tf)

这告诉您拥有多少文档与词项,并指出这是一个非常稀疏的矩阵。所谓稀疏,意味着 DTM 中大多数字段为空。由于所有文档的词汇量极其庞大,每个单独文档实际只会用到很少一部分词。

如果使用 tm 包的 inspect() 函数查看 DTM 的部分行列内容,您会看到每一行是文档,每一列是词项。(也可使用 str() 查看其实际结构。)

 #look at 4 documents and 8 words of the DTM
inspect(three_sources_dtm_balanced[1:4,1:8])
<<DocumentTermMatrix (documents: 4, terms: 8)>>
Non-/sparse entries: 9/23
Sparsity           : 72%
Maximal term length: 9
Weighting          : term frequency (tf)
Sample             :
            Terms
Docs         beautiful dance party push rock roll shake style
  party up           0     0    40    0    1    2     0     0
  push it up         0     1     1   56    0    0     0     0
  shake              0     0     1    0    0    0    52     0
  style              0     0     0    0    0    0     0    32

设置变量

既然您已经知道构建模型所需的输入,那么设置两个变量,便于在构建各模型时直接重置。它们分别命名为 source_dtm 与 source_tidy。

 #assign the source dataset to generic var names
#so we can use a generic function per model
source_dtm <- three_sources_dtm_balanced
source_tidy <- three_sources_tidy_balanced

拟合模型

终于到了拟合模型的有趣部分。代码很简单,但要成为出色的数据科学家,您会希望了解背后发生了什么。尽管这里只是粗略描述,网上有关于 LDA 的海量资料。就您的目的而言,您只需了解四个参数:输入、主题数量、采样方法与种子。

因为您知道数据集中包含三位不同写作者,您将把 k 设为 3,并将 seed 设为常数以获得可复现结果。还有其他控制参数,因此代码中采用 list 形式,但这里仅使用 seed。method 参数定义要使用的采样算法。您将使用 GIBBS 采样方法。默认是 VEM,但依我经验,它不如 GIBBS 表现稳定。

关于 GIBBS 采样的简短技术解释是:它进行一种随机游走,从某个点开始(您可初始化;此处使用默认 0),每一步以相等概率加一或减一移动。若想了解细节,请阅读这里的详细说明。

注意:我略过了 LDA 算法的细节。虽然不必理解其统计理论也能使用它,但我建议您阅读 Ethen Liu 的这篇文档,其中有扎实的解释。

 k <- 3 #number of topics
seed = 1234 #necessary for reproducibility
#fit the model passing the parameters discussed above
#you could have more control parameters but will just use seed here
lda <- LDA(source_dtm, k = k, method = "GIBBS", control = list(seed = seed))
#examine the class of the LDA object
class(lda)
[1] "LDA_Gibbs"
attr(,"package")
[1] "topicmodels"

可以看到,这创建了一个包含三个主题的 LDA_Gibbs 对象。我没有在这里运行 str(lda),因为输出很大,但您可以自行尝试,看看里面包含了什么。

下一步是展开这个对象,查看结果。您可以使用 tidy() 函数将其转为便于理解的格式。在调用 tidy() 时传入 LDA 对象,并将 matrix 参数设为 beta。传入 beta 会返回模型的“每主题-每词”的概率。以下示例使用词 iceberg 展示该词在每个主题中的概率。词 iceberg 在主题 1 中被生成的概率更高。

 #convert the LDA object into a tidy format
#passing "beta" shows the word probabilities
#filter on the word iceberg as an example
#results show probability of iceberg for each topic
tidy(lda, matrix = "beta") %>% filter(term == "iceberg")

[# A tibble: 3 x 3 topic term beta 1 1 iceberg 0.000198
2 2 iceberg 0.00000292 3 3 iceberg 0.00000315]

用高频词识别主题

为清晰理解模型,您需要查看每个主题包含哪些词。构建一个函数,用于整洁化 LDA 模型,并提取每个主题的高频词(即 beta 值最大的词)。在该函数内部,您会调用先前构建的 word_chart() 来漂亮地展示三个主题及其高频词。本例中将 num_words 设为 10,您也可以调整这个数来获得不同视角。

 num_words <- 10 #number of words to visualize

#create function that accepts the lda model and num word to display
top_terms_per_topic <- function(lda_model, num_words) {

  #tidy LDA object to get word, topic, and probability (beta)
  topics_tidy <- tidy(lda_model, matrix = "beta")


  top_terms <- topics_tidy %>%
  group_by(topic) %>%
  arrange(topic, desc(beta)) %>%
  #get the top num_words PER topic
  slice(seq_len(num_words)) %>%
  arrange(topic, beta) %>%
  #row is required for the word_chart() function
  mutate(row = row_number()) %>%
  ungroup() %>%
  #add the word Topic to the topic labels
  mutate(topic = paste("Topic", topic, sep = " "))
  #create a title to pass to word_chart
  title <- paste("LDA Top Terms for", k, "Topics")
  #call the word_chart function you built in prep work
  word_chart(top_terms, top_terms$term, title)
}
#call the function you just built!
top_terms_per_topic(lda, num_words)
三主题的 LDA 高频词

无监督学习总需要人工解读……但这些主题显然对应三种来源:Icebergs、Machine Learning 与 Prince!即便这是个非常简单的例子,细想其可能性,仍让人惊叹!

文档分类

除了将每个主题估计为词的混合,LDA 也会将每个文档表示为主题的混合。这次在整洁化 LDA 模型时使用 matrix = "gamma",即可获得“每文档-每主题”的概率。比如查看 Prince 的歌曲 1999。您会看到,正如一个词会关联多个主题,文档也是如此。这又回到混合成员的概念。下面可以看到,1999 最可能出现在主题 3 中。

 #this time use gamma to look at the prob a doc is in a topic
#just look at the Prince song 1999 as an example
tidy(lda, matrix = "gamma") %>% filter(document == "1999")
# A tibble: 3 x 3
  document topic gamma
  <chr>    <int> <dbl>
1 1999         1 0.170
2 1999         2 0.170
3 1999         3 0.661

这首歌属于每个主题,但占比不同,由 gamma 值表示。有些文档更契合某些主题。如上所示,1999 在主题 3 的 gamma 值更高。

和弦图

为澄清您对 LDA 的理解,看一下这个圆形图。该图展示了来自各来源的文档有多少比例属于各主题。为创建该图,将整洁化的 LDA 模型与存有实际来源(即写作者)的 source_tidy 通过 document 连接。随后进行恰当分组,便可得到每个来源、每个主题的平均 gamma 值。现在,您可以看到对于每个来源,大多数文档落在哪个主题中。

如果您之前没用过圆形图,不妨花点时间仔细端详。(参见第二部分 A 以练习 chordDiagrams() 与 circlize 包。关于该包的一切,Zuguang Gu 的这本书中都已详尽覆盖。)

 #using tidy with gamma gets document probabilities into topic
#but you only have document, topic and gamma
source_topic_relationship <- tidy(lda, matrix = "gamma") %>%
  #join to orig tidy data by doc to get the source field
  inner_join(three_sources_tidy_balanced, by = "document") %>%
  select(source, topic, gamma) %>%
  group_by(source, topic) %>%
  #get the avg doc gamma value per source/topic
  mutate(mean = mean(gamma)) %>%
  #remove the gamma value as you only need the mean
  select(-gamma) %>%
  #removing gamma created duplicates so remove them
  distinct()

#relabel topics to include the word Topic
source_topic_relationship$topic = paste("Topic", source_topic_relationship$topic, sep = " ")

circos.clear() #very important! Reset the circular layout parameters
#assign colors to the outside bars around the circle
grid.col = c("prince" = my_colors[1],
             "icebergs" = my_colors[2],
             "machine_learning" = my_colors[3],
             "Topic 1" = "grey", "Topic 2" = "grey", "Topic 3" = "grey")

# set the global parameters for the circular layout. Specifically the gap size (15)
#this also determines that topic goes on top half and source on bottom half
circos.par(gap.after = c(rep(5, length(unique(source_topic_relationship[[1]])) - 1), 15,
                         rep(5, length(unique(source_topic_relationship[[2]])) - 1), 15))
#main function that draws the diagram. transparancy goes from 0-1
chordDiagram(source_topic_relationship, grid.col = grid.col, transparency = .2)
title("Relationship Between Topic and Source")
主题与来源之间的关系

这是一种非常有趣的可视方式。尽管每个来源的文档都会出现在每个主题中,但每个来源在某一主题中显然占多数。例如,Prince 的歌曲大多与主题 3 相关,因为通向主题 3 的和弦比通向主题 1 和 2 的更粗。Icebergs 与主题 1、Machine Learning 与主题 2 也同理。一旦识别出这种模式,发生了什么就很清楚了。

回想刚刚完成的工作,您实际上是基于主题/来源的平均 gamma 值将文档分类到了主题中。如果您知道文档的写作者,且知道其大多歌词或书籍聚焦于特定主题,那么可以假设相似流派的艺术家会落入同一主题,从而可以推荐相似的写作者……当您查看更大的数据集时,将把这个练习付诸实践。

每个主题的顶级文档

现在在单个文档层面,查看每个主题的顶级文档。

 number_of_documents = 5 #number of top docs to view
title <- paste("LDA Top Documents for", k, "Topics")

#create tidy form showing topic, document and its gamma value
topics_tidy <- tidy(lda, matrix = "gamma")

#same process as used with the top words
top_documents <- topics_tidy %>%
  group_by(topic) %>%
  arrange(topic, desc(gamma)) %>%
  slice(seq_len(number_of_documents)) %>%
  arrange(topic, gamma) %>%
  mutate(row = row_number()) %>%
  ungroup() %>%
  #re-label topics
  mutate(topic = paste("Topic", topic, sep = " "))

title <- paste("LDA Top Documents for", k, "Topics")
word_chart(top_documents, top_documents$document, title)
三主题的 LDA 顶级文档

识别艺术家/作者

鉴于您可能不清楚文档/歌曲标题的命名(如带下划线的页面来自机器学习书籍),我将把文档名替换为来源名。

 title <- paste("Sources for Top Documents for", k, "Topics")

topics_tidy <- tidy(lda, matrix = "gamma")

top_sources <- top_documents %>%
  #join back to the tidy form to get the source field
  inner_join(source_tidy) %>%
  select(document, source, topic) %>%
  distinct() %>%
  group_by(topic) %>%
  #needed by word_chart (not relevant here)
  mutate(row = row_number()) %>%
  ungroup()

word_chart(top_sources, top_sources$source, title)
三主题的顶级文档来源

前一图中的每个主题顶级文档现已替换为其来源。您的代码很好地完成了文档分类,因为它们(至少前五个)都落入了相同类别!更大的问题是:当来源不止三个时,这是否仍然有效?如果结果准确,您就能推荐具有相似主题的写作者。

模型二:三位写作者的 K-Means

第二个模型将使用另一种机器学习技术:k-means 算法。与 LDA 一样,k-means 是无监督学习算法,需您事先决定主题数量。与 LDA 的混合成员模型不同,k-means 将文档划分为看似不相交的簇(即主题)。该算法根据相似度度量对文档分群。它将文档转换为数值向量,并为每个文档的词分配权重(类似 tf-idf)。每个文档只会出现在恰好一个簇中,这称为硬聚类。输出是一组簇及其包含的文档。相较之下,LDA 是一种模糊(软)聚类方法,一个数据点可属于多个簇。

因此,从概念上看,应用于自然语言时,LDA 在主题分配方面应比 k-means 更符合实际,因为文本通常涉及不止一个主题。现在构建模型,检查 k-means 对象,看看您的假设是否成立。

设置变量并拟合模型

 #use the same three sources you started with
source_dtm <- three_sources_dtm_balanced
source_tidy <- three_sources_tidy_balanced

#Set a seed for replicable results
set.seed(1234)
k <- 3
kmeansResult <- kmeans(source_dtm, k)
str(kmeansResult)
List of 9
 $ cluster     : Named int [1:1449] 1 3 2 2 3 1 3 2 2 3 ...
  ..- attr(*, "names")= chr [1:1449] "push it up" "shake" "party up" "style" ...
 $ centers     : num [1:3, 1:13608] 42 0.01065 0.00758 0 0.01141 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:3] "1" "2" "3"
  .. ..$ : chr [1:13608] "push" "shake" "party" "style" ...
 $ totss       : num 237535
 $ withinss    : num [1:3] 640 202211 28285
 $ tot.withinss: num 231137
 $ betweenss   : num 6398
 $ size        : int [1:3] 2 1315 132
 $ iter        : int 3
 $ ifault      : int 0
 - attr(*, "class")= chr "kmeans"

k-means 对象的结构显示两个重要信息:clusters 与 centers。您可以用下面的格式查看歌曲 1999 与其中出现的词 party 在各自变量中的内容。

 head(kmeansResult$cluster["1999"])
1999
   2
head(kmeansResult$centers[,"party"])
1         2         3
0.5000000 0.1269962 0.1439394

这些字段显示 1999 被放入单一簇(簇 2),而 party 出现在所有三个簇中,但主要集中在簇 1。接下来,根据 centers 值查看高频词,以识别主题。

用高频词识别 K-Means 主题

请记住,这个数据集包含三种来源:Prince、Icebergs 与 Machine Learning。打印每个簇的高频词,并将结果与 LDA 输出进行比较。为使用 word_chart(),您需要稍微整理一下数据格式。您可以跟着代码走,但此处细节不如对高频词的实际分析重要。

 num_words <- 8 #number of words to display
#get the top words from the kmeans centers
kmeans_topics <- lapply(1:k, function(i) {
  s <- sort(kmeansResult$centers[i, ], decreasing = T)
  names(s)[1:num_words]
})

#make sure it's a data frame
kmeans_topics_df <- as.data.frame(kmeans_topics)
#label the topics with the word Topic
names(kmeans_topics_df) <- paste("Topic", seq(1:k), sep = " ")
#create a sequential row id to use with gather()
kmeans_topics_df <- cbind(id = rownames(kmeans_topics_df),
                          kmeans_topics_df)
#transpose it into the format required for word_chart()
kmeans_top_terms <- kmeans_topics_df %>% gather(id, 1:k)
colnames(kmeans_top_terms) = c("topic", "term")

kmeans_top_terms <- kmeans_top_terms %>%
  group_by(topic) %>%
  mutate(row = row_number()) %>% #needed by word_chart()
  ungroup()

title <- paste("K-Means Top Terms for", k, "Topics")
word_chart(kmeans_top_terms, kmeans_top_terms$term, title)
三主题的 K-Means 高频词

k-means 足够聪明,能把书与音乐区分开。换言之,主题 1 与 3 明显是 Prince 主题,而主题 2 则是两本书的组合。然而,它并未像 LDA 那样进一步区分两本书。k-means 可以通过调参获得更好表现,LDA 也一样。但粗看默认参数下,k-means 似乎不如 LDA,事实上,硬聚类通常并不常用于主题建模。(想要另一个选择,可了解 mallet 包。)

模型三:12 位写作者的 LDA

该模型将对包含 12 个不同来源/写作者、涵盖多种流派的数据集使用 LDA 算法。该数据集已平衡,每位写作者的文档数与词数相近。以下是数据概览:

检查数据

 all_sources_tidy_balanced %>%
  group_by(source) %>%
  #get the word count and doc count per source
  mutate(word_count = n(),
         source_document_count = n_distinct(document)) %>%
  select(source, genre, word_count, source_document_count) %>%
  distinct() %>%
  ungroup() %>%
  #bars change size according to number
  #tiles are static sizes
  mutate(word_count = color_bar("lightpink")(word_count),
         source_document_count = color_bar("lightpink")(source_document_count),
         source = color_tile("lightblue","lightblue")(source),
         genre = color_tile("lightgreen","lightgreen")(genre)) %>%
  my_kable_styling("All Sources Stats")
所有来源统计

该数据集囊括了多样的艺术家,从 Prince 到 Johnny Cash(乡村),再到 Eminem(说唱),以及四本不同的书。这些艺术家之所以被选择,是因为他们在各自流派中产量最高。内容来自歌词网站抓取。尽管有两本机器学习的书,但一本侧重通用数据科学,另一本更偏向 R 编程的机器学习。所有图书都可作为 PDF 下载。(本分析无需原始 PDF,因为已提供整洁版本。)

简单做个清理:有些流派描述对我们的图表而言太长了,因此创建简写形式以便更易读。

 all_sources_tidy_balanced <- all_sources_tidy_balanced %>%
  mutate(source = ifelse(source == "machine_learning", "m_learn",
         ifelse(source == "machine_learning_r", "m_learn_r",
         ifelse(source == "michael_jackson", "mi_jackson",
         ifelse(source == "sports_nutrition", "nutrition", source))))) %>%
  mutate(genre = ifelse(genre == "machine_learning", "m_learn",
                 ifelse(genre == "sports_nutrition", "nutrition", genre)))

创建 DTM 并设置变量

 #this time use the dataset with 12 sources
all_sources_dtm_balanced <- all_sources_tidy_balanced %>%
  count(document, word, sort = TRUE) %>%
  ungroup() %>%
  cast_dtm(document, word, n)

source_dtm <- all_sources_dtm_balanced
source_tidy <- all_sources_tidy_balanced

拟合模型并识别主题

这次您有十二位写作者与八种流派。我希望同一流派的写作者能被分到同一主题。这才是检验的关键。所以,将主题数设为八个,并在更大的数据集上再次拟合模型。

 k <- 8 #number of topics chosen to match the number of genres
num_words <- 10 #number of words we want to see in each topic
seed = 1234 #make it repeatable
#same as before
lda <- LDA(source_dtm, k = k, method = "GIBBS", control = list(seed = seed))

top_terms_per_topic(lda, num_words)
八主题的 LDA 高频词

不想先入为主,但我的反应是:“哇”!结合该模型的输入,您能看出主题吗?看看每个主题,尝试将其与八个已知流派对应。部分会难以区分,但有些相当明显。例如,以下是一些可能的解读:

  • 主题一——机器学习与数据科学
  • 主题二——流行/摇滚
  • 主题三——运动营养
  • 主题四——乡村
  • 主题五——嘻哈/说唱
  • 主题六——乡村或流行-摇滚
  • 主题七——冰山、地球科学
  • 主题八——宗教

别忘了混合成员的概念,这些主题并非完全不相交。但我也很惊讶,结果像您所见的这样离散。顺带一提:LDA 算法可用的参数比您现在用的多,因此您可以进一步调优模型。

接下来这部分真的很令人兴奋。如何让这些主题的含义更易看出?多数情况下,解读并不容易,但在合适的数据集上,模型表现会很好。如果模型能判断哪些文档更可能落入各主题,您就能开始将写作者分组。而在您的场景中,您知道写作者的流派,因此可以在一定程度上验证结果!第一步仍是文档分类。

文档分类

和弦图

回顾一下,每个文档包含多个主题,但占比不同,由 gamma 值表示。有些文档更契合某些主题。该图展示了每个来源的文档在每个主题上的平均 gamma 值。与上面三位写作者的做法相同,只是这次查看的是 genre 字段。它是展示写作者流派与主题关系的极佳方式。

 source_topic_relationship <- tidy(lda, matrix = "gamma") %>%
  #join to the tidy form to get the genre field
  inner_join(source_tidy, by = "document") %>%
  select(genre, topic, gamma) %>%
  group_by(genre, topic) %>%
  #avg gamma (document) probability per genre/topic
  mutate(mean = mean(gamma)) %>%
  select(genre, topic, mean) %>%
  ungroup() %>%
  #re-label topics
  mutate(topic = paste("Topic", topic, sep = " ")) %>%
  distinct()

circos.clear() #very important! Reset the circular layout parameters
#this is the long form of grid.col just to show you what I'm doing
#you can also assign the genre names individual colors as well
grid.col = c("Topic 1" = "grey", "Topic 2" = "grey", "Topic 3" = "grey",
             "Topic 4" = "grey", "Topic 5" = "grey", "Topic 6" = "grey",
             "Topic 7" = "grey", "Topic 8" = "grey")

#set the gap size between top and bottom halves set gap size to 15
circos.par(gap.after = c(rep(5, length(unique(source_topic_relationship[[1]])) - 1), 15,
                         rep(5, length(unique(source_topic_relationship[[2]])) - 1), 15))
chordDiagram(source_topic_relationship,  grid.col = grid.col, annotationTrack = "grid",
             preAllocateTracks = list(track.height = max(strwidth(unlist(dimnames(source_topic_relationship))))))
#go back to the first track and customize sector labels
#use niceFacing to pivot the label names to be perpendicular
circos.track(track.index = 1, panel.fun = function(x, y) {
  circos.text(CELL_META$xcenter, CELL_META$ylim[1], CELL_META$sector.index,
              facing = "clockwise", niceFacing = TRUE, adj = c(0, 0.5))
}, bg.border = NA) # here set bg.border to NA is important
title("Relationship Between Topic and Genre")
主题与流派之间的关系

每条和弦(即连线)代表了每个流派在各主题上的文档平均 gamma 值。若您看 sports_nutrition 区域,会发现通向主题 3 的和弦比其他更粗。这意味着更多运动营养的页面落入该主题。显然,大多数机器学习与数据科学的页面落入主题 1;多数地球科学文档落入主题 7;而如您所料,流行-摇滚在多个主题中相对分散。这完全说得通,因为按定义,Pop 是“流行”的意思,是更泛化的流派。相比之下,Rap-Hip-Hop 更常出现在主题 5。那么可以用这些信息做什么?您可以基于主题内容向听众做推荐!

当然,歌词内容不必是推荐系统的唯一特征;还可结合诸如节奏、配器、速度等元数据,以带来更佳的聆听体验。

推荐相似写作者

既然您能看出文档与主题的关系,那么按source(即写作者)与主题分组,计算每组的 gamma 之和。随后使用 top_n(1) 选出每个主题中 topic_sum 最高的写作者。由于您也希望对genre做相同的操作,因此创建一个名为 top_items_per_topic() 的函数,并将 source 作为 type 传入。这样,当您按genre 分类文档时,就可再次调用它。

这是关键时刻,您将写作者映射到特定主题。您预计会发生什么?

 #this function can be used to show genre and source via passing the "type"
top_items_per_topic <- function(lda_model, source_tidy, type) {
  #get the tidy version by passing gamma for the per document per topic probs
  document_lda_gamma <- tidy(lda_model, matrix = "gamma") %>%
  #join to the tidy form to get source and genre
  inner_join(source_tidy) %>%
  select(document, gamma, source, genre, topic) %>%
  distinct() %>% #remove duplicates
  #group so that you can get sum per topic/source
  group_by(source, topic) %>%
  #sort by decending gamma value
  arrange(desc(gamma)) %>%
  #create the sum of all document gamma vals per topic/source. Important!
  mutate(topic_sum = sum(gamma)) %>%
  select(topic, topic_sum, source, genre) %>%
  distinct() %>%
  ungroup() %>%
  #type will be either source or genre
  group_by(source, genre ) %>%
  #get the highest topic_sum per type
  top_n(1, topic_sum) %>%
  mutate(row = row_number()) %>%
  mutate(label = ifelse(type == "source", source, genre),
         title = ifelse(type == "source", "Recommended Writers Per Topic",
                        "Genres Per Topic")) %>%
  ungroup() %>%
   #re-label topics
  mutate(topic = paste("Topic", topic, sep = " ")) %>%
  select(label, topic, title)

#slightly different format from word_chart input, so use this version
document_lda_gamma %>%
#use 1, 1, and label to use words without numeric values
ggplot(aes(1, 1, label = label, fill = factor(topic) )) +
  #you want the words, not the points
  geom_point(color = "transparent") +
  #make sure the labels don't overlap
  geom_label_repel(nudge_x = .2,
                   direction = "y",
                   box.padding = 0.1,
                   segment.color = "transparent",
                   size = 3) +
  facet_grid(~topic) +
  theme_lyrics() +
  theme(axis.text.y = element_blank(), axis.text.x = element_blank(),
        axis.title.y = element_text(size = 4),
        panel.grid = element_blank(), panel.background = element_blank(),
        panel.border = element_rect("lightgray", fill = NA),
        strip.text.x = element_text(size = 9)) +
  xlab(NULL) + ylab(NULL) +
  ggtitle(document_lda_gamma$title) +
  coord_flip()
}

top_items_per_topic(lda, source_tidy, "source")
每个主题的推荐写作者

这真令人振奋!不过,考虑到您可能不太熟悉这些艺术家,我将把写作者替换为流派,让一切更清晰。准备好……

按流派推荐相似文档

 top_items_per_topic(lda, source_tidy, "genre")
每个主题的流派

嘻哈-说唱艺术家被分到一起;基督教音乐艺术家也在一起;两位流行-摇滚艺术家聚在一起;每本书都有自己的主题!令人惊叹的是,无监督学习能仅基于文本就产出这样的结果(识别不同流派)。如果选择不同的主题数会怎样?会将哪些流派合并或拆分?或许您可以自行尝试。现在,接下来的模型将聚焦于您在前文用过的 Prince 数据集。

模型四:Prince 歌曲的 LDA

该模型将仅使用 Prince 歌曲的数据集。尽管歌词中有明确主题,但单曲往往涉及多个主题。当数据集中只有一位艺术家时,主题会更混合、交叉更多,解读就变得尤为关键。这一次,您不会使用 Prince 歌词的原始数据,而是使用如下所述的稍作修改的版本。

用 NLP 改进模型

此前您使用的是文本中的原词。但现在您将使用由强大的 NLP 包 cleanNLP 生成的标注数据形式。该包是一个面向自然语言处理的整洁数据模型,提供分词、词性标注、命名实体识别、实体链接、情感分析等诸多标注任务。此操作在本教程之外完成,但我已提供进行主题建模所需的一切。

检查 NLP 输出

在标注数据集中,Prince 歌词语料中的每个词对应一行,并附有该词的重要信息。

更仔细地看看分词后的标注对象,先查看字段名。

 #read in the provided annotated dataset
prince_annotated <- read.csv("prince_data_annotated.csv")
#look at the fields provided in the dataset
names(prince_annotated)
[1] "X"         "id"        "sid"       "tid"       "word"     
[6] "lemma"     "upos"      "pos"       "cid"       "pid"      
[11] "case"      "definite"  "degree"    "foreign"   "gender"   
[16] "mood"      "num_type"  "number"    "person"    "poss"     
[21] "pron_type" "reflex"    "tense"     "verb_form" "voice"

目前您只会用到两类信息:

  • lemma:词的词形还原形式(即将屈折变化的词还原为其基本形式)
  • upos:每个词的通用词性

word 字段是原词,lemma 是词形还原形式。upos 则是通用词性代码。若对 upos 调用 table(),可查看落入各词性标签的词数统计。(注意,某些词可能被多次标注)

 table(prince_annotated$upos)
ADJ   ADP   ADV   AUX CCONJ   DET  INTJ  NOUN   NUM  PART  PRON PROPN
15193 19157 20439 19855  5601 20777  5399 48047  5439 10087 50932   523
SCONJ   SYM  VERB     X
5626    72 43673  3095

为让您感受数据长什么样,不妨放大查看几首歌中 lemma 与原词不同的词,并移除停用词。

 prince_annotated %>%
  #most lemmas are the same as the raw word so ignore those
  filter((as.character(word) != as.character(lemma))
         & (id %in% c("broken", "1999"))) %>% #filter on 2 songs
  anti_join(stop_words) %>%
  select(song = id, word, lemma, upos) %>%
  distinct() %>%
  my_kable_styling("Annotated Subset")
标注子集

这展示了您可以非常有选择性地决定向模型中放入什么(如原词、lemma,或某种词性)。是否使用 lemma 或原词是一个判断问题。或者,您甚至可以使用另一种形式——词干,这在第二部分 A中提到。您也可能会质疑 cleanNLP 的结果,以及何者被视为名词或形容词。我建议尝试多种不同配置,直到找到最适合您的方案。

在本教程中,您将仅对名词建模。为获取与 Prince 相关的元数据,如流派与年份,将 prince_annotated 与 prince_tidy 通过 word 与 document 连接,然后照常创建 DTM。我选择移除一些在所有主题中都会出现的高频词,只为让结果更有意思。(注意,使用第一部分介绍的 tf-idf 也是去除常见词的可选方法。)

使用 NLP 设置变量

 source_tidy <- prince_annotated %>%
  select(document = id, word, lemma, upos) %>%
  filter(upos == "NOUN") %>% #choose only the nouns
  inner_join(prince_tidy, by = c("word", "document")) %>%
  select(document, word, lemma, upos, source, genre, year) %>%
  distinct()

source_dtm <- source_tidy %>%
  #filter out some words that exist across themes just for our purposes
  filter(!word %in% c("love", "time", "day", "night", "girl")) %>%
  count(document, word, sort = TRUE) %>%
  ungroup() %>%
  cast_dtm(document, word, n)

拟合模型并识别主题

 #Changing these parameters or the source data will cause different results!!
k <- 7
num_words <- 6
seed = 4321
lda <- LDA(source_dtm, k = k, method = "GIBBS",

control = list(seed = seed))

top_terms_per_topic(lda, num_words)
七主题的 LDA 高频词

下面列出的是多年来人们为 Prince 音乐标注的潜在主题。它们与某些词相关联,且与所有主题建模一样存在重叠。但请查看这些手工标注的主题(随机排序!),看看能否在您构建的模型中找到它们。

  • love, time, life(爱、时间、生命)
  • people, family(人、家庭)
  • war, peace, controversy, freedom(战争、和平、争议、自由)
  • pain, sad, loss(痛苦、悲伤、失去)
  • sex, drugs(性、药物)
  • self, society, religion(自我、社会、宗教)
  • music, dance, party(音乐、舞蹈、派对)

看起来,您的主题 1 与人和家庭有关;主题 7 与音乐、舞蹈和派对有关;而主题 4 涉及自我、社会与宗教。这需要非常主观的解读。在商业语境中,这一步最好由主题专家来完成,他们对预期有一定了解。现在您可以看到,NLP 的确是人工智能与计算语言学的交汇点!

尝试用不同的主题数运行,或只用动词,或使用原词而非词形还原形式,或改变高频词数量,看看能得到哪些洞察。确定主题数也有新方法:参见关于困惑度(perplexity)的介绍这里,或 ldatuning 包的说明这里。

主题的时间演变

由于 Prince 数据集包含年份,您可以跟踪主题随时间的变化。这里您可以尽情发挥创意;暂时仅查看两个主题中的几个词,并观察其随时间的频率。趋势分析本身就可写成完整教程,若您很感兴趣,请参见这个资源。

 p1 <-  prince_tidy %>%
  filter(!year == "NA") %>% #remove songs without years
  filter(word %in% c("music", "party", "dance")) %>%
  group_by(year) %>%
  mutate(topic_7_count = n()) %>%
  select(year, topic_7_count) %>%
  distinct() %>%
  ggplot(aes(year, topic_7_count)) + geom_smooth(se = FALSE, col = "red")

p2 <-  prince_tidy %>%
  filter(!year == "NA") %>% #remove songs without years
  filter(word %in% c("heaven","hand","soul")) %>%
  group_by(year) %>%
  mutate(topic_4_count = n()) %>%
  select(year, topic_4_count) %>%
  distinct() %>%
  ggplot(aes(year, topic_4_count)) + geom_smooth(se = FALSE)

grid.arrange(p1, p2, ncol = 2)
折线图

这只是一个极其粗略的示例,用来展示主题如何随时间变化。但如果将这种分析扩展到音乐以外呢?也许您的公司对产品销量与客户关于该产品的推文主题趋势之间的相关性感兴趣。理解主题如何随时间变化,有着许多应用场景。

结语

本教程仅触及主题建模、NLP 与机器学习所能做到的冰山一角。这是数据科学中一个蓬勃发展的领域,随着越来越多的科学家去探索浩瀚无垠的非结构化数据海洋,它还将继续繁荣。在音乐领域,基于歌词对歌曲进行分类的理念主要见于研究论文,也许您可以以此为跳板,为 AI 世界贡献自己的成果。

您利用歌词与非虚构类图书数据来识别主题,将单个文档分类到最可能的主题,并基于主题内容识别相似的写作者。因此,您基于文本与已标注的写作者构建了一个简易的推荐系统。

请牢记:您在尝试用机器来刻画艺术。一位艺术家可能会说:“You are the apple of my eye(你是我眼中的苹果)”,但他并不是在谈论水果或身体器官。您必须发现隐藏之物。听音乐时,您未必总能注意到和声,但它们确实存在。调高您最爱的歌,越过主唱去聆听,或许会惊喜地发现一个隐藏的信息世界。所以,在探索中,让逻辑稍退后,把创造力摆在前台!

与本系列所有教程一样,我鼓励您将此处呈现的数据作为有趣的案例研究,同时也把它当作分析您感兴趣文本的灵感来源。那可能是您最喜欢的艺术家、社交媒体、企业、科研或社会经济类文本。您对主题建模的潜在应用有何想法?欢迎在下方留言分享!

敬请期待本系列的第三部分(第四篇文章):歌词分析:用 R 进行机器学习的预测分析。届时,您将使用歌词与带标签的元数据来预测一首歌的未来。您将使用诸如决策树、朴素贝叶斯等多种算法来预测流派、年代,甚至可能预测一首歌是否会登上榜单!期待很快再见!


注意事项:

第一条:只有在完全相同的顺序运行代码,且使用相同、未修改的数据文件时,您才能得到与我一致的结果。否则,对特定主题的引用将不再有意义。

第二条:这项工作没有铁律可循,且基于我自己的研究。尽管主题建模确实存在于真实世界的应用中,但仅基于歌词开发音乐推荐器的实践并不多见。

第三条:主题建模很棘手。构建模型是一回事,解读结果则充满挑战、带有主观性、且难以完全验证(不过相关研究正在进行中:参见 Thomas W. Jones 的这篇文章)。该过程是无监督的、生成式的、迭代的,并以概率为基础。主题是微妙的、隐藏的、隐含的,而非显性的。

如果您想进一步学习使用 R 进行机器学习,请查看我们的入门教程。同时也可学习我们的《Introduction to Machine Learning》课程。

主题