歌词分析：使用 R 的机器学习进行预测性分析

如果您需要机器学习入门，请学习 DataCamp 的Introduction to Machine Learning课程，并查看Introduction to Machine Learning in Python教程。

使用多种机器学习（ML）分类算法，逐步构建模型，基于歌词预测歌曲的流派，以及它是否能登上 Billboard 排行榜！

这是一套由三部分组成的教程系列的第三部分。您将继续使用 R，在传奇艺术家 Prince 以及其他艺术家和作者的歌词个案研究上执行多种分析任务。三篇教程涵盖如下内容：

• 第一部分：使用 R 进行歌词分析、NLP 与机器学习
• 第二部分 A：在 R 中进行整洁情感分析
• 第二部分 B：使用 R 的机器学习与 NLP——主题建模与音乐分类
• 第三部分：歌词分析：使用 R 的机器学习进行预测性分析

简介

作为数据科学家，您需要理解监督学习与非监督学习。本教程解释并提供一种监督学习形式——分类——的音乐用例，依据来自多位艺术家（以及几位图书作者）的歌词。您将学习如何构建模型，将歌曲分类到相应流派，并探究是否可以通过歌词判断其商业成功。

目标

您是否使用过像 Pandora、iHeart Radio、Spotify 等音乐流媒体与自动推荐的网络电台服务？如果您设置了硬摇滚电台，大概不会期待听到关于牛仔靴和小镇的乡村歌曲。典型的音乐推荐系统侧重于声音特质，而歌词分析刚刚开始出现在研究论文中。借助本教程中的技术，您可以运用当今科学家研究的前沿方法，提出创意以推动这一新兴领域。

先决条件

本教程假设您对使用tidytext进行文本挖掘有基本了解。它是使用多种流行分类算法进行机器学习技术的中级入门。建议您具备扎实的 R 编程经验，最好对机器学习有所了解，并希望通过动手用例进一步学习其应用与实现。每种算法只做简要说明，但始终提供了更深入分析的链接。

在整篇文章中，您将使用一个名为mlr的 R 机器学习实验框架。尽管本教程并非讲解mlr，但您将广泛将其作为机器学习过程的接口来使用。目标是用它来简化使用不同算法构建模型各步骤的说明。我强烈推荐阅读这份全面的教程。

注意事项

机器学习包含非常多的组件，而在本教程中您只会略作涉猎。与本系列第一、二部分不同，叙述可能会让您产生更多疑问。若能结合自己的数据与代码边做边学，并按自己的节奏研究不同算法，您将收获最大。

步骤

以下是构建模型的高层次步骤纲要：

第一部分：学习如何基于歌词特征预测流派。

• 读取 10 位不同艺术家/作者（五种流派，每种流派两位）的歌词/文本
• 创建训练与测试的整洁数据框
• 进行特征工程，为模型创建预测变量
• 确定用于分类的算法
• 训练模型并基准测试最佳选项
• 选择一个模型并进行调优
• 在新数据集上测试模型

第二部分：使用标志性艺术家 Prince 的歌词，开发预测歌曲成功的模型。

准备

要真正理解数据及其细微之处，您需要先查看前面的教程。请记住，相较于非虚构文本，歌词的挖掘与预测分析更为复杂，因为语境、含义和细微表达常常隐藏在词曲作者的创意中。与关于主题建模的第二部分 B一样，您将继续处理不同流派的艺术家以及两本机器学习图书的内容（其流派为数据科学——用于引入另一种文本形式）。

库与函数

先加载相关库，然后查看数据的整体结构。

 library(tidyverse) #tidyr, #dplyr, #magrittr, #ggplot2
library(tidytext) #unnesting text into single words
library(mlr) #machine learning framework for R
library(kableExtra) #create attractive tables
library(circlize) #cool circle plots
library(jpeg) #read in jpg files for the circle plots

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

#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( "condensed", "bordered"),
                full_width = FALSE)
}技术支持

趣味小节

与之前的教程一样，下面这个圆形图的代码看起来可能很复杂，但我实在难以抵抗酷炫图形的诱惑。它展示了数据中每位艺术家/作者的专辑/书籍封面，覆盖了测试与训练数据集。有关circlize包的更多细节，请查看顾祖光的这本书。

 #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 )

#check out the circlize package for details!
circos.clear() #very important!
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)技术支持

获取数据

为专注于建模，我在本教程之外进行了数据清洗，并为您提供了分析所需的全部数据。预处理摘要如下：

• 从网络抓取了八位艺术家的歌词
• 使用pdftools包中的pdf_text()函数收集了两本书的内容（每页代表一个独立文档）
• 按照第一部分所述，移除不需要的字符并转换为小写
• 合并并平衡数据，使每位作者（source）拥有相同数量的歌曲/文档

下面您将读取已为您拆分好的训练与测试数据，分别加载。随后使用tidytext中的unnest()创建整洁数据，每条记录一个词。

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

five_sources_tidy <- five_sources_data %>%
  unnest_tokens(word, text) %>%
  anti_join(stop_words)

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

five_sources_test_tidy <- five_sources_data_test %>%
  unnest_tokens(word, text) %>%
  anti_join(stop_words)

#very small file that has a couple of words that help to identify certain genres
explicit_words <- read.csv("explicit_words.csv", stringsAsFactors = FALSE)技术支持

检查数据

现在训练与测试数据已加载并整理完毕，您可以查看每位艺术家/作者有多少首歌。由于数据集中既有歌曲也有书页，我将它们都称为文档。您将创建的特征基于文档及其相关元数据，理解这一概念很重要。同时，由于既有艺术家也有作者，我会将他们称为每个文档的来源。

 five_sources_data %>%
  group_by(genre, source) %>%
  summarise(doc_count = n()) %>%
  my_kable_styling("Training Dataset")技术支持

 five_sources_data_test %>%
  group_by(genre, source) %>%
  summarise(doc_count = n()) %>%
  my_kable_styling("Test Dataset")技术支持

