R-机器学习快速启动指南-全-
R 机器学习快速启动指南（全）
原文：
annas-archive.org/md5/13dee0bdb6445b090ed411f424dc82f4译者：飞龙
前言
本书提供了关于如何使用机器学习算法创建预测模型的实际指南。在教程中使用玩具或小型数据集来学习机器学习是很常见的，这对于学习基本概念非常实用，但在尝试将所学应用于实际问题时不充分。
本书涵盖了基于机器学习算法开发预测模型的主要步骤。数据收集、数据处理、单变量和多变量分析以及应用最常用的机器学习算法是本书中描述的一些步骤。这是一本编程书，包含多行代码，因此你可以复制书中描述的所有步骤。
这本书展示了为什么不存在唯一的建模可能性；在每一个建模步骤中存在的不同选项是实现准确和有用模型的关键。
本书中的应用案例基于金融行业。这主要是因为我对信息和问题很熟悉，并且因为存在大量数据可以应用多种技术，这可以代表现实生活中可以找到的问题。
本书的理论框架基于解释金融危机及其原因。我们能否预测下一次金融危机？如果不能，至少你会学到非常实用的数据压缩技术。
本书面向的对象
这本书是研究生有用的教科书，也是研究人员以及想要了解如何处理大量数据以及预测模型开发和机器学习算法应用中主要问题的机器学习和大数据实践者的参考书。它涵盖了机器学习中的基本现代主题，并描述了算法应用的一些关键方面。本书聚焦于信用风险和金融危机，因此对该领域的学者也可能很有趣。
本书涵盖的内容
第一章，机器学习中的 R 基础，介绍了本书将解决的问题，并涵盖了获取和运行 R 以供后续章节使用的基础知识。
第二章，预测银行失败 - 数据收集，涵盖了在收集数据时出现的主要问题以及如何构建数据以获得相关特征或变量来开发你的第一个预测模型。
第三章，预测银行失败 - 描述性分析，展示了如何观察和描述数据，如何处理高度不平衡的数据，以及如何处理变量中的缺失值。
第四章，预测银行失败 - 单变量分析，涵盖了变量个体预测能力和它们与目标变量之间关系的分析和测量。此外，由于变量数量较多，本章还包括了一些减少变量数量的技术。
第五章，预测银行失败 - 多变量分析，展示了不同机器学习算法的实现。逻辑回归、正则化方法、梯度提升、神经网络以及支持向量机（SVM）被简要解释并实现，以尝试获得一个准确预测银行失败的模型。本章还包括了一些基本指南，关于如何结合不同模型的结果以提高我们模型的准确性，以及如何以自动和可视化的方式生成模型。
第六章，可视化各国经济问题，涵盖了金融危机演变为主权债务危机的过程，这一危机甚至动摇了欧盟的基础和偿债能力。本章展示了如何衡量不同国家的宏观经济失衡。具体来说，本章将帮助您理解聚类分析、自然中的无监督模型以及这些技术如何帮助解决监督问题。
第七章，主权危机 - 自然语言处理和主题建模，介绍了文本挖掘和主题提取的概念。本章表明，文本挖掘在收集定性报告中的信息方面非常有用。
为了充分利用本书
本书是一本编程书，因此一些编程经验对于充分利用本书内容是可取的。如果您确实是一位编程新手，第一章，机器学习中的 R 语言基础，将为您提供理解 R 语言及其工作原理的起点。基本概念、概念和结构将被简要解释。
这第一章不会让您成为 R 语言的专家，但它为您提供了理解本书中所有代码的关键指南。
需要最新版本的 R 和 RStudio 来复制本书中包含的编程代码。
下载示例代码文件
您可以从www.packt.com的账户下载本书的示例代码文件。如果您在其他地方购买了这本书，您可以访问www.packt.com/support并注册，以便将文件直接通过电子邮件发送给您。
您可以通过以下步骤下载代码文件：
-
在www.packt.com登录或注册。
-
选择“支持”标签。
-
点击“代码下载与勘误表”。
-
在搜索框中输入书籍名称，并遵循屏幕上的说明。
文件下载后，请确保您使用最新版本解压缩或提取文件夹。
-
适用于 Windows 的 WinRAR/7-Zip
-
适用于 Mac 的 Zipeg/iZip/UnRarX
-
适用于 Linux 的 7-Zip/PeaZip
本书代码包也托管在 GitHub 上，网址为github.com/PacktPublishing/Machine-Learning-with-R-Quick-Start-Guide。如果代码有更新，它将在现有的 GitHub 仓库中更新。
我们还有其他来自我们丰富的书籍和视频目录的代码包，可在github.com/PacktPublishing/找到。查看它们吧！
下载彩色图像
我们还提供了一份包含本书中使用的截图/图表彩色图像的 PDF 文件。您可以从这里下载：www.packtpub.com/sites/default/files/downloads/9781838644338_ColorImages.pdf。
使用的约定
本书使用了多种文本约定。
CodeInText：表示文本中的代码单词、数据库表名、文件夹名、文件名、文件扩展名、路径名、虚拟 URL、用户输入和 Twitter 昵称。以下是一个示例：“我们可以使用list()创建列表，或者通过连接其他列表来创建。”
代码块设置如下：
n<-10
n
## [1] 10
任何命令行输入或输出都按以下方式编写：
install.packages("ggplot2")
粗体：表示新术语、重要单词或您在屏幕上看到的单词。例如，菜单或对话框中的单词在文本中显示如下。以下是一个示例：“寻找下载和安装 R，并选择您的操作系统。我们正在为 Windows 安装，因此选择 Windows 链接。”
联系我们
我们欢迎读者的反馈。
一般反馈：如果您对本书的任何方面有疑问，请在邮件主题中提及书名，并给我们发送电子邮件至customercare@packtpub.com。
勘误：尽管我们已经尽最大努力确保内容的准确性，但错误仍然可能发生。如果您在这本书中发现了错误，我们将不胜感激，如果您能向我们报告，我们将不胜感激。请访问www.packt.com/submit-errata，选择您的书籍，点击勘误提交表单链接，并输入详细信息。
盗版：如果您在互联网上以任何形式遇到我们作品的非法副本，我们将不胜感激，如果您能提供位置地址或网站名称，我们将不胜感激。请通过链接至材料的方式与我们联系至copyright@packt.com。
如果您想成为一名作者：如果您在某个领域有专业知识，并且对撰写或参与一本书籍感兴趣，请访问authors.packtpub.com.
评论
请留下您的评价。一旦您阅读并使用了这本书，为何不在购买它的网站上留下评价呢？潜在读者可以查看并使用您的客观意见来做出购买决定，我们 Packt 公司可以了解您对我们产品的看法，并且我们的作者可以查看他们对书籍的反馈。谢谢！
如需了解更多关于 Packt 的信息，请访问packt.com。
第一章：机器学习 R 基础
您可能已经习惯了在新闻中听到诸如大数据、机器学习和人工智能等词汇。每天出现的新应用这些术语的数量令人惊讶。例如，亚马逊、Netflix 使用的推荐系统、搜索引擎、股市分析，甚至语音识别等，只是其中的一小部分。每年都会出现不同的新算法和新技术，其中许多基于先前的方法或结合了不同的现有算法。同时，越来越多的教程和课程专注于教授这些内容。
许多课程存在一些共同限制，如解决玩具问题或全部关注算法。这些限制可能导致您对数据建模方法产生错误的理解。因此，建模过程在业务和数据理解、数据准备等步骤之前就非常重要。如果没有这些前期步骤，未来模型应用时可能存在缺陷。此外，模型开发在找到合适的算法后并未结束。模型性能评估、可解释性和模型的部署也非常相关，并且是建模过程的最终成果。
在这本书中，我们将学习如何开发不同的预测模型。本书中包含的应用或示例基于金融领域，并尝试构建一个理论框架，帮助您理解金融危机的原因，这对世界各地的国家产生了巨大影响。
本书使用的所有算法和技术都将使用 R 语言实现。如今，R 是数据科学的主要语言之一。关于哪种语言更好的争论非常激烈，R 或 Python。这两种语言都有许多优点和一些缺点。
根据我的经验，R 在金融数据分析方面更加强大。我发现了很多专注于这个领域的 R 库，但在 Python 中并不多见。尽管如此，信用风险和金融信息与时间序列的处理密切相关，至少在我看来，Python 在这方面表现更好。循环或长短期记忆（LSTM）网络在 Python 中的实现也更为出色。然而，R 提供了更强大的数据可视化和交互式风格的库。建议您根据项目需要交替使用 R 和 Python。Packt 提供了许多关于 Python 机器学习的优质资源，其中一些列在这里供您方便查阅：
-
《Python 机器学习——第二版》，
www.packtpub.com/big-data-and-business-intelligence/python-machine-learning-second-edition -
《动手实践数据科学和 Python 机器学习》，
www.packtpub.com/big-data-and-business-intelligence/hands-data-science-and-python-machine-learning -
《Python 机器学习实例》，
www.packtpub.com/big-data-and-business-intelligence/python-machine-learning-example
在本章中，让我们重温你对机器学习的知识，并使用 R 开始编码。
本章将涵盖以下主题：
-
R 和 RStudio 安装
-
一些基本命令
-
R 中的对象、特殊情况和基本运算符
-
控制代码流程
-
R 包的所有内容
-
进一步的步骤
R 和 RStudio 安装
让我们先从安装 R 开始。它是完全免费的，可以从cloud.r-project.org/下载。安装 R 是一个简单的任务。
让我们看看在 Windows PC 上安装 R 的步骤。对于在其他操作系统上安装，步骤简单，可在同一cloud.r-project.org/链接找到。
让我们从在 Windows 系统上安装 R 开始：
-
查找“下载并安装 R”，并选择你的操作系统。我们正在为 Windows 安装，所以选择 Windows 链接。
-
前往子目录并点击 base。
-
你将被重定向到一个显示下载 R X.X.X for Windows 的页面。在撰写本书时，你需要点击下载 R 3.5.2 for Windows 的版本。
-
保存并运行.exe 文件。
-
你现在可以选择安装 R 的设置语言。
-
将会打开一个设置向导，你可以继续点击“下一步”，直到到达“选择目标位置”。
-
选择你首选的位置并点击“下一步”。
-
点击“下一步”按钮几次，直到 R 开始安装。
-
安装完成后，R 将通过消息“完成 R for Windows 3.5.2 设置向导”通知你。你现在可以点击“完成”。
-
你可以在桌面上找到 R 的快捷方式，双击它以启动 R。
-
就像任何其他应用程序一样，如果你在桌面上找不到 R，你可以点击开始按钮，所有程序，然后查找 R 并启动它。
-
你将看到一个类似于以下截图的屏幕：
这是 R 命令提示符，等待输入。
关于 R 的注意事项
在输入命令之前，你必须知道 R 是一个区分大小写的和解释型语言。
你可以选择手动输入命令或根据你的意愿从源文件运行一组命令。R 提供了许多内置函数，为用户提供大部分功能。作为用户，你甚至可以创建用户自定义函数。
您甚至可以创建和操作对象。您可能知道，对象是可以分配值的任何东西。交互式会话要求在执行过程中所有对象都必须存在于内存中，而函数可以放在具有当前程序引用的包中，并且可以在需要时访问。
使用 RStudio
除了使用 R，还建议使用 RStudio。RStudio 是一个 集成开发环境（IDE），就像任何其他 IDE 一样，可以增强您与 R 的交互。
RStudio 提供了一个非常组织良好的界面，可以同时清楚地表示图表、数据表、R 代码和输出。
此外，R 提供了类似导入向导的功能，可以在不编写代码的情况下导入和导出不同格式的文件。
在看到标准的 R GUI 界面后，您会发现它与 RStudio 非常相似，但区别在于与 R GUI 相比，RStudio 非常直观且用户友好。您可以从菜单中选择许多选项，甚至可以根据您的需求自定义 GUI。桌面版 RStudio 可在 www.rstudio.com/products/rstudio/download/#download 下载。
RStudio 安装
安装步骤与 R 的安装非常相似，因此没有必要描述详细的步骤。
第一次打开 RStudio，您将看到三个不同的窗口。您可以通过转到文件，新建文件，并选择 R 脚本来启用第四个窗口：
在左上角的窗口中，可以编写脚本，然后保存并执行。接下来的左侧窗口代表控制台，其中可以直接执行 R 代码。
右上方的窗口允许可视化工作空间中定义的变量和对象。此外，还可以查看之前执行过的命令历史。最后，右下方的窗口显示工作目录。
一些基本命令
这里有一份有用的命令列表，用于开始使用 R 和 RStudio：
-
help.start(): 启动 R 文档的 HTML 版本 -
help(command)/??command/help.search(command): 显示与特定命令相关的帮助 -
demo(): 一个用户友好的界面，运行一些 R 脚本的演示 -
library(help=package): 列出包中的函数和数据集 -
getwd(): 打印当前活动的工作目录 -
ls(): 列出当前会话中使用的对象 -
setwd(mydirectory): 将工作目录更改为mydirectory -
options(): 显示当前选项中的设置 -
options(digits=5): 您可以打印指定的数字作为输出 -
history(): 显示直到限制为 25 的之前的命令 -
history(max.show=Inf): 不论限制如何，显示所有命令 -
savehistory(file=“myfile”): 保存历史记录（默认文件是.Rhistory文件） -
loadhistory(file=“myfile”): 回忆你的命令历史 -
save.image(): 保存当前工作空间到特定工作目录下的.RData文件 -
save(object list,file=“myfile.RData”): 将对象保存到指定文件 -
load(“myfile.RData”): 从指定文件加载特定对象 -
q(): 这将退出 R，并提示保存当前工作空间 -
library(package): 加载特定于项目的库 -
install.package(package): 从类似 CRAN 的存储库或甚至从本地文件下载并安装包 -
rm(object1, object2…): 删除对象
在 RStudio 中执行命令时，应在控制台中编写，然后必须按 Enter。
在 RStudio 中，可以通过结合代码行和纯文本来创建交互式文档。R 笔记本将有助于直接与 R 交互，因此当我们使用它时，可以生成具有出版质量的文档作为输出。
要在 RStudio 中创建新笔记本，请转到文件，新建文件，R 笔记本。默认笔记本将打开，如下截图所示：
这个笔记本是一个具有 .rmd 扩展名的纯文本文件。一个文件包含三种类型的内容：
-
（可选）由 --- 行包围的 YAML 标头
-
R 代码块由 ```pyr
- Text mixed with simple text formatting
R code chunks allow for the execution of code and display the results in the same notebook. To execute a chunk, click the run button within the chunk or place the cursor inside it and press Ctrl + Shift + Enter. If you wish to insert a chunk button on the toolbar, press Ctrl + Alt + I.
While saving the current notebook, a code and output file in HTML format will be generated and will be saved with the notebook. To see what the HTML file looks like, you can either click the Preview button or you can use the shortcut Ctrl + Shift + K. You can find and download all the code of this book as a R Notebook, where you can execute all the code without writing it directly.
Objects, special cases, and basic operators in R
By now, you will have figured out that R is an object-oriented language. All our variables, data, and functions will be stored in the active memory of the computer as objects. These objects can be modified using different operators or functions. An object in R has two attributes, namely, mode and length.
Mode includes the basic type of elements and has four options:
- Numeric: These are decimal numbers
- Character: Represents sequences of string values
- Complex: Combination of real and imaginary numbers, for example, x+ai
- Logical: Either true (
1) or false (0)
Length means the number of elements in an object.
In most cases, we need not care whether or not the elements of a numerical object are integers, reals, or even complexes. Calculations will be carried out internally as numbers of double precision, real, or complex, depending on the case. To work with complex numbers, we must indicate explicitly the complex part.
In case an element or value is unavailable, we assign NA, a special value. Usually, operations with NA elements result in NA unless we are using some functions that can treat missing values in some way or omit them. Sometimes, calculations can lead to answers with a positive or negative infinite value (represented by R as Inf or -Inf, respectively). On the other hand, certain calculations lead to expressions that are not numbers represented by R as NaN (short for not a number).
Working with objects
You can create an object using the <- operator:
n<-10
n
## [1] 10
```py
In the preceding code, an object called `n` is created. A value of `10` has been assigned to this object. The assignment can also be made using the `assign()` function, although this isn't very common.
Once the object has been created, it is possible to perform operations on it, like in any other programming language:
n+5
[1] 15
These are some examples of basic operations.
Let's create our variables:
x<-4
y<-3
Now, we can carry out some basic operations:
* Sum of variables:
x + y
[1] 7
* Subtraction of variables:
x - y
[1] 1
* Multiplication of variables:
x * y
[1] 12
* Division of variables:
x / y
[1] 1.333333
* Power of variables:
x ** y
[1] 64
Likewise in R, there are defined constants that are widely used, such as the following ones:
* The `pi` () number :
x * pi
[1] 12.56637
* Exponential function:
exp(y)
[1] 20.08554
There are also functions for working with numbers, such as the following:
* Sign (positive or negative of a number):
sign(y)
[1] 1
* Finding the maximum value:
max(x,y)
[1] 4
* Finding the minimum value:
min(x,y)
[1] 3
* Factorial of a number:
factorial(y)
[1] 6
* Square root function:
sqrt(y)
[1] 1.732051
It is also possible to assign the result of previous operations to another object. For example, the sum of variables `x` and `y` is assigned to an object named `z`:
z <- x + y
z
[1] 7
As shown previously, these functions apply if the variables are numbers, but there are also other operators to work with strings:
x > y
[1] TRUE
x + y != 8
[1] TRUE
The main logical operators are summarized in the following table:
| **Operator** | **Description** |
| < | Less than |
| <= | Less than or equal to |
| > | Greater than |
| >= | Greater than or equal to |
| == | Equal to |
| != | Not equal to |
| !x | Not *x* |
| x | *y* |
| x & y | *x* and *y* |
| isTRUE(x) | Test if *x* is TRUE |
# Working with vectors
A **vector** is one of the basic data structures in R. It contains only similar elements, like strings and numbers, and it can have data types such as logical, double, integer, complex, character, or raw. Let's see how vectors work.
Let's create some vectors by using `c()`:
a<-c(1,3,5,8)
a
[1] 1 3 5 8
On mixing different objects with vector elements, there is a transformation of the elements so that they belong to the same class:
y <- c(1,3)
class(y)
[1] "numeric"
When we apply commands and functions to a vector variable, they are also applied to every element in the vector:
y <- c(1,5,1)
y + 3
[1] 4 8 4
You can use the `:` operator if you wish to create a vector of consecutive numbers:
c(1:10)
[1] 1 2 3 4 5 6 7 8 9 10
Do you need to create more complex vectors? Then use the `seq()` function. You can create vectors as complex as number of points in an interval or even to find out the step size that we might need in machine learning:
seq(1, 5, by=0.1)
[1] 1.0 1.1 1.2 1.3 1.4 1.5 1.6 1.7 1.8 1.9 2.0 2.1 2.2 2.3 2.4 2.5 2.6
[18] 2.7 2.8 2.9 3.0 3.1 3.2 3.3 3.4 3.5 3.6 3.7 3.8 3.9 4.0 4.1 4.2 4.3
[35] 4.4 4.5 4.6 4.7 4.8 4.9 5.0
seq(1, 5, length.out=22)
[1] 1.000000 1.190476 1.380952 1.571429 1.761905 1.952381 2.142857
[8] 2.333333 2.523810 2.714286 2.904762 3.095238 3.285714 3.476190
[15] 3.666667 3.857143 4.047619 4.238095 4.428571 4.619048 4.809524
[22] 5.000000
The `rep()` function is used to repeat the value of *x*, *n* number of times:
rep(3,20)
[1] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
# Vector indexing
Elements of a vector can be arranged in several haphazard ways, which can make it difficult to access them when needed. Hence, indexing makes it easier to access the elements.
You can have any type of index vectors, from logical, integer, and character.
Vector of integers starting from 1 can be used to specify elements in a vector, and it is also possible to use negative values.
Let's see some examples of indexing:
* Returns the *n*th element of *x*:
x <- c(9,8,1,5)
* Returns all *x* values except the *n*th element:
x[-3]
[1] 9 8 5
* Returns values between *a* and *b*:
x[1:2]
[1] 9 8
* Returns items that are greater than *a* and less than *b*:
x[x>0 & x<4]
[1] 1
Moreover, you can even use a logical vector. In this case, either `TRUE` or `FALSE` will be returned if an element is present at that position:
x[c(TRUE, FALSE, FALSE, TRUE)]
[1] 9 5
# Functions on vectors
In addition to the functions and operators that we've seen for numerical values, there are some specific functions for vectors, such as the following:
* Sum of the elements present in a vector:
sum(x)
[1] 23
* Product of elements in a vector:
prod(x)
[1] 360
* Length of a vector:
length(x)
[1] 4
* Modifying a vector using the `<-` operator:
x
[1] 9 8 1 5
x[1]<-22
x
[1] 22 8 1 5
# Factor
A vector of strings of a character is known as a **factor**. It is used to represent categorical data, and may also include the different levels of the categorical variable. Factors are created with the `factor` command:
r<-c(1,4,7,9,8,1)
r<-factor(r)
r
[1] 1 4 7 9 8 1
Levels: 1 4 7 8 9
# Factor levels
**Levels** are possible values that a variable can take. Suppose the original value of 1 is repeated; it will appear only once in the levels.
Factors can either be numeric or character variables, but levels of a factor can only be characters.
Let's run the `level` command:
levels(r)
[1] "1" "4" "7" "8" "9"
As you can see, `1`, `4`, `7`, `8`, and `9` are the possible levels that the level `r` can have.
The `exclude` parameter allows you to exclude levels of a custom factor:
factor(r, exclude=4)
[1] 1 7 9 8 1
Levels: 1 7 8 9
Finally, let's find out if our factor values are ordered or unordered:
a<- c(1,2,7,7,1,2,2,7,1,7)
a<- factor(a, levels=c(1,2,7), ordered=TRUE)
a
[1] 1 2 7 7 1 2 2 7 1 7
Levels: 1 < 2 < 7
# Strings
Any value that is written in single or double quotes will be considered a **string**:
c<-"This is our first string"
c
[1] "This is our first string"
class(c)
[1] "character"
When I say single quotes are allowed, please know that even if you specify the string in single quotes, R will always store them as double quotes.
# String functions
Let's see how we can transform or convert strings using R.
The most relevant string examples are as follows:
* To know the number of characters in a string:
nchar(c)
[1] 24
* To return the substring of *x*, originating at a particular character in *x*:
substring(c,4)
[1] "s is our first string"
* To return the substring of *x* originating at one character located at *n* and ending at another character located at a place, *m*:
substring(c,1,4)
[1] "This"
* To divide the string *x* into a list of sub chains using the delimiter as a separator:
strsplit(c, " ")
[[1]]
[1] "This" "is" "our" "first" "string"
* To check if the given pattern is in the string, and in that case returns true (or `1`):
grep("our", c)
[1] 1
grep("book", c)
integer(0)
* To look for the first occurrence of a pattern in a string:
regexpr("our", c)
[1] 9
attr(,"match.length")
[1] 3
attr(,"index.type")
[1] "chars"
attr(,"useBytes")
[1] TRUE
* To convert the string into lowercase:
tolower(c)
[1] "这是我们第一条字符串"
* To convert the string into capital letters:
toupper(c)
[1] "THIS IS OUR FIRST STRING"
* To replace the first occurrence of the pattern by the given value with a string:
sub("our", "my", c)
[1] "这是我们第一条字符串"
* To replace the occurrences of the pattern with the given value with a string:
gsub("our", "my", c)
[1] "This is my first string"
* To return the string as elements of the given array, separated by the given separator using `paste(string,array, sep=“Separator”)`:
paste(c,"My book",sep=" : ")
[1] "这是我们第一条字符串：我的书"
# Matrices
You might know that a standard matrix has a two-dimensional, rectangular layout. Matrices in R are no different than a standard matrix.
# Representing matrices
To represent a matrix of *n* elements with *r* rows and *c* columns, the `matrix` command is used:
m<-matrix(c(1,2,3,4,5,6), nrow=2, ncol=3)
m
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
# Creating matrices
A matrix can be created by rows instead of by columns, which is done by using the `byrow` parameter, as follows:
m<-matrix(c(1,2,3,4,5,6), nrow=2, ncol=3,byrow=TRUE)
m
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 4 5 6
With the `dimnames` parameter, column names can be added to the matrix:
m<-matrix(c(1,2,3,4,5,6), nrow=2, ncol=3,byrow=TRUE,dimnames=list(c('Obs1', 'Obs2'), c('col1', 'Col2','Col3')))
m
col1 Col2 Col3
Obs1 1 2 3
Obs2 4 5 6
There are three more alternatives to creating matrices:
rbind(1:3,4:6,10:12)
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 4 5 6
[3,] 10 11 12
cbind(1:3,4:6,10:12)
[,1] [,2] [,3]
[1,] 1 4 10
[2,] 2 5 11
[3,] 3 6 12
m<-array(c(1,2,3,4,5,6), dim=c(2,3))
m
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
# Accessing elements in a matrix
You can access the elements in a matrix in a similar way to how you accessed elements of a vector using indexing. However, the elements here would be the index number of rows and columns.
Here a some examples of accessing elements:
* If you want to access the element at a second column and first row:
m<-array(c(1,2,3,4,5,6), dim=c(2,3))
m
[,1] [,2] [,3]
[1,] 1 3 5
[2,] 2 4 6
m[1,2]
[1] 3
* Similarly, accessing the element at the second column and second row:
m[2,2]
[1] 4
* Accessing the elements in only the second row:
m[2,]
[1] 2 4 6
* Accessing only the first column:
m[,1]
[1] 1 2
# Matrix functions
Furthermore, there are specific functions for matrices:
* The following function extracts the diagonal as a vector:
m<-matrix(c(1,2,3,4,5,6,7,8,9), nrow=3, ncol=3)
m
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
diag(m)
[1] 1 5 9
* Returns the dimensions of a matrix:
dim(m)
[1] 3 3
* Returns the sum of columns of a matrix:
colSums(m)
[1] 6 15 24
* Returns the sum of rows of a matrix:
rowSums(m)
[1] 12 15 18
* The transpose of a matrix can be obtained using the following code:
t(m)
[,1] [,2] [,3]
[1,] 1 2 3
[2,] 4 5 6
[3,] 7 8 9
* Returns the determinant of a matrix:
det(m)
[1] 0
* The auto-values and auto-vectors of a matrix are obtained using the following code:
eigen(m)
eigen() decomposition
$values
[1] 1.611684e+01 -1.116844e+00 -5.700691e-16
$vectors
[,1] [,2] [,3]
[1,] -0.4645473 -0.8829060 0.4082483
[2,] -0.5707955 -0.2395204 -0.8164966
[3,] -0.6770438 0.4038651 0.4082483
# Lists
If objects are arranged in an orderly manner, which makes them components, they are known as **lists**.
# Creating lists
We can create a list using `list()` or by concatenating other lists:
x<- list(1:4,"book",TRUE, 1+4i)
x
[[1]]
[1] 1 2 3 4
[[2]]
[1] "book"
[[3]]
[1] TRUE
[[4]]
[1] 1+4i
Components will always be referred to by their referring numbers as they are ordered and numbered.
# Accessing components and elements in a list
To access each component in a list, a double bracket should be used:
x[[1]]
[1] 1 2 3 4
However, it is possible to access each element of a list as well:
x[[1]][2:4]
[1] 2 3 4
# Data frames
Data frames are special lists that can also store tabular values. However, there is a constraint on the length of elements in the lists: they all have to be of a similar length. You can consider every element in the list as columns, and their lengths can be considered as rows.
Just like lists, a data frame can have objects belonging to different classes in a column; this was not allowed in matrices.
Let's quickly create a data frame using the `data.frame()` function:
a <- c(1, 3, 5)
b <- c("red", "yellow", "blue")
c <- c(TRUE, FALSE, TRUE)
df <- data.frame(a, b, c)
df
a b c
1 red TRUE
3 yellow FALSE
5 blue TRUE
You can see the headers of a table as `a`, `b`, and `c`; they are the column names. Every line of the table represents a row, starting with the name of each row.
# Accessing elements in data frames
It is possible to access each cell in the table.
To do this, you should specify the coordinates of the desired cell. Coordinates begin within the position of the row and end with the position of the column:
df[2,1]
[1] 3
We can even use the row and column names instead of numeric values:
df[,"a"]
[1] 1 3 5
Some packages contain datasets that can be loaded to the workspace, for example, the `iris` dataset:
data(iris)
# Functions of data frames
Some functions can be used on data frames:
* To find out the number of columns in a data frame:
ncol(iris)
[1] 5
* To obtain the number of rows:
nrow(iris)
[1] 150
* To print the first `10` rows of data:
head(iris,10)
Sepal.Length Sepal.Width Petal.Length Petal.Width Species
1 5.1 3.5 1.4 0.2 setosa
2 4.9 3.0 1.4 0.2 setosa
3 4.7 3.2 1.3 0.2 setosa
4 4.6 3.1 1.5 0.2 setosa
5 5.0 3.6 1.4 0.2 setosa
6 5.4 3.9 1.7 0.4 setosa
7 4.6 3.4 1.4 0.3 setosa
8 5.0 3.4 1.5 0.2 setosa
9 4.4 2.9 1.4 0.2 setosa
10 4.9 3.1 1.5 0.1 setosa
* Print the last `5` rows of the `iris` dataset:
tail(iris,5)
Sepal.Length Sepal.Width Petal.Length Petal.Width Species
146 6.7 3.0 5.2 2.3 virginica
147 6.3 2.5 5.0 1.9 virginica
148 6.5 3.0 5.2 2.0 virginica
149 6.2 3.4 5.4 2.3 virginica
150 5.9 3.0 5.1 1.8 virginica
* Finally, general information of the entire dataset is obtained using `str()`:
str(iris)
'data.frame': 150 obs. of 5 variables:
$ 花萼长度: num 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
$ 花萼宽度 : num 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
$ 花瓣长度: num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
$ 花瓣宽度: num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
$ 物种 : 因子 w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
Although there are a lot of operations to work with data frames, such as merging, combining, or slicing, we won't go any deeper for now. We will be using data frames in further chapters, and shall cover more operations later.
# Importing or exporting data
In R, there are several functions for reading and writing data from many sources and formats. Importing data into R is quite simple.
The most common files to import into R are Excel or text files. Nevertheless, in R, it is also possible to read files in SPSS, SYSTAT, or SAS formats, among others.
In the case of Stata and SYSTAT files, I would recommend the use of the `foreign` package.
Let's install and load the `foreign` package:
安装包("foreign")
载入库(foreign)
We can use the `Hmisc` package for SPSS, and SAS for ease and functionality:
安装包("Hmisc")
载入库(Hmisc)
Let's see some examples of importing data:
* Import a comma delimited text file. The first rows will have the variable names, and the comma is used as a separator:
mydata<-read.table("c:/mydata.csv", header=TRUE,sep=",", row.names="id")
* To read an Excel file, you can either simply export it to a comma delimited file and then import it or use the `xlsx` package. Make sure that the first row comprises column names that are nothing but variables.
* Let's read an Excel worksheet from a workbook, `myexcel.xlsx`:
载入库(xlsx)
mydata<-read.xlsx("c:/myexcel.xlsx", 1)
* Now, we will read a concrete Excel sheet in an Excel file:
mydata<-read.xlsx("c:/myexcel.xlsx", sheetName= "mysheet")
* Reading from the `systat` format:
载入库(foreign)
mydata<-read.systat("c:/mydata.dta")
* Reading from the SPSS format:
1. First, the file should be saved from SPSS in a transport format:
getfile=’c:/mydata.sav’ exportoutfile=’c:/mydata.por’
* 2. Then, the file can be imported into R with the `Hmisc` package:
载入库(Hmisc)
mydata<-spss.get("c:/mydata.por", use.value.labels=TRUE)
* To import a file from SAS, again, the dataset should be converted in SAS:
libname out xport ‘c:/mydata.xpt’; data out.mydata; set sasuser.mydata; run;
载入库(Hmisc)
mydata<-sasxport.get("c:/mydata.xpt")
* Reading from the Stata format:
载入库(foreign)
mydata<-read.dta("c:/mydata.dta")
Hence, we have seen how easy it is to read data from different file formats. Let's see how simple exporting data is.
There are analogous functions to export data from R to other formats. For SAS, SPSS, and Stata, the `foreign` package can be used. For Excel, you will need the `xlsx` package.
Here are a few exporting examples:
* We can export data to a tab delimited text file like this:
write.table(mydata, "c:/mydata.txt", sep="\t")
* We can export to an Excel spreadsheet like this:
载入库(xlsx)
write.xlsx(mydata, "c:/mydata.xlsx")
* We can export to SPSS like this:
载入库(foreign)
write.foreign(mydata, "c:/mydata.txt", "c:/mydata.sps", package="SPSS")
* We can export to SAS like this:
载入库(foreign)
write.foreign(mydata, "c:/mydata.txt", "c:/mydata.sas", package="SAS")
* We can export to Stata like this:
载入库(foreign)
write.dta(mydata, "c:/mydata.dta")
# Working with functions
Functions are the core of R, and they are useful to structure and modularize code. We have already seen some functions in the preceding section. These functions can be considered built-in functions that are available on the basis of R or where we install some packages.
On the other hand, we can define and create our own functions based on different operations and computations we want to perform on the data. We will create functions in R using the `function()` directive, and these functions will be stored as objects in R.
Here is what the structure of a function in R looks like:
myfunction <- function(arg1, arg2, … )
{
statements
返回(object)
}
The objects specified under a function as local to that function and the resulting objects can have any data type. We can even pass these functions as arguments for other functions.
Functions in R support nesting, which means that we can define a function within a function and the code will work just fine.
The resulting value of a function is known as the last expression evaluated on execution.
Once a function is defined, we can use that function using its name and passing the required arguments.
Let's create a function named `squaredNum`, which calculates the square value of a number:
squaredNum<-function(number)
{
a<-number²
return(a)
}
Now, we can calculate the square of any number using the function that we just created:
squaredNum(425)
[1] 180625
As we move on in this book, we will see how important such user-defined functions are.
# Controlling code flow
R has a set of control structures that organize the flow of execution of a program, depending on the conditions of the environment. Here are the most important ones:
* `If`/`else`: This can test a condition and execute it accordingly
* `for`: Executes a loop that repeats for a certain number of times, as defined in the code
* `while`: This evaluates a condition and executes only until the condition is true
* `repeat`: Executes a loop an infinite number of times
* `break`: Used to interrupt the execution of a loop
* `next`: Used to jump through similar iterations to decrease the number of iterations and time taken to get the output from the loop
* `return`: Abandons a function
The structure of `if else` is as `if (test_expression) { statement }`.
Here, if the `test_expression` returns true, the `statement` will execute; otherwise, it won't.
An additional `else` condition can be added like `if (test_expression) { statement1 } else { statement2 }`.
In this case, the `else` condition is executed only if `test_expression` returns false.
Let's see how this works. We will evaluate an `if` expression like so:
x<-4
y<-3
if (x >3) {
y <- 10
} else {
y<- 0
}
Since `x` takes a value higher than `3`, then the `y` value should be modified to take a value of `10`:
打印(y)
[1] 10
If there are more than two `if` statements, the `else` expression is transformed into `else if` like this `if ( test_expression1) { statement1 } else if ( test_expression2) { statement2 } else if ( test_expression3) { statement3 } else { statement4 }`.
The `for` command takes an iterator variable and assigns its successive values of a sequence or vector. It is usually used to iterate on the elements of an object, such as vector lists.
An easy example is as follows, where the `i` variable takes different values from `1` to `10` and prints them. Then, the loop finishes:
for (i in 1:10){
打印(i)
}
[1] 1
[1] 2
[1] 3
[1] 4
[1] 5
[1] 6
[1] 7
[1] 8
[1] 9
[1] 10
Additionally, loops can be nested in the same code:
x<- matrix(1:6,2,3)
for (i in seq_len(nrow(x))){
for (j in seq_len(ncol(x))){
打印(x[i,j])}
}
[1] 1
[1] 3
[1] 5
[1] 2
[1] 4
[1] 6
The `while` command is used to create loops until a specific condition is met. Let's look at an example:
x <- 1
while (x >= 1 & x < 20){
打印(x)
x = x+1
}
[1] 1
[1] 2
[1] 3
[1] 4
[1] 5
[1] 6
[1] 7
[1] 8
[1] 9
[1] 10
[1] 11
[1] 12
[1] 13
[1] 14
[1] 15
[1] 16
[1] 17
[1] 18
[1] 19
Here, values of `x` are printed, while `x` takes higher values than `1` and less than `20`. While loops start by testing the value of a condition, if true, the body of the loop is executed. After it has been executed, it will test the condition again, and keep on testing it until the result is false.
The `repeat` and `break` commands are related. The `repeat` command starts an infinite loop, so the only way out of it is through the `break` instruction:
x <- 1
repeat{
打印(x)
x = x+1
if (x == 6){
break
}
}
[1] 1
[1] 2
[1] 3
[1] 4
[1] 5
We can use the `break` statement inside for and while loops to stop the iterations of the loop and control the flow.
Finally, the `next` command can be used to skip some iterations without getting them terminated. When the R parser reads `next`, it terminates the current iteration and moves on to another new iteration.
Let's look at an example of `next`, where 20 iterations are skipped:
for (i in 1:15){
if (i <= 5){
next
} else { 打印(i)
} }
[1] 6
[1] 7
[1] 8
[1] 9
[1] 10
[1] 11
[1] 12
[1] 13
[1] 14
[1] 15
Before we start the next chapters of this book, it is recommended to practice these codes. Take your time and think about the code and how to use it. In the upcoming chapters, you will see a lot of code and new functions. Don't be concerned if you don't understand all of them. It is more important to have an understanding of the entire process to develop a predictive model and all the things you can do with R.
I have tried to make all of the code accessible, and it is possible to replicate all the tables and results provided in this book. Just enjoy understanding the process and reuse all the code you need in your own applications.
# All about R packages
Packages in R are a collection of functions and datasets that are developed by the community.
# Installing packages
Although R contains several functions in its basic installation, we will need to install additional packages to add new R functionalities. For example, with R it is possible to visualize data using the `plot` function. Nevertheless, we could install the `ggplot2` package to obtain more pretty plots.
A package mainly includes R code (not always just R code), documentation with explanations about the package and functions inside it, examples, and even datasets.
Packages are placed on different repositories where you can install them.
Two of the most popular repositories for R packages are as follows:
* **CRAN**: The official repository, maintained by the R community around the world. All of the packages that are published on this repository should meet quality standards.
* **GitHub**: This repository is not specific for R packages, but many of the packages have open source projects located in them. Unlike CRAN, there is no review process when a package is published.
To install a package from CRAN, use the `install.packages()` command. For example, the `ggplot2` package can be installed using the following command:
安装包("ggplot2")
To install packages from repositories other than CRAN, I would recommend using the `devtools` package:
安装包("devtools")
This package simplifies the process of installing packages from different repositories. With this package, some functions are available, depending on the repository you want to download a package from.
For example, use `install_cran` to download a package from CRAN or `install_github()` to download it from GitHub.
After the package has been downloaded and installed, we'll load it into our current R session using the `library` function. It is important to load packages so that we can use these new functions in our R session:
载入库(ggplot2)
`require`函数可用于加载包。`require`和`library`之间的唯一区别是，如果找不到特定的包，`library`将显示错误，但`require`将继续执行代码而不会显示任何错误。
# 必要的包
要运行本书中展示的所有代码，您需要安装我们提到的某些包。具体来说，您需要安装以下包（按字母顺序排序）：
+ `Amelia`: 用于缺失数据可视化和插补的包。
+ `Boruta`: 实现用于寻找相关变量的特征选择算法。
+ `caret`: 这个包（简称 **classification and regression training**）实现了几个机器学习算法，用于构建预测模型。
+ `caTools`: 包含几个基本实用函数，包括预测指标或分割样本的函数。
+ `choroplethr`/`choroplethrMaps`: 在 R 中创建地图。
+ `corrplot`: 计算变量之间的相关性并以图形方式显示。
+ `DataExplorer`: 包含数据探索过程中的不同函数。
+ `dplyr`: 数据操作包。
+ `fBasics`: 包含探索性数据分析的技术。
+ `funModeling`: 用于数据清洗、重要性变量分析和模型性能的函数。
+ `ggfortify`: 用于统计分析数据可视化工具的函数。
+ `ggplot2`: 用于声明性创建图形的系统。
+ `glmnet`: 面向 Lasso 和弹性网络正则化回归模型的包。
+ `googleVis`: R 对 Google 图表的接口。
+ `h2o`: 包含快速和可扩展算法的包，包括梯度提升、随机森林和深度学习。
+ `h2oEnsemble`: 提供从通过 `h2o` 包可访问的基学习算法创建集成功能。
+ `Hmisc`: 包含许多对数据分析和导入不同格式的文件有用的函数。
+ `kohonen`: 促进自组织图的创建和可视化。
+ `lattice`: 一个用于创建强大图形的包。
+ `lubridate`: 包含用于以简单方式处理日期的函数。
+ `MASS`: 包含几个统计函数。
+ `plotrix`: 包含许多绘图、标签、坐标轴和颜色缩放函数。
+ `plyr`: 包含可以分割、应用和组合数据的工具。
+ `randomForest`: 用于分类和回归的随机森林算法。
+ `rattle`: 这提供了一个用于不同 R 包的 GUI，可以帮助数据挖掘。
+ `readr`: 提供了一种快速且友好的方式来读取 `.csv`、`.tsv` 或 `.fwf` 文件。
+ `readtext`: 导入和处理纯文本和格式化文本文件的函数。
+ `recipes`: 用于数据操作和分析的有用包。
+ `rpart`: 实现分类和回归树。
+ `rpart.plot`: 使用 `rpart` 包创建树的最简单方法。
+ `Rtsne`: **t 分布随机邻域嵌入**（**t-SNE**）的实现。
+ `RWeka`: RWeka 包含许多数据挖掘算法，以及可以预处理和分类数据的工具。它提供了一个易于使用的接口来执行回归、聚类、关联和可视化等操作。
+ `rworldmap`: 使能国家级别和网格用户数据集的映射。
+ `scales`：这提供了一些方法，可以自动检测断点、确定坐标轴和图例的标签。它完成了映射的工作。
+ `smbinning`：一组用于构建评分模型的函数。
+ `SnowballC`：可以轻松实现非常著名的波特词干算法，该算法将单词折叠成根节点并比较词汇。
+ `sqldf`：使用 SQL 操作 R 数据框的函数。
+ `tibbletime`：用于处理时间序列的有用函数。
+ `tidyquant`：一个专注于以最简单的方式检索、操作和缩放金融数据分析的包。
+ `tidyr`：包括数据框操作的功能。
+ `tidyverse`：这是一个包含用于操作数据、探索和可视化的包的包。
+ `tm`：R 中的文本挖掘包。
+ `VIM`：使用此包，可以可视化缺失的包。
+ `wbstats`：此包让您能够访问世界银行 API 中的数据和统计数据。
+ `WDI`：搜索、提取和格式化来自世界银行**世界发展指标**（**WDI**）的数据。
+ `wordcloud`：此包提供了强大的功能，可以帮助您创建漂亮的词云。它还可以帮助可视化两份文档之间的差异和相似性。
一旦安装了这些包，我们就可以开始使用以下章节中包含的所有代码。
# 进一步的步骤
我们将使用美国破产问题陈述来帮助您深入了解机器学习过程，并为您提供处理和解决现实世界问题的实际经验。所有以下章节都将详细描述每个步骤。
以下章节的目标是描述基于机器学习技术开发模型的所有步骤和替代方案。
我们将看到几个步骤，从信息的提取和新生变量的生成，到模型的验证。正如我们将看到的，在开发的每个步骤中，都有一些替代方案或多个步骤是可能的。在大多数情况下，最佳替代方案将是给出更好预测模型的方案，但有时由于模型未来使用或我们想要解决的问题类型所施加的限制，可能会选择其他替代方案。
# 金融危机背景
在这本书中，我们将解决与金融危机相关的两个不同问题：美国银行的破产和欧洲国家偿债能力的评估。为什么我选择了这样具体的问题来写这本书？首先，是因为我对金融危机的关注，以及我试图避免未来危机的目标。另一方面，这是一个有趣的问题，因为可用的数据量很大，这使得它非常适合理解机器学习技术。
本书的大部分章节将涵盖开发预测模型以检测银行失败的情况。为了解决这个问题，我们将使用一个大型数据集，该数据集收集了处理不同算法时可能遇到的一些更典型的问题。例如，大量的观测值和变量以及不平衡的样本意味着分类模型中的一个类别比另一个大得多。
在接下来的章节中，我们将看到的一些步骤如下：
+ 数据收集
+ 特征生成
+ 描述性分析
+ 缺失信息的处理
+ 单变量分析
+ 多变量分析
+ 模型选择
最后一章将专注于开发检测欧洲国家经济失衡的模型，同时涵盖一些基本的文本挖掘和聚类技术。
尽管这本书是技术性的，但每个大数据和机器学习解决方案最重要的方面之一是理解我们需要解决的问题。
到本书结束时，你会发现仅仅了解算法是不够的来开发模型。在跳入运行算法之前，你需要遵循许多重要的步骤。如果你注意这些初步步骤，你更有可能获得好的结果。
在这个意义上，并且因为我热衷于经济理论，你可以在存放本书代码的仓库中找到关于我们将要在这本书中解决的问题原因的总结，从经济角度来分析。具体来说，描述了金融危机的原因以及其传染和转变为主权危机的过程。
# 总结
在这一开篇章节中，我们确立了本书的目的。现在你对 R 及其概念有了基本的了解，我们将继续开发两个主要预测模型。我们将涵盖所有必要的步骤：数据收集、数据分析以及特征选择，并以实用的方式描述不同的算法。
在下一章中，我们将开始解决编程问题并收集开始模型开发所需的数据。
# 第二章：预测银行失败 - 数据收集
在每个模型开发中，我们需要获取足够的数据来构建模型。非常常见的是阅读“垃圾输入，垃圾输出”这个表达，这与如果你用糟糕的数据开发模型，结果模型也会很糟糕的事实相关。
尤其是在机器学习应用中，我们期望拥有大量数据，尽管在许多情况下并非如此。无论可用信息的数量如何，数据的质量是最重要的问题。
此外，作为一个开发者，拥有结构化数据非常重要，因为它可以立即进行操作。然而，数据通常以非结构化形式存在，这意味着处理和准备用于开发需要花费大量时间。许多人认为机器学习应用仅基于使用新的算法或技术，而实际上这个过程比这更复杂，需要更多时间来理解你所拥有的数据，以获得所有观察的最大价值。通过本书中我们将讨论的实际情况，我们将观察到数据收集、清洗和准备是一些最重要且耗时的工作。
在本章中，我们将探讨如何为我们的问题陈述收集数据：
+ 收集财务数据
+ 收集目标变量
+ 数据结构化
# 收集财务数据
我们将从**联邦存款保险公司**（**FDIC**）网站（[`www.fdic.gov/`](https://www.fdic.gov/)）获取我们的数据。FDIC 是一个由美国国会领导的独立机构，其目标是维护人民的信心和金融系统的稳定。
# 为什么选择 FDIC？
FDIC 为美国商业银行和储蓄机构的存款人提供存款保险。因此，如果一家美国银行倒闭并关闭，FDIC 保证存款人不会损失他们的储蓄。最高可保证 25 万美元。
FDIC 还检查和监督某些金融机构。这些机构有义务定期报告与以下相关的财务报表的详细信息：
+ 资本水平
+ 清偿能力
+ 资产的质量、类型、流动性和多元化
+ 贷款和投资集中度
+ 收益
+ 流动性
银行的信息在 FDIC 网站上公开可用，我们可以下载用于我们的目的。我们会发现信息已经以所谓的**统一银行绩效报告**（**UBPR**）的形式结构化，它包括从财务报表中结合不同账户的几个比率。
例如，如果您想获取特定银行的 UBPR，或者只是想查看任何其他 UBPR 报告，您可以在[`cdr.ffiec.gov/public/ManageFacsimiles.aspx`](https://cdr.ffiec.gov/public/ManageFacsimiles.aspx)选择统一银行绩效报告（UBPR）：
报告下拉菜单允许选择 UBPR。我们可以通过名称或其他选项（如 FDIC 证书号码）搜索单个银行。此外，通过访问此链接[`cdr.ffiec.gov/public/PWS/DownloadBulkData.aspx`](https://cdr.ffiec.gov/public/PWS/DownloadBulkData.aspx)，可以同时下载所有可用银行的详细信息。
例如，以下截图显示了如何以文本格式下载 2016 年财务比率的批量数据：
您应仅选择“UBPR 比率 - 单期”选项，然后选择所需的日期（12/31/2016），最后设置输出格式，例如，制表符分隔。
在这个练习中，我们需要下载许多文件，从 2002 年到 2016 年每年一个。如果您不想下载数据，则没有必要下载。在代码中应用相关步骤后，R 工作空间将被保存，并且这个备份可供读者使用，无需花费时间运行代码或下载信息。
在我学习任何编程语言的经验中，当其他学习者进步时，花费时间在代码中寻找错误是非常令人沮丧的。因此，这些工作空间允许读者永远不会因为特定代码行的问题或甚至在我们的计算机上无法正常工作的具体包而感到沮丧。
在这种情况下，信息以文本分隔文件的形式下载，这使得以后上传到 R 中变得更加容易。对于每一年的每个 ZIP 文件都包含几个文本文件。这些文本文件包含关于银行特定领域的季度相关信息。2002 年到 2016 年所有 ZIP 文件的总大小达到 800MB。
# 列出文件
我们应该在电脑中为每年的文件创建一个文件夹，其中每个 ZIP 文件都需要解压缩。
一旦创建了文件夹，我们就可以在 R 中编写以下代码来列出我们创建的所有文件夹：
```py
myfiles <- list.files(path = "../MachineLearning/Banks_model/Data", pattern = "20", full.names = TRUE)
print(myfiles)
## [1] "../MachineLearning/Banks_model/Data/2002"
## [2] "../MachineLearning/Banks_model/Data/2003"
## [3] "../MachineLearning/Banks_model/Data/2004"
## [4] "../MachineLearning/Banks_model/Data/2005"
## [5] "../MachineLearning/Banks_model/Data/2006"
## [6] "../MachineLearning/Banks_model/Data/2007"
## [7] "../MachineLearning/Banks_model/Data/2008"
## [8] "../MachineLearning/Banks_model/Data/2009"
## [9] "../MachineLearning/Banks_model/Data/2010"
## [10] "../MachineLearning/Banks_model/Data/2011"
## [11] "../MachineLearning/Banks_model/Data/2012"
## [12] "../MachineLearning/Banks_model/Data/2013"
## [13] "../MachineLearning/Banks_model/Data/2014"
## [14] "../MachineLearning/Banks_model/Data/2015"
## [15] "../MachineLearning/Banks_model/Data/2016"
pattern选项允许我们搜索所有名称中包含20的文件夹，遍历我们之前创建的所有文件夹。
查找文件
让我们读取myfiles列表中每个文件夹包含的所有.txt文件。一旦为每个年份读取了.txt文件，它们就会合并成一个单一的表格。这个过程需要几分钟才能完成（在我的情况下，几乎需要 30 分钟）。
library(readr)
t <- proc.time()
for (i in 1:length(myfiles)){
tables<-list()
myfiles <- list.files(path = "../MachineLearning/Banks_model/Data", pattern = "20", full.names = TRUE)
filelist <- list.files(path = myfiles[i], pattern = "*", full.names = TRUE)
filelist<-filelist[1:(length(filelist)-1)]
for (h in 1:length(filelist)){
aux = as.data.frame(read_delim(filelist[h], "\t", escape_double = FALSE, col_names = FALSE, trim_ws = TRUE, skip = 2))
variables<-colnames(as.data.frame(read_delim(filelist[h], "\t", escape_double = FALSE, col_names = TRUE, trim_ws = TRUE, skip = 0)))
colnames(aux)<-variables
dataset_name<-paste("aux",h,sep='')
tables[[h]]<-assign(dataset_name,aux)
}
final_data_name<-paste("year",i+2001,sep='')
union <- Reduce(function(x, y) merge(x, y, all=T,
by=c("ID RSSD","Reporting Period")), tables, accumulate=F)
assign(final_data_name,union)
rm(list=ls()[! ls() %in% c(ls(pattern="year*"),"tables","t")])
}
proc.time() - t
因此，它首先列出我们创建的所有文件夹。然后，它列出每个文件夹中的所有.txt文件并将它们读入 R。单个.txt文件提供不同的数据框，然后合并成一个单一的表格。代码的结果是创建了 16 个不同的表格，每个表格包含一个特定年份的信息。
合并结果
现在我们使用rbind函数合并年度表格。这是可能的，因为所有表格包含的确切列数相同：
rm(tables)
database<-rbind(year2002,year2003,year2004,year2005,year2006,year2007,year2008,year2009,year2010,year2011,year2012,year2013,year2014,year2015,year2016)
删除表格
使用 rm() 命令，我们可以删除工作空间中除 database 之外的所有表格：
rm(list=ls()[! ls() %in% c(ls(pattern="database"))])
了解你的观测值
数据库包含总共 420404 个观测值和 1571 列：
print("Number of observations:")
## [1] "Number of observations:"
print(nrow(database))
## [1] 420404
print("Number of columns/variables:")
## [1] "Number of columns/variables:"
ncol(database)
## [1] 1571
让我们看看数据集现在看起来像什么，或者至少，前几个观测值和列：
head(database[,1:5])
## ID RSSD Reporting Period UBPR1795 UBPR3123.x UBPR4635
## 1 1000052 12/31/2002 11:59:59 PM 958 1264 996
## 2 1000100 12/31/2002 11:59:59 PM -26 2250 33
## 3 1000276 12/31/2002 11:59:59 PM 46 719 86
## 4 1000409 12/31/2002 11:59:59 PM 13926 57059 19212
## 5 1000511 12/31/2002 11:59:59 PM 37 514 86
## 6 1000557 12/31/2002 11:59:59 PM 0 120 16
如您所见，第一列是每个银行的标识符。在第二列中，提供了财务信息的参考日期。其余的列使用 UBPR 前缀和数字编码。这种情况在实际情况中非常常见，因为有很多变量可用，但它们的含义是未知的。这种情况可能非常有问题，因为我们并不确切知道某些变量是否考虑了目标变量，或者变量是否将在模型实施时可用。
在我们的情况下，这个问题实际上并不是一个问题，因为你可以找到一个包含变量含义的字典，位于cdr.ffiec.gov/CDRDownload/CDR/UserGuide/v96/FFIEC%20UBPR%20Complete%20User%20Guide_2019-01-11.Zip。
例如，第一个变量 UBPR1795 的含义是净信贷损失，衡量由于未偿还而产生的损失，导致银行贷款的总金额。
处理重复项
当我们将不同的文本文件合并成每年一个表格时，一些列被重复了，因为它们同时包含在多个文本文件中。例如，所有包含在名为 Summary ratios 的文本文件中的比率都将复制到其他文本文件中。在这些情况下，R 为变量分配 .x 或 .y 后缀。
在以下代码中，我们删除了具有 .x 后缀的变量，因为它们在数据库中是重复的：
database[,grep(".x",colnames(database))]<-NULL
grep 函数在列名中搜索 .x 模式。如果检测到列中有此模式，则该列将被删除。此外，列名中的 .y 后缀也将被移除：
var_names<-names(database)
var_names<-gsub(".y","",var_names)
colnames(database)<-var_names
rm(var_names)
最后，导入过程还创建了一些错误和不准确变量。这些列的名称以 X 开头。这些变量也将被删除，如下所示：
database[,grep("X",colnames(database))]<-NULL
让我们将工作空间保存到以下步骤：
save.image("Data1.RData")
操作我们的问题
数据库包含一个表示每个银行财务报表日期的列（称为 Reporting Period 字段）。每个银行可以在数据集中出现多次，从 2002 年 12 月到 2016 年 12 月，每季度一次。
然而，这个字段在 R 中不被识别为日期格式：
class(database$'Reporting Period')
## [1] "character"
让我们将此字段转换为日期格式：
- 首先，从
Reporting Period列中提取左侧部分。前 10 个字符被提取到一个名为Date的新变量中：
database$Date<-substr(database$'Reporting Period',1,10)
- 让我们使用
as.Date命令将这个新列转换为日期格式：
database$Date<-as.Date(database$Date,"%m/%d/%Y")
- 最后，删除
Reporting Period字段，因为它不再相关：
database$'Reporting Period'<-NULL
我们有关于 2002 年至 2016 年所有季度的信息，但我们只对年末提供的财务信息感兴趣。
让我们过滤数据集，以考虑每年 12 月的信息：
database<-database[as.numeric(format(database$Date, "%m"))==12,]
在上一行代码之后，我们的数据库包含110239个观测值：
print("Observations in the filtered dataset:")
## [1] "Observations in the filtered dataset:"
nrow(database)
## [1] 110239
此外，它包含1494个变量，如下面的代码块所示：
print("Columns in the filtered dataset:")
## [1] "Columns in the filtered dataset:"
ncol(database)
## [1] 1494
到目前为止，让我们保存工作区的一个备份：
save.image("Data2.RData")
您现在可以查看数据集中的所有变量：
database_names<-data.frame(colnames(database))
由于变量数量相当高，建议将变量的名称保存到 Excel 文件中：
write.csv(database_names,file="database_names.csv")
rm(database_names)
如您所见，数据集中有一些变量的名称是一种代码。我们还知道，可以在 FDIC 网站上找到每个变量的含义。这种情况真的很常见，尤其是在信用风险应用中，信息提供了关于账户变动或交易详情。
以某种方式理解变量的含义，或者至少了解它们是如何生成的，这是很重要的。如果不这样做，我们可以包括一些与目标变量非常接近的变量作为预测变量，甚至包括在模型实施时不可用的变量。然而，我们知道数据集中没有明显的目标。因此，让我们收集我们问题的目标变量。
收集目标变量
我们需要确定一家银行是否在过去失败过——这将是我们目标。此信息也可在 FDIC 网站上找到，网址为www.fdic.gov/bank/individual/failed/banklist.html。
网站包括自 2000 年 10 月以来失败的银行，这涵盖了我们的整个数据集：
让我们看看实现这一目标的步骤：
- 将此信息下载到
.csv文件中：
download.file("https://www.fdic.gov/bank/individual/failed/banklist.csv", "failed_banks.csv",method="auto", quiet=FALSE, mode = "wb", cacheOK = TRUE)
即使这个列表定期更新，因为历史信息不会改变，但结果仍然是可复制的。无论如何，用于开发的文件也包含在这本书的数据存储库中。
- 现在，将下载的文件上传到 R 中，如下所示：
failed_banks<-read.csv("failed_banks.csv", header=TRUE)
- 使用以下命令查看所有变量以及失败银行列表中包含的数据的一些详细信息：
str(failed_banks)
- 让我们打印前十行，如下所示：
head(failed_banks,n=10)# First 10 rows of dataset
## Bank.Name
## 1 Washington Federal Bank for Savings
## 2 The Farmers and Merchants State Bank of Argonia
## 3 Fayette County Bank
## 4 Guaranty Bank, (d/b/a BestBank in Georgia & Michigan)
## 5 First NBC Bank
## 6 Proficio Bank
## 7 Seaway Bank and Trust Company
## 8 Harvest Community Bank
## 9 Allied Bank
## 10 The Woodbury Banking Company
## City ST CERT Acquiring.Institution
## 1 Chicago IL 30570 Royal Savings Bank
## 2 Argonia KS 17719 Conway Bank
## 3 Saint Elmo IL 1802 United Fidelity Bank, fsb
## 4 Milwaukee WI 30003 First-Citizens Bank & Trust Company
## 5 New Orleans LA 58302 Whitney Bank
## 6 Cottonwood Heights UT 35495 Cache Valley Bank
## 7 Chicago IL 19328 State Bank of Texas
## 8 Pennsville NJ 34951 First-Citizens Bank & Trust Company
## 9 Mulberry AR 91 Today's Bank
## 10 Woodbury GA 11297 United Bank
## Closing.Date Updated.Date
## 1 15-Dec-17 21-Feb-18
## 2 13-Oct-17 21-Feb-18
## 3 26-May-17 26-Jul-17
## 4 5-May-17 22-Mar-18
## 5 28-Apr-17 5-Dec-17
## 6 3-Mar-17 7-Mar-18
## 7 27-Jan-17 18-May-17
## 8 13-Jan-17 18-May-17
## 9 23-Sep-16 25-Sep-17
## 10 19-Aug-16 13-Dec-18
文件包含以下相关信息：
-
失败银行的数目
-
这些银行所在的状态
-
他们失败的时间
-
收购机构
绘制失败随时间演变的趋势将非常有趣。为此，让我们检查Closing.Date列是否被识别为日期：
class(failed_banks$Closing.Date)
## [1] "factor"
这列不是日期。让我们使用类似于as.Date的另一个命令，通过lubridate库将其转换为日期：
library(lubridate)
failed_banks$Closing.Date <- dmy(failed_banks$Closing.Date)
class(failed_banks$Closing.Date)
## [1] "Date"
数据结构化
在获取了我们的目标变量并了解了我们的数据集之后，我们现在可以继续根据我们的目标进行实际的数据收集。在这里，我们将尝试根据收集目标变量部分中描述的不同年份获取银行的资料。
要做到这一点，我们创建一个新的变量，只提取银行破产时的年份，然后按年份计算银行的数目：
failed_banks$year<-as.numeric(format(failed_banks$Closing.Date, "%Y"))
Failed_by_Year<-as.data.frame(table(failed_banks$year))
colnames(Failed_by_Year)<-c("year","Number_of_banks")
print(Failed_by_Year)
## year Number_of_banks
## 1 2000 2
## 2 2001 4
## 3 2002 11
## 4 2003 3
## 5 2004 4
## 6 2007 3
## 7 2008 25
## 8 2009 140
## 9 2010 157
## 10 2011 92
## 11 2012 51
## 12 2013 24
## 13 2014 18
## 14 2015 8
## 15 2016 5
## 16 2017 8
让我们以图形方式查看我们的数据：
library(ggplot2)
theme_set(theme_classic())
# Plot
g <- ggplot(Failed_by_Year, aes(year, Number_of_banks))
g + geom_bar(stat="identity", width = 0.5, fill="tomato2") +
labs(title="Number of failed banks over time",
caption="Source: FDIC list of failed banks")+
theme(axis.text.x = element_text(angle=65, vjust=0.6))
上述代码给出了以下输出：
如前图所示，在 2001 年和 2002 年的互联网泡沫危机期间以及从 2008 年开始的金融危机期间，破产银行的数目有所增加。
现在我们需要将破产银行的列表与我们的数据库合并。在破产银行数据集中，有一个包含每个银行 ID 的列，具体是证书号码列。这是 FDIC 分配的一个数字，用于唯一标识机构和保险证书。
然而，在包含财务信息的其他数据库中，ID 号码被称为 RSSD ID，这是不同的。这个数字是由联邦储备系统分配给机构的唯一标识符。
那么，我们如何将这两个数据集连接起来呢？我们需要在两个标识符之间建立一个映射。这个映射也可以在 FDIC 网站上找到，再次是在我们之前下载所有财务报表批量数据的同一部分。记住，网站可以通过cdr.ffiec.gov/public/pws/downloadbulkdata.aspx访问。
在这个网站上，我们需要在相关期间（2002-2016）下载呼叫报告——单期文件：
在最近下载的每个文件中，我们都可以找到一个名为FFIEC CDR Call Bulk POR mmddyyyy.txt的文件。
这个文件包含了关于每家银行的全部信息。首先，我们使用它们为破产银行列表中的每家银行分配一个ID RSSD号码。然后，我们可以使用ID RSSD字段将财务比率与破产银行列表连接起来。
下载完文件后，使用list.files函数列出您系统中的所有可用文件。
我们需要找到所有名称中包含FFIEC CDR Call Bulk POR的文件：
myfiles <- list.files(path = "../MachineLearning/Banks_model/Data/IDS", pattern = "FFIEC CDR Call Bulk POR", full.names = TRUE)
现在，我们将所有文件读入 R 中，并将它们合并到一个名为IDs的数据框中：
此外，还创建了一个名为year的新列。这个列反映了对应信息的年份。我们需要存储IDs和日期，因为标识符可能会随时间变化。例如，当两家银行合并时，其中一家银行将在数据集中消失，而另一家可以保持相同的号码或获得一个新的号码。
您可以创建一个名为IDs的新空框架，如下所示：
IDs<-matrix("NA",0,4)
colnames(IDs)<-c("ID RSSD","CERT","Name","id_year")
IDs<-as.data.frame(IDs)
然后，我们迭代地读取所有文本文件，并将它们合并到这个IDs数据框中：
for (i in 1:length(myfiles))
{
aux <- read.delim(myfiles[i])
aux$year<-as.numeric(2000+i)
aux<-aux[,c(1,2,6,ncol(aux))]
colnames(aux)<-c("ID RSSD","CERT","Name","id_year")
IDs<-rbind(IDs,aux)
}
让我们按照以下方式打印出结果表：
head(IDs)
## ID RSSD CERT Name id_year
## 1 37 10057 BANK OF HANCOCK COUNTY 2001
## 2 242 3850 FIRST COMMUNITY BANK XENIA-FLORA 2001
## 3 279 28868 MINEOLA COMMUNITY BANK, SSB 2001
## 4 354 14083 BISON STATE BANK 2001
## 5 439 16498 PEOPLES BANK 2001
## 6 457 10202 LOWRY STATE BANK 2001
现在，一个包含ID RSSD框架和每个银行随时间变化的Certificate number列的主表已经可用。
你可以按照以下方式删除无关信息：
rm(list=setdiff(ls(), c("database","failed_banks","IDs")))
接下来，我们将使用证书日期将failed banks名单和IDs数据集合并，但在合并之前，我们需要将两个数据集中的证书号码转换为数值格式：
failed_banks$CERT<-as.numeric(failed_banks$CERT)
IDs$CERT<-as.numeric(IDs$CERT)
如果我们尝试将失败银行名单与IDs数据集合并，我们会发现一个问题。在failed banks名单中有一个表示银行破产年份的列，如果我们使用年份列将两个表连接起来，则不会在IDs表中找到这个列。
由于IDs快照对应于每年的 12 月，因此一家失败的银行不可能在这一特定年份的年底就已经存在。
为了正确合并两个数据集，在failed banks数据集中创建一个新的变量（id_year），从year列中减去一年：
failed_banks$id_year<-failed_banks$year-1
现在失败的银行已经使用merge函数与IDs信息连接起来。使用这个函数很简单；你只需要指定两个表以及用于连接的列名：
failed_banks<-merge(failed_banks,IDs,by.x=c("CERT","id_year"),all.x=TRUE)
failed_banks<-failed_banks[,c("CERT","ID RSSD","Closing.Date")]
head(failed_banks)
## CERT ID RSSD Closing.Date
## 1 91 28349 2016-09-23
## 2 151 270335 2011-02-18
## 3 182 454434 2010-09-17
## 4 416 3953 2012-06-08
## 5 513 124773 2011-05-20
## 6 916 215130 2014-10-24
工作空间的新备份操作如下：
save.image("Data3.RData")
现在，可以将包含财务报表的数据库与失败银行名单合并，然后创建目标变量。我们将使用ID RSSD标识符将两个表连接起来：
database<-merge(database,failed_banks,by=c("ID RSSD"),all.x = TRUE)
## Warning in merge.data.frame(database, failed_banks, by = c("ID RSSD"),
## all.x = TRUE): column name 'UBPR4340' is duplicated in the result
数据库中增加了两个新列：CERT和Closing.Date。前面的代码提醒我们之前未检测到的重复列。因此，我们应该删除其中一个重复的列。使用grep函数，我们将获得包含UBPR4340变量的列数：
grep("UBPR4340",colnames(database))
## [1] 852 1454
删除出现重复变量的第二列：
database[,1454]<-NULL
当这两个新变量（CERT和Closing.Date）中的任何一个发现缺失值时，这表明这家银行在美国金融体系中仍在运营。另一方面，如果一家银行在这些变量中包含信息，则表明这家银行已经破产。我们可以看到数据库中有多少失败的观测值：
nrow(database[!is.na(database$Closing.Date),c('ID RSSD','Date','Closing.Date')])
## [1] 3705
数据集中有3.705个与失败银行对应的观测值。正如你所看到的，失败观测值的数量占总观测值的一小部分。
失败的观测值不代表独特的失败银行。这意味着一家失败的银行在最终破产之前的一段时间内有不同的财务报表。例如，对于以下代码块中提到的银行，有不同年份的财务信息可用。根据我们的数据库，这家银行在 2010 年破产：
failed_data<-database[!is.na(database$Closing.Date),c('ID RSSD','Date','Closing.Date')]
head(failed_data)
## ID RSSD Date Closing.Date
## 259 2451 2003-12-31 2010-07-23
## 260 2451 2007-12-31 2010-07-23
## 261 2451 2008-12-31 2010-07-23
## 262 2451 2005-12-31 2010-07-23
## 263 2451 2004-12-31 2010-07-23
## 264 2451 2009-12-31 2010-07-23
我们应该评估我们预测模型的时间范围。信息日期和关闭日期之间的差异越大，我们模型的预期预测能力就越低。解释相当简单；从五年前的当前信息预测银行的失败比从一两年前的信息预测更困难。
让我们计算一下资产负债表日期之间的差异：
database$Diff<-as.numeric((database$Closing.Date-database$Date)/365)
我们的目标变量会是什么？我们想要预测什么？好吧，我们可以开发一个模型来预测在当前财务信息之后的六个月、一年甚至五年内的破产情况。
目标变量的定义应根据模型的目的进行，同时也要考虑到样本中失败银行或不良银行的数目。
标准期限根据投资组合、模型的目的以及不良银行或少数群体的样本而有所不同，这个样本应该足够大，以便开发一个稳健的模型。
时间跨度的定义非常重要，它决定了我们模型的目标及其未来的用途。
例如，我们可以将数据集中在财务报表后不到一年就失败的银行归类为不良银行：
database$Default0<-ifelse(database$Diff>=1 | is.na(database$Diff),0,1)
根据这个定义，不良银行的数目将如下：
table(database$Default0)
##
## 0 1
## 109763 476
数据集中只有476家银行在观察到财务信息后不到一年就失败了。
例如，以下银行在观察到财务信息后仅半年就失败了：
head(database[database$Default0==1,c('ID RSSD','Date','Closing.Date','Diff')],1)
## ID RSSD Date Closing.Date Diff
## 264 2451 2009-12-31 2010-07-23 0.5589041
database$Default0<-NULL
在这一点上，对工作空间进行了一次新的备份：
save.image("Data4.RData")
在这个问题中，我们看到了大多数银行都是有偿付能力的，这些银行在样本中多次重复出现，尽管财务报表不同。
然而，保留样本中的所有良好银行并增加不良银行的重要性并不相关。有一些技术可以处理这个问题。
其中一个方法是为每个良好和不良观察值分配不同的权重，以便两个类别可以更加平衡。这种方法虽然有用，但会使机器学习算法的执行变得耗时得多，因为我们将会使用整个数据集，在我们的案例中，这超过了 10 万个观察值。
类别非常不平衡，正如我们在这个问题中发现的那样，可能会以负面方式影响模型拟合。为了保留所有观察值，数据子采样是非常常见的。通常执行三种主要技术：
-
欠采样：这可能是最简单的策略。它包括随机减少多数类到与少数类相同的大小。通过欠采样，不平衡问题得到了解决，但通常情况下，我们会减少数据集，特别是在少数类非常稀缺的情况下。如果这种情况发生，模型结果很可能会很糟糕。
-
过采样：通过多次随机选择少数类来达到多数类的相同大小。最常见的方法是多次复制少数观测。在问题解决方案的这个阶段，我们还没有选择用于训练或测试未来算法的数据，过采样可能会出现问题。我们将在训练集和验证集中重复未来可能发现的少数类示例，从而导致过拟合和误导性结果。
-
其他技术：如合成少数过采样技术（SMOTE）和随机过采样示例（ROSE）等技术减少多数类，并在少数类中创建人工新观测。
在这种情况下，我们将采用一种混合方法。
为了使以下步骤更容易，我们将重命名包含每个银行标识符的第一列：
colnames(database)[1]<-"ID_RSSD"
现在我们将以不同的方式处理失败和非失败的银行。让我们从只包含失败银行的数据库部分开始：
database_Failed<-database[!is.na(database$Diff),]
有3705个观测包含失败银行的信息：
nrow(database_Failed)
## [1] 3705
这个样本看起来是这样的：
head(database_Failed[,c("ID_RSSD","Date","Diff")])
## ID_RSSD Date Diff
## 259 2451 2003-12-31 6.5643836
## 260 2451 2007-12-31 2.5616438
## 261 2451 2008-12-31 1.5589041
## 262 2451 2005-12-31 4.5616438
## 263 2451 2004-12-31 5.5616438
## 264 2451 2009-12-31 0.5589041
如显示的那样，在失败银行的列表中，我们有几个年份的相同银行的财务信息。每个银行距离破产日期最近的财务信息将被最终选中。
为了做到这一点，我们创建一个辅助表。这个表将包含银行观测到失败日期的最小距离。为此，我们现在将使用一个有用的包，sqldf。这个包允许我们像使用 SQL 语言一样编写查询：
aux<-database_Failed[,c('ID_RSSD','Diff')]
library(sqldf)
aux<-sqldf("SELECT ID_RSSD,
min(Diff) as min_diff,
max(Diff) as max_diff
from aux group by ID_RSSD")
head(aux)
## ID_RSSD min_diff max_diff
## 1 2451 0.5589041 7.564384
## 2 3953 0.4383562 9.443836
## 3 15536 0.8301370 6.835616
## 4 16337 0.7506849 7.756164
## 5 20370 0.4027397 8.408219
## 6 20866 0.5589041 7.564384
现在，我们的包含失败银行的样本与这个辅助表合并在一起：
database_Failed<-merge(database_Failed,aux,by=c("ID_RSSD"))
然后，我们只选择财务报表日期与截止日期之间的差异与min_diff列相同的观测：
database_Failed<-database_Failed[database_Failed$Diff==database_Failed$min_diff,]
按以下方式删除最近创建的列：
database_Failed$min_diff<-NULL
database_Failed$max_diff<-NULL
现在，我们想要减少非失败银行的数目。为此，我们随机选择每个银行的财务报表的一年：
使用以下代码提取非失败银行的观测总数：
database_NonFailed<-database[is.na(database$Diff),]
为了随机选择财务报表，我们应该遵循以下步骤：
- 首先，建立一个
种子。在生成随机数时，需要一个种子来获得可重复的结果。使用相同的种子将允许你获得与本书中描述的相同的结果：
set.seed(10)
- 生成随机数；我们生成的随机数数量与非失败银行数据集中的行数相同：
Random<-runif(nrow(database_NonFailed))
- 将随机数作为新列添加到数据库中：
database_NonFailed<-cbind(database_NonFailed,Random)
- 计算每个银行的随机数最大值，并创建一个新的名为
max的数据框：
max<-aggregate(database_NonFailed$Random, by = list(database_NonFailed$ID_RSSD), max)
colnames(max)<-c("ID_RSSD","max")
- 将非失败银行的数据框与
max数据框连接。然后，只选择随机数与每个银行最大值相同的观测：
database_NonFailed<-merge(database_NonFailed,max,all.x=TRUE)
database_NonFailed<- database_NonFailed[database_NonFailed$max==database_NonFailed$Random,]
- 按以下方式删除无关的列：
database_NonFailed$max<-NULL
database_NonFailed$Random<-NULL
使用 dim 函数，我们可以获得非失败银行的观测数。您可以看到，良好银行的数目已经显著减少：
dim(database_NonFailed)
## [1] 9654 1496
只有 9654 个观测值和 1496 个变量。
因此，我们最终可以通过结合之前的数据框来构建我们的数据集以开发我们的模型：
Model_database<-rbind(database_NonFailed,database_Failed)
目标变量现在也可以定义了：
Model_database$Default<-ifelse(is.na(Model_database$Diff),0,1)
工作空间中加载的其他对象可以按照以下方式删除：
rm(list=setdiff(ls(), c("Model_database")))
通常可以使用当前变量来定义新特征，然后将其包含在开发中。这些新变量通常被称为派生变量。因此，我们可以将派生变量定义为从一个或多个基础变量计算出的新变量。
一个非常直观的例子是从包含不同客户信息的数据库中计算一个名为 age 的变量。这个变量可以计算为该客户存储在系统中的日期与他们的出生日期之间的差异。
新变量应添加有用且非冗余的信息，这将有助于后续的学习，并有助于泛化步骤。
特征生成不应与特征提取混淆。特征提取与降维相关，因为它将原始特征进行转换并从潜在的原生和派生特征池中选择一个子集，这些特征可以用于我们的模型。
然而，在我们处理的问题中，构建额外的变量并不是非常相关。我们有一个非常大的数据集，测量了金融机构分析中的所有相关方面。
此外，在本部分开发中，那些在数据提取或处理阶段被包含，但对模型开发没有作用的变量必须被删除。
因此，以下变量将被删除：
Model_database$CERT<-NULL
Model_database$Closing.Date<-NULL
Model_database$Diff<-NULL
所有这些步骤都是构建我们的数据库所需要的。您可以看到我们在收集数据、目标变量以及尝试组织本章中的所有数据上花费了多少时间。在下一章中，我们将开始分析我们所获得的数据。在继续之前，您可以进行最后的备份，如下所示：
save.image("Data5.RData")
摘要
在本章中，我们开始收集开发预测银行失败的模型所需的数据。在这种情况下，我们下载了大量数据，并对它进行了结构化。此外，我们创建了我们的目标变量。在本章结束时，您应该已经了解到数据收集是模型开发的第一步，也是最重要的一步。当您处理自己的问题时，请花时间理解问题，然后考虑您需要什么样的数据以及如何获取它。在下一章中，我们将对所获得的数据进行描述性分析。
第三章：预测银行失败 - 描述性分析
在本章中，我们将学习如何理解并准备我们的银行数据集以进行模型开发。我们将回答有关我们有多少变量以及它们的质量的问题。描述性分析对于理解我们的数据和分析信息质量可能存在的问题至关重要。我们将看到如何处理缺失值，将变量转换为不同的格式，以及如何分割我们的数据以训练和验证我们的预测模型。
具体来说，我们将涵盖以下主题：
-
数据概览
-
格式转换
-
抽样
-
处理缺失值和异常值
-
实施描述性分析
数据概览
首先，我们将分析数据集中变量的类型。为此，我们可以使用 class 函数，它告诉我们一个变量是数字、字符还是矩阵。例如，银行识别号 ID_RSSD 的类别可以这样获得：
class(Model_database$ID_RSSD)
## [1] "integer"
这个函数表明这个变量是一个没有小数的数字。
我们可以使用以下代码计算所有变量的相同信息并将其存储起来：
classes<-as.data.frame(sapply(Model_database, class))
classes<-cbind(colnames(Model_database),classes)
colnames(classes)<-c("variable","class")
使用 sapply，迭代地对数据集上的 class 函数进行计算。然后，将变量的名称与仅在一个数据框中的类别结合起来，最后重命名生成的数据集：
head(classes)
## variable class
## ID_RSSD ID_RSSD integer
## UBPR1795 UBPR1795 numeric
## UBPR4635 UBPR4635 numeric
## UBPRC233 UBPRC233 numeric
## UBPRD582 UBPRD582 numeric
## UBPRE386 UBPRE386 numeric
这个数据集包含四种不同类型的变量：
table(classes$class)
## character Date integer numeric
## 462 1 4 1027
根据之前的步骤，我们知道只有具有 Date 格式的变量收集财务报表的日期。
熟悉我们的变量
一些变量的字符类型尚不明确。我们的数据集属于金融领域，并且只有金融比率作为数据，所以我们预计变量类型应该是整数或数值。让我们找出我们是否正确。
过滤 character 变量：
classes<-classes[classes$class=="character",]
head(classes)
## variable class
## UBPRE543 UBPRE543 character
## UBPRE586 UBPRE586 character
## UBPRE587 UBPRE587 character
## UBPRE594 UBPRE594 character
## UBPRFB64 UBPRFB64 character
## UBPRFB69 UBPRFB69 character
第一个变量，UBPRE543，衡量提供建筑贷款的银行的损失总额与授予的建筑贷款总额之比。正如我们所怀疑的，这个变量应该是数字、百分比或小数。
查找变量的缺失值
我们将使用以下代码计算这个变量，UBPRE543，随时间变化的缺失值数量，目的是了解这个变量的一些更多信息：
aggregate(UBPRE543 ~ Date, data=Model_database, function(x) {sum(is.na(x))}, na.action = NULL)
## Date UBPRE543
## 1 2002-12-31 1127
## 2 2003-12-31 954
## 3 2004-12-31 772
## 4 2005-12-31 732
## 5 2006-12-31 639
## 6 2007-12-31 309
## 7 2008-12-31 110
## 8 2009-12-31 98
## 9 2010-12-31 91
## 10 2011-12-31 76
## 11 2012-12-31 132
## 12 2013-12-31 98
## 13 2014-12-31 85
## 14 2015-12-31 89
## 15 2016-12-31 68
如我们所见，这个比率在 2002 年到 2006 年之间显示了一些缺失值。
另一方面，我们可以使用 table 函数计算数据集中按年份的观测数：
table(Model_database$Date)
##
## 2002-12-31 2003-12-31 2004-12-31 2005-12-31 2006-12-31 2007-12-31
## 1127 954 772 732 639 652
## 2008-12-31 2009-12-31 2010-12-31 2011-12-31 2012-12-31 2013-12-31
## 686 671 587 533 664 615
## 2014-12-31 2015-12-31 2016-12-31
## 526 498 474
比较前两个表格，我们可以看到这个变量在最初几年没有提供信息。
在练习开始时，我们将 .txt 文件上传到 R 中时，由于这个变量在最初几年没有提供信息，R 自动将这个变量的格式分配为字符格式。
对于后来的年份，当变量有信息时，变量被读取为数值，但在将所有年份合并到数据框中时格式发生了变化，就在我们执行此代码时：
#database<-rbind(year2002,year2003,year2004,year2005,year2006,year2007,year2008, year2009,year2010,year2011,year2012,year2013,year2014,year2015,year2016)
在rbind函数中使用的第一个表格中变量的格式，属于 2002 年，固定并决定了合并后的结果表格的格式。
转换变量的格式
我们现在需要将这些变量全部转换为数值格式。从第二个变量（第一个是标识符）到数据框中的其余变量，变量将被显式转换为数值。最后两个变量也将被排除在此过程之外（Date和目标变量）。让我们使用以下代码将变量转换为数值格式：
for (k in 2:(ncol(Model_database)-2))
{
Model_database[,k]<-as.numeric(Model_database[,k])
}
让我们看看这些更改是否已经应用：
table(sapply(Model_database, class))
##
## Date integer numeric
## 1 1 1492
在继续开发之前，一旦我们解决了数据格式的问题，在下一节中，我们将指定样本的哪一部分用于开发，哪一部分用于验证模型。
采样
所有后续步骤和描述性分析都只考虑训练或开发样本。因此，我们的数据将被分为两个样本：
-
训练集：通常代表数据的 70%，用于训练模型（选择更适合模型的参数）。
-
验证集：通常代表数据的 30%，用于衡量模型在做出预测时的表现。
样本分区
尽管有众多方法可以实现数据分区，但caTools包是最有用的之一。此包包含一个名为sample.split的函数，该函数生成随机数以分割样本，但同时也保持原始数据集中不良和良好的比例在分离的样本中。
由于caTools包使用随机数，固定一个seed可以方便地保证结果的复现性：
set.seed(1234)
然后，使用sample.split函数：
library(caTools)
index = sample.split(Model_database$Default, SplitRatio = .70)
此函数接受两个参数，目标变量和分区大小，在我们的案例中，是 70%。
它生成一个index，包含两个值，TRUE和FALSE，可以用来将数据集分割成两个所需的样本：
train<-subset(Model_database, index == TRUE)
test<-subset(Model_database, index == FALSE)
检查样本
让我们检查每个样本中观察值的数量以及失败银行的占比：
print("The development sample contains the following number of observations:")
## [1] "The development sample contains the following number of observations:"
nrow(train)
## [1] 7091
print("The average number of failed banks in the sample is:")
## [1] "The average number of failed banks in the sample is:"
(sum(train$Default)/nrow(train))
## [1] 0.04696094
print("The validation sample contains the following number of observations:")
## [1] "The validation sample contains the following number of observations:"
nrow(test)
## [1] 3039
print("The average number of failed banks in the sample is:")
## [1] "The average number of failed banks in the sample is:"
(sum(test$Default)/nrow(test))
## [1] 0.04705495
如所示，训练样本和测试样本分别占总样本的 70%和 30%。这两个样本中失败银行的比率保持大致相同，即 4.7%。
实施描述性分析
描述性统计分析有助于您正确理解您的数据。尽管 R 默认提供了一些函数来执行基本统计，但我们将使用两个更好的替代方案，即DataExplorer和fBasics包。
按照以下简单步骤进行：
- 由于数据集中变量的数量很高，我们将创建一个包含要用于描述性函数的变量名的列表：
Class<-as.data.frame(sapply(train, class))
colnames(Class)<-"variable_class"
Class$variable_name<-colnames(train)
numeric_vars<-Class[Class$variable_class=="numeric","variable_name"]
- 创建了一个包含 1,492 个变量的列表。将此列表传递给
fBasics包中包含的basicStats函数：
library(fBasics)
descriptives_num<- as.data.frame(t(basicStats(train[,numeric_vars])))
head(descriptives_num)
我们可以计算以下描述性统计量：
-
-
观察值数量（
nobs） -
缺失值的数量 (
NAs) -
最小值 (
Minimum) -
最大值 (
Maximum) -
第一和第三四分位数 (
1. Quartile和3. Quartile) -
中位数 (
Median) -
变量中值的总和 (
Sum) -
均值的标准误差 (
SE Mean) -
均值下置信限 (
LCL Mean) -
均值上置信限 (
UCL Mean) -
方差 (
Variance) -
标准差 (
Stdev) -
偏度 (
Skewness) -
峰度 (
Kurtosis)
-
- 在这一步，我们将检测具有大量缺失值的变量，变量的范围和离散度，即使变量只有一个唯一值。
当变量的数量很高，如我们的案例，这项任务并不容易，我们需要一些时间来分析变量。变量的图形分析也很重要，并且是补充性的。
plot_histogram 函数对于可视化变量非常有用。此函数在 DataExplorer 包中可用：
library(DataExplorer)
plot_histogram(train[,1410:1441])
以下图表显示了前面代码的输出。这些图表显示了数据中一些变量的直方图。以下是输出结果的第一页：
这里是输出结果的第二页：
这种对变量分布的分析不仅需要理解变量的分布，还需要检测潜在的问题。
处理异常值
一个重要的问题是检测数据中的异常值。异常值是看起来与一组观察值不同的值。考虑一个正态分布的例子，其中分布尾部的值可以被认为是异常值。它们与样本中最近的值关系并不紧密。
有些算法对异常值非常敏感，因此其处理不是一个简单的问题。如果变量的数量较少，检测异常值会更容易。
Winsorization 过程
当异常值的数量很高时，我们需要使用自动程序来帮助自动检测它们。避免异常值问题的最有效方法之一是Winsorization 过程。
根据这种方法，异常值将被替换为固定值。如果一个变量的值小于特定的阈值，这个值将被替换为这个极限。对于变量中的高值，情况也是相同的。
理想情况下，这些极限或阈值基于百分位数。例如，在较低范围内选择 1、2.5 或 5 的百分位数，在较高范围内选择 95、97.5 和 99 的百分位数，可以用于 Winsorization 技术，尽管可以选择其他方法，例如使用四分位距。
实施 Winsorization
让我们将 Winsorization 方法付诸实践。首先，我们需要知道数据集中比率的位置：
head(colnames(train))
## [1] "ID_RSSD" "UBPR1795" "UBPR4635" "UBPRC233" "UBPRD582" "UBPRE386"
tail(colnames(train))
## [1] "UBPRE541" "UBPRE542" "UBPRJ248" "UBPRK447" "Date" "Default"
因此，我们需要将技术应用于所有变量，除了第一个和最后两个变量。
在训练集中完成的全部转换都应该在测试数据集中后续应用。测试样本中的修改将使用训练数据的限制来完成。我们将对两个数据集都进行 winsorization：
for (k in 2:(ncol(train)-2))
{
variable<-as.character(colnames(train)[k])
limits <- quantile(train[,k], probs=c(.01, .99), na.rm = TRUE)
train[complete.cases(train[,k]) & train[,k] < as.numeric(limits[1]),k] <- as.numeric(limits[1])
train[complete.cases(train[,k]) & train[,k] > as.numeric(limits[2]),k] <- as.numeric(limits[2])
test[complete.cases(test[,k]) & test[,k] < as.numeric(limits[1]),k] <- as.numeric(limits[1])
test[complete.cases(test[,k]) & test[,k] > as.numeric(limits[2]),k] <-as.numeric(limits[2])
}
对于每个变量，这将计算训练集中的第一和第九十九百分位数。然后，替换超过第九十九百分位数值的异常值，或小于第一百分位数的值，用相应的百分位数值替换。这意味着它为第一和第九十九百分位数中固定的每个值建立了最大和最小值。这个程序对训练和测试样本都进行。
区分单值变量
现在，我们将计算一个变量所取的唯一值的数量。因此，如果一个变量只取一个单一值，它可以直接从数据集中删除。
sapply函数允许计算每个变量的n_distinct值。创建一个新的数据框，包含常量变量的名称：
library(dplyr)
unique_values<-as.data.frame(sapply(train, n_distinct))
在这个数据框中重命名变量的名称：
colnames(unique_values)<-"Unique_values"
在数据框中添加一个包含变量名称的列：
unique_values$variable_name<-colnames(train)
然后创建一个包含常量变量名称的列表：
variables_to_remove<-unique_values[unique_values$Unique_values==1,"variable_name"]
length(variables_to_remove)
## [1] 84
只有84个变量具有唯一的唯一值。这些变量将在train和test样本中删除：
train<-train[, !colnames(train) %in% variables_to_remove]
test<-test[, !colnames(test) %in% variables_to_remove]
winsorization 的一个问题是，如果一个变量显示的不同值数量很少，它可以只用一个值来替换所有值。这是因为一个变量可能在几个百分位数级别上取相同的值。了解每个程序及其对发展的影响的优缺点非常重要。
记得保存你的工作空间：
save.image("Data6.RData")
处理缺失信息
大多数算法在数据包含缺失值或自动处理这些值的预定动作时都会失败。在这种情况下，掌握控制权非常重要。
处理缺失信息的两种最常见的方法是：删除具有缺失值的观测值或用具体值（通常是中位数或平均值）替换它们。当进行值插补时，你可能会丢失重要信息。例如，变量的缺失值可能总是出现在目标变量的一个类别中。一个典型的例子是我们试图预测银行贷款的合格和不合格申请人的模型。
通常会有与过去某些支付问题相关的变量。有时，根据数据集的不同，这些变量显示缺失值仅仅是因为申请人没有先前的问题。这种情况通常发生在值插补可能导致我们丢失相关信息时。
当变量数量较低时，对缺失值的详细分析最为常见。如果变量数量较高，一些自动替代方法可能更有效。
在对缺失值采取行动之前，让我们通过分析列和行来找出缺失值的数量。然后您可以删除具有大量缺失值的变量和行（也称为观测值）。
在任何情况下，删除变量或观测值的阈值是主观的，并且取决于它们应用的特定案例。
使用DataExplorer包，我们可以找到我们数据中缺失值的百分比。让我们用少数几个变量试一试：
plot_missing(train[,c(6:8,1000:1020)])
上一行代码将打印出类似此图的图表：
上述图表仅是使用DataExplorer包表示某些变量缺失值的一个示例。此包还根据缺失值的数量提供有关使用变量的有用性建议。
我们还有另一种确定具有缺失值的变量的方法。这是一个替代方案，如果您无法访问DataExplorer包，或者只是不想使用它。这更是一种手动方式。让我们编写代码：
ncol=rep(nrow(train) ,each=ncol(train))
missingdata=as.data.frame(cbind(colnames=names(train),ncol,nmsg=as.integer(as.character(as.vector(apply(train, 2, function(x) length(which(is.na(x)))))))))
missingdata$nmsg=as.numeric(levels(missingdata$nmsg))[missingdata$nmsg]
missingdata=cbind(missingdata,percmissing=(missingdata$nmsg/ncol*100))
head(missingdata)
## colnames ncol nmsg percmissing
## 1 ID_RSSD 7091 0 0
## 2 UBPR1795 7091 0 0
## 3 UBPR4635 7091 0 0
## 4 UBPRC233 7091 0 0
## 5 UBPRD582 7091 0 0
## 6 UBPRE386 7091 0 0
例如，我们可以检查缺失值占总观测值超过 99%的变量（这里只显示了少数几行）：
print(missingdata[missingdata$percmissing>=99,])
## colnames ncol nmsg percmissing
## 19 UBPRE406 7091 7066 99.64744
## 26 UBPRE413 7091 7028 99.11155
## 35 UBPRFB69 7091 7038 99.25257
## 121 UBPRE137 7091 7048 99.39360
## 161 UBPRE184 7091 7046 99.36539
## 1347 UBPRE855 7091 7073 99.74616
## 1348 UBPRE856 7091 7047 99.37950
## 1356 UBPRE864 7091 7083 99.88718
## 1360 UBPRE868 7091 7056 99.50642
在这种情况下，我更倾向于不删除任何变量，考虑到其缺失值的数量。没有空变量：
print(missingdata[missingdata$percmissing==100,])
## [1] colnames ncol nmsg percmissing
## <0 rows> (or 0-length row.names)
让我们通过分析行来计算缺失值的数量：
train$missingvalues<-rowSums(is.na(train[,2:1410]))/1409
现在绘制一个直方图来图形化描述缺失值的分布：
hist(train$missingvalues,main="Distribution of missing values",xlab="Percentage of missing values",border="blue", col="red",breaks=25)
上一段代码生成了以下图表：
可以使用以下代码获取银行缺失值百分比的摘要：
summary(train$missingvalues)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.06671 0.44003 0.47480 0.46779 0.50958 0.74663
虽然某些银行的缺失值数量很高，但建议现在不要删除任何观测值，而只删除最近创建的缺失变量：
train$missingvalues<-NULL
我们将使用一个有趣的包来可视化数据集中缺失值的数量，这个包是Amelia包。这是一个用于多重插补缺失数据的包，还包括一个图形界面。
让我们看看一些变量的例子：
library(Amelia)
missmap(train[,5:35], main = "Missing values vs observed",col=c("black", "grey"),,legend = FALSE)
上一段代码生成了以下图表：
虽然表示方式不太美观，但这个图表显示了x轴上的某些变量和数据集中的y轴上的观测值。黑色点表示数据集中存在缺失变量。
如所示，一些变量显示有大量的缺失值。
分析缺失值
我们已经提到，了解缺失值的来源以及它们是否可以提供一些信息是很重要的。在下面的例子中，我们将分析UBPRE628变量中呈现的缺失值。这个变量衡量的是一家银行的长期债务总额除以总银行股本资本。银行的资本很重要，因为在运营中面临损失的情况下，银行将使用这部分资本来吸收损失并避免未来的破产。资本越高，银行面对经济问题的缓冲能力就越强。
通常，与银行资本相关的债务比例越高，银行在未来如果发生新危机的情况下可能遇到的问题就越多。在新的金融危机发生时，银行可能无法偿还其债务，即使通过出售其资产。
根据我们的分析，这个变量显示了高比例的缺失值，具体来说，这个比率对于我们数据中的 23.97%的银行没有信息：
missingdata[missingdata$colnames=="UBPRE628",]
## colnames ncol nmsg percmissing
## 281 UBPRE628 7091 17 0.2397405
理解结果
现在我们将创建一个辅助数据框来统计失败银行的数目并检查这个比率是否已告知：
missing_analysis<-train[,c("UBPRE628","Default")]
现在我们将创建一个标志来检查变量是否存在缺失：
missing_analysis$is_miss<-ifelse(is.na(missing_analysis$UBPRE628),"missing_ratio","complete_ratio")
最后，让我们总结一下数据集中两种情况下的现有违约数量：这个比率中缺失值的存在或缺失：
aggregate(missing_analysis$Default, by = list(missing_analysis$is_miss), sum)
## Group.1 x
## 1 complete_ratio 319
## 2 missing_ratio 14
根据这个表格，只有14家失败的银行在这个比率中显示了缺失值。显然，我们可以从这个结论中得出，一家银行可能会故意不报告特定的比率，因为计算出的比率可能会让其他人意识到这家银行的糟糕经济状况。在这种情况下，如果观察到缺失值，我们不会观察到高比例的坏银行。
缺失值将通过计算训练数据集中非缺失观测值的比率平均值来估计。这意味着，如果验证数据集中存在缺失值，它们也可能存在于训练数据集中。让我们看一个例子：
train_nomiss<-train
test_nomiss<-test
for(i in 2:(ncol(train_nomiss)-2))
{
train_nomiss[is.na(train_nomiss[,i]), i] <- mean(train_nomiss[,i], na.rm = TRUE)
test_nomiss[is.na(test_nomiss[,i]), i] <- mean(train_nomiss[,i], na.rm = TRUE)
}
我们可以使用Amelia包在训练和验证样本上检查这个过程是否成功（可能需要几分钟）。例如，你可以在过程执行后检查训练样本中是否存在缺失值：
missmap(train_nomiss[,2:(ncol(train_nomiss)-2)], main = "Missing values vs observed",col=c("black", "grey"),,legend = FALSE)
这里是前面代码的输出：
对测试样本执行相同的检查：
missmap(test_nomiss[,2:(ncol(train_nomiss)-2)], main = "Missing values vs observed",col=c("black", "grey"),,legend = FALSE)
再次，显示了新的输出：
两个地图以灰色绘制，表示没有缺失值。
现在我们将备份我们的工作空间并删除所有不必要的表格：
rm(list=setdiff(ls(), c("Model_database","train","test","train_nomiss","test_nomiss")))
save.image("Data7.RData")
摘要
在本章中，我们了解了一些准备和了解数据的基本重要步骤。在我们的数据集中有多少个变量可用？我们有什么样的信息？数据中是否有缺失值？我该如何处理缺失值和异常值？我希望你现在可以回答这些问题。
此外，在本章中，我们还学习了如何将我们的数据分割成训练集和验证集，以训练和验证我们即将到来的预测模型。在下一章，我们将更进一步，对这份数据进行单变量分析，这意味着分析变量是否对预测银行破产有用。
第四章：预测银行失败 - 单变量分析
近年来，大数据和机器学习在许多领域变得越来越受欢迎。人们普遍认为，变量越多，分类器就越准确。然而，这并不总是正确的。
在本章中，我们将通过分析每个变量的单独预测能力以及使用不同的替代方案来减少数据集中的变量数量。
在本章中，我们将涵盖以下主题：
-
特征选择算法
-
过滤方法
-
包装方法
-
内嵌方法
-
维度降低
特征选择算法
在预测银行失败的这一实际案例中，我们有许多变量或财务比率来训练分类器，因此我们预计会得到一个很好的预测模型。考虑到这一点，我们为什么要选择替代变量并减少它们的数量呢？
嗯，在某些情况下，通过添加新特征来增加问题的维度可能会降低我们模型的性能。这被称为维度诅咒问题。
根据这个问题，增加更多特征或增加特征空间的维度将需要收集更多数据。从这个意义上说，我们需要收集的新观察结果必须以指数速度快速增长，以维持学习过程并避免过拟合。
这个问题通常在变量数量与我们的数据中的观察数量之间的比率不是很高的情况下观察到。
特征选择对于从数据中识别和删除不必要的、不相关的和冗余变量，以及降低模型复杂性也是很有用的。
特征选择类别
在许多机器学习指南中可以找到三种特征选择算法的通用类别。这些包括以下内容：
-
过滤方法：在这个方法中，变量是根据与目标变量的相关性来选择的。因此，它是通过每个变量解释模型目标的能力来衡量的。这些方法在变量数量高时特别有用，并且有助于避免过拟合。作为缺点，值得提到的是，尽管这些变量在单独的情况下不是预测性的，并且以单变量的方式衡量，但当与其他变量结合时，它们可以成为预测性的。总之，这些方法不考虑变量之间的关系。
-
包装方法：包装方法通过评估变量的子集来检测变量之间的可能相互作用。在包装方法中，在预测模型中使用多个变量的组合，并根据模型的准确性为每个组合给出一个分数。因此，可以避免不相关的组合。然而，如果变量的数量很大，这些方法会非常耗时，并且始终存在过拟合的风险，尤其是在观察数量较低的情况下。
-
嵌入式方法：最后，通过嵌入式方法，在训练过程中学习并记住对提高模型准确性最有贡献的特征。正则化就是这样一种特征选择方法。它们也被称为惩罚方法，因为它们对优化参数施加约束，通常使模型变量数量减少。Lasso、弹性网络和岭回归是最常见的正则化方法。其他嵌入式特征选择算法的例子包括 Lasso、弹性网络和岭回归算法。我们将在稍后更详细地研究这些模型。
过滤方法
让我们从一种过滤方法开始，以减少第一步中的变量数量。为此，我们将测量一个变量的预测能力或其单独和正确分类目标变量的能力。
在这种情况下，我们试图找到能够正确区分清偿能力和非清偿能力银行的变量。为了衡量一个变量的预测能力，我们使用一个名为信息值（IV）的指标。
具体来说，给定一个分为n组的分组变量，每个组都有一定数量的良好银行和不良银行——或者在我们的案例中，清偿能力和非清偿能力银行——该预测器的信息值可以按以下方式计算：
IV 统计量通常根据其值进行解释：
-
< 0.02：分析变量不能准确区分目标变量的类别
-
0.02 到 0.1：变量与目标变量有较弱的关系
-
0.1 到 0.3：变量显示出中等强度的关系
-
> 0.3：变量是目标的好预测器
根据这个值，这个变量本身具有很强的预测性。因此，这个变量可以用于我们的模型。让我们看看一个变量IV的计算示例：
在先前的表中，我们可以看到UBPRE006变量的信息值计算，它代表贷款和损失预留总额除以银行的资产总额。
从广义上讲，当贷款发放时，其中一部分必须预留以备信用违约的情况；也就是说，银行在其损益表中做出两种类型的预留以覆盖所谓的信用风险：一种是贷款发放时做出的通用预留，另一种是针对未偿还信用的特定预留。
理论上，比率越高，银行破产的可能性就越大，因为如果预留水平高，这表明其贷款的信用质量将较低。
记住，在我们的样本中，失败银行的百分比为 4.70%。在这个例子中，UBPRE006 变量已被分为四个类别，以及一个额外的类别来衡量缺失值的水平。这可以在 BadRate 列中看到，作为失败银行的比率，其值低于 0.5487%。这非常低，仅代表该组中 0.80% 的银行。随着这个比率的增加，失败银行的比率也会更高。此外，在这个比率中没有银行有缺失值。
此表第一组中出现的值是根据此方程计算的：
在此表格的 IV 列中所有值的总和可以在第 6 行的 3.2803 列中找到。
根据这个值，这个变量本身具有很强的预测性。因此，在模型中使用这个变量可能是有用的。
另一方面，证据权重（WoE）是一个与信息值非常密切相关的指标。此指标也包括在先前的表格中。WoE 的计算方法如下：
实际上，WoE 方程是 IV 指标的一部分。如果 良好到不良 比率的优势为 1，则 WoE 的值将为 0。
如果一个组中 不良 的百分比大于 良好 的百分比，则优势比将小于 1，WoE 将是负数；如果组中 良好 的数量大于 不良，则 WoE 值将是正数。
通常，WoE 的正值表示被放入该组的银行比样本中所有银行的平均状况更稳健。另一方面，负值越高，该组中的银行风险越大。
我们将计算训练集中每个变量的信息值。smbinning 包对此非常有用。
如已所见，一个重要步骤是分组变量，这个包会自动完成。
我们将进行两个不同的实验。因此，在缺失值插补前后，我们将计算训练集的信息值。我们将在本节后面讨论这些实验背后的原因。
此包假设如果一家银行稳健，则目标变量应取值为 1，否则为 0，这与我们在之前步骤中所做的正好相反。因此，第一步包括反转目标值：
aux_original<-train
aux_original$Defaultf<-as.numeric(as.character(aux_original$Default))
aux_original$Defaultf<-ifelse(aux_original$Default==1,0,1)
aux_nomiss<-train_nomiss
aux_nomiss$Defaultf<-as.numeric(as.character(aux_nomiss$Default))
aux_nomiss$Defaultf<-ifelse(aux_nomiss$Default==1,0,1)
接下来，我们运行以下代码（这是一个非常耗时的过程）：
library(smbinning)
table_iv<-matrix("NA",0,5)
table_iv<-data.frame(table_iv)
colnames(table_iv)<-c("Char","IV_original","Process_original","IV_nomiss","Process_nomiss")
for (var in 1:length(aux_original[,2:1408]))
{
variable<-colnames(aux_original)[var+1]
aux_original2<-aux_original[,c(variable,"Defaultf")]
aux_nomiss2<-aux_nomiss[,c(variable,"Defaultf")]
temp1<-smbinning.sumiv(aux_original2, "Defaultf")
temp2<-smbinning.sumiv(aux_nomiss2, "Defaultf")
colnames(temp1)<-c("Char","IV_original","Process_original")
colnames(temp2)<-c("Char","IV_nomiss","Process_nomiss")
temp2$Char<-NULL
temp1<-cbind(temp1,temp2)
table_iv<-rbind(table_iv,temp1)
}
之前的代码创建了一个表格，其中将存储信息值（table_iv）。然后，对于 train 数据集中的每个变量，使用 smbinning.sumiv 函数计算信息值。
一旦过程完成，就会创建工作区备份：
save.image("Data8.RData")
让我们看看结果：
head(table_iv)
## Char IV_original Process_original IV_nomiss
## 1 UBPR1795 2.6138 Numeric binning OK 2.6138
## 2 UBPR4635 2.5253 Numeric binning OK 2.5253
## 3 UBPRC233 NA No significant splits NA
## 4 UBPRD582 NA Uniques values < 5 NA
## 5 UBPRE386 NA No significant splits NA
## 6 UBPRE388 0.5853 Numeric binning OK 0.5622
## Process_nomiss
## 1 Numeric binning OK
## 2 Numeric binning OK
## 3 No significant splits
## 4 Uniques values < 5
## 5 No significant splits
## 6 Numeric binning OK
在这个表中，我们展示了在缺失值插补前后训练样本中每个变量的信息值。
在信息值之后，一列告诉我们计算状态。这里可能显示不同的消息如下：
-
数值分箱正常：信息值已正确计算，并且至少可以在变量中区分出两个不同的组，以区分好银行和坏银行。 -
无显著分割：由于变量无法区分银行的未来偿债能力，因此不计算信息值。未检测到银行的不同组。 -
唯一值少于 5：一个变量具有少于五个不同的值。在这种情况下，不计算信息值。
结果取决于缺失值之前是否已处理或是否包含在示例中：
table(table_iv$Process_original)
##
## Numeric binning OK No significant splits Uniques values < 5
## 522 807 78
table(table_iv$Process_nomiss)
##
## Numeric binning OK No significant splits Uniques values < 5
## 539 790 78
smbinning包将缺失值视为一个新类别，在某些情况下，这可能包含相关信息或与我们的目标变量中的一个类别更相关。
重要的是要意识到缺失变量的插补意味着对您的数据的一种限制。
让我们检查这个简单决策对预测能力的影响。计算如下，存在或不存在缺失值的IV差异：
diff_iv<-table_iv[complete.cases(table_iv) & table_iv$Process_original=="Numeric binning OK" &table_iv$Process_nomiss=="Numeric binning OK" ,]
diff_iv$diff<-(diff_iv$IV_nomiss - diff_iv$IV_original)
hist(diff_iv$diff, border=TRUE , col=rgb(0.8,0.2,0.8,0.7) , main="")
让我们看看输出结果：
这里是总结统计信息：
summary(diff_iv$diff)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -2.64110 -0.03052 0.00000 -0.05247 0.00000 0.22570
根据总结统计信息，平均而言，缺失值插补会降低变量的预测能力或信息值 5.247%。在某些情况下，变量甚至会增加预测能力。
我们可以根据其信息值对变量的预测能力进行分类。我们将考虑之前解释的阈值来定义变量是否显示强大的、中等的或弱的预测能力：
table_iv$IV_Category<-ifelse(table_iv$IV_nomiss >= 0.3, "1:Strong", ifelse(table_iv$IV_nomiss >= 0.1, "2:Medium","3:Weak"))
table(table_iv$IV_Category)
##
## 1:Strong 2:Medium 3:Weak
## 358 114 67
在这一步，我们可以移除预测能力低的变量。因此，从数据集中我们拥有的超过一千个变量中，我们只会选择被分类为强或中的变量：
table_iv<-table_iv[complete.cases(table_iv) & table_iv$IV_Category != "3:Weak",]
尽管存在限制，我们仍将使用之前已处理缺失值的数据库：
train<-train_nomiss
test<-test_nomiss
通常，对可能作为多元模型一部分的变量进行单变量转换可以提高其区分能力。
变量转换有助于减轻异常值对模型开发的影响，并捕捉变量与目标之间的非线性关系。
信用风险中最常见的做法之一是将变量转换为不同的类别，然后为每个类别分配其对应的 WoE 值。让我们看看这个例子。再次，使用smbinning包。
对于这一点，我们首先需要将目标值转换为由于包限制而具有的相反值：
train$Defaultf<-as.numeric(as.character(train$Default))
train$Defaultf<-ifelse(train$Default==1,0,1)
test$Defaultf<-as.numeric(as.character(test$Default))
test$Defaultf<-ifelse(test$Default==1,0,1)
我们将smbinning函数应用于UBPRD486变量或“一级杠杆资本”。从监管者的角度来看，“一级”比率代表银行财务实力的核心指标。比率越高，银行的偿付能力和实力就越强。
首先，我们分析这个变量在失败和非失败银行中的分布情况：
boxplot(train$UBPRD486~train$Default, horizontal=T, frame=F, col="lightgray",main="Tier One Leverage Ratio Distribution")
这是“一级”比率分布图：
通常情况下，根据之前的截图，失败银行在这个比率中显示的值较低。应用smbinning函数，创建了一个对象，并进行了变量分类。
可以进行以下一些图形分析：
smbinning.plot(result,option="dist")
以下截图很好地描述了分类情况：
在这个变量中，74.6%的银行显示的值高于 8.16。让我们看看按组划分的失败银行百分比：
smbinning.plot(result,option="badrate")
下面的结果图显示，在比率值低于或等于5.6的银行中观察到较高的不良率：
如注释所述，前面的截图显示，比率值越低，失败银行的数目就越高。这个变量非常有预测性，因为它很容易通过收集大量失败银行来找到组。因此，第一组中包含的 74.8%的银行破产了。也有可能通过运行以下代码来绘制每个组的WoE值：
smbinning.plot(result,option="WoE")
前面的代码提供了以下截图，其中显示了证据值的权重：
对于一些信用申请，随着评分模型的发展，将每个比率的原始值替换为对应证据值的权重，这是一种非常常见的做法，如图所示。例如，值低于或等于 5.6 的将被替换为-4.1。因此，WoE 变量随后用于训练模型，使用逻辑回归，这是最常见的方法。
smbinning包还帮助将原始变量转换为相应的组。根据我的经验，我没有发现很多证据表明 WoE 转换真的能提高模型的性能。因此，在这种情况下，我们不会转换我们的变量。
弱变量也被移除了：
relevant_vars<-as.vector(table_iv$Char)
relevant_vars<-c("ID_RSSD","Default","Defaultf", relevant_vars)
train<-train[,relevant_vars]
test<-test[,relevant_vars]
以下是将工作区保存的步骤：
save.image("Data9.RData")
我们可以继续过滤变量。到目前为止，我们数据集的维度如下：
dim(train)
## [1] 7091 465
当面对回归或分类问题时，如果移除了高度相关的属性，一些模型的表现会更好。相关性可以通过以下方式获得：
correlations <- cor(train[,4:ncol(train)])
属于 caret 包的 findCorrelation 函数在相关矩阵上执行搜索，并输出包含整数的向量。这些整数对应于如果删除，可以减少成对相关性的列。因此，此函数寻找具有更高相关性的属性。
它通过考虑成对相关列的绝对值来工作。它移除具有最大平均绝对值的变量，这是通过比较高度相关的变量来计算的：
## Loading required package: lattice
highlyCorrelated <- data.frame("Char"=findCorrelation(correlations, cutoff=0.75,names = TRUE))
截断选项是选择高度相关变量的阈值：
correlated_vars<-as.vector(highlyCorrelated$Char)
non_correlated_vars<-!(colnames(train) %in% correlated_vars)
train<-train[,non_correlated_vars]
test<-test[,non_correlated_vars]
数据集中总共剩下 262 个变量：
ncol(train)
#262
包装方法
如本节开头所述，包装方法评估变量子集以检测变量之间可能的相互作用，这比过滤方法提前一步。
在包装方法中，在预测模型中使用多个变量的组合，并根据模型精度对每个组合给出分数。
在包装方法中，分类器通过作为黑盒的多变量组合进行迭代训练，其唯一输出是重要特征的排名。
Boruta 包
R 中最知名的包装包之一称为 Boruta。此包主要基于 随机森林 算法。
虽然此算法将在本书的后续部分进行更详细的解释，但由 Breiman 于 2001 年提出的 Boruta 是一种挖掘数据和在样本上生成许多决策树并通过多数投票结合的工具。随机森林创建不同决策树的目的，是为了从不同类别的数据中获得最佳可能的分类。
随机森林的一个成功应用实例是在信用卡欺诈检测系统中。
在 Boruta 包中，使用数据集中其他变量的多个组合创建随机变量。
然后将新变量与原始变量结合，并训练不同的随机森林。通过比较随机变量与原始变量的重要性，获得不同特征的重要性。
只有比随机变量重要性更高的变量才被认为是重要的。如果变量数量很多，Boruta 包将非常耗时，尤其是因为算法会创建更多变量来对其特征进行排名。
让我们在 R 中启动 Boruta 算法。首先，建立一个 seed 以使练习可重复：
set.seed(123)
然后从训练数据集创建一个辅助表，并且没有删除相关变量：
aux<-train
aux$`ID_RSSD`<-NULL
aux$Defaultf<-NULL
最后，启动 Boruta 算法（这非常耗时，可能需要超过一小时）：
library(Boruta)
wrapper <- Boruta(Default ~. , data = aux, doTrace = 2,maxRuns = 100)
当打印 wrapper 对象时，它提供了数据集中特征的重要性。
Boruta 算法对我们数据库中的任何变量得出结论：
print(wrapper)
## Boruta performed 99 iterations in 1.15968 hours.
## 85 attributes confirmed important: UBPR2150, UBPR7402, UBPRA222,
## UBPRD488, UBPRD646 and 80 more;
## 139 attributes confirmed unimportant: UBPR0071, UBPR1590,
## UBPR1616, UBPR1658, UBPR1661 and 134 more;
## 35 tentative attributes left: UBPR2366, UBPR3816, UBPRE083,
## UBPRE085, UBPRE140 and 30 more;
许多变量被分类为重要或不重要，但在其他情况下，变量被分配到尝试性类别：
table(wrapper$finalDecision)
##
## Tentative Confirmed Rejected
## 35 85 139
尝试性特征的重要性几乎与它们最好的随机特征相同。在这种情况下，Boruta无法就默认的随机森林迭代次数做出自信的决定。
在继续之前，让我们先备份工作空间：
save.image("Data10.RData")
通过TentativeRoughFix函数，可以对尝试性变量做出决定。为此，将中值特征 Z 分数与最重要的随机特征的中值 Z 分数进行比较，并做出决定：
wrapper <- TentativeRoughFix(wrapper)
print(wrapper)
## Boruta performed 99 iterations in 1.15968 hours.
## Tentatives roughfixed over the last 99 iterations.
## 108 attributes confirmed important: UBPR2150, UBPR3816, UBPR7402,
## UBPRA222, UBPRD488 and 103 more;
## 151 attributes confirmed unimportant: UBPR0071, UBPR1590,
## UBPR1616, UBPR1658, UBPR1661 and 146 more;
因此，根据此包，我们的训练样本将减少到只有99个变量。
Boruta不是唯一的包装方法。caret包还包括一个包装过滤器。在这种情况下，该算法被称为递归特征消除（RFE）。
在此算法中，首先使用所有独立变量训练一个模型，并计算特征的重要性。将不那么重要的变量（n）从样本中移除，并再次训练模型。这一步骤重复多次，直到所有变量都被使用。在每个迭代中，评估模型的性能。在性能最佳的模型中确定最佳预测变量。
在此算法中，除了随机森林（rfFuncs）之外，还有许多可用于训练的模型，例如以下这些：
-
线性回归，
lmFuncs函数 -
朴素贝叶斯函数，
nbFuncs -
带袋的树函数，
treebagFuncs
让我们看看这个算法如何在 R 中使用：
- 首先，固定一个
seed以获得相同的结果：
library(caret)
set.seed(1234)
- 将目标变量转换为
factor。因此，算法用于分类。如果不这样做，则假定是一个回归问题：
aux$Default<-as.factor(aux$Default)
- 最后，运行算法。随机森林被选为具有 10 折验证的分类器（此执行也很耗时）：
rfe_control <- rfeControl(functions=rfFuncs, method='cv', number=10)
recursive <- rfe(aux[,2:260], aux[,1], rfeControl=rfe_control)
如果打印recursive对象，将显示最重要的变量：
print(recursive, top=10)
##
## Recursive feature selection
##
## Outer resampling method: Cross-Validated (10 fold)
##
## Resampling performance over subset size:
##
## Variables Accuracy Kappa AccuracySD KappaSD Selected
## 4 0.9848 0.8224 0.005833 0.06490
## 8 0.9866 0.8451 0.004475 0.04881
## 16 0.9884 0.8685 0.005398 0.06002
## 259 0.9886 0.8659 0.004019 0.04617 *
##
## The top 10 variables (out of 259):
## UBPRD488, UBPRE626, UBPRE217, UBPRE170, UBPRE392, UBPRE636, UBPRE883, UBPRE394, UBPRE370, UBPRE074
plot(recursive, type=c("g", "o"), cex = 1.0)
将获得以下输出：
让我们获取所有变量的排名：
head(predictors(recursive))
## [1] "UBPRD488" "UBPRE626" "UBPRE217" "UBPRE170" "UBPRE392" "UBPRE636
head(recursive$resample, 10)
## Variables Accuracy Kappa .cell1 .cell2 .cell3 .cell4 Resample
## 4 259 0.9915374 0.8988203 675 1 5 28 Fold01
## 8 259 0.9915374 0.8988203 675 1 5 28 Fold02
## 12 259 0.9830748 0.7976887 672 3 9 25 Fold03
## 16 259 0.9887165 0.8690976 673 3 5 28 Fold04
## 20 259 0.9929577 0.9169746 676 0 5 29 Fold05
## 24 259 0.9901269 0.8801237 675 1 6 27 Fold06
## 28 259 0.9873061 0.8590115 671 5 4 29 Fold07
## 32 259 0.9859155 0.8314180 674 2 8 26 Fold08
## 36 259 0.9929478 0.9169536 675 1 4 29 Fold09
## 40 259 0.9816384 0.7903799 669 6 7 26 Fold10
如您所见，我们成功获得了变量的排名。尽管如此，用户必须具体选择最终模型中将包含多少最终变量。
在这种情况下，只考虑Boruta包执行后的结果变量：
predictors<-data.frame("decision"=wrapper$finalDecision)
predictors<-cbind("variable"=row.names(predictors),predictors)
predictors<- as.vector(predictors[predictors$decision=="Confirmed","variable"])
train<-train[,c('ID_RSSD','Default',predictors)]
test<-test[,c('ID_RSSD','Default',predictors)]
我们的样本已经减少：
ncol(train)
## [1] 110
save.image("Data11.RData")
嵌入式方法
过滤器和包装方法之间的主要区别在于，在过滤器方法中，例如嵌入式方法，你不能将学习和特征选择部分分开。
正则化方法是嵌入式特征选择方法中最常见的类型。
在此类分类问题中，逻辑回归方法无法处理当变量高度相关时的多重共线性问题。当观测数数量不比协变量数量 p 多很多时，可能会有很多变异性。因此，这种变异性甚至可以通过简单地添加更多参数来增加似然，从而导致过拟合。
如果变量高度相关或存在多重共线性，我们预计模型参数和方差会被夸大。高方差是因为错误指定的模型包含了冗余的预测变量。
为了解决这些局限性，一些方法已经出现：岭回归、Lasso 和弹性网络是最常见的方法。
岭回归
在 Ridge regression 中，回归系数的大小基于 L2 范数进行惩罚：
这里，L(B|y,x) 代表逻辑回归的似然函数，λ 是调整参数，用于控制这两个项对回归系数估计的相对影响。
岭回归的局限性
岭回归将所有预测变量包含在最终模型中。然而，当变量数量 p 很大时，它通常在模型解释上显示出问题。
Lasso
Lasso 代表正则化的另一种选择，并且它克服了岭回归的缺点，减少了最终模型中的预测变量数量。这次，它使用 L1 惩罚来惩罚回归系数的大小：
当 λ 足够大时，它迫使一些系数估计值恰好等于零，从而获得更简洁的模型。
Lasso 的局限性
有时，Lasso 也显示出重要的弱点：如果协变量的数量 p 远远大于观测数的数量，选定的变量数量将受到观测数数量的限制。
弹性网络
Elastic net 尝试克服岭回归和 Lasso 模型的局限性，并在变量高度相关时表现良好。
弹性网络使用所有变量来训练模型，但它也试图结合两种先前使用的方法（岭回归和 Lasso 回归）的优点。因此，弹性网络根据 L1 范数和 L2 范数对回归系数的大小进行惩罚，如下所示：
弹性网络的缺点
弹性网络（Elastic net）涉及选择 λ[1] 和 λ[2] 作为模型良好性能的关键值。这些参数通常通过交叉验证技术获得。从这些方法中，Lasso 和弹性网络通常用于特征选择。目前，我们的数据集中有 96 个变量；我们决定不减少变量的数量。
维度降低
维度投影，或特征投影，包括将高维空间中的数据转换为低维空间。
高维数大大增加了计算复杂度，甚至可能增加过拟合的风险。
降维技术对特征选择也很有用。在这种情况下，变量通过不同的组合转换为其他新变量。这些组合通过较少的变量从复杂的数据库中提取和总结相关信息。
存在着不同的算法，以下是最重要的：
-
主成分分析（PCA）
-
Sammon 映射
-
奇异值分解（SVD）
-
Isomap
-
局部线性嵌入（LLE）
-
拉普拉斯特征映射
-
t 分布随机邻域嵌入（t-SNE）
尽管在诸如故障预测模型或信用风险等情况下，降维并不常见，但我们将看到我们数据中的一个例子。
我们还将看到 PCA 和 t-SNE 的应用，它们是最常用的算法。
PCA 是一种通过变量的线性变换来提取数据集上重要变量的方法。因此，我们可以将主成分定义为原始变量的归一化线性组合。
第一主成分是变量的线性组合，它捕捉了数据集中最大的方差。第一成分中捕捉到的方差越大，该成分捕捉到的信息就越多。第一成分只用一行就能最好地总结我们数据中的最大信息。第二和后续的主成分也是原始变量的线性组合，它们捕捉了数据中剩余的方差。
当变量高度相关时，PCA 也被使用。这种方法的主要特性之一是不同组件之间的相关性为零。
让我们看看在 R 中的实现。为此，我们使用rstat包中包含的prcomp函数：
pca <- prcomp(train[,3:ncol(train)], retx=TRUE, center=TRUE, scale=TRUE)
在实现 PCA 方法之前，变量应该被标准化。这意味着我们应该确保变量具有等于零的均值和等于 1 的标准差。
这可以通过使用同一函数中的scale和center选项作为参数来完成：
names(pca)
## [1] "sdev" "rotation" "center" "scale" "x"
center和scale向量包含我们所使用的变量的均值和标准差。
旋转测量返回主成分。我们获得与样本中变量相同数量的主成分。
让我们打印出这些组件的外观。例如，前四个组件的第一行如下所示：
pca$rotation[1:10,1:4]
## PC1 PC2 PC3 PC4
## UBPRE395 -0.05140105 0.027212743 0.01091903 -0.029884263
## UBPRE543 0.13068409 -0.002667109 0.03250766 -0.010948699
## UBPRE586 0.13347952 -0.013729338 0.02583513 -0.030875234
## UBPRFB60 0.17390861 -0.042970061 0.02813868 0.016505787
## UBPRE389 0.07980840 0.069097429 0.08331793 0.064870471
## UBPRE393 0.08976446 0.115336263 0.02076018 -0.012963786
## UBPRE394 0.16230020 0.119853462 0.07177180 0.009503902
## UBPRE396 0.06572403 0.033857693 0.07952204 -0.005602078
## UBPRE417 -0.06109615 -0.060368186 -0.01204455 -0.155802734
## UBPRE419 0.08178735 0.074713474 0.11134947 0.069892907
每个组件解释了总方差的一部分。每个组件解释的方差比例可以按以下方式计算：
- 让我们先计算每个组件的方差：
pca_variances =pca$sdev²
- 然后将每个方差除以成分方差的和：
prop_var_explained <- pca_variances/sum(pca_variances)
head(prop_var_explained,10)
## [1] 0.10254590 0.06510543 0.04688792 0.04055387 0.03637036 0.03576523
## [7] 0.02628578 0.02409343 0.02305206 0.02091978
第一主成分解释了大约 10%的方差。第二成分解释了 6%的方差，以此类推。
我们可以使用此代码图形化地观察总方差及其贡献：
plot(pca, type = "l",main = " Variance of Principal components")
上述代码生成了以下内容：
让我们运行代码来绘制方差图：
plot(prop_var_explained, xlab = "Principal Component",
ylab = "Proportion of Variance Explained",
type = "b")
上述代码生成了以下图形：
前面的截图有助于确定解释总方差重要部分的变量数量或主成分数量。
因此，这些成分可以用来建模，而不是使用完整的变量列表。绘制累积解释方差很有趣：
plot(cumsum(prop_var_explained), xlab = "Principal Component",
ylab = "Cumulative Proportion of Variance Explained",
type = "b")
上述代码生成了以下图形：
根据前面的截图，前 20 个成分解释了我们数据集中大约 60%的总方差。
我们可以选择使用这 20 个成分来创建我们的模型。这种方法在信用风险模型中并不常见，所以我们不会使用这些转换。
然而，评估我们的数据集的外观很重要。在下面的截图中，我们使用前两个成分展示了数据的图形表示。
此外，我们根据相应的目标变量在图中对每个银行进行分类。这次，我们使用ggfortify包：
library(ggfortify)
train$Default<-as.factor(train$Default)
autoplot(pca, data = train, colour = 'Default'
此截图显示了失败和非失败银行的分类图：
只看两个成分非常有趣。尽管这些成分只解释了大约 17%的总方差，但失败和非失败的银行在某种程度上是区分开的。
降维技术
您应该考虑，主成分假设变量的线性变换，但还有其他非线性降维技术。
对我来说，最有趣的技巧之一是 Laurens van der Maaten 开发的 t-SNE，他说：
“作为一个理智的检查，尝试对你的数据进行 PCA，将其降低到二维。如果这也给出糟糕的结果，那么可能你的数据一开始就没有太多好的结构。如果 PCA 运行良好但 t-SNE 不行，我相当确信你做错了什么。”
让我们看看 t-SNE 在我们数据集上的应用示例。通常，建议您设置一个seed：
set.seed(1234)
我们需要使用Rtsne包。此包包含执行算法的Rtsne函数。最重要的参数如下：
-
pca：这确定在运行 t-SNE 之前是否执行主成分分析。 -
perplexity：这是信息的一个度量（定义为香农熵的 2 次方）。perplexity参数确定了每个观察中最近邻的数量。这个参数对算法很有用，因为它使它能够在你的数据观察中找到局部和全局关系之间的平衡。
运行算法的代码如下：
library(Rtsne)
tsne= Rtsne(as.matrix(train[,3:ncol(train)]), check_duplicates=TRUE, pca=TRUE, perplexity=75, theta=0.5, dims=2,max_iter = 2000,verbose=TRUE)
这个过程需要几分钟才能完成。有关算法工作原理的更多信息也包含在包文档及其参考文献中。
通常，完整的数据集被简化为只有两个向量：
tsne_vectors = as.data.frame(tsne$Y)
head(tsne_vectors)
## V1 V2
## 1 -4.300888 -14.9082526
## 2 4.618766 44.8443129
## 3 21.554283 3.2569812
## 4 45.518532 0.7150365
## 5 12.098218 4.9833460
## 6 -14.510530 31.7903585
让我们根据其向量绘制我们的训练数据集：
ggplot(tsne_vectors, aes(x=V1, y=V2)) +
geom_point(size=0.25) +
guides(colour=guide_legend(override.aes=list(size=6))) +
xlab("") + ylab("") +
ggtitle("t-SNE") +
theme_light(base_size=20) +
theme(axis.text.x=element_blank(),
axis.text.y=element_blank()) +
scale_colour_brewer(palette = "Set2")
前面的代码生成了以下图表：
现在让我们再次绘制它，为每个目标值分配一个颜色，以及失败和未失败的银行：
plot(tsne$Y, t='n', main="tsne",xlab="Vector X",ylab="Vector y")
text(tsne$Y, labels=as.vector(train$Default), col=c('red', 'blue')[as.numeric(train$Default)])
前面的代码生成了以下图表：
我们可以看到许多失败的银行被放置在结果的双变量地图的同一部分。然而，t-SNE 的一个主要弱点是算法的黑盒性质。基于结果无法对额外数据进行推断，这在使用 PCA 时是不会发生的。
t-SNE 主要用于探索性数据分析，它也被用作聚类算法的输入。
在这个实际案例中，我们试图在信用风险分析过程中保持准确，我们将忽略 PCA 和 t-SNE 的结果，并继续使用我们的原始维度。
一旦我们选定了最具有预测性的变量，我们将尝试使用不同的算法将它们结合起来。目标是开发一个具有最高准确性的模型来预测银行未来的破产。
在继续之前，让我们保存工作空间：
rm(list=setdiff(ls(), c("Model_database","train","test","table_iv")))
save.image("~/Data12.RData")
摘要
在本章中，我们看到了如何通过单变量分析减少我们问题数据的空间样本，并分析了数据。因此，在下一章中，我们将看到这些变量如何结合以获得一个准确的模型，其中将测试多个算法。
第五章：预测银行失败 - 多元分析
在本章中，我们将应用不同的算法，目的是通过我们的预测因子的组合来获得一个好的模型。在信用风险应用中，如信用评分和评级，最常用的算法是逻辑回归。在本章中，我们将看到其他算法如何应用于解决逻辑回归的一些弱点。
在本章中，我们将介绍以下主题：
-
逻辑回归
-
正则化方法
-
测试随机森林模型
-
梯度提升
-
神经网络中的深度学习
-
支持向量机
-
集成方法
-
自动机器学习
逻辑回归
从数学上讲，二元逻辑模型有一个具有两个分类值的因变量。在我们的例子中，这些值与银行是否有偿付能力相关。
在逻辑模型中，对数几率指的是一个类别的对数几率，它是一个或多个独立变量的线性组合，如下所示：
逻辑回归算法的系数（beta 值，β）必须使用最大似然估计来估计。最大似然估计涉及获取回归系数的值，以最小化模型预测的概率与实际观察案例之间的误差。
逻辑回归对异常值的存在非常敏感，因此应避免变量之间的高相关性。在 R 中应用逻辑回归的方法如下：
set.seed(1234)
LogisticRegression=glm(train$Default~.,data=train[,2:ncol(train)],family=binomial())
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
代码运行没有问题，但出现了一个警告信息。如果变量高度相关或存在多重共线性，模型参数和方差膨胀是预期的。
高方差不是由于准确的或好的预测因子，而是由于一个未指定且有冗余预测因子的模型。因此，通过简单地添加更多参数来增加最大似然，这会导致过拟合。
我们可以使用summary()函数观察模型的参数：
summary(LogisticRegression)
##
## Call:
## glm(formula = train$Default ~ ., family = binomial(), data = train[,
## 2:ncol(train)])
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.9330 -0.0210 -0.0066 -0.0013 4.8724
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -11.7599825009 6.9560247460 -1.691 0.0909 .
## UBPRE395 -0.0575725641 0.0561441397 -1.025 0.3052
## UBPRE543 0.0014008963 0.0294470630 0.048 0.9621
## .... ..... .... .... ....
## UBPRE021 -0.0114148389 0.0057016025 -2.002 0.0453 *
## UBPRE023 0.4950212919 0.2459506994 2.013 0.0441 *
## UBPRK447 -0.0210028916 0.0192296299 -1.092 0.2747
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2687.03 on 7090 degrees of freedom
## Residual deviance: 284.23 on 6982 degrees of freedom
## AIC: 502.23
##
## Number of Fisher Scoring iterations: 13
我们可以看到，前一个表的最后一列中的大多数变量都是不显著的。在这种情况下，应该减少回归中的变量数量，或者遵循另一种方法，例如惩罚或正则化方法。
正则化方法
使用正则化方法有三种常见的方法：
-
Lasso
-
岭回归
-
弹性网络
在本节中，我们将看到这些方法如何在 R 中实现。对于这些模型，我们将使用h2o包。这个包提供了一个开源的预测分析平台，用于机器学习，基于内存参数，分布式、快速且可扩展。它有助于创建基于大数据的模型，并且由于其提高了生产质量，因此最适合企业应用。
有关h2o软件包的更多信息，请访问其文档cran.r-project.org/web/packages/h2o/index.html。
此软件包非常有用，因为它在一个软件包中总结了几个常见的机器学习算法。此外，这些算法可以在我们的计算机上并行执行，因为它非常快。该软件包包括广义线性朴素贝叶斯、分布式随机森林、梯度提升和深度学习等。
不需要具备高级编程知识，因为该软件包自带用户界面。
让我们看看这个软件包是如何工作的。首先，应该加载软件包：
library(h2o)
使用h2o.init方法初始化 H2O。此方法接受可在软件包文档中找到的其他选项：
h2o.init()
建立我们的模型的第一步是将我们的数据放入 H2O 集群/Java 进程。在此步骤之前，我们将确保我们的目标是作为factor变量考虑：
train$Default<-as.factor(train$Default)
test$Default<-as.factor(test$Default)
现在，让我们将我们的数据上传到h2o集群：
as.h2o(train[,2:ncol(train)],destination_frame="train")
as.h2o(test[,2:ncol(test)],destination_frame="test")
如果您关闭 R 并在稍后重新启动它，您将需要再次上传数据集，如前面的代码所示。
我们可以使用以下命令检查数据是否已正确上传：
h2o.ls()
## key
## 1 test
## 2 train
该软件包包含一个易于使用的界面，允许我们在浏览器中运行时创建不同的模型。通常，可以通过在网页浏览器中写入以下地址来启动界面，http://localhost:54321/flow/index.html。您将面对一个类似于以下截图的页面。在模型选项卡中，我们可以看到该软件包中实现的所有可用模型的列表：
首先，我们将开发正则化模型。为此，必须选择广义线性建模…。本模块包括以下内容：
-
高斯回归
-
泊松回归
-
二项式回归（分类）
-
多项式分类
-
伽马回归
-
有序回归
如以下截图所示，我们应该填写必要的参数来训练我们的模型：
我们将填写以下字段：
-
model_id：在这里，我们可以指定模型可以引用的名称。
-
training_frame：我们希望用于构建和训练模型的数据库可以在这里提及，因为这将是我们的训练数据集。
-
validation_frame：在这里，提到的数据集将用于检查模型的准确性。
-
nfolds：为了验证，我们需要在此处提及一定数量的折数。在我们的案例中，nfolds 的值是
5。 -
seed：这指定了算法将使用的种子。我们将使用随机数生成器（RNG）为算法中需要随机数的组件提供随机数。
-
response_column：这是用作因变量的列。在我们的案例中，该列命名为 Default。
-
ignored_columns：在本节中，可以在训练过程中忽略变量。在我们的情况下，所有变量都被认为是相关的。
-
ignore_const_cols：这是一个标志，表示包应避免常数变量。
-
family：这指定了模型类型。在我们的情况下，我们想要训练一个回归模型，因此 family 应该固定为二项式，因为我们的目标变量有两个可能的值。
-
solver：这指定了要使用的求解器。我们不会更改此值，因为无论选择哪个求解器，都没有观察到显著差异。因此，我们将保持默认值。
-
alpha：在这里，您必须从 L1 到 L2 选择正则化分布的值。如果您选择 1，它将是一个 Lasso 回归。如果您选择 0，它将是一个 Ridge 回归。如果您选择 0 和 1 之间的任何值，您将得到 Lasso 和 Ridge 的混合。在我们的情况下，我们将选择 1。Lasso 模型的主要优点之一是减少变量的数量，因为训练模型将非相关变量的系数设为零，从而产生简单但同时又准确的模型。
-
lambda_search：此参数启动对正则化强度的搜索。
-
标准化：如果此标志被标记，则表示数值列将被转换，以具有零均值和零单位方差。
最后，构建模型按钮训练模型。尽管可以选择其他选项，但前面的规格已经足够：
我们可以看到模型训练得很快。查看按钮为我们提供了有关模型的一些有趣细节：
-
模型参数
-
得分历史
-
训练和验证样本的接收者操作特征（ROC）曲线
-
标准化系数幅度
-
交叉验证、训练和验证样本的增益/提升表
-
交叉验证模型
-
指标
-
系数
让我们看看一些主要结果：
如我们所见，我们的 Lasso 模型是用 108 个不同的变量训练的，但只有 56 个变量导致系数大于零的模型。
该模型提供了几乎完美的分类。在训练样本中，曲线下面积（AUC）达到 99.51%。在验证样本中，此值略低，为 98.65%。标准化变量也相关：
如果一个变量以蓝色显示，这表示系数是正的。如果是负的，颜色是橙色。
如我们所见，UBPRE626 看起来是一个重要的变量。它显示总贷款和租赁融资应收账款超过实际股本总额的次数。这里的正号意味着更高的比率，这也意味着银行在其运营中失败的概率更高。
根据这个图，前五个相关变量如下：
-
UBPRE626：净贷款和租赁融资应收账款超过总股本次数
-
UBPRE545：应计和未实现贷款及租赁总额，除以贷款和租赁损失准备金
-
UBPRE170：总股本
-
UBPRE394：其他建筑和土地开发贷款，除以平均总贷款和租赁
-
UBPRE672：证券年度化实现收益（或损失）的四分之一，除以平均资产
在评估信用风险时，了解哪些变量最为重要以及这些变量的经济相关性非常重要。例如，如果非正常贷款或有问题贷款越多，银行的偿债能力就越高，那就没有意义了。我们并不关心模型中变量的经济意义，但这对于金融机构开发的一些模型来说是一个关键问题。如果变量没有预期的符号，它们必须从模型中移除。
在某些情况下，有必要测试不同的参数组合，直到获得最佳模型。例如，在最近训练的正则化模型中，我们可以尝试不同的 alpha 参数值。要同时测试不同的参数，需要使用代码执行算法。让我们看看如何做。这次我们将再次训练正则化模型，但这次使用一些代码。首先，我们从 h2o 系统中删除所有对象，包括最近创建的模型：
h2o.removeAll()
## [1] 0
然后，我们再次上传我们的训练和验证样本：
as.h2o(train[,2:ncol(train)],destination_frame="train")
as.h2o(test[,2:ncol(test)],destination_frame="test")
让我们编写我们的模型。创建一个空参数网格如下：
grid_id <- 'glm_grid'
然后，我们在网格中分配不同的参数进行测试：
hyper_parameters <- list( alpha = c(0, .5, 1) )
stopping_metric <- 'auc'
glm_grid <- h2o.grid(
algorithm = "glm",
grid_id = grid_id,
hyper_params = hyper_parameters,
training_frame = training,
nfolds=5,
x=2:110,
y=1,
lambda_search = TRUE,
family = "binomial", seed=1234)
如我们所见，参数与我们用来训练先前模型的参数完全相同。唯一的区别是我们现在同时使用不同的 alpha 值，这对应于岭回归、Lasso 和弹性网络。模型使用以下代码进行训练：
results_glm <- h2o.getGrid(
grid_id = grid_id,
sort_by = stopping_metric,
decreasing = TRUE)
根据之前的代码，网格中的不同模型应该按照 AUC 指标排序。因此，我们对第一个模型感兴趣：
best_GLM <- h2o.getModel(results_glm@model_ids[[1]])
让我们来看看这个模型的一些细节：
best_GLM@model$model_summary$regularization
## [1] "Ridge ( lambda = 0.006918 )"
表现最好的模型是一个岭回归模型。模型的性能可以通过以下方式获得：
perf_train<-h2o.performance(model = best_GLM,newdata = training)
perf_train
## H2OBinomialMetrics: glm
##
## MSE: 0.006359316
## RMSE: 0.07974532
## LogLoss: 0.02561085
## Mean Per-Class Error: 0.06116986
## AUC: 0.9953735
## Gini: 0.990747
## R²: 0.8579102
## Residual Deviance: 363.213
## AIC: 581.213
##
## Confusion Matrix (vertical: actual; across: predicted) for F1- optimal threshold:
## 0 1 Error Rate
## 0 6743 15 0.002220 =15/6758
## 1 40 293 0.120120 =40/333
## Totals 6783 308 0.007756 =55/7091
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.540987 0.914197 144
## 2 max f2 0.157131 0.931659 206
## 3 max f0point5 0.617239 0.941021 132
## 4 max accuracy 0.547359 0.992244 143
## 5 max precision 0.999897 1.000000 0
## 6 max recall 0.001351 1.000000 383
## 7 max specificity 0.999897 1.000000 0
## 8 max absolute_mcc 0.540987 0.910901 144
## 9 max min_per_class_accuracy 0.056411 0.972973 265
## 10 max mean_per_class_accuracy 0.087402 0.977216 239
##
AUC 和 Gini 指数，作为性能的主要指标，仅略高于我们最初训练的 Lasso 模型——至少在训练样本中是这样。
模型在测试样本中的性能也很高：
perf_test<-h2o.performance(model = best_GLM,newdata = as.h2o(test))
perf_test
## H2OBinomialMetrics: glm
##
## MSE: 0.01070733
## RMSE: 0.1034762
## LogLoss: 0.04052454
## Mean Per-Class Error: 0.0467923
## AUC: 0.9875425
## Gini: 0.975085
## R²: 0.7612146
## Residual Deviance: 246.3081
## AIC: 464.3081
##
## Confusion Matrix (vertical: actual; across: predicted) for F1- optimal threshold:
## 0 1 Error Rate
## 0 2868 28 0.009669 =28/2896
## 1 12 131 0.083916 =12/143
## Totals 2880 159 0.013162 =40/3039
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.174545 0.867550 125
## 2 max f2 0.102341 0.904826 138
## 3 max f0point5 0.586261 0.885167 89
## 4 max accuracy 0.309187 0.987167 107
## 5 max precision 0.999961 1.000000 0
## 6 max recall 0.000386 1.000000 388
## 7 max specificity 0.999961 1.000000 0
## 8 max absolute_mcc 0.174545 0.861985 125
## 9 max min_per_class_accuracy 0.027830 0.955456 210
## 10 max mean_per_class_accuracy 0.102341 0.965295 138
与 Lasso 模型相比，结果没有显著差异。尽管如此，Lasso 模型的系数数量较少，这使得它更容易解释且更简洁。
岭回归中的系数总数等于数据集中的变量数量和模型的截距：
head(best_GLM@model$coefficients)
## Intercept UBPRE395 UBPRE543 UBPRE586 UBPRFB60
## -8.448270911 -0.004167366 -0.003376142 -0.001531582 0.027969152
## UBPRE389
## -0.004031844
现在，我们将每个模型的预测结果存储在一个新的数据框中。我们可以将不同模型的成果结合起来，得到一个额外的模型。最初，我们的数据框将只包含每个银行的 ID 和目标变量：
summary_models_train<-train[,c("ID_RSSD","Default")]
summary_models_test<-test[,c("ID_RSSD","Default")]
让我们计算模型预测并将它们存储在汇总数据框中：
summary_models_train$GLM<-as.vector(h2o.predict(best_GLM,training)[3])
summary_models_test$GLM<-as.vector(h2o.predict(best_GLM,validation)[3])
当我们运行前面的代码来计算模型的性能时，我们还获得了一个混淆矩阵。例如，在测试样本中，我们得到以下结果：
perf_test@metrics$cm$table
## Confusion Matrix: Row labels: Actual class; Column labels: Predicted class
## 0 1 Error Rate
## 0 2868 28 0.0097 = 28 / 2,896
## 1 12 131 0.0839 = 12 / 143
## Totals 2880 159 0.0132 = 40 / 3,039
此软件包将违约概率高于 0.5 的银行分类为失败银行，否则为成功银行。
根据这个假设，40家银行被错误分类（28+12）。然而，0.5 的截止点实际上并不正确，因为在样本中失败银行与非失败银行的比率是不同的。
失败银行的比率实际上仅为 4.696%，如下代码所示：
mean(as.numeric(as.character(train$Default)))
## [1] 0.04696094
因此，如果一个银行的违约概率高于这个比例，将其视为失败银行更为合适：
aux<-summary_models_test
aux$pred<-ifelse(summary_models_test$GLM>0.04696094,1,0)
因此，测试样本的新混淆表如下：
table(aux$Default,aux$pred)
##
## 0 1
## 0 2818 78
## 1 8 135
根据这张表，模型错误分类了 86 家银行（78+8）。几乎所有失败银行都被正确分类。要获得比这个更好的算法将非常困难。
模型可以使用h2o.saveModel本地保存：
h2o.saveModel(object= best_GLM, path=getwd(), force=TRUE)
我们从工作区中移除无关的对象，并按以下方式保存：
rm(list=setdiff(ls(), c("Model_database","train","test","summary_models_train","summary_models_test","training","validation")))
save.image("Data13.RData")
记住，如果你关闭 R 并再次加载此工作区，你应该再次将你的训练和测试样本转换为h2o格式：
training<-as.h2o(train[,2:ncol(train)],destination_frame=“train”)
validation<-as.h2o(test[,2:ncol(test)],destination_frame=“test”)
测试随机森林模型
随机森林是一组决策树。在决策树中，基于独立变量的训练样本将被分割成两个或更多同质集合。此算法处理分类变量和连续变量。使用递归选择方法选择最佳属性，并将其分割成叶节点。这会一直持续到满足停止循环的准则。通过叶节点的扩展创建的每个树都被视为一个弱学习器。这个弱学习器建立在子集的行和列之上。树的数量越多，方差越低。分类和回归随机森林都会计算所有树的平均预测，以做出最终预测。
当训练随机森林时，可以设置一些不同的参数。其中最常见的参数包括树的数量、最大变量数、终端节点的大小以及每棵树的深度。应该进行多次测试，以在性能和过拟合之间找到平衡。例如，树的数量和深度越高，训练集上的准确率越好，但这增加了过拟合的风险。为了获得这种平衡，应该在验证集上测试几个参数及其参数组合，然后在训练过程中进行交叉验证。
再次，这个算法在 h2o 包中很容易实现，可以使用浏览器中的可视化指南。参数网格应该通过编码实现。代码几乎与先前的模型相同。然而，这次过程更耗时：
grid_space <- list()
grid_space$ntrees <- c(25, 50, 75)
grid_space$max_depth <- c(4, 10, 20)
grid_space$mtries <- c(10, 14, 20)
grid_space$seed <- c(1234)
grid <- h2o.grid("randomForest", grid_id="RF_grid", x=2:110,y=1,training_frame=training, nfolds=5, hyper_params=grid_space)
results_grid <- h2o.getGrid(grid_id = "RF_grid",
sort_by = "auc",
decreasing = TRUE)
print(results_grid)
## H2O Grid Details
## ================
##
## Grid ID: RF_grid
## Used hyper parameters:
## - max_depth
## - mtries
## - ntrees
## - seed
## Number of models: 27
## Number of failed models: 0
##
## Hyper-Parameter Search Summary: ordered by decreasing auc
## max_depth mtries ntrees seed model_ids auc
## 1 20 20 75 1234 RF_grid_model_26 0.9928546480780869
## 2 10 10 75 1234 RF_grid_model_19 0.9922021014799943
## 3 10 10 50 1234 RF_grid_model_10 0.9921534437663471
## 4 10 20 75 1234 RF_grid_model_25 0.9920343545676484
## 5 10 20 50 1234 RF_grid_model_16 0.9919039341205663
##
## ---
## max_depth mtries ntrees seed model_ids auc
## 22 20 20 25 1234 RF_grid_model_8 0.9879017816277361
## 23 20 10 25 1234 RF_grid_model_2 0.9876307203918924
## 24 10 20 25 1234 RF_grid_model_7 0.9873765449379537
## 25 10 14 25 1234 RF_grid_model_4 0.986949956763511
## 26 4 10 25 1234 RF_grid_model_0 0.984477522802471
## 27 20 14 25 1234 RF_grid_model_5 0.980687331308817
如我们所见，树的数量（ntrees）、深度（max_depth）和每棵树中要考虑的变量数量（mtries）的组合被测试。使用 AUC 指标对生成的模型进行排序。
根据 preceding 规范，已经训练了 27 个不同的模型。选择第一个模型，或者准确率最高的模型：
best_RF <- h2o.getModel(results_grid@model_ids[[1]])
该模型在训练和测试样本上的性能如下：
h2o.performance(model = best_RF,newdata = training)
## H2OBinomialMetrics: drf
##
## MSE: 0.001317125
## RMSE: 0.03629222
## LogLoss: 0.009026859
## Mean Per-Class Error: 0
## AUC: 1
## Gini: 1
##
## Confusion Matrix (vertical: actual; across: predicted) for F1- optimal threshold:
## 0 1 Error Rate
## 0 6758 0 0.000000 =0/6758
## 1 0 333 0.000000 =0/333
## Totals 6758 333 0.000000 =0/7091
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.586667 1.000000 29
## 2 max f2 0.586667 1.000000 29
## 3 max f0point5 0.586667 1.000000 29
## 4 max accuracy 0.586667 1.000000 29
## 5 max precision 1.000000 1.000000 0
## 6 max recall 0.586667 1.000000 29
## 7 max specificity 1.000000 1.000000 0
## 8 max absolute_mcc 0.586667 1.000000 29
## 9 max min_per_class_accuracy 0.586667 1.000000 29
## 10 max mean_per_class_accuracy 0.586667 1.000000 29
如您所见，代码与先前的模型完全相同。
现在，我们使用以下代码找到测试或验证样本的性能：
h2o.performance(model = best_RF,newdata = validation)
## H2OBinomialMetrics: drf
##
## MSE: 0.00940672
## RMSE: 0.09698825
## LogLoss: 0.05488315
## Mean Per-Class Error: 0.06220299
## AUC: 0.9882138
## Gini: 0.9764276
##
## Confusion Matrix (vertical: actual; across: predicted) for F1- optimal threshold:
## 0 1 Error Rate
## 0 2880 16 0.005525 =16/2896
## 1 17 126 0.118881 =17/143
## Totals 2897 142 0.010859 =33/3039
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.346667 0.884211 44
## 2 max f2 0.280000 0.897790 49
## 3 max f0point5 0.760000 0.897196 18
## 4 max accuracy 0.346667 0.989141 44
## 5 max precision 1.000000 1.000000 0
## 6 max recall 0.000000 1.000000 70
## 7 max specificity 1.000000 1.000000 0
## 8 max absolute_mcc 0.346667 0.878520 44
## 9 max min_per_class_accuracy 0.106667 0.965035 62
## 10 max mean_per_class_accuracy 0.106667 0.968878 62
两个样本的结果几乎完美。可以获取变量的重要性：
var_importance<-data.frame(best_RF@model$variable_importances)
h2o.varimp_plot(best_RF,20)
上述代码生成以下输出：
就像岭回归一样，破产的概率将存储在训练和验证样本中：
summary_models_train$RF<-as.vector(h2o.predict(best_RF,training)[3])
summary_models_test$RF<-as.vector(h2o.predict(best_RF,validation)[3])
最后，我们可以计算混淆矩阵。记住，根据观察到的坏银行在总样本中的比例，确定将银行分类为破产概率的截止值：
aux<-summary_models_test
aux$pred<-ifelse(summary_models_test$RF>0.04696094,1,0)
table(aux$Default,aux$pred)
## 0 1
## 0 2753 143
## 1 5 138
如果将随机森林和岭回归模型进行比较，我们可以看到随机森林只错误分类了五家失败的银行，而岭回归中有 12 家银行被错误分类。尽管如此，随机森林将更多有偿付能力的银行错误分类为失败的银行，这意味着它有较高的假阳性率。
无关对象再次从工作区中移除。此外，我们备份了我们的工作区：
rm(list=setdiff(ls(), c("Model_database","train","test","summary_models_train","summary_models_test","training","validation")))
save.image("Data14.RData")
梯度提升
梯度提升意味着将弱预测器和平均预测器结合以获得一个强预测器。这确保了鲁棒性。它与随机森林类似，主要基于决策树。区别在于样本在树之间没有修改；只有不同观察的权重被修改。
提升通过使用先前训练的树的信息按顺序训练树。为此，我们首先需要使用训练数据集创建决策树。然后，我们需要创建另一个模型，它除了纠正训练模型中发生的错误之外什么都不做。这个过程会按顺序重复，直到达到指定的树的数量或达到某个停止规则。
关于该算法的更具体细节可以在h2o包的文档中找到。在训练算法时，我们需要定义诸如我们将要组合的树的数量和每个节点中的最小观察值等参数，就像我们在随机森林中做的那样。
收缩参数，或者说提升学习的学习速率，可以改变模型的性能。我们需要考虑许多实验的结果，以确定最佳参数，确保高精度。
我们的参数网格收集了树的数量和max_depth参数的不同组合：
grid_space <- list()
grid_space$ntrees <- c(25,75,100)
grid_space$max_depth = c(4,6,8,12,16,20)
通过执行以下代码将训练不同的模型：
gbm_grid <- h2o.grid(hyper_params = grid_space,
algorithm = "gbm",
grid_id ="Grid1",
x=2:110,
y=1,
training_frame = training,seed=1234)
网格是按照AUC排序的。结果如下：
results_gbm <- h2o.getGrid("Grid1", sort_by = "AUC", decreasing = TRUE)
results_gbm
## H2O Grid Details
## ================
##
## Grid ID: Grid1
## Used hyper parameters:
## - max_depth
## - ntrees
## Number of models: 18
## Number of failed models: 0
##
## Hyper-Parameter Search Summary: ordered by decreasing AUC
## max_depth ntrees model_ids auc
## 1 16 100 Grid1_model_16 1.0
## 2 4 100 Grid1_model_12 1.0
## 3 16 25 Grid1_model_4 1.0
## 4 20 75 Grid1_model_11 1.0
## 5 6 75 Grid1_model_7 1.0
## 6 20 100 Grid1_model_17 1.0
## 7 8 75 Grid1_model_8 1.0
## 8 20 25 Grid1_model_5 1.0
## 9 12 75 Grid1_model_9 1.0
## 10 16 75 Grid1_model_10 1.0
## 11 6 100 Grid1_model_13 1.0
## 12 12 100 Grid1_model_15 1.0
## 13 8 100 Grid1_model_14 1.0
## 14 4 75 Grid1_model_6 0.9999986669119549
## 15 12 25 Grid1_model_3 0.9999986669119549
## 16 8 25 Grid1_model_2 0.9999922236530701
## 17 6 25 Grid1_model_1 0.9998680242835318
## 18 4 25 Grid1_model_0 0.9977795196794901
大多数模型获得了完美的分类。这可能是一个过拟合的迹象。让我们看看第一个模型在验证样本上的性能：
best_GBM <- h2o.getModel(results_gbm@model_ids[[1]])
h2o.performance(model = best_GBM,newdata = as.h2o(test))
## H2OBinomialMetrics: gbm
##
## MSE: 0.01053012
## RMSE: 0.1026164
## LogLoss: 0.06001792
## Mean Per-Class Error: 0.05905179
## AUC: 0.9876222
## Gini: 0.9752444
##
## Confusion Matrix (vertical: actual; across: predicted) for F1- optimal threshold:
## 0 1 Error Rate
## 0 2878 18 0.006215 =18/2896
## 1 16 127 0.111888 =16/143
## Totals 2894 145 0.011188 =34/3039
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.076792 0.881944 143
## 2 max f2 0.010250 0.892857 154
## 3 max f0point5 0.852630 0.906902 118
## 4 max accuracy 0.076792 0.988812 143
## 5 max precision 0.999962 1.000000 0
## 6 max recall 0.000006 1.000000 392
## 7 max specificity 0.999962 1.000000 0
## 8 max absolute_mcc 0.076792 0.876096 143
## 9 max min_per_class_accuracy 0.000181 0.958042 246
## 10 max mean_per_class_accuracy 0.000816 0.963611 203
结果非常好，甚至在测试样本中也是如此。选择了第一个模型，并将预测存储起来，就像之前的模型一样：
summary_models_train$GBM<-as.vector(h2o.predict(best_GBM,training)[3])
summary_models_test$GBM<-as.vector(h2o.predict(best_GBM,validation)[3])
最后，测试样本中的混淆表被计算出来：
aux<-summary_models_test
aux$pred<-ifelse(summary_models_test$GBM>0.04696094,1,0)
table(aux$Default,aux$pred)
##
## 0 1
## 0 2876 20
## 1 15 128
总共有 14 家破产银行和 25 家非破产银行被错误分类。让我们保存结果：
rm(list=setdiff(ls(), c("Model_database","train","test","summary_models_train","summary_models_test","training","validation")))
save.image("Data15.RData")
神经网络中的深度学习
对于机器学习，我们需要能够处理非线性且无关数据集的系统。这对于我们预测破产问题非常重要，因为违约变量和解释变量之间的关系很少是线性的。因此，使用神经网络是最佳解决方案。
人工神经网络（ANNs）长期以来一直被用来解决破产问题。ANN 是一个具有多个相互连接处理器的计算机系统。这些处理器通过处理信息和动态响应提供的输入来提供输出。ANN 的一个突出和基本示例是多层感知器（MLP）。MLP 可以表示如下：
除了输入节点外，每个节点都是一个使用非线性激活函数的神经元，该函数被发送进来。
从其图表中可以看出，多层感知器（MLP）不过是一个前馈神经网络。这意味着提供的输入信息将只向前移动。这种类型的网络通常由一个输入层、一个隐藏层和一个输出层组成。输入层代表模型的输入数据，或变量。在我们的案例中，这些是金融变量。在这个层中不进行任何计算。隐藏层是进行中间处理或计算的地方。它们执行计算，然后将权重（信号或信息）从输入层传递到下一层。最后，输出层从隐藏层接收输入并计算网络的输出。输入节点使用非线性激活函数将信息从一层传递到下一层。激活函数的目的是将输入信号转换为输出信号，以模拟复杂的非线性模式。
感知器网络通过在处理完每一组数据后修改权重来学习。这些权重指定了处理输入时发生的错误数量，这是通过比较期望的输出获得的。
深度学习与 MLP 有何不同？MLP 只是深度学习算法的一种。在许多情况下，深度学习与 MLP 网络不同，但这仅仅是因为计算复杂性和隐藏层数量的不同。深度学习可以被视为具有两个或更多隐藏层的 MLP。当包含两个或更多隐藏层时，学习过程也应该有所不同，因为 MLP 中使用的反向传播学习规则将失效。感知器更新规则容易产生消失和爆炸梯度，这使得训练多于一层或两层的网络变得困难。
设计神经网络
在设计多层网络时，确保你确定适当的层数以获得更好的准确性和精度。通常，对于许多模型来说，仅仅一个隐藏层就足以解决分类问题。然而，使用多个隐藏层已经在语音识别或物体检测等领域证明了其有用性。另一个需要考虑的是每个隐藏层中的神经元数量。这是一个非常重要的方面。估计这些值时的错误可能导致过度拟合（当添加太多神经元时）和欠拟合（当添加的神经元不足时）等问题。
训练神经网络
h2o包帮助我们训练神经网络。深度学习模型有许多输入参数。在这个练习中，以下参数将被测试：
hyper_params <- list(
hidden=list(c(5),c(80,80,80),c(75,75)),
input_dropout_ratio=c(0.05,0.1,0.15,0.2,0.25),
rate=c(0.01,0.02,0.10))
在这里，我们将测试三种结构：首先，一个只包含一个包含 25 个神经元的隐藏层的网络，然后是一个包含三个隐藏层，每个层有 32 个神经元的网络，最后是一个包含两个隐藏层，每个层有 64 个神经元的网络。
神经网络学习，神经元逐渐在特定变量的值上实现专业化。如果神经元在训练集中过于专业化，就有很高的过拟合风险。为了避免过拟合，包含了input_dropout_ratio命令。dropout 技术是神经网络模型的一种正则化方法，用于提高神经网络的泛化能力。
在训练过程中，dropout 方法会随机选择神经元并在训练中忽略它们。在实践中，在每一步训练中，都会创建一个不同的网络，因为一些随机单元被移除，并使用反向传播进行训练，就像通常一样。这迫使网络学习具有相同输入和输出的多个独立表示，从而提高泛化能力。
要获取有关 dropout 方法的更多信息，我建议阅读原始论文，Dropout: **一种简单防止神经网络过拟合的方法*，作者为 Nitish Srivastava 等人。该论文可在www.cs.toronto.edu/~hinton/absps/JMLRdropout.pdf找到。
建议的输入层 dropout 比值为 0.1 或 0.2。最后，使用rate命令，我们可以指定学习率。记住，如果学习率设置得太高，模型可能变得不稳定；如果设置得太低，则收敛将非常缓慢。
让我们编写一些训练代码：
deep_grid <- h2o.grid(
algorithm="deeplearning",
grid_id="dl_grid",
training_frame=training,
validation_frame=as.h2o(test),
x=2:110,
y=1,
epochs=2,
stopping_metric="AUC",
stopping_tolerance=1e-2,
stopping_rounds=2,
score_duty_cycle=0.01,
l1=1e-5,
l2=1e-5,
activation=c("Rectifier"),
nfolds=5,
hyper_params=hyper_params,standardize=TRUE,seed=1234)
上述代码中的参数可以描述如下：
-
epochs：这里指定的值决定了在学习过程中数据集需要流式传输的次数。 -
stopping_metric：这指定了用于早期停止的指标，在我们的案例中是 AUC。 -
stopping_tolerance和stopping_rounds：这些参数分别确定在模型停止学习前的容忍值和停止值，当stopping_metric在指定轮次后没有改善时，防止模型继续学习。当指定交叉验证（如我们案例中所示）时，此选项将应用于所有交叉验证模型。在我们的案例中，我们设置了stopping_tolerance=1e-2和stopping_rounds = 2，这意味着模型将在 2 轮迭代后停止训练，或者如果没有至少 2%（1e-2）的改善。 -
score_duty_cycle：这表示在评分和训练之间花费多少时间。这些值是介于 0 到 1 之间的百分比。较低的值表示更多的训练。此选项的默认值为 0.1，表示应该花费 10%的时间进行评分，剩余的 90%用于训练。 -
l1和l2：这里添加的值是正则化指数，它确保了更好的泛化能力和稳定性。 -
activation：可以在此处提及如tanh、tanh with dropout、Maxout等激活函数。 -
nfolds：这表示交叉验证的折数。由于要测试多个配置，因此训练过程非常耗时。可以通过运行以下代码来获得不同配置的性能：
results_deep <- h2o.getGrid("dl_grid",sort_by="auc",decreasing=TRUE)
results_deep
## H2O Grid Details
## ================
##
## Grid ID: dl_grid
## Used hyper parameters:
## - hidden
## - input_dropout_ratio
## - rate
## Number of models: 45
## Number of failed models: 0
##
## Hyper-Parameter Search Summary: ordered by decreasing auc
## hidden input_dropout_ratio rate model_ids
## 1 [75, 75] 0.25 0.01 dl_grid_model_14
## 2 [75, 75] 0.25 0.1 dl_grid_model_44
## 3 [75, 75] 0.2 0.01 dl_grid_model_11
## 4 [80, 80, 80] 0.25 0.02 dl_grid_model_28
## 5 [75, 75] 0.1 0.01 dl_grid_model_5
## auc
## 1 0.9844357527103902
## 2 0.9841366966255987
## 3 0.9831344365969994
## 4 0.9830902225101693
## 5 0.9830724480029008
##
## ---
## hidden input_dropout_ratio rate model_ids auc
## 40 [5] 0.1 0.1 dl_grid_model_33 0.9603608491593103
## 41 [5] 0.1 0.01 dl_grid_model_3 0.9599749201702442
## 42 [5] 0.2 0.01 dl_grid_model_9 0.9599749201702442
## 43 [5] 0.2 0.02 dl_grid_model_24 0.9591890647676383
## 44 [5] 0.05 0.02 dl_grid_model_15 0.9587149297862527
## 45 [5] 0.15 0.1 dl_grid_model_36 0.9575646969846437
使用三个具有 32 个单位的隐藏层、0.25的 dropout 比率和0.02的学习率获得了最佳模型。
模型选择如下：
best_deep <- h2o.getModel(results_deep@model_ids[[1]])
测试样本的性能如下：
h2o.performance(model = best_deep,newdata = validation)
## H2OBinomialMetrics: deeplearning
##
## MSE: 0.02464987
## RMSE: 0.1570028
## LogLoss: 0.1674725
## Mean Per-Class Error: 0.1162044
## AUC: 0.9794568
## Gini: 0.9589137
##
## Confusion Matrix (vertical: actual; across: predicted) for F1- optimal threshold:
## 0 1 Error Rate
## 0 2871 25 0.008633 =25/2896
## 1 32 111 0.223776 =32/143
## Totals 2903 136 0.018756 =57/3039
##
## Maximum Metrics: Maximum metrics at their respective thresholds
## metric threshold value idx
## 1 max f1 0.001538 0.795699 135
## 2 max f2 0.000682 0.812672 153
## 3 max f0point5 0.011028 0.831904 109
## 4 max accuracy 0.001538 0.981244 135
## 5 max precision 0.999998 1.000000 0
## 6 max recall 0.000000 1.000000 398
## 7 max specificity 0.999998 1.000000 0
## 8 max absolute_mcc 0.001538 0.786148 135
## 9 max min_per_class_accuracy 0.000017 0.937063 285
## 10 max mean_per_class_accuracy 0.000009 0.943153 314
与先前的模型一样，训练和验证样本的预测被存储：
summary_models_train$deep<-as.vector(h2o.predict(best_deep,training)[3])
summary_models_test$deep<- as.vector(h2o.predict(best_deep,validation)[3])
验证样本的混淆矩阵也获得了：
aux<-summary_models_test
aux$pred<-ifelse(summary_models_test$deep>0.04696094,1,0)
table(aux$Default,aux$pred)
##
## 0 1
## 0 2886 10
## 1 61 82
rm(list=setdiff(ls(), c("Model_database","train","test","summary_models_train","summary_models_test","training","validation")))
save.image("Data16.RData")
支持向量机
支持向量机（SVM）算法是一种监督学习技术。为了理解这个算法，请查看以下图中关于最优超平面和最大边界的图示：
在这个分类问题中，我们只有两个类别，它们对应于许多可能的解决方案。如图所示，支持向量机通过计算最优超平面并最大化类别间的边界来对这些对象进行分类。这两者都将最大限度地区分类别。位于边界最近的样本被称为支持向量。然后，问题被处理为一个优化问题，可以通过优化技术来解决，其中最常见的是使用拉格朗日乘数法。
即使在可分线性问题中，如图所示，有时也不总是能够获得完美的分离。在这些情况下，支持向量机模型是最大化边界同时最小化误分类数量的模型。在现实世界中，问题之间的距离太远，无法进行线性分离，至少在没有先前的数据预处理或转换的情况下。以下图中显示了线性可分问题和非线性可分问题之间的区别：
为了处理非线性问题，核函数将数据映射到不同的空间。这意味着数据被转换到更高维的空间。这种技术被称为核技巧，因为有时可以在数据中执行类之间的线性分离，从而进行转换。
支持向量机算法的优点如下：
-
支持向量机很简单
-
支持向量机是统计和机器学习技术的结合
-
支持向量机可以用于解决像我们问题陈述中的金融问题
选择支持向量机参数
让我们讨论一些我们可能需要的参数，这样我们就可以使用支持向量机。
支持向量机核参数
支持向量机的主要困难之一是选择将数据转换的核函数。以下是最常用的转换：
-
线性
-
多项式
-
径向基
-
Sigmoid
成本参数
控制清算和训练误差与模型复杂度之间的交易将由成本参数（C）负责。如果你为C设置一个相对较小的数值，就会有更多的训练误差。如果C是一个较大的数值，你可能会得到一个过拟合的模型，这意味着你的训练模型已经学会了所有的训练数据，但这个模型可能无法在任何一个其他样本上正常工作。你可以将成本设置为 1.001 到 100 之间的任何值。
Gamma 参数
在使用高斯核时需要 gamma 参数。此参数将计算每个训练样本可以产生的影响水平。在这里，你可能认为较低的值是远的，而较高的值是近的。
Gamma 实际上是与我们之前看到的支持向量相反。因此，在 SVM 中，应该测试所有三个参数的不同值。
训练 SVM 模型
h2o包中没有 SVM 算法。为了训练 SVM 分类器，我们将使用caret包。记住，我们的目标值有两个不同的值：
levels(train$Default)
## [1] "0" "1"
尽管这个变量的不同值（0和1）在其他算法中不会显示问题，但在这种情况下，我们需要在这里进行一点转换。目标变量的类别只能取X0或X1这样的值，因此我们需要对它们进行转换。让我们为这个任务编写一些代码：
levels(train$Default) <- make.names(levels(factor(train$Default)))
levels(train$Default)
## [1] "X0" "X1"
这些值也在测试样本中进行了转换：
test$Default<-as.factor(test$Default)
levels(test$Default) <- make.names(levels(factor(test$Default)))
levels(test$Default)
## [1] "X0" "X1"
我们将以与h2o包类似的方式创建一个网格，其中包含成本和 gamma 参数的不同值：
svmGrid <- expand.grid(sigma= 2^c(-20, -15,-10, -5, 0), C= 2^c(2:5))
print(svmGrid)
## sigma C
## 1 0.0000009536743 4
## 2 0.0000305175781 4
## 3 0.0009765625000 4
## 4 0.0312500000000 4
## 5 1.0000000000000 4
## 6 0.0000009536743 8
## 7 0.0000305175781 8
## 8 0.0009765625000 8
## 9 0.0312500000000 8
## 10 1.0000000000000 8
## 11 0.0000009536743 16
## 12 0.0000305175781 16
## 13 0.0009765625000 16
## 14 0.0312500000000 16
## 15 1.0000000000000 16
## 16 0.0000009536743 32
## 17 0.0000305175781 32
## 18 0.0009765625000 32
## 19 0.0312500000000 32
## 20 1.0000000000000 32
然后，我们将运行以下代码来训练不同的模型：
library(caret)
set.seed(1234)
SVM <- train(Default ~ ., data = train[,2:ncol(train)],
method = "svmRadial",
standardize=TRUE,
tuneGrid = svmGrid,
metric = "ROC",
allowParallel=TRUE,
trControl = trainControl(method = "cv", 5, classProbs = TRUE,
summaryFunction=twoClassSummary))
为了训练一个SVM分类器，应该将train()方法与method参数作为svmRadial传递，这是我们选择的核。TuneGrid代表成本和 gamma 参数的不同组合。模型的准确性使用ROC指标来衡量。使用 5 折交叉验证。
模型训练完成后，我们可以如下查看结果：
print(SVM)
## Support Vector Machines with Radial Basis Function Kernel
##
## 7091 samples
## 108 predictor
## 2 classes: 'X0', 'X1'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 5674, 5673, 5672, 5672, 5673
## Resampling results across tuning parameters:
##
## sigma C ROC Sens Spec
## 0.0000009536743 4 0.9879069 0.9899383 0.8710086
## 0.0000009536743 8 0.9879135 0.9903822 0.8710086
## 0.0000009536743 16 0.9879092 0.9900863 0.8710086
## 0.0000009536743 32 0.9880736 0.9909741 0.8679783
## 0.0000305175781 4 0.9894669 0.9943777 0.8380371
## 0.0000305175781 8 0.9903574 0.9957094 0.8439168
## 0.0000305175781 16 0.9903018 0.9958573 0.8499774
## 0.0000305175781 32 0.9903865 0.9958572 0.8619629
## 0.0009765625000 4 0.9917597 0.9960052 0.8739937
## 0.0009765625000 8 0.9913792 0.9963011 0.8590231
## 0.0009765625000 16 0.9900214 0.9960050 0.8379919
## 0.0009765625000 32 0.9883768 0.9961529 0.8410222
## 0.0312500000000 4 0.9824358 0.9789899 0.9159656
## 0.0312500000000 8 0.9824358 0.9767682 0.8735414
## 0.0312500000000 16 0.9824358 0.9783977 0.8622343
## 0.0312500000000 32 0.9824358 0.9755850 0.9189959
## 1.0000000000000 4 0.4348777 1.0000000 0.0000000
## 1.0000000000000 8 0.4336278 1.0000000 0.0000000
## 1.0000000000000 16 0.4273365 1.0000000 0.0000000
## 1.0000000000000 32 0.4325194 1.0000000 0.0000000
##
## ROC was used to select the optimal model using the largest value.
## The final values used for the model were sigma = 0.0009765625 and C = 4.
总结来说，最佳参数如下：
SVM$bestTune
## sigma C
## 9 0.0009765625 4
此外，我们可以通过以下方式访问具有最佳参数的模型：
SVM$finalModel
## Support Vector Machine object of class "ksvm"
##
## SV type: C-svc (classification)
## parameter : cost C = 4
##
## Gaussian Radial Basis kernel function.
## Hyperparameter : sigma = 0.0009765625
##
## Number of Support Vectors : 252
##
## Objective Function Value : -619.9088
## Training error : 0.007333
## Probability model included.
模型的性能不是直接获得的，就像在h2o包中一样。这并不难做，但我们需要使用ROCR包：
library(ROCR)
SVM_pred<-as.numeric(unlist(predict(SVM, newdata =test, type = "prob")[2]))
pred2 <- prediction(SVM_pred,test$Default)
pred3 <- performance(pred2,"tpr","fpr")
plot(pred3, lwd=1, colorize=FALSE)
lines(x=c(0, 1), y=c(0, 1), col="red", lwd=1, lty=3);
上述代码生成了以下图表：
Gini 指数可以计算为2*ROC -1。我们可以使用Hmisc包来计算 ROC，然后计算 Gini 指数，如下所示：
library(Hmisc)
print("Gini indicator of SVM in the test sample is:")
## [1] "Gini indicator of SVM in the test sample is:"
print(abs(as.numeric(2*rcorr.cens(SVM_pred,test[,'Default'])[1]-1)))
## [1] 0.9766884
在测试样本中，Gini 指数达到 0.9766。与之前的模型一样，混淆矩阵是使用验证或测试样本计算的。为此，首先，存储训练和测试样本的概率：
summary_models_train$SVM<-as.numeric(unlist(predict(SVM, newdata =train, type = "prob")[2]))
summary_models_test$SVM<- as.numeric(unlist(predict(SVM, newdata =test, type = "prob")[2]))
现在在测试样本上计算混淆表：
aux<-summary_models_test
aux$pred<-ifelse(summary_models_test$SVM>0.04696094,1,0)
table(aux$Default,aux$pred)
##
## 0 1
## 0 2828 68
## 1 8 135
SVM 在对银行进行分类方面做得很好。在测试样本中只有 76 家银行（68+8）被错误分类。现在，创建一个新的工作区备份：
rm(list=setdiff(ls(), c("Model_database","train","test","summary_models_train","summary_models_test","train_woe","test_woe")))
save.image("~/Data17.RData")
集成
到目前为止，我们已经训练了五个不同的模型。预测结果存储在两个数据框中，一个用于训练样本，另一个用于验证样本：
head(summary_models_train)
## ID_RSSD Default GLM RF GBM deep
## 4 37 0 0.0013554364 0 0.000005755001 0.000000018217172
## 21 242 0 0.0006967876 0 0.000005755001 0.000000002088871
## 38 279 0 0.0028306028 0 0.000005240935 0.000003555978680
## 52 354 0 0.0013898732 0 0.000005707480 0.000000782777042
## 78 457 0 0.0021731695 0 0.000005755001 0.000000012535539
## 81 505 0 0.0011344433 0 0.000005461855 0.000000012267744
## SVM
## 4 0.0006227083
## 21 0.0002813123
## 38 0.0010763298
## 52 0.0009740568
## 78 0.0021555739
## 81 0.0005557417
让我们总结一下先前训练的模型的准确性。首先，将使用基尼指数计算每个分类器的预测能力。以下代码计算了训练样本和验证样本的基尼指数：
gini_models<-as.data.frame(names(summary_models_train[,3:ncol(summary_models_train)]))
colnames(gini_models)<-"Char"
for (i in 3:ncol(summary_models_train))
{
gini_models$Gini_train[i-2]<-(abs(as.numeric(2*rcorr.cens(summary_models_train[,i],summary_models_train$Default)[1]-1)))
gini_models$Gini_test[i-2]<-(abs(as.numeric(2*rcorr.cens(summary_models_test[,i],summary_models_test$Default)[1]-1)))
}
结果存储在一个名为 gini_models 的数据框中。训练样本和测试样本之间预测能力的差异也被计算：
gini_models$var_train_test<-(gini_models$Gini_train-gini_models$Gini_test)/gini_models$Gini_train
print(gini_models)
## Char Gini_train Gini_test var_train_test
## 1 GLM 0.9906977 0.9748967 0.01594943
## 2 RF 1.0000000 0.9764276 0.02357242
## 3 GBM 1.0000000 0.9754665 0.02453348
## 4 deep 0.9855324 0.9589837 0.02693848
## 5 SVM 0.9920815 0.9766884 0.01551595
模型之间并没有太多显著的差异。在测试样本中，SVM 是预测能力最高的模型。另一方面，深度学习模型获得了最差的结果。
这些结果表明，从当前的财务报表中找到将在不到一年内失败的银行并不非常困难，这正是我们定义的目标变量。
我们还可以看到每个模型的预测能力，这取决于正确分类的银行数量：
decisions_train <- summary_models_train
decisions_test <- summary_models_test
现在，让我们创建新的数据框，其中银行根据预测概率被分类为清偿能力银行或非清偿能力银行，就像我们对每个模型所做的那样：
for (m in 3:ncol(decisions_train))
{
decisions_train[,m]<-ifelse(decisions_train[,m]>0.04696094,1,0)
decisions_test[,m]<-ifelse(decisions_test[,m]>0.04696094,1,0)
}
现在，创建了一个函数，用于计算银行被正确和非正确分类的数量：
accuracy_function <- function(dataframe, observed, predicted)
{
bads<-sum(as.numeric(as.character(dataframe[,observed])))
goods<-nrow(dataframe)-bads
y <- as.vector(table(dataframe[,predicted], dataframe[,observed]))
names(y) <- c("TN", "FP", "FN", "TP")
return(y)
}
通过运行前面的函数，我们将看到每个模型的性能摘要。首先，该函数应用于训练样本：
print("Accuracy GLM model:")
## [1] "Accuracy GLM model:"
accuracy_function(decisions_train,"Default","GLM")
## TN FP FN TP
## 6584 174 9 324
print("Accuracy RF model:")
## [1] "Accuracy RF model:"
accuracy_function(decisions_train,"Default","RF")
## TN FP FN TP
## 6608 150 0 333
print("Accuracy GBM model:")
## [1] "Accuracy GBM model:"
accuracy_function(decisions_train,"Default","GBM")
## TN FP FN TP
## 6758 0 0 333
print("Accuracy deep model:")
## [1] "Accuracy deep model:"
accuracy_function(decisions_train,"Default","deep")
## TN FP FN TP
## 6747 11 104 229
print("Accuracy SVM model:")
## [1] "Accuracy SVM model:"
accuracy_function(decisions_train,"Default","SVM")
## TN FP FN TP
## 6614 144 7 326
然后，我们可以看到测试样本中不同模型的结果：
print("Accuracy GLM model:")
## [1] "Accuracy GLM model:"
accuracy_function(decisions_test,"Default","GLM")
## TN FP FN TP
## 2818 78 8 135
print("Accuracy RF model:")
## [1] "Accuracy RF model:"
accuracy_function(decisions_test,"Default","RF")
## TN FP FN TP
## 2753 143 5 138
print("Accuracy GBM model:")
## [1] "Accuracy GBM model:"
accuracy_function(decisions_test,"Default","GBM")
## TN FP FN TP
## 2876 20 15 128
print("Accuracy deep model:")
## [1] "Accuracy deep model:"
accuracy_function(decisions_test,"Default","deep")
## TN FP FN TP
## 2886 10 61 82
print("Accuracy SVM model:")
## [1] "Accuracy SVM model:"
accuracy_function(decisions_test,"Default","SVM")
## TN FP FN TP
## 2828 68 8 135
根据在测试样本上测量的表格，RF 是最准确的失败银行分类器，但它也将 138 家清偿能力银行错误分类为失败，提供了错误的警报。
不同模型的结果是相关的：
correlations<-cor(summary_models_train[,3:ncol(summary_models_train)], use="pairwise", method="pearson")
print(correlations)
## GLM RF GBM deep SVM
## GLM 1.0000000 0.9616688 0.9270350 0.8010252 0.9910695
## RF 0.9616688 1.0000000 0.9876728 0.7603979 0.9719735
## GBM 0.9270350 0.9876728 1.0000000 0.7283464 0.9457436
## deep 0.8010252 0.7603979 0.7283464 1.0000000 0.7879191
## SVM 0.9910695 0.9719735 0.9457436 0.7879191 1.0000000
将不同模型的结果结合起来以获得更好的模型可能很有趣。在这里，集成（Ensemble）的概念派上用场。集成是一种将不同的算法组合起来以创建更稳健模型的技巧。这个组合模型包含了所有基学习器的预测。结果模型将比单独运行模型时的准确性更高。实际上，我们之前开发的一些模型是集成模型，例如；随机森林或梯度提升机（GBM）。创建集成时有很多选项。在本节中，我们将探讨从最简单到更复杂的不同替代方案。
平均模型
这简单定义为取模型预测的平均值：
summary_models_test$avg<-(summary_models_test$GLM + summary_models_test$RF + summary_models_test$GBM + summary_models_test$deep + summary_models_test$SVM)/5
因此，银行最终失败的概率将被计算为前五个模型失败概率的简单平均值。
这个简单集成模型的预测能力如下：
abs(as.numeric(2*rcorr.cens(summary_models_test[,"avg"],summary_models_test$Default)[1]-1))
## [1] 0.9771665
我们可以创建以下混淆矩阵：
aux<-summary_models_test
aux$pred<-ifelse(summary_models_test$avg>0.04696094,1,0)
table(aux$Default,aux$pred)
## 0 1
## 0 2834 62
## 1 7 136
这个组合模型只错误地将7家破产银行和62家非破产银行分类。显然，这个平均模型比所有单个模型的表现都要好。
为了增加一些保守性，我们可能会认为更好的方法是从不同的模型中分配最高的失败概率。然而，这种方法不太可能成功，因为我们之前观察到随机森林对某些银行产生了误报。
多数投票
这定义为在预测分类问题的结果时，选择具有最大投票的预测。首先，我们需要为每个模型分配一个投票。这一步已经在decisions_test数据框中完成。如果五个模型中有三个将银行分类为非清偿，则该银行将被分类为非清偿。让我们看看这种方法的结果：
decisions_test$votes<-rowSums(decisions_test[,3:7])
decisions_test$majority_vote<-ifelse(decisions_test$votes>2,1,0)
table(decisions_test$Default,decisions_test$majority_vote)
## 0 1
## 0 2844 52
## 1 8 135
结果似乎不如单个模型或考虑平均概率的集成模型好：
rm(list=setdiff(ls(), c("Model_database","train","test","summary_models_train","summary_models_test","train_woe","test_woe","decisions_train","decisions_test")))
save.image("~/Data18.RData")
rm(list=ls())
模型模型
这涉及到使用另一个机器学习模型（如 Lasso、GBM 或随机森林）结合模型的单个输出（如随机森林或 SVM）。集成模型的顶层可以是任何模型，即使底层使用了相同的技巧（如随机森林）。最复杂的算法（如随机森林、梯度提升、SVM 等）并不总是比简单的算法（如树或逻辑回归）表现更好。
在这种情况下，不会训练额外的示例和算法，因为之前的结果已经足够。
自动机器学习
现在我们已经学会了如何开发一个强大的模型来预测银行破产，我们将测试一个最终选项来开发不同的模型。具体来说，我们将尝试自动机器学习（autoML），它包含在h2o包中。我们执行的过程是自动完成的，无需任何先验知识，通过autoML函数构建许多模型并找到最佳模型。此函数通过尝试不同的参数网格来训练不同的模型。此外，堆叠集成或基于先前训练模型的模型也被训练，以找到更准确或更具预测性的模型。
在我看来，在启动任何模型之前使用这个函数强烈推荐，以获得一个参考起点的基本概念。使用自动方法，我们可以评估最可靠的算法、最重要的潜在变量或我们可能获得的准确度参考。
为了测试这个函数，我们将加载一个先前的工作空间：
load("~/Data12.RData")
Data12.RData 包含在启动任何模型之前的训练和测试样本。
我们还需要加载h2o包。此外，在h2o空间中创建的所有对象都将被删除：
library(h2o)
h2o.init()
h2o.removeAll()
标准化变量
在先前的模型中，我们固定了一个参数来标准化数据。然而，这个选项在autoML函数中不可用。因此，变量将首先进行标准化。列将具有零均值和单位方差。我们需要标准化变量，因为否则结果将会有主导变量，这些变量似乎比其他属性具有更高的方差，这是由于它们的规模造成的。
标准化使用caret包完成。首先，我们选择要标准化的数值列的名称：
library(caret)
features <- setdiff(names(train), c("ID_RSSD","Default"))
变量使用preProcess函数进行转换：
pre_process <- preProcess(x = train[, features],
method = c( "center", "scale"))
之前的功能存储了在任意数据集上进行标准化所需的参数。使用predict函数，我们可以实际应用这种转换。训练和测试样本都必须进行转换：
# apply to both training & test
train <- cbind(train[,"Default"],predict(pre_process, train[, features]))
test <- cbind(test[,"Default"],predict(pre_process, test[, features]))
colnames(train)[1]<-"Default"
colnames(test)[1]<-"Default"
现在，我们准备创建不同的模型。训练和测试样本被转换为h2o表：
train <- as.h2o(train)
test <- as.h2o(test)
我们需要目标和预测变量的名称：
y <- "Default"
x <- setdiff(names(train), y)
在所有这些基本预处理步骤之后，是时候创建一个模型了。h2o.automl函数实现了 autoML 方法。以下参数是必需的：
-
x：预测变量的名称 -
y：目标列名称 -
training_frame：用于创建模型的训练数据集 -
leaderboard_frame：h2o用于确保模型不会过度拟合数据的验证数据集
有更多参数，但前面的列表包含了最小要求。也可以排除一些算法，例如。在我们的案例中，我们将固定要训练的模型的最大数量和 AUC 作为停止指标标准。
让我们训练一些模型：
AML_models <- h2o.automl(y = y, x = x,
training_frame = train,
max_models = 10,stopping_metric ="AUC",
seed = 1234,sort_metric ="AUC")
我们可以如下访问训练模型的Leaderboard：
Leaderboard <- AML_models@leaderboard
print(Leaderboard)
## model_id auc
## 1 GBM_grid_0_AutoML_20190105_000223_model_4 0.9945125
## 2 StackedEnsemble_BestOfFamily_0_AutoML_20190105_000223 0.9943324
## 3 StackedEnsemble_AllModels_0_AutoML_20190105_000223 0.9942727
## 4 GLM_grid_0_AutoML_20190105_000223_model_0 0.9941941
## 5 GBM_grid_0_AutoML_20190105_000223_model_1 0.9930208
## 6 GBM_grid_0_AutoML_20190105_000223_model_5 0.9926648
## logloss mean_per_class_error rmse mse
## 1 0.03801166 0.04984862 0.09966934 0.009933978
## 2 0.03566530 0.03747844 0.09228175 0.008515921
## 3 0.03589846 0.03929486 0.09251204 0.008558478
## 4 0.03026294 0.05200978 0.08904775 0.007929502
## 5 0.03664414 0.06546054 0.09659713 0.009331005
## 6 0.13078645 0.08500441 0.18747430 0.035146615
##
## [12 rows x 6 columns]
根据Leaderboard，如果考虑准确度，则梯度提升模型是最佳的。让我们获取这个提升模型的预测：
leader_model <- AML_models@leaderpred_test <- as.data.frame(h2o.predict(object = leader_model, newdata = test))
可以使用以下代码打印出模型的完整细节（由于长度原因，这些结果没有打印在这本书中）：
print(leader_model)
同样，也可以分析堆叠模型中单个模型的重要性。让我们看看最佳模型在测试样本上的准确度：
head(pred_test)
## predict p0 p1
## 1 0 0.9977300 0.002270014
## 2 0 0.9977240 0.002275971
## 3 0 0.9819248 0.018075249
## 4 0 0.9975793 0.002420683
## 5 0 0.9977238 0.002276235
## 6 0 0.9977240 0.002276009
重要的是要记住，预测列是根据模型预测的类别，但我们需要考虑破产预测概率中的 50%作为阈值。
与先前的算法一样，我们应该在我们的样本中定义观察到的违约率：
pred_test$predict<-ifelse(pred_test$p1>0.04696094,1,0)
现在，我们将添加观察到的类别，然后计算准确度表：
pred_test<-cbind(as.data.frame(test[,"Default"]),pred_test)
table(pred_test$Default,pred_test$predict)
## 0 1
## 0 2810 86
## 1 6 137
自动模型获得了非常好的性能，但略逊于 SVM 模型。类似于h2o包中的先前模型，该模型可以保存以供将来使用：
h2o.saveModel(leader_model, path = "AML_model")
摘要
在本章中，我们使用了不同的模型和算法来尝试优化我们的模型。所有算法都获得了良好的结果。在其他问题中可能不会是这样。你可以在你的问题中尝试使用不同的算法，并测试最佳参数组合以解决你的特定问题。结合不同的算法或集成也可能是一个不错的选择。
在下一章中，我们将继续探讨其他实际问题——特别是，欧洲国家经济失衡的数据可视化。
第六章：可视化欧洲联盟的经济问题
现在，我们将继续探讨第二个问题，即在不同国家，尤其是在欧盟内部检测宏观经济失衡的问题。在我看来，这失败了，并加剧了金融危机的损害。
在本章中，我们将探讨我们的问题，并为那些被确定为遭受宏观经济失衡的国家创建聚类。我们将涵盖以下主题：
-
欧洲联盟经济问题的概述
-
根据宏观经济失衡对国家进行聚类
各国经济问题的概述
2008 年的全球金融危机始于银行层面的危机，关闭了资金流动并增加了金融不稳定。在前几个月，主要影响的是金融机构和中介机构。然而，之后它达到了宏观经济层面，威胁到整个国家的稳定。
欧洲联盟、国际货币基金组织（IMF）和欧洲中央银行（ECB）采取了紧急措施以避免某些国家的破产。因此，希腊在 2010 年获得了 1100 亿欧元来偿还其公共债务。这笔贷款是进一步支出的开始。爱尔兰在 2017 年 11 月获得了 870 亿欧元，目的相同。随后，2011 年在葡萄牙发现了问题，希腊又收到了一笔额外的贷款。西班牙和塞浦路斯分别在 2012 年和 2013 年获得了资金。
当发生金融危机或出现新问题时，人们常说这是必然会发生的事情，或者每个人都预测到了。在金融危机之前，宏观经济失衡一直在稳步增加，但可能因为从 2002 年开始的全球经济增长而被隐藏。信用评级机构也无法检测到这些宏观经济失衡。
理解信用评级
信用评级可以描述为一个类别或等级，它代表了一个政府偿还其债务的能力和意愿，并按时全额偿还。与信用评级相关联的是一个潜在的违约概率。
信用评级对国家来说非常重要，因为它们决定了资本市场的融资成本，并使他们能够获得衍生品和贷款合同。
近年来，评级数量及其重要性显著增加。在一个更加全球化和复杂的世界中，投资者需要标准指标来比较发行人之间的信用质量，即使他们属于非常不同的国家。尽管信用评级机构标准普尔认为这并不是一门精确的科学，但信用评级根据各国的偿债能力进行排名。它们被认为是投资者和国际组织的重要参考。在下表中，描述了不同的等级及其含义：
信用评级机构的作用
依赖信用评级赋予了信用评级机构高水平的影響力和政治权力。尽管有大量的信用评级机构，但只有其中三家收集了超过 90%的市场份额。这些是穆迪、标准普尔和惠誉。
信用评级机构因在 1990 年代末的亚洲和俄罗斯金融危机以及 2008 年爆发的近期全球金融危机等重要危机中的表现而受到批评。在这些事件中，信用评级机构加剧了不平衡，反应或预测违约事件的时间过长，然后过度反应，导致严重降级。
例如，在最近的金融危机中，欧洲经济体的评级平均下降了三个等级。希腊和意大利是受影响最严重的国家之一。
信用评级流程
评级过程中考虑了许多因素，包括政治、增长、外债、金融部门、公私部门结构、社会发展以及贸易。例如，标准普尔在六点量表上对国家的信用度进行五项关键因素的评分。然而，不同因素的权重以及这些因素的结合方式是未知的。此外，这些因素的重要性随时间变化。定性判断通常在评级分配过程中起着非常重要的作用。
对评级质量的担忧在过去二十年里激励了世界各地的研究人员。了解评级的决定因素对于减少对信用评级机构的依赖以及使信用评级的分配更加客观至关重要。
信用评级的复制主要基于不同的计量经济学模型，试图找到一组宏观经济变量来更好地解释外部评级。然而，信用评级研究广泛忽视了定性和更为主观的信息。这些附加信息可以补充当前的定量宏观经济信息，并提高信用评级模型的性能。
根据宏观经济不平衡对国家进行聚类
在本节中，我们将开发一个无监督模型来直观地检测国家的宏观经济问题，并更深入地了解信用评级的主要驱动因素。我们将首先创建一个具有宏观经济问题的国家集群。在下一章中，我们将继续基于这些集群预测信用评级。
在本章中，我试图重复前几章中的代码。
让我们开始吧！
数据收集
与之前的模型一样，我们需要收集尽可能多的数据。首先，我们需要国家的宏观经济指标来分析宏观经济不平衡并预测主权评级。
下载和查看数据
我们将使用wbstats包，它提供了对从世界银行 API 获取的所有信息的结构化访问，包括所有年度、季度和月度数据。在这个包中，wb_cachelist函数提供了一个可用国家、指标和其他相关信息的快照，如下所示：
library(wbstats)
str(wb_cachelist, max.level = 1)
## List of 7
## $ countries :'data.frame': 304 obs. of 18 variables:
## $ indicators :'data.frame': 16978 obs. of 7 variables:
## $ sources :'data.frame': 43 obs. of 8 variables:
## $ datacatalog:'data.frame': 238 obs. of 29 variables:
## $ topics :'data.frame': 21 obs. of 3 variables:
## $ income :'data.frame': 7 obs. of 3 variables:
## $ lending :'data.frame': 4 obs. of 3 variables:
超过 16,000 个变量适用于 300 多个国家。默认语言是英语。
要搜索不同的指标，请使用wbsearch函数。例如，我们可以搜索包含国内生产总值（GDP）的所有指标，如下所示：
new_cache <- wbcache()
gdp_vars <- wbsearch(pattern = "gdp")
print(gdp_vars[1:5,])
## indicatorID
## 2 XGDP.56.FSGOV.FDINSTADM.FFD
## 3 XGDP.23.FSGOV.FDINSTADM.FFD
## 758 TG.VAL.TOTL.GG.ZS
## 759 TG.VAL.TOTL.GD.ZS
## 760 TG.VAL.TOTL.GD.PP.ZS
## indicator
## Government expenditure in tertiary institutions as % of GDP (%)
## Government expenditure in secondary institutions education as % of GDP (%)
## Trade in goods (% of goods GDP)
## Merchandise trade (% of GDP)
## Trade (% of GDP, PPP)
您也可以下载数据并指定指标、开始日期和结束日期，如下所示：
stock_return <- wb(indicator = "GFDD.OM.02", startdate = 2000, enddate = 2017)
head(stock_return)
## iso3c date value indicatorID indicator
## 110 ARG 2016 31.1342 GFDD.OM.02 Stock market return (%, year- on-year)
## 111 ARG 2015 36.6400 GFDD.OM.02 Stock market return (%, year- on-year)
## 112 ARG 2014 103.1500 GFDD.OM.02 Stock market return (%, year- on-year)
## 113 ARG 2013 60.0070 GFDD.OM.02 Stock market return (%, year- on-year)
## 114 ARG 2012 -19.8370 GFDD.OM.02 Stock market return (%, year- on-year)
## 115 ARG 2011 22.1574 GFDD.OM.02 Stock market return (%, year- on-year)
## iso2c country
## 110 AR Argentina
## 111 AR Argentina
## 112 AR Argentina
## 113 AR Argentina
## 114 AR Argentina
## 115 AR Argentina
我们现在已下载了所有国家的股市回报率。前几个值属于阿根廷。也可以只为特定国家获取信息。让我们获取 2015 年至 2017 年美国和西班牙的总人口，如下所示：
population_stock <- wb(country = c("ES","US"),indicator = c("SP.POP.TOTL","GFDD.OM.02"), startdate = 2015, enddate = 2017)
head(population_stock)
## iso3c date value indicatorID indicator iso2c country
## 1 ESP 2017 46572028 SP.POP.TOTL Population, total ES Spain
## 2 ESP 2016 46484062 SP.POP.TOTL Population, total ES Spain
## 3 ESP 2015 46444832 SP.POP.TOTL Population, total ES Spain
## 4 USA 2017 325719178 SP.POP.TOTL Population, total US United States
## 5 USA 2016 323405935 SP.POP.TOTL Population, total US United States
## 6 USA 2015 321039839 SP.POP.TOTL Population, total US United States
变量总是按行获取，但这并不是展示信息的一种常见方式。使用return_wide = TRUE选项，如果获取了多个变量，它们将以列的形式展示。让我们看一下以下示例：
population_stock <- wb(country = c("ES","US"),
indicator = c("SP.POP.TOTL","GFDD.OM.02"), startdate = 2015, enddate =2017,return_wide = TRUE)
head(population_stock)
## iso3c date iso2c country GFDD.OM.02 SP.POP.TOTL
## 1 ESP 2015 ES Spain 1.96478 46444832
## 2 ESP 2016 ES Spain -18.17990 46484062
## 3 ESP 2017 ES Spain NA 46572028
## 4 USA 2015 US United States 6.71498 321039839
## 5 USA 2016 US United States 1.70065 323405935
## 6 USA 2017 US United States NA 325719178
如果一个指标的最新可用日期未知，mrv参数代表最新值，并取一个整数，对应于所需的最新的值的数量。让我们显示美国股市回报率的 10 个最新值，如下所示：
wb(country = c("US"),indicator = "GFDD.OM.02", mrv=10,return_wide = TRUE)
## iso3c date iso2c country GFDD.OM.02
## 1 USA 2007 US United States 12.72230
## 2 USA 2008 US United States -17.40770
## 3 USA 2009 US United States -22.29390
## 4 USA 2010 US United States 20.24370
## 5 USA 2011 US United States 11.19970
## 6 USA 2012 US United States 8.81282
## 7 USA 2013 US United States 19.17170
## 8 USA 2014 US United States 17.49470
## 9 USA 2015 US United States 6.71498
## 10 USA 2016 US United States 1.70065
默认日期格式对排序或绘图没有用。POSIXct参数添加了date_ct和granularity列，使这些任务变得容易得多。
让我们以查看美国军事费用随时间演变的例子为例，如下所示：
library(ggplot2)
military_exp <- wb(country = c("US"),indicator = "MS.MIL.XPND.GD.ZS", POSIXct = TRUE)
ggplot() + theme_bw() +
geom_line(aes(y = value, x = date_ct), size=1.5, data = military_exp,
stat="identity") +
theme(legend.position="bottom", legend.direction="horizontal",
legend.title = element_blank()) +
labs(x="Year", y="Expenses as %GDP") +
ggtitle("US Military expenses %GDP")
您将得到以下输出图：
我们看到下载信息非常容易。然而，为了开发我们的模型，我们不会使用所有数据。现在，让我们定义我们需要多少变量、国家和历史数据。
数据简化
让我们使用以下代码查看世界银行数据库中的国家列表：
countries<-wb_cachelist$countries
尽管列表很长，但一些国家属于几个国家的联盟，例如阿拉伯世界或欧盟。我们需要对这些国家进行选择。
让我们查看以下可用的指标列表：
indicators<-wb_cachelist$indicators
指标列表甚至更大（有超过 16,000 个条目），但我们将选择其中最重要的，如下面的片段所示。这些指标是通过主要信用评级机构提供的评级方法指南获得的：
relevant_indicators<-c('NYGDPMKTPKDZ','FB.BNK.CAPA.ZS','GFDD.OI.01','GFDD.EI.07','GFDD.SI.04','GFDD.OI.02','GFDD.EI.02','FD.RES.LIQU.AS.ZS','FB.AST.NPER.ZS','GFDD.SI.05','GFDD.EI.05','GFDD.EI.09','GFDD.EI.06','GFDD.EI.10','GFDD.SI.01','FM.LBL.BMNY.GD.ZS','FM.LBL.BMNY.ZG','FS.AST.CGOV.GD.ZS','CC.EST','GFDD.EI.08','BN.CAB.XOKA.GD.ZS','IC.CRD.INFO.XQ','FS.AST.DOMS.GD.ZS','NE.EXP.GNFS.KD.ZG','NE.RSB.GNFS.ZS','GFDD.DI.08','NY.GDP.MKTP.KD.ZG','NY.GDP.PCAP.CD','NY.GDP.PCAP.KD.ZG','NE.CON.GOVT.ZS','NE.CON.GOVT.KD.ZG','GE.EST','NY.GDS.TOTL.ZS','NE.GDI.FTOT.ZS','NE.GDI.FTOT.KD.ZG','NE.CON.PRVT.KD.ZG','NE.CON.PRVT.PC.KD.ZG','NE.IMP.GNFS.KD.ZG','NV.IND.TOTL.ZS','NV.IND.TOTL.KD.ZG','FP.CPI.TOTL.ZG','FR.INR.LNDP','CM.MKT.LCAP.GD.ZS','PV.EST','SP.POP.GROW','GFDD.SI.07','REER','RQ.EST','RL.EST','NV.SRV.TETC.ZS','NV.SRV.TETC.KD.ZG','DT.DOD.DSTC.ZS','DT.DOD.DSTC.IR.ZS','GFDD.OM.02','IC.LGL.CRED.XQ','TOTRESV','SL.UEM.TOTL.ZS','SL.UEM.1524.ZS','VA.EST','SP.POP.TOTL')
indicators<-indicators[indicators$indicatorID %in% relevant_indicators,]
head(indicators[,c("indicatorID","indicator")])
获得的指标列表如下：
## indicatorID
## 284 VA.EST
## 1793 TOTRESV
## 1986 PV.EST
## 2569 RQ.EST
## 2607 RL.EST
## 2636 REER
## indicator
## 284 Voice and Accountability: Estimate
## 1793 Total Reserves
## 1986 Political Stability and Absence of Violence/Terrorism: Estimate
## 2569 Regulatory Quality: Estimate
## 2607 Rule of Law: Estimate
## 2636 Real Effective Exchange Rate
让我们从 2000 年到 2018 年下载这些指标的历史数据。使用以下代码，这将花费大约五分钟：
macroeconomic_data<-wb(indicator = relevant_indicators,startdate = 2000, enddate = 2018,return_wide = TRUE,POSIXct = TRUE)
让我们如下获取我们数据的结构：
str(macroeconomic_data)
完整的输出如下：
## 'data.frame': 5903 obs. of 66 variables:
## $ iso3c : chr NA NA NA NA ...
## $ date : chr "2018" "2017" "2016" "2015" ...
## $ iso2c : chr "EA" "EA" "EA" "EA" ...
## $ country : chr "Euro Area" "Euro Area" "Euro Area" "Euro Area" ...
## $ date_ct : Date, format: "2018-01-01" "2017-01-01" ...
## $ granularity : chr "annual" "annual" "annual" "annual" ...
## $ BN.CAB.XOKA.GD.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ CC.EST : num NA NA NA NA NA NA NA NA NA NA ...
## $ CM.MKT.LCAP.GD.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ DT.DOD.DSTC.IR.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ DT.DOD.DSTC.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ FB.AST.NPER.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ FB.BNK.CAPA.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ FD.RES.LIQU.AS.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ FM.LBL.BMNY.GD.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ FM.LBL.BMNY.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ FP.CPI.TOTL.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ FR.INR.LNDP : num NA NA NA NA NA NA NA NA NA NA ...
## $ FS.AST.CGOV.GD.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ FS.AST.DOMS.GD.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ GE.EST : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.DI.08 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.EI.02 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.EI.05 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.EI.06 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.EI.07 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.EI.08 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.EI.09 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.EI.10 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.OI.01 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.OI.02 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.OM.02 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.SI.01 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.SI.04 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.SI.05 : num NA NA NA NA NA NA NA NA NA NA ...
## $ GFDD.SI.07 : num NA NA NA NA NA NA NA NA NA NA ...
## $ IC.CRD.INFO.XQ : num NA NA NA NA NA NA NA NA NA NA ...
## $ IC.LGL.CRED.XQ : num NA NA NA NA NA NA NA NA NA NA ...
## $ NE.CON.GOVT.KD.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ NE.CON.GOVT.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ NE.CON.PRVT.KD.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ NE.CON.PRVT.PC.KD.ZG: num NA NA NA NA NA NA NA NA NA NA ...
## $ NE.EXP.GNFS.KD.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ NE.GDI.FTOT.KD.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ NE.GDI.FTOT.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ NE.IMP.GNFS.KD.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ NE.RSB.GNFS.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ NV.IND.TOTL.KD.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ NV.IND.TOTL.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ NV.SRV.TETC.KD.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ NV.SRV.TETC.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ NY.GDP.MKTP.KD.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ NY.GDP.PCAP.CD : num NA NA NA NA NA NA NA NA NA NA ...
## $ NY.GDP.PCAP.KD.ZG : num NA NA NA NA NA NA NA NA NA NA ...
## $ NY.GDS.TOTL.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ NYGDPMKTPKDZ : num 2.1 2.39 1.8 2.07 2.21 ...
## $ PV.EST : num NA NA NA NA NA NA NA NA NA NA ...
## $ REER : num NA NA NA NA NA NA NA NA NA NA ...
## $ RL.EST : num NA NA NA NA NA NA NA NA NA NA ...
## $ RQ.EST : num NA NA NA NA NA NA NA NA NA NA ...
## $ SL.UEM.1524.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ SL.UEM.TOTL.ZS : num NA NA NA NA NA NA NA NA NA NA ...
## $ SP.POP.GROW : num NA NA NA NA NA NA NA NA NA NA ...
## $ SP.POP.TOTL : num NA NA NA NA NA NA NA NA NA NA ...
## $ TOTRESV : num NA NA NA NA NA NA NA NA NA NA ...
## $ VA.EST : num NA NA NA NA NA NA NA NA NA NA ...
如您所见，大多数变量在前面几行显示缺失值。让我们获取一个国家在前面的列表中出现的次数列表：
head(table(macroeconomic_data$country))
##
## Advanced economies Advanced Economies Afghanistan
## 4 19 19
## Africa Albania Algeria
## 12 19 19
该数据包含的国家总数如下：
length(table(macroeconomic_data$country))
## [1] 330
我们可以如下探索我们的缺失值：
library(DataExplorer)
plot_missing(macroeconomic_data)
我们将获得以下输出：
获得的图表不太美观，因为变量数量众多。虽然信息容易获取，但许多变量显示大量缺失值。这是因为信息未更新，且最近几年的数据不可用。
要查看结果，您应手动选择不同官方来源的相关变量并在 Excel 文件中合并它们，该文件将用于我们的模型开发。首先，按照如下操作删除工作区中的所有对象：
rm(list=ls())
现在，将新的数据样本加载到 R 中，如下：
macroeconomic_data <- read.csv("SovereignData.csv",sep=";",header=TRUE,stringsAsFactors = FALSE,dec=",")
该文件包含以下信息：
str(macroeconomic_data)
## 'data.frame': 224 obs. of 14 variables:
## $ Year : int 2010 2011 2012 2013 2014 2015 2016 2017 2010 2011 ...
## $ CountryISO : chr "AT" "AT" "AT" "AT" ...
## $ CountryName : chr "Austria" "Austria" "Austria" "Austria" ...
## $ CARA : num 2.92 1.57 1.5 1.95 2.39 ...
## $ DCPI : num 1.69 3.54 2.57 2.12 1.47 ...
## $ DGDP : num 1.828 2.935 0.662 0.008 0.923 ...
## $ ILMA : num 22284 25161 27211 23290 24941 ...
## $ PSBR : num -4.44 -2.55 -2.19 -1.95 -2.68 ...
## $ PUDP : num 82.4 82.2 81.7 81 83.7 ...
## $ TDRA : num -0.469 -1.168 -0.992 -0.313 0.232 ...
## $ YPCA : num 0.0467 0.0511 0.0483 0.0506 0.0519 ...
## $ MEANWGI : num 1.55 1.48 1.52 1.54 1.52 ...
## $ YearsFromLastDefault: int 21 22 23 24 25 26 27 28 21 22 ...
## $ RatingMayT1 : int 6 5 5 5 5 5 5 5 5 5 ...
如str函数所示，数据样本包含224个观测值和以下14个变量：
-
Year: 年末的参考日期 -
CountryISO: 国际标准国家代码 -
CountryName: 国家的名称 -
CARA: 一个国家的经常账户余额 -
DCPI: 消费者价格增长率 -
DGDP: GDP 增长率 -
ILMA: 国际储备 -
PSBR: 预算平衡占 GDP 的百分比 -
PUDP: 公共债务占 GDP 的百分比 -
TDRA: 总进口减去总出口的商品和服务占 GDP 的百分比 -
YPCA: 人均 GDP -
MEANWGI: 六个全球治理指标的平均值 -
YearsFromLastDefault: 自上次国家违约以来经过的时间 -
RatingMayT1: 宏观经济信息一年后国家的信用评级
您可以从以下来源获取更多数据：
所考虑的所有变量在先前的研究或由信用评级机构（CRAs）使用中已被广泛采用。在我们的变量列表中，我们使用了世界银行的多种治理指标，包括MEANWGI变量。该变量是通过世界银行提供的六个不同指标计算得出的简单平均值。这些指标衡量的话题包括政治稳定性、暴力水平和对腐败的控制。世界银行根据不同非政府组织、国际组织或私营部门公司的调查来计算这些综合指标。每个指标的价值越高，一个国家在该指标中的质量或评分就越高。
本章剩余部分将使用的数据集收集了多年来每个国家在五月底的信用评级。宏观经济信息代表了每个国家上一年年末的经济状况。各国在年初的第一季度或第二季度发布这些信息，因此每年五月份获取的最新宏观经济信息属于上一年。
研究数据
我们的首要目标将是根据各国的宏观经济状况检测国家集群，并预测这些国家的评级。然后，我们将评估欧洲委员会发布的国家报告中的定性信息是否有助于预测国家评级。这些报告通常在每年的前几个月发布，因此它们应该在五月的信用评级中也有影响力。
再次，我们必须从分析以下数据集开始：
head(macroeconomic_data)
## Year CountryISO CountryName CARA DCPI DGDP ILMA PSBR PUDP TDRA
## 1 2010 AT Austria 2.923 1.694 1.828 22284 -4.440 82.401 -0.469
## 2 2011 AT Austria 1.575 3.542 2.935 25161 -2.554 82.193 -1.168
## 3 2012 AT Austria 1.499 2.569 0.662 27211 -2.189 81.667 -0.992
## 4 2013 AT Austria 1.947 2.118 0.008 23290 -1.950 81.016 -0.313
## 5 2014 AT Austria 2.389 1.468 0.923 24941 -2.683 83.714 0.232
## 6 2015 AT Austria 1.932 0.810 1.073 22236 -1.033 84.297 0.609
## YPCA MEANWGI YearsFromLastDefault RatingMayT1
## 1 0.0466532 1.552740 21 6
## 2 0.0510888 1.477206 22 5
## 3 0.0483316 1.515706 23 5
## 4 0.0505913 1.540124 24 5
## 5 0.0519292 1.521760 25 5
## 6 0.0447088 1.471732 26 5
该数据集中没有缺失值。让我们按以下方式探索我们的数据：
library(funModeling)
library(DataExplorer)
info<-df_status(macroeconomic_data)
##variable q_zeros p_zeros q_na p_na q_inf p_inf type
## Year 0 0 0 0 0 0 integer
## CountryISO 0 0 0 0 0 0 character
## CountryName 0 0 0 0 0 0 character
## CARA 0 0 0 0 0 0 numeric
## DCPI 0 0 0 0 0 0 numeric
## DGDP 0 0 0 0 0 0 numeric
## ILMA 0 0 0 0 0 0 numeric
## PSBR 0 0 0 0 0 0 numeric
## PUDP 0 0 0 0 0 0 numeric
## TDRA 0 0 0 0 0 0 numeric
## YPCA 0 0 0 0 0 0 numeric
## MEANWGI 0 0 0 0 0 0 numeric
## YearsFromLastDefault 0 0 0 0 0 0 integer
## RatingMayT1 0 0 0 0 0 0 integer
不同国家的宏观经济信息从 2010 年到 2017 年可用，如下所示：
table(macroeconomic_data$Year)
## 2010 2011 2012 2013 2014 2015 2016 2017
## 28 28 28 28 28 28 28 28
以下是需要考虑的 28 个国家的列表：
unique(macroeconomic_data$CountryName)
## [1] "Austria" "Belgium" "Bulgaria" "Croatia"
## [5] "Cyprus" "Czech Republic" "Denmark" "Estonia"
## [9] "Finland" "France" "Germany" "Greece"
## [13] "Hungary" "Ireland" "Italy" "Latvia"
## [17] "Lithuania" "Luxembourg" "Malta" "Netherlands"
## [21] "Poland" "Portugal" "Romania" "Slovakia"
## [25] "Slovenia" "Spain" "Sweden" "United Kingdom"
获取目标变量
目标变量将是每个国家的信用评级。让我们用以下代码查看目标变量的不同值：
unique(macroeconomic_data$RatingMayT1)
## [1] 6 5 3 2 4 1
如我们所见，该量表只包含六个不同的等级，它们是数字的，而不是字母的。以下代码创建了一个表格来显示每个评级类别的分配数字：
RatingSP <- c('AAA','AA+','AA','AA-','A+','A','A-','BBB+','BBB','BBB-','BB+','BB','BB-','B+','B','B-','CCC+','CCC','CCC-','CC','C','D','DD','SD')
Rating_num <- c('6','5','5','5','4','4','4','3','3','3','2','2','2','1','1','1','1','1','1','1','1','1','1','1')
mapping<-data.frame(RatingSP, Rating_num)
rm(RatingSP,Rating_num)
print(mapping)
以下映射表将被用于将所有可能的信用评级水平减少到仅六个类别：
## RatingSP Rating_num
## 1 AAA 6
## 2 AA+ 5
## 3 AA 5
## 4 AA- 5
## 5 A+ 4
## 6 A 4
## 7 A- 4
## 8 BBB+ 3
## 9 BBB 3
## 10 BBB- 3
## 11 BB+ 2
## 12 BB 2
## 13 BB- 2
## 14 B+ 1
## 15 B 1
## 16 B- 1
## 17 CCC+ 1
## 18 CCC 1
## 19 CCC- 1
## 20 CC 1
## 21 C 1
## 22 D 1
## 23 DD 1
## 24 SD 1
因此，6的值与最高评级等级（AAA）相关联，而1则对应最低评级等级。这种映射是为了减少不同标签的数量，并获得一个更细粒度的目标变量。
让我们用以下代码查看目标变量的分布情况：
tab<-table(macroeconomic_data$RatingMayT1)
barplot(tab,xlab="Rating",ylab="Count",border="blue",col="blue")
你将看到一个如下所示的图表：
获取信用质量
2018 年 5 月，每个欧洲国家的信用评级如下：
with(macroeconomic_data[macroeconomic_data$Year==2017,], table(CountryName,RatingMayT1))
每个国家的信用质量表如下：
## RatingMayT1
## CountryName 1 2 3 4 5 6
## Austria 0 0 0 0 1 0
## Belgium 0 0 0 0 1 0
## Bulgaria 0 1 0 0 0 0
## Croatia 0 1 0 0 0 0
## Cyprus 0 1 0 0 0 0
## Czech Republic 0 0 0 0 1 0
## Denmark 0 0 0 0 0 1
## Estonia 0 0 0 0 1 0
## Finland 0 0 0 0 1 0
## France 0 0 0 0 1 0
## Germany 0 0 0 0 0 1
## Greece 1 0 0 0 0 0
## Hungary 0 0 1 0 0 0
## Ireland 0 0 0 1 0 0
## Italy 0 0 1 0 0 0
## Latvia 0 0 0 1 0 0
## Lithuania 0 0 0 1 0 0
## Luxembourg 0 0 0 0 0 1
## Malta 0 0 0 1 0 0
## Netherlands 0 0 0 0 0 1
## Poland 0 0 1 0 0 0
## Portugal 0 1 0 0 0 0
## Romania 0 0 1 0 0 0
## Slovakia 0 0 0 1 0 0
## Slovenia 0 0 0 1 0 0
## Spain 0 0 1 0 0 0
## Sweden 0 0 0 0 0 1
## United Kingdom 0 0 0 0 1 0
丹麦、德国、卢森堡、荷兰和瑞典显示出最高的信用质量。另一方面，根据标准普尔的数据，希腊是欧盟中偿债能力最低的国家。
在地图上显示信用评级
使用rworldmap包，我们可以创建一个地图并按国家显示信用评级。让我们关注最后可用的信用评级（2018 年 5 月），如下所示：
macro2017<-macroeconomic_data[macroeconomic_data$Year==2017,]
library(rworldmap)
Map <- joinCountryData2Map(macro2017, joinCode = "ISO2",
nameJoinColumn = "CountryISO")
可以快速总结如下：
## 28 codes from your data successfully matched countries in the map
## 0 codes from your data failed to match with a country code in the map
## 215 codes from the map weren't represented in your data
指定轴的极限，如下所示：
mapCountryData(Map, catMethod = "categorical", missingCountryCol = gray(.8), xlim = c(-20, 59),ylim = c(35, 71),asp = 1)
将会显示如下非常漂亮的输出：
执行数据的描述性分析
我们现在应该进行描述性分析，就像我们在前面的章节中所做的那样，使用以下代码：
library(fBasics)library(DataExplorer)
descriptives_num<-as.data.frame(t(basicStats(macroeconomic_data[,4:13])))
head(descriptives_num)
获得的输出如下：
## nobs NAs Minimum Maximum 1\. Quartile 3\. Quartile Mean
## CARA 224 0 -11.354 12.638 -1.44275 4.15000 1.004080
## DCPI 224 0 -2.097 6.113 0.27950 2.44350 1.418147
## DGDP 224 0 -9.168 25.492 0.87175 3.17450 1.946969
## ILMA 224 0 207.470 248856.000 3099.44000 59386.00000 45290.293839
## PSBR 224 0 -32.055 3.931 -4.32325 -0.94425 -3.110054
## PUDP 224 0 6.067 181.147 40.68500 86.39600 68.819321
## Median Sum SE Mean LCL Mean UCL Mean
## CARA 0.6140 224.914 0.284204 0.444012 1.564149
## DCPI 1.3000 317.665 0.103081 1.215009 1.621285
## DGDP 1.8995 436.121 0.195218 1.562261 2.331676
## ILMA 23359.0000 10145025.820 3712.287504 37974.641205 52605.946474
## PSBR -2.5980 -696.652 0.239382 -3.581794 -2.638313
## PUDP 65.0070 15415.528 2.417700 64.054860 73.583783
## Variance Stdev Skewness Kurtosis
## CARA 1.809288e+01 4.253572 0.057613 0.070869
## DCPI 2.380167e+00 1.542779 0.324855 -0.127702
## DGDP 8.536634e+00 2.921752 1.873828 18.872568
## ILMA 3.086962e+09 55560.431839 1.508513 1.483938
## PSBR 1.283607e+01 3.582746 -2.870375 18.134018
## PUDP 1.309341e+03 36.184813 0.792637 0.645762
按如下方式绘制这些变量：
plot_histogram(macroeconomic_data[,4:13])
下面的图表如下所示：
一旦我们研究过我们的数据集，我们就可以开始处理我们的数据了。保存工作区的一个备份。如果出了问题，总是可以加载备份并继续使用代码，如下所示：
rm(list=setdiff(ls(), c("macroeconomic_data")))
save.image("Backup1.RData")
检测宏观经济失衡
在本节中，我们将使用称为自组织映射（SOM）的技术，根据宏观经济变量对欧洲国家进行分类。
自组织映射技术
识别国家之间的相似性和差异性对于检测失衡并采取纠正措施以避免金融危机的传播至关重要。SOM 是一种非常适用于探索性数据分析（EDA）的无监督神经网络。SOM 的无监督性质是由于网络能够学习数据中的模式，而不使用目标变量。因此，网络中包含的不同神经元通过输入数据自我组织。以下图是 SOM 最常见的表示形式：
如前图所示，存在两个主要的神经元层：一个输入层和一个输出层。输入层是我们发送到网络的输入数据，即要分析的数据。输出层是一个二维地图，其中将放置所有我们的数据。输入层中的数据通过突触权重连接到输出层的所有神经元。这样，输入层每个神经元提供的信息就传递到了输出层的所有神经元。
网络试图找到输出层中与输入层神经元值最相似的突触权重神经元。最相似的权重在输入数据和输出层中创建的原型权重之间具有最低的距离。这些权重最初是随机创建的。一旦计算出距离，就会识别出获胜神经元。这个神经元是权重与输入集之间差异最小或欧几里得距离最短的神经元。
一旦识别出获胜神经元，其权重将使用学习规则进行调整，以将这些权重代理到使神经元获胜的输入模式。这样，权重最接近输入模式的神经元被更新，以变得更加接近。因此，输出层中的每个神经元都专门化于这个输入模式。
获胜神经元不是唯一更新其权重的神经元。还使用邻域函数来更新获胜神经元及其邻域神经元的权重，以定位相似的模式。随着模型迭代次数的增加，这个邻域半径会减小，以实现每个神经元的更好专业化。
训练 SOM
现在是时候使用 R 来训练 SOM 了。为此，我们将使用kohonen包。这个包的名字来源于 Teuvo Kohonen，他首先介绍了这个算法。
由于 SOM 主要基于欧几里得距离，建议对变量进行标准化。我们将使用caret包来完成这项工作，如下所示：
library(kohonen)
library(caret)
preprocess <- preProcess(macroeconomic_data[,4:13], method=c("center", "scale"))
print(preprocess)
## Created from 224 samples and 10 variables
##
## Pre-processing:
## - centered (10)
## - ignored (0)
## - scaled (10)
这将创建一个包含转换变量的数据框。然后，我们将国家名称和评分添加到这个转换数据框中，如下所示：
macroeconomic_data_trn <- cbind(macroeconomic_data[,c(1:3,14)],predict(preprocess, macroeconomic_data[,4:13]))
现在，是时候训练映射了。网络的第一层将有十个输入模式或十个宏观经济变量。我们的输出层将被固定为一个 6×5 大小的二维映射。这个大小是在多次测试后获得的，如下所示：
set.seed(1234)
som_grid <- somgrid(xdim = 6, ydim=5, topo="hexagonal")
som_model <- som(as.matrix(macroeconomic_data_trn[,5:14]),grid=som_grid,rlen=800,alpha=c(0.1,0.01), keep.data = TRUE )
经过 800 次迭代后，训练过程结束。可以从训练好的映射中获取不同的图表。
让我们使用以下代码显示训练过程中到最近码本向量的平均距离：
plot(som_model, type = "changes")
这将绘制以下图表：
我们可以看到，训练过程中的误差，即测量到最近单元的平均距离，在迭代过程中是逐渐减少的。如果迭代次数足够高，算法就会收敛。
此外，还可以可视化映射并计算每个神经元中分类的国家数量：
plot(som_model, type = "counts", main="Node Counts")
节点计数的图形表示可以在以下图表中看到：
在图中，根据分类的国家数量，用不同颜色标记了 30 个单元格（大小为 6x5）。灰色单元格表示在这个单元格中没有国家被分类。单元格数量越多，每个神经元中的国家数量就越少，从而获得更细粒度的地图。
在下面的图中，显示了映射到地图中每个单元的国家之间的平均距离。距离越小，表示国家由代码簿向量表示得越好，如下所示：
plot(som_model, type = "quality", main="Node Quality/Distance")
节点质量图如下：
地图上的权重向量也可以被可视化。这有助于揭示不同国家分布中的模式。
节点权重向量或代码由用于生成 SOM 的原变量的归一化值组成：
plot(som_model, type = "codes")
前面代码的输出显示在以下图表中：
从前面的图表中，可以提取出被放置在每个单元格中的国家的特征。还可以可视化单个变量在地图上的分布情况。例如，让我们看一下MEANWGI变量的分布，如下所示：
plot(som_model, type = "property", property = getCodes(som_model)[,'MEANWGI'], main="WorldBank Governance Indicators")
训练好的地图被绘制出来，并且根据这些地图上国家所在位置的变量值来着色单元格，如下所示：
根据前面的地图，该变量值较高的国家将位于地图的右上角。
现在，让我们使用以下代码，利用 2017 年 12 月的宏观经济信息来查看这些国家的位置：
Labels<-macroeconomic_data_trn[,c("CountryName","Year")]
Labels$CountryName<-ifelse(Labels$Year!=2017,"",as.character(Labels$CountryName))
plot(som_model, type = "mapping",label=Labels$CountryName)
将根据经济变量将国家放置在地图上的地图将显示如下：
在宏观经济变量中值相似的国家更靠近。因此，希腊、葡萄牙和塞浦路斯在地图上非常接近。这些国家在过去几年中由于金融危机而遇到了重要问题。德国、法国和英国等国家根据宏观经济信息也相似。最后，我们可以通过考虑训练地图的代码簿向量来在这个地图上创建不同的聚类或组。可以使用层次聚类来选择组数。以下代码将获得五个不同的国家组：
clusters <- cutree(hclust(dist(getCodes(som_model))), 5)
通过运行以下代码，可以在地图上可视化最近创建的组：
plot(som_model, type="codes", bgcol = clusters, main = "Clusters")
add.cluster.boundaries(som_model, clusters)
下面的地图被绘制出来：
前面的图表给出了以下信息：
-
组 1：葡萄牙、希腊和塞浦路斯等国家。
-
第二组：包括波兰、马耳他、保加利亚和西班牙等国家。总的来说，这是一个由西欧和其他经济状况较弱的国家组成的集群。这个组比之前的组状况更好。
-
第三组：欧盟中更富裕的国家，如英国、德国和法国。
-
第四组和第五组：这些组各有一个单元格，其中一个包含爱尔兰。爱尔兰几年前经历了严重的经济危机，但现在的情况非常不同。这种差异如此之大，以至于它不能被包含在任何其他国家的组中。
如往常一样，您现在可以使用以下代码备份您的 工作空间：
save.image("Backup2.RData")
使用这种简单的聚类方法，可以可视化欧盟每个国家的不同情况。
摘要
在本章中，我们介绍了不同欧洲国家经历的经济危机。我们获得了数据并对其进行了分析。然后，我们开发了一个可视化工具，同时使用不同的变量来比较各国。
在下一章中，我们将尝试创建一个评级模型。我们将根据各国的经济状况分配不同的分数。让我们看看我们是否能够预测不同国家的评级！
第七章：主权危机 - 自然语言处理和主题建模
继续探讨欧洲国家的经济问题检测，在本章中，我们将尝试使用定量和定性信息复制标准普尔提供的国家评级。
本章是一个有趣的实际案例应用，因为我们将使用一些基本的文本挖掘技术来复制标准普尔的信用评级。为此，我们将使用欧洲委员会为欧洲成员国发布的国家报告。
我们将执行文本挖掘过程，提取单词组合或有用的术语来预测主权评级。
本章将涵盖以下主题：
-
使用宏观经济信息预测国家评级
-
实现决策树
-
使用欧洲国家报告预测主权评级
使用宏观经济信息预测国家评级
在我们的聚类模型中，如第六章所述，使用自组织图可视化欧盟的经济问题，我们使用了所有可用数据。现在，为了训练一个能够预测主权评级的模型，我们需要将数据分为两个样本：训练样本和测试样本。
这对我们来说并不新鲜。当我们试图开发不同的模型来预测银行的失败时，我们使用了caTools包来分割数据，同时考虑我们的目标变量。
这里再次使用相同的程序：
library(caTools)
index = sample.split(macroeconomic_data$RatingMayT1, SplitRatio = .75)
train_macro<-subset(macroeconomic_data, index == TRUE)
test_macro<-subset(macroeconomic_data, index == FALSE)
现在，你可以打印以下语句：
print(paste("The number of observations in the train sample is: ",nrow(train_macro),sep=""))
## [1] "The number of observations in the train sample is: 168"
print(paste("The number of observations in the test sample is: ",nrow(test_macro),sep=""))
## [1] "The number of observations in the test sample is: 56"
因此，测试样本代表了总数据的 25%。此外，不同信用评级的相对比例在训练样本和测试样本中都得到了保留。
这两个样本都将进行标准化。再次使用caret包：
library(caret)
变换应仅考虑训练样本，然后应用于测试样本：
preprocess <- preProcess(train_macro[,4:13], method=c("center", "scale"))
print(preprocess)
## Created from 168 samples and 10 variables
##
## Pre-processing:
## - centered (10)
## - ignored (0)
## - scaled (10)
这里是两个额外的训练和测试样本，将原始变量替换为转换后的变量：
train_macro_trn <- cbind(train_macro[,c(1:3,14)],predict(preprocess, train_macro[,4:13]))
test_macro_trn <- cbind(test_macro[,c(1:3,14)],predict(preprocess, test_macro[,4:13]))
让我们看看变量是如何与目标变量（评级）相关的。为此，我们首先将目标变量转换为因子变量，然后我们将根据每个变量的类别创建不同的箱线图：
library(ggplot2)
variables<-colnames(train_macro_trn[,5:14])
train_macro_trn$RatingMayT1<-as.factor(train_macro_trn$RatingMayT1)
for (i in 5:14)
{
library(ggplot2)
theme_set(theme_classic())
var<-colnames(train_macro_trn)[i]
data_aux<-train_macro_trn[,c(var,"RatingMayT1")]
colnames(data_aux)<-c("variable","RatingMayT1")
g <- ggplot(data_aux, aes(RatingMayT1,variable))
plot(g + geom_boxplot(varwidth=T, fill="plum") +
labs(title="Box plot",
subtitle=var,
x="Rating Number",
y=var))
}
以下是以一个国家的经常账户余额（CARA）变量为输出的结果：
以下是以消费者价格增长率（DCPI）变量为输出的结果：
以下是以 GDP 增长（DGPD）变量为输出的结果：
以下是以国际储备（ILMA）变量为输出的结果：
以下是以六个全球治理指标平均值（MEANWGI）变量为输出的结果：
以下是以 GDP（国内生产总值）百分比表示的预算平衡（PSBR）变量的输出：
以下是对公共债务比率（PUDP）变量的输出：
以下是对商品和服务总进口减去总出口占 GDP 百分比（TDRA）变量的输出：
以下是对 GDP 人均值（YPCA）变量的输出：
这些图表有助于观察数据中的某些模式以及变量如何帮助预测信用评级。
例如，对于公共债务（GDP 百分比）的箱形图，或PUDP，显示评级最低的国家在这个变量上的平均值较高。
在以下代码中，让我们使用上一个图表，但这次提供更多关于每个评级类别中包含的国家细节：
library(dplyr)
means_YPCA <- train_macro_trn %>% group_by(RatingMayT1) %>%
summarise(YPCA = mean(YPCA))
ggplot(train_macro_trn, aes(x = RatingMayT1, y = YPCA, color = RatingMayT1, fill = RatingMayT1)) +
geom_bar(data = means_YPCA, stat = "identity", alpha = .3) + ggrepel::geom_text_repel(aes(label = CountryName), color = "black", size = 2.5, segment.color = "grey") + geom_point() + guides(color = "none", fill = "none") + theme_bw() + labs( x = "Rating", y = "GDP per capita")
以下是对 YPCA 的更详细图表：
让我们看看另一个替代方案：
library(ggplot2)
theme_set(theme_classic())
ggplot(train_macro_trn, aes((MEANWGI))) + geom_density(aes(fill=factor(RatingMayT1)),alpha=0.8) +
labs(title="Density plot",
subtitle="Mean of the Worldwide Governance Indicators",
x=paste("MeanWGI",sep=''),
fill="RatingNum")
这是 MeanWGI 的密度图：
让我们为CARA实现一个Density plot：
ggplot(train_macro_trn, aes((CARA))) + geom_density(aes(fill=factor(RatingMayT1)),alpha=0.8) + labs(title="Density plot",
subtitle="Current account balance/GDP",
x=paste("CARA",sep=''),
fill="RatingNum")
CARA 上的密度图输出将如下所示：
作为目标值，我们有一个取六个不同值的变量。在这个问题中，与上一个问题不同，我们预测的是失败的银行，无法计算六个。
为了评估每个变量预测信用评级的能力，我们可以计算每个变量与目标变量的相关性：
colnames(train_macro_trn)
## [1] "Year" "CountryISO" "CountryName"
## [4] "RatingMayT1" "CARA" "DCPI"
## [7] "DGDP" "ILMA" "PSBR"
## [10] "PUDP" "TDRA" "YPCA"
## [13] "MEANWGI" "YearsFromLastDefault"
variables<-colnames(train_macro_trn[,c(4:14)])
使用以下代码，我们首先创建我们训练样本的副本，然后将目标变量转换为数值格式。这是因为无法用非数值变量计算相关性。
然后我们将使用cor函数计算相关性：
aux<-train_macro_trn
aux$RatingMayT1<-as.numeric(as.character(aux$RatingMayT1))
# Correlation matrix
correlations<-cor(aux[, variables], use="pairwise", method="pearson")
correlations_with_Rating<-as.matrix(correlations[1,])
接下来，打印这些相关性：
print(correlations_with_Rating)
## [,1]
## RatingMayT1 1.0000000
## CARA 0.3938594
## DCPI 0.1517755
## DGDP 0.1167254
## ILMA 0.3130267
## PSBR 0.2783237
## PUDP -0.4172153
## TDRA 0.3854816
## YPCA 0.6491449
## MEANWGI 0.8024756
## YearsFromLastDefault 0.5132374
与信用评级最相关的变量是治理指标的平均值（MEANWGI），其次是人均 GDP（YPCA）。在这两种情况下，变量的值越高，偿付能力或信用评级值就越高。
另一方面，相关性最弱的变量是消费者价格变化（DCPI）。所有变量都有正相关，除了PUDP。这意味着一个国家的债务越高，信用评级就越低。
根据文献和信用评级机构提供的方法论指南，所有变量都与信用评级有预期的符号。
在这一点上，我们应该保存我们的工作空间并删除任何不必要的对象：
rm(list=setdiff(ls(), c("macroeconomic_data","train_macro","test_macro","correlations_with_Rating","train_macro_trn","test_macro_trn")))
save.image("Backup3.RData")
如所示，观察值和变量的数量与我们在第二章中获得的银行数据集大不相同，预测银行失败 - 数据收集。
让我们尝试一些算法来预测信用评级。具体来说，在下一节中，我们将训练一个决策树和一个有序逻辑回归。
实现决策树
在之前第五章的“测试随机森林模型”部分（预测银行失败 - 多变量分析）中，我们查看随机森林时，简要介绍了决策树。在决策树中，训练样本根据最显著的独立变量分成两个或更多同质集合。在决策树中，找到将数据分成不同类别的最佳变量。信息增益和基尼指数是找到这个变量的最常见方法。然后，数据递归分割，扩展树的叶节点，直到达到停止标准。
让我们看看如何在 R 中实现决策树以及这个算法如何预测信用评级。
决策树在rpart包中实现。此外，rpart.plot包将有助于稍后可视化我们的训练模型。通过以下步骤实现这些包：
library(rpart)
library(rpart.plot)
要创建一个树，我们将使用rpart函数。必须指定四个参数：
-
公式：在格式目标：
~ predictor1+predictor2+…+predictorN -
数据：指定数据框
-
方法：
class用于分类树或anova用于回归树 -
控制：控制树增长的可选参数
在我们的情况下，以下控制参数被指定：
-
maxdepth：指最终树中任何节点的最大深度。它定义了分割的数量，换句话说，树可以增长多少，考虑到根节点深度为 0。 -
复杂度参数（或
cp）：此参数也用于控制决策树的大小。此参数可以被认为是增加决策树增长或复杂性的最小增益。如果添加新节点到树中不增加我们的拟合度，算法将停止增长。
让我们训练模型。首先创建一个包含我们变量的列表：
variables<-names(train_macro_trn[,4:14])
print(variables)
## [1] "RatingMayT1" "CARA" "DCPI"
## [4] "DGDP" "ILMA" "PSBR"
## [7] "PUDP" "TDRA" "YPCA"
## [10] "MEANWGI" "YearsFromLastDefault"
现在，训练了一个决策树：
set.seed(1234)
DT<-rpart(formula = RatingMayT1 ~ ., data = train_macro_trn[,c(variables)], control=rpart.control(maxdepth=5,cp=0.001))
模型训练完成后，可以使用summary函数打印模型给出的所有信息，尽管这次由于输出量较大而没有打印：
#summary(DT)
现在让我们使用决策树预测信用评级，包括训练样本和测试样本：
DT_pr_train <- data.frame(cbind(train_macro_trn$CountryName,train_macro_trn$Year,train_macro_trn$RatingMayT1,predict(DT, newdata=train_macro_trn, type="class")))
colnames(DT_pr_train)<-c("Country","year","Observed","Predicted")
DT_pr_test <- data.frame(cbind(test_macro_trn$CountryName,test_macro_trn$Year,test_macro_trn$RatingMayT1,predict(DT, newdata=test_macro_trn, type="class")))
colnames(DT_pr_test)<-c("Country","year","Observed","Predicted")
这是训练样本的混淆表：
table(DT_pr_train$Observed,DT_pr_train$Predicted)
## 1 2 3 4 5 6
## 1 6 2 0 0 0 0
## 2 0 16 5 1 1 0
## 3 1 4 22 4 2 0
## 4 0 0 7 25 0 0
## 5 0 0 7 1 25 1
## 6 0 0 0 2 1 35
训练好的模型能够预测训练样本中几乎所有的信用评级。现在让我们打印其在测试样本中的准确率：
table(DT_pr_test$Observed,DT_pr_test$Predicted)
## 1 2 3 4 5 6
## 1 2 0 0 1 0 0
## 2 0 3 5 0 0 0
## 3 0 1 8 2 0 0
## 4 0 0 1 8 1 0
## 5 0 0 2 2 7 1
## 6 0 0 0 1 1 10
为了评估决策树的准确性，我们可以计算不同的指标。具体来说，我们可以计算实际评级值与预测值之间的差异。通过计算这些差异，我们可以测量我们的模型在哪个等级上与实际评级水平不同。
为此，创建了一个函数：
model_assessment<-function(data,model)
{
data$Observed<-as.numeric(as.character(data$Observed))
data$Predicted<-as.numeric(as.character(data$Predicted))
data$df<-abs(as.numeric(data$Predicted)-as.numeric(data$Observed))
comparison<-as.data.frame(table(data$df))
comparison$perc<-comparison$Freq/nrow(data)
colnames(comparison)<-c("notche","N",paste("perc_",model,sep=''))
comparison$N<-NULL
comparison$cumulative<-cumsum(comparison[,ncol(comparison)])
return(comparison)
}
这里是不同的结果：
model_assessment(DT_pr_train,"DT")
## notche perc_DT cumulative
## 1 0 0.767857143 0.7678571
## 2 1 0.148809524 0.9166667
## 3 2 0.077380952 0.9940476
## 4 3 0.005952381 1.0000000
根据前面的表格，几乎 77%的国家被正确分类。另一方面，14.88%的国家的预测没有被正确分类，但与实际观察到的评级的差异只有一个等级。另一方面，7.74%的国家有一个错误的预测评级，并且这个预测与实际值相差两个等级，等等。
现在将相同的函数应用于测试样本：
model_assessment(DT_pr_test,"DT")
## notche perc_DT cumulative
## 1 0 0.67857143 0.6785714
## 2 1 0.25000000 0.9285714
## 3 2 0.05357143 0.9821429
## 4 3 0.01785714 1.0000000
这些结果被认为足够好。外部评级机构提供的信用评级基于定量和定性信息，其中后者最为相关。在我们的案例中，我们仅使用定量公共信息就能预测 68%的评级。
最后，使用rpart.plot包绘制决策树：
prp(DT)
YPCA决策树将如下所示：
模型不是很容易解释吗？
在开始下一部分之前，让我们保存决策树：
save.image("Backup4.RData")
在下一节中，我们将使用另一种有趣的方法，有序逻辑回归，这将能够改进决策树中获得的成果。
有序逻辑回归
正如我们所见，决策树在多分类问题中表现良好。我们还可以遵循其他方法。其中之一是逻辑回归，它对一个问题给出六个可能的结果。然而，这种方法有一些局限性。例如，我们假设目标变量中的类别没有顺序。这意味着目标变量中的不同类别或类是名义的。在评级的情况下，这个假设不一定成立，因为评级分配了一个排名。此外，信用评级之间的差异并不相同，这意味着 AAA 和 AA+评级之间的差异不一定等于 BBB 和 BBB-评级之间的差异。
因此，在这本书的这一部分，我们将实现有序逻辑回归，它假设目标变量中有顺序，并且评级之间的差异不是常数。
该模型可以使用MASS包中的polr函数部署。此函数只需要模型的公式、数据集，在我们的案例中，还需要Hess=TRUE选项。此选项将允许我们计算并可视化模型中变量的标准误差：
library(MASS)
ordered_logistic <- polr(RatingMayT1 ~ ., data = train_macro_trn[,c(variables)], Hess=TRUE)
然后打印出模型的摘要：
summary(ordered_logistic)
## Call:
## polr(formula = RatingMayT1 ~ ., data = train_macro_trn[, c(variables)],
## Hess = TRUE)
##
## Coefficients:
## Value Std. Error t value
## CARA -0.3624 0.2520 -1.4381
## DCPI 0.1432 0.1807 0.7924
## DGDP -0.2225 0.2129 -1.0452
## ILMA 1.5587 0.2592 6.0126
## PSBR 0.6929 0.2209 3.1371
## PUDP -2.8039 0.3886 -7.2145
## TDRA 0.3070 0.2464 1.2461
## YPCA 2.6988 0.7100 3.8011
## MEANWGI 2.2565 0.4707 4.7937
## YearsFromLastDefault 0.8091 0.2191 3.6919
##
## Intercepts:
## Value Std. Error t value
## 1|2 -10.0770 1.1157 -9.0321
## 2|3 -5.6306 0.6134 -9.1789
## 3|4 -2.4390 0.4011 -6.0810
## 4|5 0.4135 0.3615 1.1439
## 5|6 4.8940 0.5963 8.2070
##
## Residual Deviance: 236.9271
## AIC: 266.9271
前面的表格为我们提供了回归系数表。此外，它还显示了不同截距的估计值，有时被称为截点。截距表明预测结果应该在何处被切割，以使数据中观察到的不同信用评级。
此外，该模型为我们提供了残差偏差和AIC指标，这些是用于比较不同模型的有用指标。
在前面的结果中，我们看不到任何表示变量是否显著的p_values，因为在任何回归中通常都不会显示。因此，我们需要计算它们。
p_values可以通过比较t 值与标准正态分布来近似计算。首先，我们将使用以下代码存储我们的系数：
coefs <- coef(summary(ordered_logistic))
print(coefs)
## Value Std. Error t value
## CARA -0.3623788 0.2519888 -1.4380749
## DCPI 0.1432174 0.1807448 0.7923737
## DGDP -0.2225049 0.2128768 -1.0452282
## ILMA 1.5586713 0.2592360 6.0125575
## PSBR 0.6928689 0.2208629 3.1371002
## PUDP -2.8038553 0.3886409 -7.2145133
## TDRA 0.3069968 0.2463570 1.2461463
## YPCA 2.6988066 0.7100112 3.8010760
## MEANWGI 2.2564849 0.4707199 4.7936888
## YearsFromLastDefault 0.8090669 0.2191455 3.6919175
## 1|2 -10.0770197 1.1156894 -9.0321014
## 2|3 -5.6306456 0.6134365 -9.1788566
## 3|4 -2.4389936 0.4010815 -6.0810418
## 4|5 0.4134912 0.3614860 1.1438653
## 5|6 4.8940176 0.5963226 8.2069960
如果我们观察系数的符号，有一些负值。显然，一些变量显示出非直观或意外的符号，但在本例中我们无需对此感到担忧。
模型的系数可能有些难以解释，因为它们是以对数形式缩放的。因此，将之前的原始系数转换为概率比是常见的做法。
概率比将按以下方式获得：
exp(coef(ordered_logistic))
## CARA DCPI DGDP
## 0.69601870 1.15398065 0.80051110
## ILMA PSBR PUDP
## 4.75250240 1.99944358 0.06057607
## TDRA YPCA MEANWGI
## 1.35933662 14.86198455 9.54946258
## YearsFromLastDefault
## 2.24581149
最后，不同变量的p_values被计算并合并到我们获得的系数中：
p_values <- pnorm(abs(coefs[, "t value"]), lower.tail = FALSE) * 2
coefs <- cbind(coefs, "p value" = p_values)
print(coefs)
## Value Std. Error t value p value
## CARA -0.3623788 0.2519888 -1.4380749 1.504128e-01
## DCPI 0.1432174 0.1807448 0.7923737 4.281428e-01
## DGDP -0.2225049 0.2128768 -1.0452282 2.959175e-01
## ILMA 1.5586713 0.2592360 6.0125575 1.826190e-09
## PSBR 0.6928689 0.2208629 3.1371002 1.706278e-03
## PUDP -2.8038553 0.3886409 -7.2145133 5.412723e-13
## TDRA 0.3069968 0.2463570 1.2461463 2.127107e-01
## YPCA 2.6988066 0.7100112 3.8010760 1.440691e-04
## MEANWGI 2.2564849 0.4707199 4.7936888 1.637422e-06
## YearsFromLastDefault 0.8090669 0.2191455 3.6919175 2.225697e-04
## 1|2 -10.0770197 1.1156894 -9.0321014 1.684062e-19
## 2|3 -5.6306456 0.6134365 -9.1788566 4.356928e-20
## 3|4 -2.4389936 0.4010815 -6.0810418 1.194042e-09
## 4|5 0.4134912 0.3614860 1.1438653 2.526795e-01
## 5|6 4.8940176 0.5963226 8.2069960 2.267912e-16
一旦我们开发出我们的模型，我们将预测模型的结果：
Ord_log_pr_train <- cbind(train_macro_trn[,c("CountryName","Year","RatingMayT1")], predict(ordered_logistic, train_macro_trn, type = "probs"))
colnames(Ord_log_pr_train)<-c("Country","year","Observed","X1","X2","X3","X4","X5","X6")
head(Ord_log_pr_train,1)
##Country year Observed X1 X2 X3 X4
1 Austria 2010 6 5.468638e-06 4.608843e-04 0.010757249 0.15316033
## X5 X6
## 1 0.7811701 0.05444599
该模型为每个评级给出了不同的概率。预测评级是预测概率最高的评级。例如，对于 2010 年的奥地利，模型将最高的概率分配给了 5（X5）评级，因此预测评级是 5。
以下代码将预测评级分配给最高概率：
for (j in 1:nrow(Ord_log_pr_train))
{
Ord_log_pr_train$maximaPD[j]<-max(Ord_log_pr_train$X1[j],Ord_log_pr_train$X2[j],Ord_log_pr_train$X3[j],Ord_log_pr_train$X4[j],Ord_log_pr_train$X5[j],Ord_log_pr_train$X6[j])
}
Ord_log_pr_train$Predicted<-ifelse(Ord_log_pr_train$X1==Ord_log_pr_train$maximaPD,1,ifelse(Ord_log_pr_train$X2==Ord_log_pr_train$maximaPD,2,ifelse(Ord_log_pr_train$X3==Ord_log_pr_train$maximaPD,3,ifelse(Ord_log_pr_train$X4==Ord_log_pr_train$maximaPD,4,ifelse(Ord_log_pr_train$X5==Ord_log_pr_train$maximaPD,5,6)))))
让我们看看模型在训练样本中的准确率：
model_assessment(Ord_log_pr_train,"Ordered_logistic")
## notche perc_Ordered_logistic cumulative
## 1 0 0.69047619 0.6904762
## 2 1 0.29761905 0.9880952
## 3 2 0.01190476 1.0000000
如我们所见，该模型能够使用训练样本正确预测 69.05%的信用评级。当使用决策树时，这些结果更好。
让我们看看模型在测试样本中的表现。以下代码给出了每个国家在每个评级水平上的预测概率。预测评级是由概率最高的类别给出的：
Ord_log_pr_test <- cbind(test_macro_trn[,c("CountryName","Year","RatingMayT1")], predict(ordered_logistic, test_macro_trn, type = "probs"))
colnames(Ord_log_pr_test)<-c("Country","year","Observed","X1","X2","X3","X4","X5","X6")
以下代码找到概率最高的评级类别，并将其分配为预测评级：
for (j in 1:nrow(Ord_log_pr_test))
{
Ord_log_pr_test$maximaPD[j]<-max(Ord_log_pr_test$X1[j],Ord_log_pr_test$X2[j],Ord_log_pr_test$X3[j],Ord_log_pr_test$X4[j],Ord_log_pr_test$X5[j],Ord_log_pr_test$X6[j])
}
Ord_log_pr_test$Predicted<-ifelse(Ord_log_pr_test$X1==Ord_log_pr_test$maximaPD,1,ifelse(Ord_log_pr_test$X2==Ord_log_pr_test$maximaPD,2,ifelse(Ord_log_pr_test$X3==Ord_log_pr_test$maximaPD,3,ifelse(Ord_log_pr_test$X4==Ord_log_pr_test$maximaPD,4,ifelse(Ord_log_pr_test$X5==Ord_log_pr_test$maximaPD,5,6)))))
在测试样本中，模型的准确率如下：
model_assessment(Ord_log_pr_test,"Ordered_logistic")
## notche perc_Ordered_logistic cumulative
## 1 0 0.57142857 0.5714286
## 2 1 0.39285714 0.9642857
## 3 2 0.01785714 0.9821429
## 4 3 0.01785714 1.0000000
结果也略逊于决策树模型。
在开始下一节之前，你现在可以保存工作空间：
save.image("Backup5.RData")
在下一节中，我们将使用宏观经济数据来预测国家评级。我们使用的所有变量都是定量变量。在下一节中，我们将使用国家报告来达到相同的目的。
使用欧洲国家报告预测主权评级
根据在“使用宏观经济信息预测国家评级”部分描述的基于宏观经济信息的模型，决策树可以被认为是一种预测主权评级的良好替代方法。
然而，定性信息代表了评级分配中一个重要且低透明度的一部分。在本节中，我们提出了一种仅基于所谓的国家报告的模型，这些报告由欧洲委员会发布。
这些报告主要在二月底发布，包含对欧盟成员国经济和社会挑战的年度分析。
例如，在以下链接中，我们可以下载 2018 年发布的国家报告，ec.europa.eu/info/publications/2018-european-semester-country-reports_en。对于所有 28 个欧盟国家，我们已经从 2011 年到 2018 年下载了它们的国别报告，并将它们转换为文本格式。我们按年份将它们存储在不同的文件夹中，每个文件夹对应一年：
directories <- list.files(path = "../MachineLearning/CountryReports/", pattern = "201", full.names = TRUE)
print(directories)
## [1] "../MachineLearning/CountryReports/2011"
## [2] "../MachineLearning/CountryReports/2012"
## [3] "../MachineLearning/CountryReports/2013"
## [4] "../MachineLearning/CountryReports/2014"
## [5] "../MachineLearning/CountryReports/2015"
## [6] "../MachineLearning/CountryReports/2016"
## [7] "../MachineLearning/CountryReports/2017"
## [8] "../MachineLearning/CountryReports/2018"
让我们创建一个包含每个文件夹中不同报告名称的列表：
txt_files2011<-list.files(path = directories[1], pattern = ".txt", recursive=TRUE,full.names = TRUE)
txt_files2012<-list.files(path = directories[2], pattern = ".txt", recursive=TRUE,full.names = TRUE)
txt_files2013<-list.files(path = directories[3], pattern = ".txt", recursive=TRUE,full.names = TRUE)
txt_files2014<-list.files(path = directories[4], pattern = ".txt", recursive=TRUE,full.names = TRUE)
txt_files2015<-list.files(path = directories[5], pattern = ".txt", recursive=TRUE,full.names = TRUE)
txt_files2016<-list.files(path = directories[6], pattern = ".txt", recursive=TRUE,full.names = TRUE)
txt_files2017<-list.files(path = directories[7], pattern = ".txt", recursive=TRUE,full.names = TRUE)
txt_files2018<-list.files(path = directories[8], pattern = ".txt", recursive=TRUE,full.names = TRUE)
这里，文本文件名存储在一个列表中：
country_reports_list<-do.call(c,list(txt_files2011,txt_files2012,txt_files2013,txt_files2014,txt_files2015,txt_files2016,txt_files2017,txt_files2018))
head(country_reports_list)
## [1] "../MachineLearning/CountryReports/2011/swp_austria_en_0.txt"
## [2] "../MachineLearning/CountryReports/2011/swp_belgium_en_0.txt"
## [3] "../MachineLearning/CountryReports/2011/swp_bulgaria_en_0.txt"
## [4] "../MachineLearning/CountryReports/2011/swp_cyprus_en_0.txt"
## [5] "../MachineLearning/CountryReports/2011/swp_czechrepublic_en_0.txt"
## [6] "../MachineLearning/CountryReports/2011/swp_denmark_en_0.txt"
文件名包含根目录和文件名。让我们尝试将国家名称和报告年份分开：
list<-data.frame(country_reports_list)
list<-data.frame(t(data.frame(strsplit(as.character(list$country_reports_list), "/"))))
list<-list[,(ncol(list)-1):ncol(list)]
row.names(list)<-NULL
list<-cbind(list,country_reports_list)
colnames(list)<-c("Year","file","root")
head(list)
## Year file
## 1 2011 swp_austria_en_0.txt
## 2 2011 swp_belgium_en_0.txt
## 3 2011 swp_bulgaria_en_0.txt
## 4 2011 swp_cyprus_en_0.txt
## 5 2011 swp_czechrepublic_en_0.txt
## 6 2011 swp_denmark_en_0.txt
## root
## 1 ../MachineLearning/CountryReports/2011/swp_austria_en_0.txt
## 2 ../MachineLearning/CountryReports/2011/swp_belgium_en_0.txt
## 3 ../MachineLearning/CountryReports/2011/swp_bulgaria_en_0.txt
## 4 ../MachineLearning/CountryReports/2011/swp_cyprus_en_0.txt
## 5 ../MachineLearning/CountryReports/2011/swp_czechrepublic_en_0.txt
## 6 ../MachineLearning/CountryReports/2011/swp_denmark_en_0.txt
让我们尝试创建一个包含国家名称的列，考虑到每个文件名。例如，如果文件名中包含单词czech，将创建一个新列，其中包含捷克共和国：
list$CountryMapping<-NA
list[grep("austria",list$file),"CountryMapping"]<-"Austria"
list[grep("belgium",list$file),"CountryMapping"]<-"Belgium"
list[grep("bulgaria",list$file),"CountryMapping"]<-"Bulgaria"
list[grep("croatia",list$file),"CountryMapping"]<-"Croatia"
list[grep("cyprus",list$file),"CountryMapping"]<-"Cyprus"
list[grep("czech",list$file),"CountryMapping"]<-"Czech Republic"
list[grep("denmark",list$file),"CountryMapping"]<-"Denmark"
list[grep("estonia",list$file),"CountryMapping"]<-"Estonia"
list[grep("finland",list$file),"CountryMapping"]<-"Finland"
list[grep("france",list$file),"CountryMapping"]<-"France"
list[grep("germany",list$file),"CountryMapping"]<-"Germany"
list[grep("greece",list$file),"CountryMapping"]<-"Greece"
list[grep("hungary",list$file),"CountryMapping"]<-"Hungary"
list[grep("ireland",list$file),"CountryMapping"]<-"Ireland"
list[grep("italy",list$file),"CountryMapping"]<-"Italy"
list[grep("latvia",list$file),"CountryMapping"]<-"Latvia"
list[grep("lithuania",list$file),"CountryMapping"]<-"Lithuania"
list[grep("luxembourg",list$file),"CountryMapping"]<-"Luxembourg"
list[grep("malta",list$file),"CountryMapping"]<-"Malta"
list[grep("netherlands",list$file),"CountryMapping"]<-"Netherlands"
list[grep("poland",list$file),"CountryMapping"]<-"Poland"
list[grep("portugal",list$file),"CountryMapping"]<-"Portugal"
list[grep("romania",list$file),"CountryMapping"]<-"Romania"
list[grep("slovakia",list$file),"CountryMapping"]<-"Slovakia"
list[grep("slovenia",list$file),"CountryMapping"]<-"Slovenia"
list[grep("spain",list$file),"CountryMapping"]<-"Spain"
list[grep("sweden",list$file),"CountryMapping"]<-"Sweden"
list[grep("uk",list$file),"CountryMapping"]<-"United Kingdom"
list[grep("kingdom",list$file),"CountryMapping"]<-"United Kingdom"
list[grep("netherland",list$file),"CountryMapping"]<-"Netherlands"
让我们看看欧盟每个国家有多少个报告：
table(list$CountryMapping)
##
## Austria Belgium Bulgaria Croatia Cyprus
## 8 8 8 6 8
## Czech Republic Denmark Estonia Finland France
## 8 8 8 8 8
## Germany Greece Hungary Ireland Italy
## 8 4 8 8 8
## Latvia Lithuania Luxembourg Malta Netherlands
## 8 8 8 8 8
## Poland Portugal Romania Slovakia Slovenia
## 8 8 8 8 8
## Spain Sweden United Kingdom
## 8 8 8
我们为欧盟的所有国家提供了八个不同的报告，除了克罗地亚（只有6个报告）和希腊（只有4个）。克罗地亚作为欧盟的正式成员国加入是在 2013 年 7 月 1 日。因此，没有 2011 年和 2012 年的报告。至于希腊，2014 年之后没有针对希腊的具体报告。
由于我们打算使用欧洲报告来训练预测信用评级的模型，我们需要选择一些报告来训练模型，其他报告来测试它。在第六章中使用的模型，即在欧洲联盟中可视化经济问题（使用宏观经济信息预测国家评级）部分中使用的相同国家将再次使用。首先，我们需要选择我们之前用于训练模型的那些国家。然后，我们将选定的国家与对应报告所在的位置名称和根目录合并：
train_list<-train_macro[,c("CountryName","Year")]
train_list$year_report<-train_list$Year+1
train_list<-merge(train_list,list,by.x=c("CountryName","year_report"),by.y=c("CountryMapping","Year"),all.x=TRUE)
train_list<-train_list[complete.cases(train_list),]
files_train<-as.vector(train_list$root)
这里是我们将用于训练我们模型的报告示例：
print(head(files_train))
## [1] "../MachineLearning/CountryReports/2011/swp_austria_en_0.txt"
## [2] "../MachineLearning/CountryReports/2012/swd2012_austria_en.txt"
## [3] "../MachineLearning/CountryReports/2013/swd2013_austria_en.txt"
## [4] "../MachineLearning/CountryReports/2014/swd2014_austria_en_0.txt"
## [5] "../MachineLearning/CountryReports/2016/cr2016_austria_en.txt"
## [6] "../MachineLearning/CountryReports/2017/2017-european-semester-country-report-austria-en_1.txt"
同样的程序用于获取验证或测试样本：
test_list<-test_macro[,c("CountryName","Year")]
test_list$year_report<-test_list$Year+1
test_list<-merge(test_list,list,by.x=c("CountryName","year_report"),by.y=c("CountryMapping","Year"),all.x=TRUE)
test_list<-test_list[complete.cases(test_list),]
files_test<-as.vector(test_list$root)
现在我们来看看输出结果：
print(head(files_test))
## [1] "../MachineLearning/CountryReports/2015/cr2015_austria_en.txt"
## [2] "../MachineLearning/CountryReports/2018/2018-european-semester-country- report-austria-en.txt"
## [3] "../MachineLearning/CountryReports/2013/swd2013_belgium_en.txt"
## [4] "../MachineLearning/CountryReports/2011/swp_bulgaria_en_0.txt"
## [5] "../MachineLearning/CountryReports/2013/swd2013_bulgaria_en.txt"
## [6] "../MachineLearning/CountryReports/2014/swd2014_croatia_en.txt"
由于一些国家没有报告，与先前模型中使用的样本大小存在一些差异。以下代码显示了这一点：
print(paste("The number of countries used to train previous model was formed by",nrow(train_macro_trn), "countries",sep=" "))
## [1] "The number of countries used to train previous model was formed by 168 countries"
这是我们将用于训练新模型的国家的数量：
print(paste("The number of countries which we will use to train this new model will be formed by",nrow(train_list), "countries",sep=" "))
## [1] "The number of countries which we will use to train this new model will be formed by 165 countries"
这是用于验证先前模型的国家的数量：
print(paste("The number of countries used to validate previous model was formed by",nrow(test_macro_trn), "countries",sep=" "))
## [1] "The number of countries used to validate previous model was formed by 56 countries"
这是用于训练新模型的国家的数量：
print(paste("The number of countries which we will use to train this new model will be formed by",nrow(test_list), "countries",sep=" "))
## [1] "The number of countries which we will use to train this new model will be formed by 53 countries"
如您所见，差异并不显著。在将文件读入 R 之前，我们将创建一个读取文件的函数。
一旦运行以下函数，我们就可以迭代地读取不同的报告：
Import_txt <- function(txt)
{
x<-as.data.frame(read.delim(txt, header=FALSE, comment.char="#", stringsAsFactors=FALSE))
return(x)
}
将创建两个列表。在每个列表元素中，我们可以找到每个国家的报告：
Reports_train <- lapply(files_train,
function(x)
read.delim(x,
header = FALSE, comment.char="#",
stringsAsFactors = FALSE))
Reports_test <- lapply(files_test,
function(x)
read.delim(x,
header = FALSE, comment.char="#",
stringsAsFactors = FALSE))
在继续之前，可以删除一些不必要的对象，并保存工作区：
rm(list=setdiff(ls(), c("macroeconomic_data","Reports_train","Reports_test","train_list","test_list")))
save.image("Backup6.RData")
报告需要预处理。在提取有用信息或特征以构建我们的模型之前，需要进行数据预处理。
数据清理，或数据预处理，涉及将数据转换为纯文本，然后删除格式、空白、数字、大写字母和停用词。
停用词是指在一种语言中如此常见，以至于它们的信息价值实际上为零的词。由于所有国家报告都可用英文，这些停用词的例子包括介词、限定词和连词。
为了进行这些预处理步骤，加载了tm包，并将报告转换为语料库格式：
library(tm)
docs_train <- as.VCorpus(Reports_train)
docs_test <- as.VCorpus(Reports_test)
创建以下函数以逐个清理我们的报告：
corpus_treatment<-function(corpus)
{
toSpace <- content_transformer(function(x, pattern) {return (gsub(pattern, " ", x))})
corpus <- tm_map(corpus,PlainTextDocument)
corpus <- tm_map(corpus, toSpace, "-")
corpus <- tm_map(corpus, toSpace, ":")
corpus <- tm_map(corpus, removePunctuation)
corpus <- tm_map(corpus, toSpace, "'")
corpus <- tm_map(corpus, toSpace, "'")
corpus <- tm_map(corpus, toSpace, " -")
corpus <- tm_map(corpus,content_transformer(tolower))
corpus <- tm_map(corpus, removeNumbers)
corpus <- tm_map(corpus, removeWords, stopwords("english"))
corpus <- tm_map(corpus, stripWhitespace)
return(corpus)
}
这些报告通过应用以下函数进行转换：
docs_train<-corpus_treatment(docs_train)
docs_test<-corpus_treatment(docs_test)
将进行一项额外的分析，称为词干提取。词干提取过程是指删除词尾以检索词的根（或词干），这在不显著损失信息的情况下减少了数据的复杂性。
因此，动词argue将被缩减为词干argu，无论文本中该词的形式或复杂性如何。因此，其他形式如argued、argues、arguing和argus也将缩减到相同的词干。词干提取过程减少了需要考虑的单词数量，并提供了更好的频率表示。
词干提取过程使用的是SnowballC包：
library(SnowballC)
docs_train <- tm_map(docs_train,stemDocument)
docs_test <- tm_map(docs_test,stemDocument)
在预处理过程之后，考虑国家报告构建了一个矩阵（文档-词矩阵）。这个矩阵的每一行代表每个国家报告，每一列代表在它们上观察到的所有单词。
如果一个词出现在某个国家的报告中，则对应行和列的矩阵条目为 1，否则为 0。当记录文档内的多次出现时，即如果一个词在报告中出现两次，则在相关矩阵条目中记录为 2。
然而，一些提取的单个单词可能缺少原始文本中包含的重要信息，例如词与词之间的依赖关系和高频词周围的上下文。
例如，在报告中提取单词unemployment无法提供足够的信息来解释该术语是积极的还是消极的。因此，从报告中提取的是两个单词的组合，而不是单个单词。
以这种方式，可以在信用度较低的国家中找到一些可能更频繁出现的组合，例如高失业率。
我们将使用名为Rweka的包来提取单词组合：
library(RWeka)
创建以下函数以获取报告中1和2个单词的组合：
options(mc.cores=4)
BigramTokenizer <- function(x) NGramTokenizer(x, Weka_control(min = 1, max = 2))
现在获得了报告的训练和测试样本的文档-词矩阵。只有长度超过3个字符且小于20个字符的单词将被考虑：
tdm2_train <- TermDocumentMatrix(docs_train, control = list(tokenize = BigramTokenizer,wordLengths = c(3,20)))
在验证样本的情况下，我们将考虑在训练样本中找到的单词字典来计算矩阵。测试样本中找到的新单词将不予考虑。请记住，我们不能使用测试样本中找到的单词来开发模型，这意味着，现在我们应该假装测试样本不存在来训练算法。
因此，当在报告的测试样本上计算文档-术语矩阵时，我们应该在我们的函数中添加一个新参数：dictionary = Terms(tdm2_train)。这在上面的代码中显示：
tdm2_test <- TermDocumentMatrix(docs_test, control = list(dictionary = Terms(tdm2_train),tokenize = BigramTokenizer,wordLengths = c(3,20)))
让我们分析结果矩阵：
tdm2_train
## <<TermDocumentMatrix (terms: 609929, documents: 165)>>
## Non-/sparse entries: 2034690/98603595
## Sparsity : 98%
## Maximal term length: 20
## Weighting : term frequency (tf)
tdm2_test
## <<TermDocumentMatrix (terms: 609929, documents: 53)>>
## Non-/sparse entries: 504543/31821694
## Sparsity : 98%
## Maximal term length: 20
## Weighting : term frequency (tf)
第一行表示每个样本中不同术语的数量和报告的数量。每个矩阵的列数或术语数是相同的，属于我们在训练样本中找到的总单词列表。
总共有 609,929 个术语至少在国家报告的训练样本中出现过一次。
此外，在训练矩阵中，有 98,603,595 个单元格的频率为 0，而 2,034,690 个单元格具有非零值。因此，所有单元格中有 98%是零。这种情况在文本挖掘问题中非常常见。当一个矩阵包含许多零值单元格时，它被认为是稀疏矩阵。
removeSparseTerms函数将删除使用频率较低的单词，只留下语料库中最常用的单词。
在我们的情况下，我们将矩阵减少到最多保留 75%的空空间。这个过程必须只应用于我们稍后用于训练模型的那些数据：
tdm2_train2 <- removeSparseTerms(tdm2_train, 0.75)
tdm2_train2
## <<TermDocumentMatrix (terms: 6480, documents: 165)>>
## Non-/sparse entries: 589204/479996
## Sparsity : 45%
## Maximal term length: 20
## Weighting : term frequency (tf)
我们现在用于训练模型的矩阵有 6,480 个术语。
让我们观察我们的矩阵看起来是什么样子：
print(as.matrix(tdm2_train2[1:10, 1:4]))
## Docs
## Terms character(0) character(0) character(0) character(0)
## gj 0 0 0 0
## mwh 0 0 0 0
## ± ± 0 0 0 0
## à vis 1 1 1 5
## abil 0 1 1 2
## abl 0 1 1 0
## abl afford 0 0 0 0
## abolish 1 1 3 1
## abroad 2 4 3 0
## absenc 0 0 0 0
例如，单词abroad在第一份报告中出现了2次，在第二份报告中出现了4次。只需记住，在之前的步骤中已经进行了词干提取，所以只显示单词的根。矩阵中也包含单个单词和两个单词的组合。
在前面代码中显示的报告名称是按照我们最初用来导入报告的列表顺序排列的。具体来说，前四个文档属于以下：
print(head(as.character(train_list$root),4))
## [1] "../MachineLearning/CountryReports/2011/swp_austria_en_0.txt"
## [2] "../MachineLearning/CountryReports/2012/swd2012_austria_en.txt"
## [3] "../MachineLearning/CountryReports/2013/swd2013_austria_en.txt"
## [4] "../MachineLearning/CountryReports/2014/swd2014_austria_en_0.txt"
也可能获得术语及其频率的完整列表：
freq <- rowSums(as.matrix(tdm2_train2))
ord <- order(freq,decreasing=TRUE)
这是出现频率最高的术语列表：
freq[head(ord,20)]
## gdp rate increas market labour sector tax growth public
## 20566 16965 15795 15759 15751 15381 14582 14545 14515
## year employ energi invest measur govern debt bank term
## 13118 12481 12330 12027 11341 10903 10854 10668 10470
## averag social
## 10059 10051
为了可视化，我们可以创建一个包含我们文档中最频繁单词的词云图。为此，我们可以使用wordcloud包：
library(wordcloud)
set.seed(1234)
wordcloud(row.names(tdm2_train2), freq = freq, max.words=200,min.freq=4000,scale=c(2,.4),
random.order = FALSE,rot.per=.5,vfont=c("sans serif","plain"),colors=palette())
结果看起来就是这样：
看起来很漂亮，对吧？
现在，我们需要将之前的矩阵转换为以国家为行、术语为列。简而言之，我们需要转置训练和测试矩阵：
tdm2_train2 <- as.matrix(tdm2_train2)
dim(tdm2_train2)
## [1] 6480 165
tdm2_train2 <- t(tdm2_train2)
tdm2_test2<-as.matrix(tdm2_test)
tdm2_test2 <- t(tdm2_test2)
rm(tdm2_test)
再次，一些无关的对象被移除了：
rm(list=setdiff(ls(), c("macroeconomic_data","train_list","test_list","tdm2_test2","tdm2_train2")))
并且工作区再次保存为备份：
save.image("Backup7.RData")
到目前为止，我们已经处理了我们的报告，并从中提取了一些特征、术语和单词组合。尽管如此，目标变量，即国家评级，并不在我们新的数据集中。信用评级仅在macroeconomic_data样本中存在。
在下面的代码中，我们将为最近创建的训练和验证矩阵添加信用评级：
train_list<-merge(train_list[,c("Year","CountryName","year_report")],macroeconomic_data[,c("CountryName","Year","RatingMayT1")],by=c("CountryName","Year"),all.x=TRUE)
test_list<-merge(test_list[,c("Year","CountryName","year_report")],macroeconomic_data[,c("CountryName","Year","RatingMayT1")],by=c("CountryName","Year"),all.x=TRUE)
training <- cbind(train_list,tdm2_train2)
validation <- cbind(test_list,tdm2_test2)
由于我们模型中要训练的特征数量相当高（超过 6,000 个），我们将评估我们的特征与信用评级的相关性，以帮助排除其中的一些。
首先，我们将创建一个包含我们的术语列表和与信用评级相关性的数据框。前三个变量必须排除。以下代码显示了这一点：
head(colnames(training),7)
## [1] "CountryName" "Year" "year_report" "RatingMayT1" " gj"
## [6] " mwh" "± ±"
现在我们有了相关性，让我们按降序排列它们：
correlations<-data.frame(correlations)
colnames(correlations)<-c("word","correlation")
correlations$abs_corr<-abs(as.numeric(as.character(correlations$correlation)))
correlations<-correlations[order(correlations$abs_corr,decreasing = TRUE),]
correlations = matrix("NA",nrow=(ncol(training)-4),2)
ncolumns<-ncol(training)
for (i in 5:ncolumns)
{
correlations[i-4,1]<-colnames(training[i])
correlations[i-4,2]<- as.numeric(cor(training[,i],as.numeric(as.character(training[,"RatingMayT1"]))))
}
这里是信用评级相关性最高的前 10 个变量：
head(correlations,10)
## word correlation abs_corr
## 3245 judici -0.495216233392176 0.4952162
## 1175 court -0.4939081009835 0.4939081
## 132 administr -0.470760214895828 0.4707602
## 3710 migrant 0.460837714113155 0.4608377
## 1343 delay -0.46038844705712 0.4603884
## 468 background 0.455839970556903 0.4558400
## 116 adequ -0.445062248908142 0.4450622
## 2811 immigr 0.428818668867468 0.4288187
## 3246 judici system -0.42745138771952 0.4274514
## 6106 undeclar -0.419206156830568 0.4192062
显然，来自诸如司法等单词的judici词根与信用评级高度相关。负号表示在报告中出现频率非常高的特定单词的国家信用质量较低。
我们将只使用前 1,000 个单词来训练我们的模型。这里创建了一个包含前 1,000 个术语的列表：
list_vars<-dput(as.vector(correlations$word[1:1000]))
在训练模型之前，让我们再次保存工作空间：
save.image("Backup8.RData")
是时候训练模型了。选定的模型是一个纯 Lasso 模型，因为已经证明这种模型在列数或特征数较多的情况下效果良好，它作为一种变量选择的方法。
这种方法已经在第五章：预测银行失败 - 多变量分析中使用过，使用了h2o包。这次，我们仅为了学术目的使用glmnet包，目的是让读者可以应用不同的解决方案：
library(glmnet)
glmnet 包需要一个包含变量的矩阵和一个包含类别标签或目标值的向量。
让我们确保我们的目标变量是一个factor：
training$RatingMayT1<-as.factor(training$RatingMayT1)
validation$RatingMayT1<-as.factor(validation$RatingMayT1)
依赖变量和独立变量存储在不同的对象中，如下面的代码所示，以训练模型：
xtrain<-training[,list_vars]
ytrain<-training$RatingMayT1
与前面的代码一样，相同的步骤在验证样本中执行：
validation$RatingMayT1<-as.factor(validation$RatingMayT1)
xtest<-validation[,list_vars]
ytest<-validation$RatingMayT1
我们还将使用cv.glmnet函数在训练过程中，该函数自动执行网格搜索以找到 Lasso 算法中所需的λ的最佳值。
此函数中最重要的参数如下：
-
y：我们的目标变量，在本例中，是信用评级。 -
x：一个包含我们特征所有独立变量的矩阵。 -
alpha：在我们的情况下，值为1表示模型是 Lasso。 -
family：我们的响应变量的类型。如果目标变量只有两个水平，则应将family定义为binomial。在我们的情况下，由于我们的目标变量显示超过两个水平，因此应将family指定为multinomial。 -
type.multinomial：如果grouped，则对变量的multinomial系数使用分组 Lasso 惩罚。默认为ungrouped。 -
parallel：如果TRUE，算法将以并行方式处理。这意味着算法将不同的任务分割并同时执行，显著减少训练时间。
下面是使用当前数据的此函数的应用：
set.seed(1234)
ModelLasso <- cv.glmnet(y = ytrain, x=data.matrix(xtrain[,list_vars]), alpha=1,family='multinomial',type.multinomial = "grouped",parallel=TRUE)
在执行此代码的过程中，出现了一个警告信息：one multinomial or binomial class has fewer than 8 observations; dangerous ground。
问题在于我们对于目标变量中的所有类别都没有足够的观测数据。我们可以通过运行以下代码来检查目标变量中不同类别的数量：
table(ytrain)
## ytrain
## 1 2 3 4 5 6
## 5 23 33 32 34 38
对于评级1，只有5个观测值。因此，对于这个类别，可能不会期望有任何稳定的估计。
一种可能的解决方案是将评级1和2合并到同一个评级类别中：
ytrain<-gsub("1","2",ytrain)
ytest<-gsub("1","2",ytest)
现在，问题应该不会出现了：
table(ytrain)
## ytrain
## 2 3 4 5 6
## 28 33 32 34 38
set.seed(1234)
ModelLasso <- cv.glmnet(y = ytrain, x=data.matrix(xtrain[,list_vars]), alpha=1,family='multinomial',type.multinomial = "grouped")
模型训练完成后，以下图表有助于找到减少模型误差的lambda参数：
plot(ModelLasso)
根据以下图表，最优对数值大约为-3：
可以通过检查代码中的lambda_min变量来查看确切值：
log(ModelLasso$lambda.min)
## [1] -3.836699
正则化方法的目标是在准确性和简单性之间找到一个平衡点，这意味着要获得一个具有最小系数数量且也能给出良好准确率的模型。在这方面，cv.glmnet函数也有助于找到误差在最小误差一倍标准差内的模型。
这个lambda值可以在lambda.1se变量中找到。这个值将被选为我们模型的最终lambda值：
best_lambda <- ModelLasso$lambda.1se
print(best_lambda)
## [1] 0.05727767
现在，是时候评估我们模型的准确率了。首先，让我们看看训练样本：
predictLASSO_train <- predict(ModelLasso, newx = data.matrix(xtrain[,list_vars]),
type = "class", s = ModelLasso$lambda.1se)
predictLASSO_train<-as.data.frame(cbind(training[,1:2],ytrain ,predictLASSO_train))
colnames(predictLASSO_train)<-c("Country","Year","Rating","Prediction")
以下表格是训练样本的结果表：
table(predictLASSO_train$Rating,predictLASSO_train$Prediction)
## 2 3 4 5 6
## 2 27 0 0 0 1
## 3 1 32 0 0 0
## 4 0 1 30 0 1
## 5 0 0 0 33 1
## 6 0 0 0 1 37
现在，让我们看看验证样本的准确率：
predictLASSO_test <- predict(ModelLasso, newx = data.matrix(xtest),
type = "class", s = ModelLasso$lambda.1se)
predictLASSO_test<-as.data.frame(cbind(validation[,1:2],ytest ,predictLASSO_test))
colnames(predictLASSO_test)<-c("Country","Year","Rating","Prediction")
以下表格是验证样本的结果表：
table(predictLASSO_test$Rating,predictLASSO_test$Prediction)
## 2 3 4 5 6
## 2 5 3 1 0 1
## 3 1 7 1 0 0
## 4 0 0 7 0 3
## 5 0 1 1 8 2
## 6 0 0 0 2 10
考虑到我们使用了国家报告，结果似乎已经足够好。正如我们使用宏观经济数据训练模型时做的那样，我们将使用以下函数计算正确分类国家的百分比：
model_assessment<-function(data,model)
{
data$Observed<-as.numeric(as.character(data$Rating))
data$Predicted<-as.numeric(as.character(data$Prediction))
data$df<-abs(as.numeric(data$Predicted)-as.numeric(data$Observed))
comparison<-as.data.frame(table(data$df))
comparison$perc<-comparison$Freq/nrow(data)
colnames(comparison)<-c("notch","N",paste("perc_",model,sep=''))
comparison$N<-NULL
return(comparison)
}
让我们运行这个模型的评估：
model_assessment(predictLASSO_train,"Train_LASSO")
## notch perc_Train_LASSO
## 1 0 0.963636364
## 2 1 0.024242424
## 3 2 0.006060606
## 4 4 0.006060606
model_assessment(predictLASSO_test,"Test_LASSO")
## notch perc_Test_LASSO
## 1 0 0.69811321
## 2 1 0.18867925
## 3 2 0.09433962
## 4 4 0.01886792
Lasso 模型在验证样本中能够正确预测 69.81%的国家。由此得到的模型在仅使用宏观经济数据获得的结果上略有改进，达到了 67.86%的准确率。
最后，评估国家报告中出现并决定国家信用评级的最重要的术语是非常有趣的。
以下函数用于提取模型的系数：
coefs<-coef(ModelLasso, s = "lambda.1se")
结果是一个列表，列出了每个评级级别的不同系数。例如，信用评级 1 和 2（这些类别在此部分之前已合并）的系数被获得。这将在以下代码中显示：
coefs2<-coefs$`2`
list_coefs2<-as.data.frame(coefs2@Dimnames)
colnames(list_coefs2)<-c("variable","id")
list_coefs2$id<-as.numeric(row.names(list_coefs2))-1
aux_coefs2<-cbind(as.data.frame(coefs2@i),as.data.frame(coefs2@x))
colnames(aux_coefs2)<-c("id","coefficient")
list_coefs2<-merge(list_coefs2,aux_coefs2,by.x="id")
rm(coefs2,aux_coefs2)
这里显示了一些最相关的术语：
head(list_coefs2[order(list_coefs2$coefficient,decreasing = TRUE),],10)
## id variable coefficient
## 18 69 financ need 0.24991828
## 37 192 personnel 0.13635379
## 44 305 outflow 0.11243899
## 15 51 energi sector 0.06854058
## 24 97 minimum incom 0.05821313
## 39 216 gross extern 0.05237113
## 10 37 resolut 0.04807981
## 72 700 analyt 0.03036531
## 75 774 healthcar sector 0.02997181
## 26 102 social benefit 0.02572995
正面的迹象表明，一个术语在国别报告中出现的频率越高，该国的信用质量就越低。
让我们检查这是否被正确观察到。例如，模型检查了 2018 年塞浦路斯国别报告中包含financ need的一些句子。以下是报告的三个部分：
-
塞浦路斯似乎不面临立即的财政压力风险，这主要得益于其有利的财政地位。这主要归功于一般政府财政平衡和初级平衡的改善、低融资需求以及相对较低短期一般政府债务。这些因素超过了仍然相当大的公共债务。然而，宏观金融方面的短期风险仍然显著。
-
融资渠道有限和降低债务的需求仍然抑制了私营部门的投资。
-
公共债务显著下降，但仍然很高，2017 年约为 GDP 的 99%。高公共债务使塞浦路斯容易受到金融或经济冲击。然而，在经济调整计划期间，外部债权人提供的长期低息债务的大比例、当前低主权债券收益率以及相对较低的中期融资需求减轻了再融资风险。
在这三个部分中，去除了停用词，这也是找到financ need的原因。
对于最佳的评级类别，也可以得到不同的系数。这可以通过以下代码实现：
coefs6<-coefs$`6`
list_coefs6<-as.data.frame(coefs6@Dimnames)
colnames(list_coefs6)<-c("variable","id")
list_coefs6$id<-as.numeric(row.names(list_coefs6))-1
aux_coefs6<-cbind(as.data.frame(coefs6@i),as.data.frame(coefs6@x))
colnames(aux_coefs6)<-c("id","coefficient")
list_coefs6<-merge(list_coefs6,aux_coefs6,by.x="id")
rm(coefs6,aux_coefs6)
这里是我们找到的一些最相关的术语：
head(list_coefs6[order(list_coefs6$coefficient,decreasing = TRUE),],10)
## id variable coefficient
## 45 309 remaind 0.22800169
## 1 0 (Intercept) 0.20122381
## 7 20 govern balanc 0.15410796
## 81 899 stimulus 0.11734883
## 82 918 europ strategi 0.06968609
## 17 57 interest payment 0.05516403
## 49 367 fiscal posit 0.04272709
## 65 568 contribut rate 0.03101503
## 38 207 decad 0.03063200
## 2 6 background 0.03029957
还获得了一些示例报告的句子。例如，对于 2018 年的德国，以下句子包含govern balanc的组合：
-
德国一直改善其政府平衡，从 2014 年开始转变为盈余。
-
积极的政府平衡也反映在政府债务的下降上，2015 年达到 70.9%，进一步下降到 2016 年的 68.1%。
最后，为了以防万一你想以后使用，请备份所有你的模型：
save.image("Backup9.RData")
摘要
在本章中，你学习了文本挖掘和主题提取的一些基本概念。你现在应该知道如何读取文本文件并处理原始文本以获取有用的常用词。此外，你现在能够在自己的问题中使用以文本格式收集的信息。
根据您想要解决的数据量和问题类型，您现在可以应用本书中先前使用过的各种技术，无论是简单的还是复杂的。
最后，考虑到本章内容，你已经准备好深入探索其他更近和更有前景的技术，例如 word2vec 和 doc2vec，这两种都是高级技术，允许你在文本和文档中发现相关信息或主题。如果你对此感兴趣，可以进一步研究这些主题。
我希望你对机器学习有了深入的了解，并且这本书帮助你开始了使用机器学习解决问题的旅程。感谢阅读，祝您一切顺利！
浙公网安备 33010602011771号