尽管您可以看到流派、来源与文档数量，下面的弦图更适合展示这些关系。贯穿整个教程，您将看到这些关系如何随着新模型而变化。目前来源与流派是一一对应，因为艺术家被如此分类；然而跨界艺术家非常常见，后续版本的图中您会看到相关证据。

 #get SONG count per genre/source. Order determines top or bottom.
genre_chart <-  five_sources_data %>%
  count(genre, source)  

circos.clear() #very important! Reset the circular layout parameters
#assign chord colors
grid.col = c("christian" = my_colors[1], "pop-rock" = my_colors[2],
             "hip-hop-rap" = my_colors[3], "data-science" = my_colors[4],
             "country" = my_colors[5],
             "amy-grant" = "grey", "eminem" = "grey",
             "johnny-cash" = "grey", "machine_learning" = "grey",
             "prince" = "grey")
# set the global parameters for the circular layout. Specifically the gap size
circos.par(gap.after = c(rep(5, length(unique(genre_chart[[1]])) - 1), 15,
                         rep(5, length(unique(genre_chart[[2]])) - 1), 15))

chordDiagram(genre_chart, grid.col = grid.col, transparency = .2)
title("Relationship Between Genre and Source")技术支持

想一想，如果不是一一对应，这张图会是什么样？如果仅凭歌词来预测流派，您认为会发生什么？

预测流派

如果您对歌曲分类所能使用的只有歌词，如何生成预测变量？先想想歌曲，以及从歌词上看一首歌与另一首有何不同。所有音乐的共同主题是“重复”。某些流派会不会更常使用重复？那词长呢？有的流派更常用更长或更短的词吗？您还能想到哪些用来描述歌词的因素？如果您按歌曲得到这些计数，就获得了第一组预测变量！

请注意，上述变量都是基于每首歌的词的定量特征（计数、长度等）。但对于特定于流派的个别词呢？在之前的教程中，您做过情感分析与主题建模，这些活动聚焦于特定艺术家或流派的词。如果再进一步，您就可以创建一些最重要的、基于内容（或语境）的预测组件。这是文本分析中特有的创意步骤，会为您的模型带来关键预测变量。

特征工程

首先，您需要获取每个流派中最常见（高频）的词。这在第一部分中已经完成。先获取每个流派的总词数，然后按词与流派分组，统计每个词的使用频次。接着选择由number_of_words变量定义的前n个高频词。难点在这里：应选择多少词？如果太少，无法优化模型；若太多，又会过拟合并扭曲结果。虽然描述起来较复杂，但真正的解决办法是反复试验。我得到的最佳总词数是 5500。您可以调整这个值，看看对结果的影响，或许能找到更佳结果！如果此步骤现在还不够清晰，继续往下看，很快就会明白。

许多词在多个流派中都很常见（例如 time、life 等），我在下面用multi_genre变量剔除了这些词。这样可以得到更干净的区别性词表，更好地区分不同来源。

 #play with this number until you get the best results for your model.
number_of_words = 5500

top_words_per_genre <- five_sources_tidy %>%
  group_by(genre) %>%
  mutate(genre_word_count = n()) %>%
  group_by(genre, word) %>%
  #note that the percentage is also collected, when really you
  #could have just used the count, but it's good practice to use a %
  mutate(word_count = n(),
         word_pct = word_count / genre_word_count * 100) %>%
  select(word, genre, genre_word_count, word_count, word_pct) %>%
  distinct() %>%
  ungroup() %>%
  arrange(desc(word_pct)) %>%
  top_n(number_of_words) %>%
  select(genre, word, word_pct)

#remove words that are in more than one genre
top_words <- top_words_per_genre %>%
  ungroup() %>%
  group_by(word) %>%
  mutate(multi_genre = n()) %>%
  filter(multi_genre < 2) %>%
  select(genre, top_word = word)

#create lists of the top words per genre
book_words <- lapply(top_words[top_words$genre == "data-science",], as.character)
country_words <- lapply(top_words[top_words$genre == "country",], as.character)
hip_hop_words <- lapply(top_words[top_words$genre == "hip-hop-rap",], as.character)
pop_rock_words <- lapply(top_words[top_words$genre == "pop-rock",], as.character)
christian_words <- lapply(top_words[top_words$genre == "christian",], as.character)技术支持

现在将这些流派特定词作为数据集中的特征。由于您将为多个数据集创建特征，建议写成函数，这样只需编写一次。在该函数中，您会看到提到“词汇多样性与密度”。有关这些概念，请参阅第一部分。

思考下面每个特征如何随流派而变化。我将把重点放在随后的机器学习步骤上，而不逐一解释每个特征，请花点时间阅读代码并理解其作用。别忘了关键的流派特定预测变量。例如，country_word_count只是每首歌中出现的“乡村流派高频词”的计数。注意我为露骨与图书词赋予了更高权重（在sum()函数中使用了 10 和 20）。这样做是因为这些词辨识度很高，有助于分类文档。这同样是通过反复试验得到的！

 
features_func_genre <- function(data) {
  features <- data %>%
  group_by(document) %>%
  mutate(word_frequency = n(),
         lexical_diversity = n_distinct(word),
         lexical_density = lexical_diversity/word_frequency,
         repetition = word_frequency/lexical_diversity,
         document_avg_word_length = mean(nchar(word)),
         title_word_count = lengths(gregexpr("[A-z]\\W+",
                                             document)) + 1L,
         title_length = nchar(document),
         large_word_count =
           sum(ifelse((nchar(word) > 7), 1, 0)),
         small_word_count =
           sum(ifelse((nchar(word) < 3), 1, 0)),
         #assign more weight to these words using "10" below
         explicit_word_count =
          sum(ifelse(word %in% explicit_words$explicit_word,10,0)),
         #assign more weight to these words using "20" below
         book_word_count =
           sum(ifelse(word %in% book_words$top_word,20,0)),
         christian_word_count =
           sum(ifelse(word %in% christian_words$top_word,1,0)),
         country_word_count =
           sum(ifelse(word %in% country_words$top_word,1,0)),
         hip_hop_word_count =
           sum(ifelse(word %in% hip_hop_words$top_word,1,0)),
         pop_rock_word_count =
           sum(ifelse(word %in% pop_rock_words$top_word,1,0))
         ) %>%
  select(-word) %>%
  distinct() %>% #to obtain one record per document
  ungroup()

features$genre <- as.factor(features$genre)
return(features)
}技术支持

现在对训练与测试数据集调用您的features()函数。

 train <- features_func_genre(five_sources_tidy)
test  <- features_func_genre(five_sources_test_tidy)技术支持

机器学习流程

如果您之前没用过mlr包，也没关系。我们一步一步来，您会发现流程其实很直接。同样强烈建议您查看这份教程，它是该包最全面的文档。您也可以访问mlr.org。

mlr（Machine Learning for R）是一个框架，涵盖所有常用的机器学习算法。这里不讲每种算法背后的理论，而是聚焦其实现。到本教程结束时，您将使用多种分类工具，若能结合这里的代码动手练习，收获最大。

完成特征工程后，ML 流程很简单：创建任务，指定学习器，训练，测试。您将按以下步骤进行：

• 创建分类任务：声明数据集与输出（目标）变量
• 数据归一化：预处理（缩放与中心化）
• 创建学习器列表：选择学习算法
• 选择重采样方法：在训练过程中用验证集评估性能
• 选择度量：创建如准确率或错误率等度量列表
• 执行训练/基准测试：基于任务与学习器比较模型结果
• 调优最佳模型：选择表现最佳的学习器，调节超参数
• 在新数据上测试：让模型对从未见过的数据进行预测

分类任务

任务只是学习器学习的数据集。由于是分类问题，您将使用makeClassifTask()创建分类任务。需要通过target参数传入分类输出变量genre。

我在下面创建了三个任务，目的不同。测试与训练不必多说，另有一个只使用基础定量特征（文档汇总与计数）的数据集。这个任务task_train_subset不包含流派词计数特征（如country_word_count、pop_rock_word_count等），用于说明这些语境型预测变量对最终模型的重要性。使用数据集train[3:13]即可移除这些变量。另外，创建分类任务时应始终移除文本列，本例中它们位于数据框的第 1 和第 2 列。

 #create classification tasks to use for modeling

#this dataset does not include genre specific words
task_train_subset <- makeClassifTask(id = "Five Sources Feature Subset",
                                     data = train[3:13], target = "genre")

#create the training dataset task
task_train <- makeClassifTask(id = "Five Sources",
                              data = train[-c(1:2)], target = "genre")

#create the testing dataset task
task_test <- makeClassifTask(id = "New Data Test",
                             data = test[-c(1:2)], target = "genre")技术支持

数据归一化

数据归一化是一个需要稍作研究的话题，并非总是必要，视数据集而定；但在本例中是有益的。它只是将数据缩放到零与一（或您传入的区间）之间的方法。如果某些变量取值远大、量纲不同，会让模型对这些变量赋予更高权重而产生偏差。归一化可以解决这一问题。这里有一个不错的讨论帖。这是预处理中的重要步骤，值得进一步研究。mlr提供了一个简单的normalizeFeatures()函数来完成此步骤。

 
#scale and center the training and test datasets
task_train_subset <- normalizeFeatures(task_train_subset, method = "standardize",
  cols = NULL, range = c(0, 1), on.constant = "quiet")

task_train <- normalizeFeatures(task_train, method = "standardize",
  cols = NULL, range = c(0, 1), on.constant = "quiet")

task_test <- normalizeFeatures(task_test, method = "standardize",
  cols = NULL, range = c(0, 1), on.constant = "quiet")技术支持

创建学习器列表

在mlr中，使用makeLearner()生成学习器。在构造时需指定要使用的学习方法。调用listLearners("classif")[c("class","package")]可获取可选分类算法的列表，同时还能看到它们依赖的包（可能需要单独安装）。

在本练习中，我选择了能处理多类问题并覆盖广泛技术的方法列表，从决策树到随机森林、支持向量机、梯度提升与神经网络。mlr中有许多学习器可选（目前有 80 多种分类学习器），鼓励您多加尝试！

 #create a list of learners using algorithms you'd like to try out
lrns = list(
makeLearner("classif.randomForest", id = "Random Forest", predict.type = "prob"),
makeLearner("classif.rpart", id = "RPART", predict.type = "prob"),
makeLearner("classif.xgboost", id = "xgBoost", predict.type = "prob"),
makeLearner("classif.kknn", id = "KNN"),
makeLearner("classif.lda", id = "LDA"),
makeLearner("classif.ksvm", id = "SVM"),
makeLearner("classif.PART", id = "PART"),
makeLearner("classif.naiveBayes", id = "Naive Bayes"),
makeLearner("classif.nnet", id = "Neural Net", predict.type = "prob")
)技术支持

重采样

重采样是机器学习中的重要工具，值得单独开一篇教程。此处只需基本理解即可。它涉及从训练集中重复抽样，并在每个样本上重新拟合模型。这可能让您获得仅用原始训练数据拟合一次无法获得的信息。

重采样有多种方法，这里使用的是 k 折交叉验证，在makeResampleDesc()函数调用中的“CV”即表示该方法，返回重采样描述对象（rdesc）。该方法将数据集随机划分为k个等大小分组（折）。第一个折作为验证集，其余折用于训练。对每个折重复k次。每次迭代记录错误率，最后取平均。

如果您第一次接触重采样，这听起来可能有些晦涩，但这是必须熟悉的关键概念！下面的示例将使用 10 折交叉验证。“对于分类问题，通常希望每个折中类别比例一致。”（来源）使用stratify = TRUE即可保证这一点。

有关mlr中的重采样更多信息，请查看这篇文章。

 # n-fold cross-validation
#use stratify for categorical outcome variables
rdesc = makeResampleDesc("CV", iters = 10, stratify = TRUE)技术支持

性能度量

分类的典型目标是获得较高的预测准确率并最小化错误数。在此意义上，各种误分类错误被视为同等权重。然而在许多应用中，不同类型的错误影响不同。例如，若判断病人是否患病，未能识别真实疾病的误分类可能危及生命。不同的性能度量可反映这些细微差别。但在歌词分析中，您主要关注基本的准确率与错误率。请记住，准确率与错误率并非总是评估模型稳健性的最佳选择。这个重要主题也值得在教程之外进一步讨论。

准确率是所有预测中预测正确的数量。为检查模型的误分类，您还将查看混淆矩阵，了解实际与预测的对应关系。稍后详述。现在先设定感兴趣的度量列表。我这里添加了三个度量，但我们仅查看acc。更多可用性能度量的信息请参阅此链接。

 #let the benchmark function know which measures to obtain
#accuracy, time to train
meas = list(acc, timetrain)技术支持

训练模型 / 基准测试

在mlr中，您可以进行基准实验，将不同算法（学习方法）应用到数据集上。这可以让您根据特定度量（如准确率）比较算法表现。您将运行benchmark()来训练模型，并生成BenchmarkResult对象，可从中访问模型与结果。

特征子集

终于到了建模的时候。先使用不包含流派特定词计数的任务。向benchmark传入学习器列表、子集任务、重采样策略（rdesc）以及度量列表。

 #it would be best to loop through this multiple times to get better results
#so consider adding a for loop here!
set.seed(123)
bmr <- benchmark(lrns, task_train_subset, rdesc, meas, show.info = FALSE)

#I'm just accessing an aggregated result directly so you can see
#the object structure and so I can use the result in markdown narrative
rf_perf <- round(bmr$results$`Five Sources Feature Subset`$`Random Forest`$aggr[[1]],2) * 100技术支持

## [1] "BenchmarkResult"技术支持

class(bmr)
bmr技术支持

##                       task.id    learner.id acc.test.mean
## 1 Five Sources Feature Subset Random Forest     0.7282895
## 2 Five Sources Feature Subset         RPART     0.6516754
## 3 Five Sources Feature Subset       xgBoost     0.6871616
## 4 Five Sources Feature Subset           KNN     0.6676070
## 5 Five Sources Feature Subset           LDA     0.6632281
## 6 Five Sources Feature Subset           SVM     0.6965042
## 7 Five Sources Feature Subset          PART     0.6561634
## 8 Five Sources Feature Subset   Naive Bayes     0.6184923
## 9 Five Sources Feature Subset    Neural Net     0.7073271
##   timetrain.test.mean
## 1               0.892
## 2               0.013
## 3               0.062
## 4               0.000
## 5               0.007
## 6               0.222
## 7               0.218
## 8               0.012
## 9               0.252技术支持

查看BenchmarkResult对象，您可以看到传入的每种算法的acc.test.mean。注意这里特指test，它是交叉验证训练过程中各次验证集的平均准确率。这与您稍后使用的测试数据集不同。这也是一个值得深入解释的话题，但请记住：在交叉验证中有一系列被留出的验证数据集，而选择算法并调参之后，您会再使用一个测试数据集。

在这次基准实验中，您会发现随机森林以r rf_perf百分比表现最佳（且训练时间最长）。记住这个值，随后在完整特征集上重跑实验。

完整特征集

这次传入包含每个文档流派特定词计数的任务。它新增了指示歌曲是否包含更多乡村词、流行摇滚词等的特征。回想一下，您使用带标签的数据集，选出了最常见的嘻哈词，并将其放入名为hip_hop_words的列表，其中有thug、crib、drug等词。乡村词列表包含lonesome、coal、drunken、cattle等。您明白了。

mlr提供了多种访问基准结果的方法。这里我只用少数几个，但要熟悉基准对象，建议使用getBMR*系列getter函数。如果对基准对象调用str()，恐怕要等很久才能返回细节！

在详细查看完整特征集之前，先基准测试多个任务，并使用plotBMRSummary()比较完整特征集与上述特征子集。方法是创建任务列表传入benchmark()。

 #always set.seed to make sure you can replicate your results
set.seed(123)
task_list <- list(task_train, task_train_subset)
bmr_multi_task <- benchmark(lrns, task_list, rdesc, meas, show.info = FALSE)

plotBMRSummary(bmr_multi_task)技术支持

可以看到，不含流派特定词计数的训练子集的acc.test.mean低于完整特征数据集。这表明这些特征影响巨大！这种小小的创意步骤仅在文本机器学习中可见。把它装进您的工具箱，以备今后项目使用。

尽管可以直接从bmr_multi_task获取训练结果，但我们再仅基于训练任务做一次基准测试，然后用getBMRAggrPerformances()与plotBMRBoxplots()更仔细地查看结果。

 set.seed(123)
bmr = benchmark(lrns, task_train, rdesc, meas, show.info = FALSE)

plotBMRSummary(bmr)技术支持

这让您可以聚焦查看完整特征数据集的结果。现在更清晰地看到算法间差异，以及random forest如何优于其他算法。

 plotBMRBoxplots(bmr, measure = acc, style = "violin",
                pretty.names = FALSE) +
  aes(color = learner.id) +
  ylab("Accuracy") +
  theme(strip.text.x = element_text(size = 8))技术支持

这些小提琴图展示了基准测试多次迭代中每种方法的结果。

 performances <- getBMRAggrPerformances(bmr, as.df = TRUE) %>%
  select(ModelType = learner.id, Accuracy = acc.test.mean) %>%
  mutate(Accuracy = round(Accuracy, 4)) %>%
  arrange(desc(Accuracy))

#just for use in markdown narrative
first_three <- round(performances$Accuracy[1:3],2) * 100

performances %>%
  my_kable_styling("Validation Set Model Comparison")技术支持

可以看到，随机森林、神经网络与 xgBoost 的准确率最高，分别为r first_three。那么模型到底发生了什么？这些文档/歌曲是如何被分类的？哪些流派仅凭歌词最难分类？为获得更多洞见，查看预测结果的混淆矩阵。在该矩阵中，对角线是正确分类的文档数，非对角线是误分类。边际处为错误统计。列代表预测值，行代表真实值。使用getBMRPredictions()访问训练/验证集的预测结果。然后查看您此前标记为训练任务、id 为Five Sources的随机森林模型的混淆矩阵result。（注意，您也可以对基准结果中的任意模型执行此操作。）

 predictions <- getBMRPredictions(bmr)

calculateConfusionMatrix(predictions$`Five Sources`$`Random Forest`)$result  %>%
  my_kable_styling("Random Forest Confusion Matrix: Rows are True, Columns are Predictions")技术支持

您终于对模型有了一些洞见！正如预期，仅有一次误分类的“数据科学”与歌曲歌词很容易区分，这要归功于您工程化的文本元数据特征。此外，嘻哈说唱与其他音乐流派的差异也很明显，仅有八次误分类。不过，尽管整体表现相当不错，乡村、基督教与流行摇滚歌词之间的区分度较低。

本教程的目的不仅是接触预测型机器学习技术，也是在本系列前几篇基础上继续进行歌词分析。所以想一想这些结果意味着什么。如果您在开发一个结合歌词洞见的推荐系统，应考虑哪些因素？系统是否可能为基督教音乐听众或乡村乐迷推荐带有露骨歌词的嘻哈艺人？

还记得教程开头的弦图吗？再看一看，这次用预测结果而非真实标签。

 train$id <- seq_len(nrow(train))
df <- predictions$`Five Sources`$`Random Forest`$data

chart <- train %>%
  inner_join(predictions$`Five Sources`$`Random Forest`$data) %>%
  group_by(source, response) %>%
  summarise(n())

circos.clear() #very important! Reset the circular layout parameters
#assign chord colors
grid.col = c("christian" = my_colors[1], "pop-rock" = my_colors[2],
             "hip-hop-rap" = my_colors[3], "data-science" = my_colors[4],
             "country" = my_colors[5],
             "amy-grant" = my_colors[1], "prince" = my_colors[2],
             "eminem" = my_colors[3], "machine_learning" = my_colors[4],
             "johnny-cash" = my_colors[5])

# set the global parameters for the circular layout. Specifically the gap size
circos.par(gap.after = c(rep(5, length(unique(chart[[1]])) - 1), 15,
                         rep(5, length(unique(chart[[2]])) - 1), 15))

chordDiagram(chart, grid.col = grid.col, transparency = .2)
title("Predicted Relationship Between Genre and Source - Train")技术支持

很酷吧。现在您可以看到在训练数据上的表现。结果再次令人印象深刻。细线代表误分类。但这里可能是本教程最重要的概念：尽管这是验证集的准确率结果，它仍然基于带标签的训练数据！若不小心，您可能会过拟合模型并引入高方差。高方差意味着学习算法对所给数据非常敏感。这可能导致算法对从未见过的新数据中引入的噪声不够稳健。稍后当您输入全新的数据时，将对模型进行真正的测试。

在测试新数据之前，您需要选择一个模型并对其进行调优。这将通过调整超参数来实现。最近如果您访问过Kaggle，会注意到一种流行算法——极端梯度提升——在竞赛中占据主导。尽管它在我们的基准中并非表现最好的模型，我仍会选择它进行调优并在测试数据集上运行。如果您对这类算法尚不熟悉，调参可能是最难的部分。受限于篇幅，我无法讲解极端梯度提升的原理或其超参数，但下面的代码会提供起点。强烈建议在深入调参前先了解梯度提升的概念。这篇文章（作者 Prince Grover）是很好的入门。按照他的描述，经典梯度提升的一般流程如下：

先用简单模型拟合数据并分析错误。这些错误表明那些难以用简单模型拟合的数据点。随后在后续模型中特别关注这些难点数据，将其拟合好。最后，将所有基学习器组合起来，并为每个学习器赋予一定权重。

（顺带一提：下面makeTuneControlRandom()中的maxit取 150，运行时间相当久。您可能希望从更小的数开始。）

调优模型 - xgBoost

 #experiment here!! this is where you can really improve your model
xgb_params <- makeParamSet(
  makeDiscreteParam("booster",values = c("gbtree")),
  makeIntegerParam("nrounds",lower=10,upper=20),
  makeIntegerParam("max_depth",lower = 4,upper = 6),
  makeNumericParam("min_child_weight",lower = 1L,upper = 10L),
  makeNumericParam("subsample",lower = 0.5,upper = 1),
  makeNumericParam("colsample_bytree",lower = 0.5,upper = 1),
  makeNumericParam("eta",lower = .01, upper = .2)
)
control <- makeTuneControlRandom(maxit = 150L)

xglearn <- makeLearner("classif.xgboost", predict.type = "prob", id="tuned xgboost")

library(parallelMap)
parallelStartSocket(2)
set.seed(123)
tuned_params <- tuneParams(
  learner = xglearn,
  task = task_train,
  resampling = rdesc,
  par.set = xgb_params,
  control = control,
  measures = acc,
  show.info = TRUE
)

xgb_tuned_learner <- setHyperPars(
  learner = xglearn,
  par.vals = tuned_params$x
)

tuned_params$x
 技术支持

## $booster
## [1] "gbtree"
##
## $nrounds
## [1] 16
##
## $max_depth
## [1] 5
##
## $min_child_weight
## [1] 1.395328
##
## $subsample
## [1] 0.6397534
##
## $colsample_bytree
## [1] 0.7986664
##
## $eta
## [1] 0.1917797技术支持

您可以通过查看tuneParams()的输出检视优化后的参数。现在要使用调优后的超参数创建新模型，并在训练数据集上重新训练。

lrns = list(makeLearner("classif.nnet", predict.type = "prob"),
            makeLearner("classif.PART", predict.type = "prob"),
            makeLearner("classif.randomForest", predict.type = "prob"),
            makeLearner("classif.xgboost", id="untunedxgboost" ,predict.type = "prob"),
            xgb_tuned_learner)

set.seed(123)
bmr = benchmark(lrns, task_train, rdesc, meas)
plotBMRBoxplots(bmr, measure = acc, style = "violin", pretty.names = FALSE) +
  aes(color = learner.id) +
  ylab("Accuracy") +
  theme(strip.text.x = element_text(size = 8))技术支持

 performances <- getBMRAggrPerformances(bmr, as.df = TRUE) %>%
  select(ModelType = learner.id, Accuracy = acc.test.mean) %>%
  mutate(Accuracy = round(Accuracy, 4)) %>%
  arrange(desc(Accuracy))

# #used in markdown
# first_three <- round(performances$Accuracy[1:3],2) * 100

performances %>%
  my_kable_styling("Validation Set Model Comparison")技术支持

调优后的 xgBoost 仅略高于未调优版本，且仍不及随机森林准确。那么在测试数据上表现如何？

真正的测试：新数据

现在您已经有了调优模型与基准结果，可以在从未见过的测试数据集上，为排名前三的模型调用predict()。其中包含先前展示过的完全不同的五个来源。看看它们的表现与实际分类。

 set.seed(12)
rf_model = train("classif.randomForest", task_train)
result_rf <- predict(rf_model, task_test)
performance(result_rf, measures = acc)技术支持

##       acc
## 0.6541262技术支持

set.seed(12)
nnet_model = train("classif.nnet", task_train)技术支持

## # weights:  68
## initial  value 2500.439406
## iter  10 value 876.420114
## iter  20 value 531.977942
## iter  30 value 412.756436
## iter  40 value 334.449379
## iter  50 value 304.202353
## iter  60 value 295.229853
## iter  70 value 286.347519
## iter  80 value 282.524065
## iter  90 value 280.438058
## iter 100 value 278.713625
## final  value 278.713625
## stopped after 100 iterations技术支持

result_nnet <- predict(nnet_model, task_test)
performance(result_nnet, measures = acc)技术支持

##      acc
## 0.631068技术支持

set.seed(12)
xgb_model = train(xgb_tuned_learner, task_train)
result_xgb <- predict(xgb_model, task_test)
test_perf <- performance(result_xgb, measures = acc)
test_perf技术支持

##       acc
## 0.6492718技术支持

这些结果颇有意思。尽管随机森林在训练数据上的准确率高于调优后的 xgBoost，但在测试数据上却略微逊色。神经网络在测试集上的准确率也远低于训练集。神经网络模型非常灵活，因此容易对训练集过拟合。

调优 xgBoost 的测试准确率为r round(test_perf,2)*100% ，与训练相比仍有明显下降，而调参仅带来轻微改进（在本最小配置下！）。训练与测试准确率之间的这种下降十分常见，这正是为什么您应该在新数据上测试模型。

现在看看实际分类情况。

 calculateConfusionMatrix(result_xgb)$result %>%
  my_kable_styling("TEST: xgBoost Confusion Matrix: Rows are True, Columns are Predictions")技术支持

从混淆矩阵可以看到，这位嘻哈艺人Jay-Z要难分类得多。即便您不熟悉音乐，结果也表明用于训练模型的Eminem与测试数据中的Jay-Z之间可能存在差异。理想情况下，您会拥有更多数据、更多艺人、更多调参，并多次运行模型！

不过，想想这在提示什么。再看看弦图：

 test$id <- seq_len(nrow(test))

chart <- test %>%
  inner_join(result_xgb$data) %>%
  group_by(source, response) %>%
  summarise(n())

circos.clear() #very important! Reset the circular layout parameters
#assign chord colors
grid.col = c("christian" = my_colors[1], "pop-rock" = my_colors[2],
             "hip-hop-rap" = my_colors[3], "data-science" = my_colors[4],
             "country" = my_colors[5],
             "chris-tomlin" = my_colors[1], "michael-jackson" = my_colors[2],
             "jay-z" = my_colors[3], "machine_learning_r" = my_colors[4],
             "patsy-cline" = my_colors[5])

# set the global parameters for the circular layout. Specifically the gap size
circos.par(gap.after = c(rep(5, length(unique(chart[[1]])) - 1), 15,
                         rep(5, length(unique(chart[[2]])) - 1), 15))

chordDiagram(chart, grid.col = grid.col, transparency = .2)
title("Predicted Relationship Between Genre and Source - Test")技术支持

这错了吗？不准确吗？还是很有启发？我认为您正在窥见真实的音乐世界。想想看：Michael Jackson 是否与说唱艺人合作过？他是否唱过宗教主题？乡村艺人是否跨界到流行摇滚？您新的弦图实际上给出了比原始数据更现实的歌词分类！现实中，艺术家与流派之间并非通常的一一对应，而这种灵活性也反映在模型中。

预测上榜级别

教程的下一部分将探讨一个可用于市场、销售、科学、经济等领域的想法，这里将其应用到音乐。歌曲的成功很主观，而商业成功的概念更明确，可由行业标准定义。Billboard 排行榜（以及其他许多榜单）就是此类成功的衡量标准。如果您在唱片公司工作，需要决定签约哪些艺术家或推广哪些已签约艺人，若能仅根据歌词用科学方法预测其能否上榜，岂不有趣？您需要大量的最新数据以及描述每首歌的大量元数据。鉴于此处资源有限，我们就用现有数据，在标注了上榜信息的 Prince 歌词上测试这一想法。

获取数据

在之前的教程中，您创建了一个 Prince 歌曲数据集，其中大部分歌曲未上榜。这里我们将使用一个平衡的歌词集合，上榜与未上榜歌曲数量相同。如下所示：

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

prince_charted_data %>%
  count(charted) %>%
  my_kable_styling("Prince Data")技术支持

 prince_tidy <- prince_charted_data %>%
  unnest_tokens(word, lyrics) %>%
  anti_join(stop_words)技术支持

特征工程

使用与上文相同的流程，分两步创建特征。这次不是统计每首歌中每个流派的词数，而是统计每个上榜级别的词数。换句话说，找出上榜歌曲与未上榜歌曲最常用的词，分别存入列表。我选择了 1000 个词，效果较好。您可自行尝试不同数字。随后在构建歌曲特征时，务必添加两个特征：统计每首歌中属于这两个列表的词数（与上文流派的做法相同）。

同样地，我移除了同时出现在上榜与未上榜高频列表中的词。我还加入了几个额外的多项式特征，即对原始输入做平方。通过变换输入而非调参来改进模型的思想，是机器学习方法的基本功。

 number_of_words <- 1000

top_words_per_chart <- prince_tidy %>%
  group_by(charted) %>%
  mutate(chart_word_count = n()) %>%
  group_by(charted, word) %>%
  mutate(word_count = n(),
         word_pct = word_count / chart_word_count * 100) %>%
  select(word, charted, chart_word_count, word_count, word_pct) %>%
  distinct() %>%
  ungroup() %>%
  arrange(word_pct) %>%
  top_n(number_of_words) %>%
  select(charted, word, word_pct)

top_words <- top_words_per_chart %>%
  ungroup() %>%
  group_by(word) %>%
  mutate(multi_chart = n()) %>%
  filter(multi_chart < 2) %>%
  select(charted, top_word = word)

charted_words <- lapply(top_words[top_words$charted == "Charted",],
                        as.character)
uncharted_words <- lapply(top_words[top_words$charted == "Uncharted",],
                          as.character)


features_func_chart <- function(data, remove) {
  features <- data %>%
  group_by(song) %>%
  mutate(word_frequency = n(),
         lexical_diversity = n_distinct(word),
         lexical_density = lexical_diversity/word_frequency,
         repetition = word_frequency/lexical_diversity,
         document_avg_word_length = mean(nchar(word)),
         title_word_count = lengths(gregexpr("[A-z]\\W+",
                                             song)) + 1L,
         title_length = nchar(song),
         large_word_count =
           sum(ifelse((nchar(word) > 7), 1, 0)),
         small_word_count =
           sum(ifelse((nchar(word) < 3), 1, 0)),
         charted_word_count =
           sum(ifelse(word %in% charted_words$top_word,1,0)),
         uncharted_word_count =
           sum(ifelse(word %in% uncharted_words$top_word,1,0)),
         div_sq = lexical_diversity^2,
         den_sq = lexical_density^2,
         large_word_count2 = large_word_count^2
         ) %>%
  select(-remove) %>%
  distinct() %>% #to obtain one record per document
  ungroup()

features$charted <- as.factor(features$charted)
return(features)
}

#remove these fields from the passed dataframe
remove <- c("word", "X", "X.1", "year", "album", "peak", "us_pop", "us_rnb", "decade", "chart_level")
song_summary <- features_func_chart(prince_tidy, remove)技术支持

设置与训练

重复上述步骤，为 Prince 数据集创建分类任务，目标为charted字段。对数据进行归一化，设置交叉验证并创建学习器列表。这里我添加了几种不同算法，因为这次是二分类，而非之前的多分类。

 task_prince <- makeClassifTask(id = "Prince", data = song_summary[-1],
                               target = "charted")

task_prince <- normalizeFeatures(task_prince, method = "standardize",
  cols = NULL, range = c(0, 1), on.constant = "quiet")


# n-fold cross-validation
rdesc <- makeResampleDesc("CV", iters = 10, stratify = TRUE)

## Create a list of learners
lrns = list(
makeLearner("classif.randomForest", id = "Random Forest"),
makeLearner("classif.logreg", id = "Logistic Regression"),
makeLearner("classif.rpart", id = "RPART"),
makeLearner("classif.xgboost", id = "xgBoost"),
makeLearner("classif.lda", id = "LDA"),
makeLearner("classif.qda", id = "QDA"),
makeLearner("classif.ksvm", id = "SVM"),
makeLearner("classif.PART", id = "PART"),
makeLearner("classif.naiveBayes", id = "Naive Bayes"),
makeLearner("classif.kknn", id = "KNN"),
makeLearner("classif.nnet", id = "Neural Net")
)

set.seed(123)
bmr_prince = benchmark(lrns, task_prince, rdesc, meas, show.info = FALSE)技术支持

基准建立后，以多种形式查看结果。注意学习器表现与上文的不同之处。

plotBMRSummary(bmr_prince)
技术支持

 plotBMRBoxplots(bmr_prince, measure = acc, style = "violin", pretty.names = FALSE) +
  aes(color = learner.id) +
  ylab("Accuracy") +
  theme(strip.text.x = element_text(size = 8))技术支持

 #with knn so you can see the numbers
getBMRAggrPerformances(bmr_prince, as.df = TRUE) %>%
  select(ModelType = learner.id, Accuracy = acc.test.mean) %>%
  mutate(Accuracy = round(Accuracy, 4)) %>%
  arrange(desc(Accuracy)) %>%
  my_kable_styling("Validation Set Model Comparison")技术支持

在预测上榜级别时，您面对的是两类问题：要么上榜，要么未上榜。而在预测流派时是多类问题，有两个以上的可能类别。（注意这不同于多标签问题，即一个观测可同时属于多个类别。这或许值得探索！）由于这是一个二项分类问题，我添加了几种更适合二类问题的算法：QDA 与逻辑回归。

逻辑回归针对二元结果，建模观测（歌曲）属于某一类别的概率。基于默认阈值.5：概率大于.5的归为目标类，小于该阈值的归为另一类。该阈值可调整。QDA（二次判别分析）更灵活，能处理二次而非线性的决策边界。抛出这些术语而不展开并不公平，因此请花时间查看您手头的数据、表现良好的算法，并分别深入研究。希望这些分析能激发您去查阅细节！

下一步是运行预测并查看分类结果。

 predictions <- getBMRPredictions(bmr_prince)

calculateConfusionMatrix(predictions$Prince$`QDA`)$result %>%
  my_kable_styling("Logistic Regression Confusion Matrix: Rows are True, Columns are Predictions")技术支持

误分类

查看模型如何对每首歌进行分类非常容易。对于二分类，有相当多的度量可供检视。此处我们只看假阳性——即预测会上榜但实际上未进入 Top 100 的歌曲。

 false_positives <- as.data.frame(predictions$Prince$`QDA`) %>%
  filter(truth == "Uncharted" & response == "Charted")

song_summary$id <- seq_len(nrow(song_summary))
song_summary %>%
  inner_join(false_positives) %>%
  inner_join(prince_charted_data) %>%
  select(song, response, truth, peak, album, year) %>%
  my_kable_styling("False Positive Prince Songs")技术支持

测试集在哪？

尽管您在训练模型时使用了交叉验证，仍应将该模型应用于独立数据集（就像上面的流派预测那样）。这部分留作练习，欢迎您反馈结果。若要真实检验基于歌词分析的预测能力，最现实的做法是选一位与 Prince 同为流行摇滚的艺术家。另一个因素是时间段。这些歌曲主要在 70、80、90 年代上榜，因此选择同一时期的艺术家很关键。或者，您也可以自选艺术家来构建训练与测试数据，看看会得到什么！

结论

在本教程中，您构建了一个仅基于歌词预测歌曲流派的模型。您使用了监督式机器学习分类算法，在由五位不同艺术家与五种不同流派组成的数据集上训练模型。借助mlr框架，您创建了任务、学习器与重采样策略，以训练并调优模型。随后，您将模型应用于由不同艺术家组成的未见测试数据集。您能够识别默认设置下表现更好的算法，并最终预测模型从未见过的新歌的流派。

就歌词分析而言，应当清楚：即使音乐行业（以及 Billboard 排行）为每位艺术家预设了流派，您的分析表明，从歌词角度看，歌曲跨越流派并不罕见，艺术家与流派通常并非一一对应。（作为一名词曲作者，我的流派标语是“funkified, acoustic, rockin' soul!”）。您还用同样技术，仅基于歌词对歌曲能否上榜建模，在训练数据上取得了不错的准确率。接下来就把这些知识应用到您自己的数据集上吧！

我很高兴能与您一起完成这套三部分（四篇教程）的歌词分析系列。希望您已经体会到处理这类文本的复杂性，以及与其他文本形式（如非虚构）相比，歌词所蕴含的微妙之处。也希望您学到了新技能，并受到启发，用自己的数据去发掘新主题的洞见。机器学习是一个令人兴奋的领域，无论您是新晋还是资深数据科学家，创意、灵感与坚持都会让您脱颖而出。请记住，跳出“平行四边形”的框架，享受学习之旅！

“我把脚放在起跑线上，启程奔向崭新的一天。我向风中送去一吻，闭上眼睛，将恐惧踢开。——Debbie Liske，《New Day》”

（顺便说一句，我写了 100 多首自己的歌，并用最后那个模型跑过我的音乐。它预测我的 35 首歌本该上榜！要是我早知道这套技术就好了！！也许我下一篇文章应该讲如何用歌词分析，基于当下艺人来写一首热门歌曲……）

附录

进一步分析的主题

我在文中简要提及以下主题，鼓励您花时间深入理解各个主题。

• 多次重复构建模型，每次分别划分数据。
• 理解各算法背后的概念，以及为何某些算法在特定数据集上表现更好。
• 回顾性能度量的不同方面，并理解为何在不同用例下有些度量更相关。
• 学习如何为不同类型的模型调节超参数。
• 深入研究重采样（交叉验证与自助法）并理解其目的。
• 除 mlr 之外，考虑其他包以获得更全面的知识。
• 查阅各类研究论文，了解歌词分析领域的最新进展。

如有问题，欢迎在评论区留言！

以下是数据集链接：

• five_sources_data_balanced.csv
• five_sources_data_test.csv
• explicit_words.csv
• prince_data_balanced.csv