统计学大灌篮-全-

统计学大灌篮（全）

原文：Statistics Slam Dunk

译者：飞龙

协议：CC BY-NC-SA 4.0

前置材料

前言

数据科学始于数据。我们收集数据。我们准备数据。我们使用数据在预测模型中。数据越好，模型越好，无论是基于传统统计学还是机器学习。

通过从原始数据和度量中创建新的数据和度量，通过操作数据，我们提高了模型性能和效率。这是特征工程的工作。

可视化帮助我们从数据中学习。它们展示了变量之间的关系。它们提出了有用的转换。它们指向数据中的建模问题、异常值和异常模式。

将这些放在一起——数据准备、特征工程和可视化——你就有了 Gary Sutton 的Statistics Slam Dunk: Statistical analysis with R on real NBA data的精髓。Sutton 借鉴了许多职业篮球的例子，为体育分析和数据科学提供了对探索性数据分析的全面介绍。

由于其众多包和工具，R 是这本书的明显选择。我们期待 Sutton 的工作会受到 R 爱好者的欢迎，尤其是那些希望从基础 R 过渡到tidyverse函数的人。R 编程的机制在Statistics Slam Dunk中得到了很好的说明。

许多人一直在等待 Dean Oliver 的Basketball on Paper的续集，Sutton 的书代表了这一方向的第一步。篮球涉及持续的活动，而不是有明显的开始和结束时间的比赛。篮球提出了从显然是团队努力中提取个人绩效指标的困难。解决篮球分析的特定问题始于篮球数据。

随着我们从一章跳到另一章，没有规定的顺序，我们听到 Sutton 说：“这里有关于美国职业篮球联赛中球员和球队的数据。让我们探索这些数据，看看概率论和统计学（以及经济学）的基本概念如何应用于这项运动。”通过精心设计的例子，他教我们关于建模最佳实践、经典推断、约束优化、处理异常值的方法、帕累托原则和 80-20 规则、主客场球队裁判偏见、防守是否赢得冠军、球员薪资支出转化为胜利记录的程度（除了纽约尼克斯队），以及表示收入不平等的基尼系数和洛伦兹曲线、随机性、蒙特霍尔问题，以及“手感热”的神话。这是一次有趣的旅程，值得体育迷和分析员一同体验。

相关的指标和大量的数据是当今体育领域以数据分析为导向的竞争优势的关键。无情的分析在经理和教练做出关于团队组成和比赛策略的决定时，以及为从准确预测比赛结果中受益的人提供服务时，都发挥着作用。从数据到决策或从数据到行动意味着用数据编程。真相在代码中——而且萨顿提供了大量的代码来证明这一点。

——托马斯·W·米勒博士

西北大学数据科学项目主任

《体育分析与数据科学：用方法和模型赢得比赛》一书的作者

前言

《统计学扣篮》至少是以下三个因素的交汇点。

首先，我非常想提高自己的 R 编程技能。作为一个组织的领导者，我花费时间指导和管理我的员工的工作，移除他们的障碍和其他挑战，制定目标，创建和交付高层演示，招聘（有时解雇）员工，准备和传达绩效评估，计算和分配年度薪酬调整和奖金，等等。换句话说，没有多余的时间来编写自己的代码，因此无法维持，更不用说提高我的编程技能了。

其次，我想满足一些我的求知欲。例如，我读过布赖恩·克里斯蒂安和汤姆·格里菲斯写的《算法改变生活：人类决策的计算机科学》中关于最优停止的内容；詹姆斯·苏罗维基的《群体的智慧》中关于大众智慧与专业人士和其他专家的比较；纳西姆·尼古拉斯·塔勒布关于幂律和林迪效应的内容，最著名的是在《随机之愚》、《黑天鹅》、《反脆弱》和《置身事内》中；以及吹捧休息带来绩效和生产率提升的案例研究，比如午睡和周五休息，以产生绩效和生产率提升。一路上，我一直想知道这些概念在职业篮球（我多年来在竞争性和非竞争性篮球中都有所涉猎，同时，作为一个年轻人，我对这项运动也有求知欲）中效果如何。此外，我对防守赢得冠军、比赛在第四节赢得、以及 NBA 薪资上限创造赛季内和赛季间平衡持长期怀疑态度，我想了解数据说了什么。最后，我想确定统计分析是否可以证明摆烂是有道理的，或者是否可以揭示裁判或官员的偏见。

第三，尽管我渴望（或需要？）提高自己的 R 技能，但我仍然相信我有值得传授给别人的专业知识和经验。

我最初的想法是将每一章组织成两个大致相等的部分：前半部分会用通俗易懂的语言总结我的发现，后半部分则大致相当于代码审查。会有适合每个人的内容！当我开始写我的书稿时，我最终意识到我实际上在写两本书……其中一本书的挑战性就足够大了。虽然我针对的是技术和非技术读者，但我的书可能没有足够的焦点来吸引任何人。从根本上说，我知道我在写一本编程和统计学书籍；我随后相应地重构了手稿，并更新了我的提案。

尽管如此，统计扣篮大赛与其他类似书籍不同。毕竟，我从一开始的总体目标就是写一本不同的书，这本书不能轻易与之前的手册相比较。每一章从开始到结束都像是一个真实世界的数据科学或统计学项目。

回到过去，我开始使用 SAS，但后来看到未来在于开源技术。我记不清为什么或如何选择了 R……而且从未回头——你也不应该。

致谢

虽然我的名字在封面上，但写书实际上是一个团队的努力。我想感谢以下人员，不仅是因为他们使这一切成为可能，还因为他们的贡献让统计扣篮大赛比原本更好：

• 首先和最重要的是，我的开发编辑，伊恩·豪，他让我保持专注，提供了极好的建议，并在我需要额外指导时总是可用（这经常发生）。

• 马兰·巴塞，曼宁的出版商，以及安迪·沃尔德伦，采购编辑，他们相信我，并接受了我关于这本书的异想天开的想法。

• 罗希特·戈斯瓦米，我的技术编辑，他提供了敏锐的见解，并鼓励我在这里展示的许多方法上进行详细阐述。当他建议我用pivot_longer()和pivot_wider()函数替换gather()和spread()函数时，他似乎特别高兴。罗希特是 Quansight Labs 的软件工程师，也是冰岛大学科学学院由 Rannis 资助的博士研究员。他是 rOpenSci 的活跃审稿人，并维护 R 的“软件工艺”课程。他博士研究的大部分工作集中在 R 工作流程以及使用Rcpp和Cpp11包与编译的 C++和 Fortran 的绑定。

• 艾利·梅约斯特，技术校对员，他检查了我的代码，并确保一切按设计工作。

• 亚历克斯·德拉戈萨夫列维奇，我的审稿编辑，他获得了审稿人并协调了同行评审流程。

• 保罗·韦尔斯和他的团队——特别是凯西·罗森兰、朱莉·麦克尼和梅洛迪·多拉布——在曼宁生产过程中出色地运行了统计扣篮大赛。

• 评审员们，他们投入了许多“空闲”时间阅读手稿并提供宝贵的反馈：Ayush Bihani、Bob Quintus、Chen Sun、Christian Sutton、David Cronkite、David Jacobs、Eli Mayost、George Carter、Giri Swaminathan、Jan Pieter Herweijer、John Williams、Juan Delgado、Kim Lokøy、Lachman Dhalliwal、Mark Graham、Maxim Volgin、Oliver Korten、Ravi Kiran Bamidi、Sander Zegveld、Simone Sguazza、Sleiman Salameh、Stefano Ongarello 和 Ulrich Gauger。

• 感谢托马斯·米勒博士为撰写前言并教我关于约束优化的知识（见第四章）。

• 在 Manning 早期访问计划（MEAP）期间购买书籍的参与者，他们提出了明智的问题，并指出了错别字和其他错误。

此外，对于那些“无声的英雄”表示感谢也是理所当然的，他们没有名声或金钱回报，却创建和分享数据集。他们是后续一切真正的推动者。

最后，我必须感谢我的妻子，Liane，她容忍了我情绪的波动（这些波动与我的非线性进展高度相关）以及我在整个旅程中的一般不可用。

关于这本书

统计扣篮与其他编程手册相当不同。其他类似的书通常按技术或方法组织；例如，可能会有关于常见数据处理操作的章节，另一章关于线性回归，另一章关于创建基本图表，等等。

没有什么是错的。然而，在现实世界中，没有数据处理项目、线性回归项目或数据可视化项目。统计扣篮是项目驱动的：从加载包到导入数据，再到数据处理、探索、可视化、测试和建模，每个章节都执行从零到预定义终点的所有操作。统计扣篮教你如何从始至终思考、设置和运行一个数据科学或统计项目。

第一，这是最重要的。第二，统计扣篮贯穿整个 NBA 数据集，试图在每一章中找到一些有用和相关的信息，这些信息应该可以转移到您自己的世界中。我的希望是统计扣篮是一种更有趣、更有效的学习 R 的方法。

应该阅读这本书的人

毋庸置疑，对 R 语言或至少对其他统计编程语言的一些先前接触将有助于您充分利用这本书。此外，对基本统计概念的基础知识、数据可视化的背景和最佳实践，以及甚至对篮球游戏的基本理解和一些对基本篮球统计数据的熟悉，都将是有益的。

然而，《统计学灌篮》假设的内容非常少。R 和 RStudio，R 的集成开发环境（IDE），都是免费下载的。《统计学灌篮》假设你可以下载软件，然后通过点击几次“下一步”来安装它。否则，每个操作都将以最适合那些在 R 或统计学方面几乎没有背景的本科生和研究生、有一定 R 经验但希望提升技能的初级或中级数据科学家和数据分析师，以及从其他编程语言过渡过来的数据科学家和数据分析师的详细程度进行解释。

话虽如此，对于已经熟悉 R 语言的读者来说，《统计学灌篮》中也有足够的内容。如果你熟悉 R，那么《统计学灌篮》将帮助你进一步巩固关键统计概念，展示如何创建主流之外的引人入胜的图形内容，并介绍你尚未接触过的包及其函数。

对于数据敏感的篮球迷以及那些在篮球领域工作的人来说，这本书的研究成果肯定会引起他们的兴趣——但你必须筛选数百行代码和辅助文本才能到达那里。你不需要对篮球运动有丝毫了解就能充分利用这本书，就像你不需要成为园艺学家才能使用鸢尾花数据集（它随 R 软件捆绑提供，并且比其他任何数据集更常用于展示各种技术）一样。关于篮球和数据集的任何你需要知道的内容都将详细解释。

这本书的组织方式：一个路线图

《统计学灌篮》分为 20 章。几乎每一章都是一个独立的项目或故事，有开始、结束和中间的情节。以第五章为例，我们检查和测试了勤奋对胜负的影响。每个操作都进行了详细解释和演示，从加载包、导入数据，到探索和整理数据，再到开发模型。

话虽如此，以下是按章节划分的概述：

• 第一章基本上是一种介绍。到结束时，你应该不仅感到舒适，而且对在 R 上投资学习感到兴奋。这一章没有包含任何代码。

• 第二章展示了如何最好地处理数据集，计算基本统计数据，以及可视化结果。你还将学习如何加载包、导入数据、整理和总结数据，以及使用内置和包装函数的组合来创建引人入胜的图形内容。

• 第三章是在前一章建立的基础上构建的。你将学习如何可视化均值和中位数，创建一个称为桑基图的流程图，设置和估计期望值分析，以及执行一个无监督学习问题，即层次聚类。

• 第四章演示了如何设置并完成一个约束优化问题。你还将学习如何最好地可视化数据分布，并在 R 代码中添加注释。

• 第五章演示了如何识别数据中的异常值，运行并解释正态性统计测试，计算并可视化连续变量之间的相关性，开发多重线性回归并解释结果，以及开发决策树并绘制相同的内容。

• 第六章展示了如何对数据集进行子集化，分离和连接数据集，以及重命名和转换变量，以及其他数据整理操作。此外，你还将学习如何应用许多数据可视化的最佳实践，包括一些小细节，这些细节可能会对你的观众产生重大影响。

• 第七章演示了如何运行、解释和可视化 t 检验，以及运行和解释补充效应量测试。

• 第八章介绍了最优停止规则，通常被称为 37%规则。此外，你还将学习如何从子字符串创建派生变量；创建频率表；向在ggplot2中创建的视觉图中添加主题，ggplot2是本书中使用的顶级图形包；将图像导入并嵌入到其他ggplot2内容中；以及在ggplot2折线图中添加多个趋势线。

• 第九章详细讨论了排列和组合——如何区分一个与另一个，以及如何计算相同的内容。你还将学习如何创建令人惊叹的、尽管有些不典型但仍然能够快速而引人入胜的视觉内容，包括小面板图、气球图和马赛克图；运行并解释分类数据的显著性统计测试；以及运行并解释相同数据的补充效应量测试。

• 第十章展示了如何计算成对连续变量之间的相关系数；执行相关测试；创建相关图、点图和棒棒糖图；通过转换和连接修改标签；以及处理数据中的缺失值。

• 第十一章演示了如何执行另一种无监督学习问题，即 K-means 聚类。你将学习如何计算和可视化竞争最优聚类数量，创建聚类，并绘制相同的内容。你还将学习如何创建克利夫兰点图，这是一种可能不典型但仍然能够快速而引人入胜的另一种可视化类型。

• 第十二章介绍了基尼系数以及如何使用洛伦兹曲线可视化不平等。你还将接触到显著性测试和效应量测试。

• 第十三章再次演示了如何计算和解释基尼系数，但使用的是与上一章不同的数据集。你还将学习如何创建替代的洛伦兹曲线，进行 t 检验（再次）和 F 检验，以及进行在先前章节中未展示的其他效应量测试。还包括有关创建for循环和编写你自己的函数的章节。

• 第十四章可能是书中最重和最技术性的章节。你将学习如何运行相关性测试并解释其结果；开发方差分析（ANOVA）模型；开发逻辑回归；理解并区分概率、优势比和对数优势；创建接收者操作特征（ROC）曲线；以及创建相当不寻常的箱线图。

• 第十五章主要致力于讨论 80-20 法则和创建帕累托图的替代方法。你还将学习如何创建小提琴图和成对直方图。

• 第十六章主要讨论了当其他人可能看到因果关系时的情况。你将了解拉普拉斯的后继法则，如何模拟抛硬币，以及如何将ggplot2对象插入到其他ggplot2对象中（一个非常酷的功能）。

• 第十七章以对三个竞争性的自动化探索性数据分析包的连续演示开始。还介绍了可以应用于ggplot2条形图的先进功能和美学技术。

• 第十八章介绍了几种统计分散性的度量，并讨论了为什么或如何最好地使用它们。你还将学习如何计算客户流失率以及如何创建金字塔图。

• 第十九章介绍了几种数据标准化或归一化的方法，并讨论了为什么以及如何应用它们。你还将学习如何着色数据框并突出观察结果，以及如何比较两个数据集的内容。

• 第二十章是对第二章至第十九章之间应用的技术进行回顾，并总结这些技术沿途产生的结果。这不是逐章重述，而是一个对本书中经常涵盖的九个学习领域的关键发现进行整合，包括聚类分析、显著性检验、效应量检验、建模、运筹学、概率、统计分散性、标准化以及汇总统计和可视化。

这显然是对这些章节的高层次描述。"Statistics Slam Dunk" 展示了许多前述列表中没有提到的数据处理操作——例如，如何删除列或行；如何将数据从长格式转换为宽格式或反之；如何按组总结数据；如何从条件逻辑创建段；以及如何操作日期格式，仅举几例。"Statistics Slam Dunk" 还包含大约 300 个可视化效果和大约 40 种图表类型，其中大多数是在 ggplot2 或 ggplot2 扩展中开发的。通常，让听众理解其他技术或方法的结果的最佳和最有效的方式是通过创建图形内容。创建引人入胜的可视化可能很困难。采用最佳实践并应用细节处理（添加标题和副标题、添加字幕、注释你的可视化、重新格式化标签、操作坐标轴等）有时可能更加困难。几乎每个 "Statistics Slam Dunk" 章节都教授这些技术的一些子集。

关于代码

代码与文本交织在一起。通常情况下，代码会先被解释，然后是对结果的总结或讨论。书中出现了许多函数，包括内置的和打包的；因此，随着函数和代码的重复，解释性文本逐渐减少，假设你已经阅读了前面的章节。然而，当你认为需要提醒时，你将定期遇到详尽的重复。本书中的源代码以 fixed-width font like this 的格式呈现，以与普通文本区分开来。在许多情况下，原始源代码已被重新格式化；我们添加了换行并重新调整了缩进，以适应书中的页面空间。

您可以从本书的 liveBook（在线）版本中获取可执行的代码片段，链接为 livebook.manning.com/book/statistics-slam-dunk。代码和数据集可在以下 GitHub 位置找到：github.com/garysutton/statisticsplaybook。书中脚本的完整代码也可从 Manning 网站下载：www.manning.com/books/statistics-slam-dunk。

liveBook 讨论论坛

购买《统计学扣篮》包括免费访问 liveBook，Manning 的在线阅读平台。使用 liveBook 的独特讨论功能，您可以在全球范围内或针对特定章节或段落附加评论。为自己做笔记、提出和回答技术问题，以及从作者和其他用户那里获得帮助都非常简单。要访问论坛，请访问livebook.manning.com/book/statistics-slam-dunk/discussion。您还可以在livebook.manning.com/discussion了解更多关于 Manning 的论坛和行为的规则。

Manning 对我们读者的承诺是提供一个场所，在这里个人读者之间以及读者与作者之间可以进行有意义的对话。这不是对作者参与特定数量活动的承诺，作者对论坛的贡献仍然是自愿的（且未付费）。我们建议您尝试向作者提出一些挑战性的问题，以免他的兴趣转移！只要这本书还在印刷中，论坛和先前讨论的存档将可通过出版社的网站访问。

关于作者

Gary Sutton 在多个垂直领域建立了并领导了表现优异的商业智能和分析组织，在这些组织中，R 语言是统计分析、预测建模和其他定量洞察的首选编程语言。Sutton 先生在南加州大学获得了本科学位，在乔治·华盛顿大学获得了硕士学位，并在西北大学获得了第二个硕士学位，主修数据科学。他是一位热心的读者，前铁人三项运动员，以及前篮球运动员。

关于封面插图

《统计学扣篮》封面上的图像是“Homme Koraik”，或“Koryaks Man”，取自 Jacques Grasset de Saint-Sauveur 的收藏，1788 年出版。每一幅插图都是手工精心绘制和着色的。

在那些日子里，仅凭人们的服饰就能轻易地识别出他们居住的地方以及他们的职业或社会地位。Manning 通过基于几个世纪前丰富多样的地域文化的书封面来庆祝计算机行业的创新精神和主动性，这些文化通过像这样的一些收藏品中的图片被重新呈现出来。

1 开始

本章涵盖

• R 和 RStudio 的简要介绍

• R 相对于其他编程语言的竞争优势

• 未来的期待

数据正在改变企业和其他组织的工作方式。在过去，挑战在于获取数据；现在挑战在于理解它，从噪音中筛选出信号，并为决策者提供可操作的见解。我们这些与数据打交道的人，尤其是在前端——统计学家、数据科学家、商业分析师等等——有许多编程语言可供选择。

R 是一种用于切片和切块大型数据集、进行显著性统计测试、开发预测模型、生成无监督学习算法和创建高质量视觉内容的常用编程语言。无论是初学者还是专业人士，无论是组织内部还是多个垂直领域，都依赖 R 的强大功能来生成推动有目的行动的见解。

本书提供了使用 R 语言发现和生成一系列独特且引人入胜见解的端到端和分步指南。实际上，本书在几个有意义的方面与其他你可能已经熟悉的手册有所不同。首先，本书按项目组织，而不是按技术组织，这意味着启动和完成一个离散项目所需的任何和所有操作都包含在每个章节中，从加载包到导入和整理数据，再到探索、可视化、测试和建模数据。你将学习如何从始至终思考、设置和运行一个数据科学或统计学项目。

其次，我们仅使用从网络上下载或抓取的可用数据集进行工作——有时需要支付少量费用——这些数据集当然是在没有任何预先了解内容可能如何分析的情况下创建的。换句话说，我们的数据集不是即插即用的。这实际上是一件好事，因为它提供了介绍与特定数据可视化方法和统计测试方法相关的各种数据整理技术的机会。你将学习如何将看似不同的操作结合起来，而不是孤立地学习这些技术。

第三，说到数据可视化，您将学习如何创建专业级别的图表和其他视觉内容——不仅仅是条形图和时间序列图，还有树状图、桑基图、金字塔图、分面图、克利夫兰点图和洛伦兹曲线等，仅举几个可能不在主流但仍然比您可能习惯的内容更有吸引力的可视化。通常，讲述故事或传达结果最有效的方式是通过图片而不是文字或数字。您将获得创建数十种图表类型和其他视觉内容的详细说明，其中一些使用基础 R 函数，但大多数来自 R 的顶级图形包ggplot2。

第四，这本书贯穿了职业篮球的主题；这是因为所有数据集实际上都是 NBA 数据集。每章中介绍的技术不仅仅是目的本身，而且是通过这些技术最终揭示 NBA 独特而迷人的洞察力的手段——所有这些都可以完全应用到您自己的专业或学术工作中。最终，这本书提供了一种更愉快、更有效的学习 R 语言的方法，并进一步巩固了统计概念。话虽如此，让我们深入探讨；以下部分提供了进一步背景信息，这将使您最好地准备应对本书的剩余部分。

1.1 R 和 RStudio 的简要介绍

R 是一种开源且免费的编程语言，由统计学家于 1993 年推出，用于其他统计学家。R 在执行统计计算（毫不奇怪）方面始终获得高分，产生引人注目的可视化，处理大量数据集，并支持广泛的监督和非监督学习方法。

近年来，为 R 创建了几种集成开发环境（IDE），其中源代码编辑器、调试器和其他实用工具结合成一个单一的图形用户界面。到目前为止，最受欢迎的 GUI 是 RStudio。

您不需要 RStudio。但想象一下没有现代便利设施的生活，比如自来水、微波炉和洗碗机；这就是没有 RStudio 优势的 R。同样，RStudio 也是免费下载的。本书中的所有代码都是在 RStudio 1.4.1103 上编写的，它运行在 R 4.1.2 之上，在装有 Big Sur 操作系统 11.1 版本的 Mac 笔记本电脑上。顺便说一下，R 和 RStudio 在 Windows 和 Linux 桌面上运行得同样好。

你应该首先下载并安装 R(cran.r-project.org)，然后同样安装 RStudio(www.rstudio.com)。通过下载库、编写脚本、运行代码以及在 RStudio 中直接查看输出，你将间接与 R 交互。RStudio 界面分为四个面板或窗口（见图 1.1）。脚本编辑器位于左上角；这是你导入数据、安装和加载库（也称为包）以及编写代码的地方。脚本编辑器下方是控制台。

图 1.1 RStudio 界面的快照。代码在左上角面板中编写；程序在左下角面板中运行；绘图窗口在右下角面板中；创建的对象的运行列表在右上角面板中。通过偏好设置，你可以设置背景颜色、字体和字体大小。

控制台的外观和操作方式与基本的 R 界面相似；这是你查看脚本编辑器输出的地方，包括错误信息和警告（如有）。控制台旁边，在 RStudio 界面的右下角，是绘图窗口；这是你查看在脚本编辑器中创建的视觉化的地方，如果你选择的话，可以调整它们的大小，并将它们导出到 Microsoft Word、PowerPoint 或其他应用程序。然后是环境窗口，它记录了在脚本编辑器内部创建的对象——数据框、tibbles（R 特有的数据框类型）和可视化。

RStudio 还可以在云端运行(login.rstudio.cloud)，并且几乎可以通过任何网络浏览器访问。如果你的本地机器资源不足，这可能是一个不错的选择。

1.2 为什么选择 R？

数字宇宙的规模正沿着指数曲线而不是线性线扩展；最成功的企业和组织是那些比其他企业收集、存储和使用数据更多的企业；当然，我们知道 R 已经并且一直是全球统计学家、数据科学家和商业分析师近 30 年的首选编程语言。但为什么你应该投资时间磨练你的 R 技能，当有几种开源和商业替代品时？

1.2.1 可视化数据

这本书包含大约 300 个左右的图表。通常，分析数据最有效的方法是将其可视化。在将汇总数据转换为专业外观的视觉内容方面，R 绝对是一流的。因此，我们先从图片而不是数字开始讨论。

几个预包装的数据集包含在 R 的基础安装中。本书不使用这些对象中的任何，但在这里，mtcars 数据集——一个只有 32 行 11 列的对象——足以帮助展示 R 图形能力的强大。mtcars 数据是从 1974 年的一期《汽车趋势》杂志中提取的；该数据集包含美国、欧洲和日本制造的 32 种汽车型号的性能和其他数据。

以下可视化以 mtcars 作为数据源（见图 1.2）；它们是用ggplot2包创建的，然后使用patchwork包组合成一个 2×2 的矩阵。这两个包，尤其是ggplot2，在整本书中都被广泛使用。（关于包的更多内容，稍后将会介绍。）

图 1.2 使用ggplot2包对汽车数据的可视化

我们的视觉化包括顶部的一个相关图和分面图，以及底部的一个条形图和直方图，具体描述如下：

• 相关图—相关图显示了一对连续或数值变量之间的关系。两个连续变量之间的关系或关联可以是正的、负的或中性的。当为正时，变量朝同一方向移动；当为负时，两个变量朝相反方向移动；当为中性时，两者之间没有任何有意义的关系。

• 分面图—分面图是一组子图，它们共享相同的水平和垂直轴（分别对应 x 轴和 y 轴）；因此，每个子图必须其他方面都相同。数据通过数据中的组（通常称为因素）进行分割或分段。分面图为数据中的每个因素绘制一个子图，并在其自己的面板中显示。我们绘制了箱线图来显示每加仑行驶英里数在气缸数和变速器类型上的分布情况。

• 条形图—条形图，通常称为条形图，使用矩形条来显示离散或分类数据的计数。数据中的每个类别或因素都由其自己的条表示，每个条的长度对应于它所表示的值或频率。条形通常垂直显示，但可以将条形图的方向翻转，使条形水平显示。

• 直方图—有时被误认为是条形图，直方图是单个连续变量分布的图形表示。它显示在指定区间内的数据计数或频率，这些区间通常被称为箱。

我们可以从这四个可视化中轻易得出几个有趣和有意义的结论：

• 每加仑行驶英里数与重量之间存在强烈的负相关，相关系数为-0.87；也就是说，重量较重的汽车每加仑行驶的英里数比重量较轻的汽车少。回归线的斜率表示两个变量，如每加仑行驶英里数和重量，之间的相关性有多强，或者不强，这个相关性是在-1 到+1 的范围内计算的。

• 气缸数较少的汽车每加仑行驶的英里数比气缸数较多的汽车多。此外，特别是对于拥有四个或六个气缸的汽车，手动变速的汽车比自动变速的汽车每加仑行驶的英里数更多。

• 根据汽车的前进挡位数，每加仑行驶英里数存在显著差异；例如，拥有四个前进挡的汽车比只装备三个前进挡的汽车每加仑多行驶 8 英里。

• mtcars 数据集中 32 个品牌和型号的每加仑行驶英里数的分布似乎呈正态分布（想想一个钟形曲线，其中大部分数据集中在平均值或平均数周围）；然而，大约每加仑行驶 20 英里或更少的汽车比其他汽车多。丰田卡罗拉的每加仑行驶英里数最高，而凯迪拉克 Fleetwood 和林肯 Continental 在每加仑行驶英里数最低上并列。

R 在数据可视化领域的声誉归功于可以创建的大量图表、图表、图形、图表和地图的数量以及它们的美学质量；这绝不是由于易用性。R，特别是ggplot2包，赋予你定制任何视觉对象和应用最佳实践的能力。但是，定制也带来了复杂性，例如以下内容：

• 关于分面图，例如，创建了成对的箱线图，并根据汽车发动机的气缸数进行划分，仅为了创建代表总体平均值的白色点（否则ggplot2在箱线图内打印一条水平线以表示中位数），就调用了具有六个参数的额外函数。还调用了另一个函数，以便ggplot2返回表示变速类型的 x 轴标签，而不是自动的 0 和手动的 1。

• 条形图，一个相对简单的视觉对象，尽管如此，仍然包含几个定制选项。数据标签不是默认可用的；添加它们需要调用另一个函数，并决定它们的字体大小和位置。由于这些数据标签是添加在每个条形图上方的，因此有必要延长 y 轴的长度，这又需要另一行代码。

• 当你创建直方图时，ggplot2并不会自动返回一个具有理想数量分箱的图表；相反，这需要你自己去确定，通常这需要一些实验。此外，y 轴上的刻度是硬编码的，只包括整数；默认情况下，ggplot2返回一半刻度的分数值，这对于直方图来说显然是没有意义的。

本书提供了逐步指导，说明如何创建这些以及其他大约三打种ggplot2可视化类型，它们符合最高美学标准，并且包含足够的功能和装饰，以传达清晰和引人入胜的信息。

1.2.2 安装和使用软件包以扩展 R 的功能范围

无论你想执行或需要执行哪种操作，有很大可能性其他程序员已经在你之前做过。也有很大可能性，那些程序员中的一位随后编写了一个 R 函数，将其打包成软件包，并使其易于你和其他人下载。R 的软件包库正在迅速扩展，这要归功于世界各地那些习惯使用 R 开源平台的程序员。简而言之，程序员将他们的源代码、数据和文档打包成软件包，然后将最终产品上传到中央仓库，以便我们其他人下载和使用。

到本书写作时为止，综合 R 档案网络（CRAN）中存储了 19,305 个软件包。大约三分之一是在 2022 年发布的；另外三分之一是在 2019 年至 2021 年之间发布的；剩余的三分之一是在 2008 年至 2018 年之间发布的。图 1.3 中显示的ggplot2条形图揭示了 CRAN 按出版年份可用的软件包数量。（请注意，软件包的可用数量与发布的数量不同，因为许多软件包已经过时。）条形图内部白色方框标签表示截至 2023 年 3 月的总软件包数量的百分比；例如，2021 年发布的所有软件包中，有 3,105 个仍然在 CRAN 中，这代表了总软件包数量的 16%。

图 1.3：CRAN 中按出版年份显示的软件包数量

显然，新软件包的发布速度正在不断增加；实际上，2023 年的新软件包数量预计将接近甚至超过 12,000 个。这意味着平均每天有大约 33 个新软件包。R-bloggers 是一个拥有数百个教程的流行网站，它每月发布一个包含 40 个新软件包的排行榜，仅为了帮助程序员筛选所有的新内容。这些数字在商业软件世界中无疑会让人们感到头晕目眩。

软件包的安装非常简单：只需一行代码或 RStudio GUI 内的几个点击即可安装一个。这本书将向你展示如何安装软件包，如何将软件包加载到你的脚本中，以及如何利用现在可用的最强大的软件包之一。

1.2.3 与其他用户进行网络连接

R 程序员在网络上非常活跃，寻求支持并得到它。这种网络活动的热潮有助于你纠正代码中的错误，克服其他障碍，并提高生产力。在统计学家、数据科学家和其他程序员聚集寻求技术支持的网站 Stack Overflow 上进行的一系列搜索，返回了大约 450,000 条关于 R 的搜索结果，而五个主要商业替代品（JMP、MATLAB、Minitab、SAS 和 SPSS）的总和仅占其中的一小部分，大约 20%。

在完全披露的精神下，另一种开源编程语言 Python 返回的搜索结果比 R 多得多——实际上要多得多。但请记住，尽管 Python 经常用于数据科学和统计计算，但它实际上是一种通用编程语言，也用于开发应用程序接口、网络门户甚至视频游戏；而另一方面，R 严格用于数值计算和数据分析。因此，将 R 与 Python 进行比较，就像比较苹果和橘子一样。

1.2.4 与大数据交互

如果你需要或预期需要与典型的大数据技术栈（例如，Hadoop 用于存储，Apache Kafka 用于摄取，Apache Spark 用于处理）交互，R 是你分析层最佳选择之一。实际上，在“最佳大数据编程语言”的 Google 搜索结果中，前 10 名都列出了 R 作为首选选择，而之前提到的商业平台（除 MATLAB 外）都没有被提及。

1.2.5 找到一份工作

R 程序员有一个健康的工作市场。Indeed 的搜索结果显示，在美国有近 19,000 个 R 程序员的职位机会，比 SAS、Minitab、SPSS 和 JMP 的总和还要多。这是一个单一国家在特定时间点的快照，但这个观点仍然成立。（注意，许多 SAS 和 SPSS 的职位机会是在 SAS 或 IBM 的工作。）其中一部分机会是由世界上一些领先的技术公司发布的，包括亚马逊、苹果、谷歌和 Meta（Facebook 的母公司）。图 1.4 中所示的 ggplot2 条形图可视化了完整的结果。由于之前提到的原因，没有包括 Python 的工作机会。

图 1.4 对于 R 程序员来说，有一个健康的工作市场。

1.3 这本书是如何工作的

如前所述，本书的组织结构是这样的，即以下每一章都是一个独立的项目——除了最后一章，它是对整本书的总结。这意味着从设计到完成的每个项目所需的操作都包含在每个章节中。下面的流程图或过程图提供了一个可视化的快照，展示了您接下来可以期待的内容（见图 1.5）。

图 1.5 典型的章节流程，以及不无巧合的是，大多数现实世界数据科学和统计项目从开始到结束的典型流程

我们只使用基础 R 函数——也就是说，在完成 R 和 RStudio 安装后立即可用的现成函数——将包加载到我们的脚本中。毕竟，不能本末倒置，也不能在没有先安装和加载包的情况下调用包内的函数。之后，我们依赖内置和包内函数的混合，强烈倾向于后者，尤其是在准备和整理我们的数据集以及创建视觉内容方面。

我们每章的开始都会提出一些假设。这可能是一个随后根据测试结果予以拒绝或未能拒绝的零假设。例如，在第七章中，我们的初始假设是主队和客队之间的个人犯规和尝试罚球之间的差异是由于偶然造成的。然后我们拒绝这个假设，并在我们的显著性统计测试返回获得相等或更极端结果的低概率时假设裁判存在偏见；否则，我们未能拒绝那个相同的假设。或者，它可能仅仅是一个必须通过应用其他方法来证实或否认的假设。以第十五章为例，我们假设 NBA 球队数量和比赛数量与赢得的比赛数量之间存在非线性关系，然后创建帕累托图，即单位频率和累积频率的视觉展示，来呈现结果。另一个例子是第十九章，我们假设通过季节标准化每场比赛的平均得分——即把原始数据转换为共同和简单的尺度——肯定会对 NBA 得分王的非常不同的历史视角提供帮助。

然后，我们开始编写我们的脚本。我们每个脚本都是从加载所需的包开始的，通常是通过调用 library() 函数来实现。在加载之前，包必须被安装，在调用其函数之前也必须被加载。因此，没有硬性要求在 R 脚本前加载任何包；如果这是你的偏好，它们可以逐个加载。但将我们的假设视为战略计划，将包视为代表战术或短期步骤的一部分，这些步骤帮助我们实现更大的目标。我们选择在开始时加载包反映了我们深思熟虑地规划了从起点到终点的细节。

接下来，我们通过调用 readr 包中的 read_csv() 函数导入我们的数据集或数据集，就像 ggplot2 一样，它是 tidyverse 包宇宙的一部分。这是因为我们所有的数据集都是从公共网站下载的 .csv 文件，或者是从抓取的数据创建的，然后复制到 Microsoft Excel 中并保存为 .csv 扩展名。

这本书展示了如何执行几乎任何你需要的数据整理操作，通常是通过调用 dplyr 和 tidyr 函数，这些函数也是 tidyverse 的一部分。你将学习如何转换或重塑数据集；通过行或列对数据进行子集化；在必要时按组总结数据；创建新变量；以及将多个数据集合并成一个。

本书还展示了如何应用最佳的数据探索性分析（EDA）实践。EDA 是对数据集的初步但彻底的质询，通常是通过将基本统计的计算与相关性图、直方图和其他视觉内容相结合来进行的。在整理完数据并在测试或分析数据之前，熟悉你的数据总是一个好习惯。我们主要调用基础 R 函数来计算基本统计量，如平均值和中位数；然而，我们几乎完全依赖于 ggplot2 函数甚至 ggplot2 扩展来创建一流的视觉呈现。

我们随后测试或至少进一步分析我们的数据。例如，在第五章中，我们开发了线性回归和决策树模型，以隔离哪些 hustle 统计指标——如 loose balls recovered（回收的松球）、passes deflected（被挡回的传球）、shots defended（防守的射门）等——对胜负有统计学上的显著影响。在第九章中，我们运行了卡方检验，这是一种针对两个分类变量的统计或假设检验，以确定前一天的休息日安排是否有助于决定谁获胜。或者让我们考虑第三章，在那里我们开发了一种称为 层次聚类 的无监督学习算法，以确定球队是否应该对前五顺位选秀和任何其他首轮选秀有非常不同的职业预期。或者看看第十六章，在那里我们通过“仅仅”应用一些硬核分析技术来评估所谓的“手感”现象，而不进行任何正式的测试。

最后，我们提出了我们的结论，这些结论与我们的假设相联系：是的（或不是），官员倾向于主场球队；是的（或不是），休息对胜负有影响；是的（或不是），防守实际上赢得冠军。我们的结论往往是可操作的，因此，它们自然演变成一系列建议。如果某些 hustle 统计指标比其他指标更重要，那么球队应该针对这些指标进行训练；如果球队希望通过业余选秀加强阵容，并且如果故意输球以提升选秀名单，以便选择最佳可用球员是有意义的，那么球队就应该这样做；进攻应该围绕 24 秒投篮时钟内的得分概率来设计。

在深入本书的其余部分之前，这里有一些注意事项和其他需要考虑的要点。首先，有些章节的顺序并不完全连续，例如，数据整理和 EDA 之间的界限并不清晰。数据整理操作可能贯穿始终；可能需要准备一个数据集作为探索其内容的先决条件，但可能还需要进行其他数据整理以创建可视化。关于结论，它们并不总是保留到章节末尾才揭晓。此外，第三章基本上是第二章的延续，第十一章是第十章的延续。这些一对一的断裂是为了将这些章节的长度限制在合理的页数范围内。然而，相同的流程或过程适用，你将在第二章中学到与第三章一样多的知识，同样在第十章中学到的知识与第十一章一样多。我们将从探索首轮选秀和其随后职业轨迹的数据集开始。

摘要

• R 是一种由统计学家为统计学家开发的编程语言；它是一种仅用于处理数字和分析数据的编程语言。

• RStudio 是一个图形用户界面（GUI）或集成开发环境（IDE），用于控制 R 会话。使用 RStudio 安装和加载包、编写代码、查看和分析结果、调试错误以及生成专业质量的报告，这些任务都变得更加容易。

• 面对许多竞争的替代方案——开源和商业——R 在执行统计计算、创建优雅的视觉内容、管理大型和复杂的数据集、创建回归模型和应用其他监督学习方法、以及进行细分分析和其他类型的无监督学习方面，仍然是最佳解决方案。作为一名 R 程序员，你的限制只在于你的想象力。

• R 的功能性一直在，并且一直在飞速增长。包扩展了 R 的功能范围，现在在 CRAN 上可用的超过一半的包都是在过去三年内开发的。下一代程序员——在西北大学、伯克利大学或其他一些课程自然聚焦于开源和免费技术的大学或学院学习的学生——很可能会在可预见的未来保持 R 当前的轨迹。

• 没有可以拨打的 1-800 客服电话，但你有 Stack Overflow、GitHub 和其他类似网站，可以在这些网站上与其他 R 程序员互动并获得解决方案，这比任何一天请求一级分析师仅仅打开一个支持工单要好得多。

• R 是使与大数据技术交互变得用户友好的编程语言之一。

• 在当今的市场上，对 R 程序员的需求很高。高等教育与私营行业之间持续的双赢关系创造了一个基于 R 的课程和 R 工作的恶性循环，这种循环在未来几年可能会自我延续。

2 探索数据

本章涵盖了

• 加载包

• 导入数据

• 数据整理

• 探索和分析数据

• 写入数据

本章和下一章是一套组合——我们将在本章探索一个真实的数据集，然后在第三章中从中获得实际应用。探索性数据分析（EDA）是一个过程——实际上是一系列过程——通过计算基本统计量和创建相同数据的图形表示来对数据集进行质询。我们不会在过程中画任何大笔触；相反，我们将分析的重点放在一个单一变量上，这是一个称为赢分的性能指标，并发现赢分如何与我们数据中的其他变量相关联。我们在下一章中的初始假设将直接与本章的发现相联系。在这个过程中，我们将展示如何最好地利用 R 的力量彻底探索一个数据集——任何数据集。

但首先，我们必须完成加载包、导入我们的数据集以及整理和整理数据的强制任务。如果你没有将 大部分 时间投入到“无形”的任务中，这些任务有时会感觉像苦力活——理解时间分配并不一定与代码行数相关——那么你很可能在做一些错误的事情。不幸的是，数据并不总是为了后续的分析需求而收集和存储的；整理和整理数据有助于我们避免不良或误导性的结果。尽管如此，我们将介绍一些将对我们未来大有裨益的操作，在这个过程中，你将学到很多关于赢分和其他 NBA 数据的知识。

2.1 加载包

我们首先调用 library() 函数来加载允许我们调用基础产品中不可用的函数的包。你通过仅使用内置函数，并没有充分利用 R 的优势。这可能无需多言，但包必须在将它们加载到脚本中并调用它们的函数之前安装。这就是为什么我们保留脚本的最顶部来加载我们之前安装的包。为了明确起见，当你安装 R 时，你只安装了基础产品；任何需要超越基础 R 特性和功能的后续需求都需要持续安装包，通常是从 Comprehensive R Archive Network (CRAN) 安装，但偶尔也会从 GitHub 安装。

通过调用基础 R 的 install.packages() 函数，并在一对单引号或双引号之间传递包名作为参数来安装包，如下所示：

install.packages("tidyverse")

为了避免混淆 R，我们在引用整行代码时使用双引号，并在必要时在内部使用单引号引用代码的一部分。

虽然包只需要安装一次，但每次你计划使用它们时都必须加载它们。包扩展了 R 的功能和函数，而不会修改或以其他方式影响原始代码库（今天没有人想修改它）。以下是本章中我们计划使用的包的概述：

• dplyr 和 tidyr 包包含了用于操作和整理数据的许多函数。这两个包都是 tidyverse 包宇宙的一部分。这意味着你可以一次调用 library() 函数，并传递 tidyverse 包，R 将自动加载 dplyr、tidyr 以及 tidyverse 的其他所有包。

• ggplot2 包包含了 ggplot() 函数，用于创建优雅的视觉内容，其效果远胜于大多数现成的图表。此外，ggplot2 包还包含了一些其他函数，用于修剪你的可视化效果，总体来说，这些函数在基础 R 中没有等效功能。ggplot2 包也是 tidyverse 的一部分。

• readr 包用于快速轻松地读取或导入由分隔符分隔的矩形数据；readr 是 tidyverse 的一部分。矩形数据等同于结构化数据或表格数据；它仅仅意味着数据是有行和列组织的。一个 分隔符文件 是一种平面文件，其中的值由一个特殊字符或字符序列分隔；它们通常保存为具有扩展名，该扩展名指示数据是如何分隔的。我们将仅使用之前保存为 .csv 扩展名的文件。一个 .csv，或 逗号分隔值 文件，是一个使用逗号作为分隔符的 Microsoft Excel 文件。

• reshape2 包包含了使数据在宽格式和长格式之间转换变得容易的函数——这同样只需要一行代码。数据通常会被转换以适应特定的分析方法或可视化技术。

• sqldf 包用于编写 SELECT 语句和其他结构化查询语言（SQL）查询。SQL 是一种编程语言，它提供了一种主要标准化的方式与存储数据交互。那些从其他编程语言迁移过来的人可能会发现，R 支持 SQL 是一种安慰；然而，我们将逐渐引导你从 sqldf 转向 dplyr。

• patchwork 包使得将两个或更多可视化组合成一个单一图形对象变得非常简单——这同样只需要一行代码。

在下面的部分中，library() 函数被调用了四次，用于加载我们已安装的四个包。请注意，在调用 library() 函数时，不需要在包名周围使用一对引号：

library(tidyverse)
library(reshape2)
library(sqldf)
library(patchwork)

要运行一行或多行代码——顺便说一句，这些代码应该在脚本编辑器面板中输入——使用鼠标指针突出显示代码，然后在脚本编辑器的顶部点击运行。如果你在 Mac 上工作，可以按住 Control 键并按 Return 键。

2.2 导入数据

来自 readr 包的 read_csv() 函数用于导入以 .csv 扩展名保存的平面文件形式的数据集。只要数据局限于单个工作表（可以将 Microsoft Excel 文件想象成一个可以包含一个或多个工作表的工作簿），R 就能很好地读取 .csv 文件。否则，R 会抛出错误。read_csv() 函数只需要传递一个参数：文件名，前面是它的存储位置，由一对单引号或双引号包围。

然而，如果你之前设置了工作目录并在该位置部署了文件，你只需传递包括扩展名的文件名即可。你可以通过调用 setwd() 函数来设置工作目录，通过调用 getwd() 函数来获取之前设置的工作目录；setwd() 和 getwd() 都是基础 R 函数。当你调用 read_csv() 函数时，R 会自动导航你的文件夹结构，搜索你的工作目录，并导入你的文件。

以下代码行导入了一个名为 draft 的 .csv 文件，因为它存储在我们的工作目录中，并通过赋值运算符 (<-) 将其设置为与对象相同的名称。这个数据集是从 data.world 网站下载的，包含了 2000 年至 2009 年业余选秀中每个 NBA 第一轮选秀的信息：

draft <- read_csv("draft.csv")

NBA 选秀是什么？

对于可能不熟悉 NBA 的你来说，选秀是一个年度活动，在赛季间隙举行，各队轮流从美国和海外选择合格的球员。如今，选秀只有两轮。除非球队之间进行交易，否则每个队在每轮中只能选择一次，顺序由前一年的成绩决定，最差的球队可以首先选择。

确认数据导入成功并同时返回数据集维度的快速简单方法是通过调用基础 R 的 dim() 函数：

dim(draft)
## [1] 293  26

我们的数据集包含 293 行和 26 列。任何以一对井号（#）开头的内容都是 R 随后为我们返回的复制粘贴内容。现在我们有了数据集，我们将在探索、分析和从中得出一些有意义的结论之前对其进行处理。

2.3 处理数据

在现实世界中，你导入的大多数数据集可能都不完美；因此，绝对有必要执行一系列操作，将数据转换成干净整洁的对象，然后才能进行适当的准确分析。最常见的数据处理操作包括以下内容：

• 通过将列聚集到行或将行扩展到列来重塑或转置数据布局

• 通过行满足某些逻辑标准对数据进行子集化

• 通过列对数据进行子集化以删除多余数据

• 通过数学运算总结您的数据，通常按数据集中的其他变量分组

• 创建新变量，通常是从数据中的一个或多个原始变量派生出来的

• 将变量从一种类型转换为另一种类型，例如，从数值转换为日期或从字符字符串转换为分类

• 更改变量名

• 替换属性

• 将您的数据与一个或多个其他数据集合并或连接

我们将从删除不必要的列或变量开始。

2.3.1 删除变量

我们的第一步数据整理操作是从草稿数据集中删除多余的变量。大部分情况下，我们正在删除不会影响我们分析的职业统计数据。这是一个纯粹的选择性操作，但始终是最佳实践只保留您需要的，丢弃其他所有内容。当处理大型数据集时，删除无关或冗余数据绝对可以提高计算效率。

在以下代码行中，我们调用了来自 dplyr 包的 select() 函数以及来自基础 R 的 c() 函数：

draft <- select(draft,-c(3,4,16:24))

select() 函数用于通过变量名或索引选择或取消选择变量；c() 函数用于将多个参数组合成一个向量。我们调用 select() 函数通过移除变量来对草稿数据集进行子集化，这些变量通过在数据集中从左到右的位置表示，传递给 c() 函数（注意前面的减号 [-] 操作符）。在 R 中，通常有多种方法可以“剥猫皮”，这是一个例子：

• 变量名可以替换为位置编号。这实际上是一种最佳实践，应该是首选方法，除非要删除的变量数量过多或存在特殊情况。事实上，其中一些变量包含会导致 R 错误的字符，因此我们这次选择调用位置编号而不是变量名。

• 减号操作符可以移除，然后可以将要包含的变量名或位置作为参数传递给 c() 函数。

• 可以使用基础 R 函数代替 dplyr 代码。

我们将根据情况应用所有这些替代方案。

2.3.2 删除观测值

下一行代码删除了草稿中的观测值（即行或记录）90 和 131，原因很简单，这些观测值包含不完整的数据，否则会中断正在进行的操作。记录大部分为空白，因此消除了数据插补或其他纠正措施作为选项：

draft <- draft[-c(90, 131),]

现在我们已经通过首先删除不必要的变量然后删除大部分不完整的观测值来减少了草稿的维度，接下来我们将查看我们的数据并执行更有意义的数据整理操作。

2.3.3 查看数据

dplyr 的 glimpse() 函数，其中我们的数据集名称作为唯一的参数传递，返回数据的转置视图。在这个视图中，列显示为行，行显示为列，这使得在 RStudio 控制台中查看每一列成为可能；这在处理宽数据集时特别有用。

glimpse() 函数还返回每个变量的类型或类，以及在顶部，对象的维度：

glimpse(draft)
## Rows: 289
## Columns: 18
## $ Rk       <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1...
## $ Year     <fct> 2009, 2009, 2009, 2009, 2009, 2009, 2009, 2009, ...
## $ Pk       <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1...
## $ Tm       <fct> LAC, MEM, OKC, SAC, MIN, MIN, GSW, NYK, TOR, MIL...
## $ Player   <chr> "Blake Griffin", "Hasheem Thabeet", "James Harde...
## $ Age      <dbl> 20.106, 22.135, 19.308, 19.284, 18.252, 20.144, ...
## $ Pos      <chr> "F", "C", "G", "G-F", "G", "G", "G", "C-F", "G-F...
## $ Born     <fct> us, tz, us, us, es, us, us, us, us, us, us, us, ...
## $ College  <chr> "Oklahoma", "UConn", "Arizona State", "Memphis",...
## $ From     <fct> 2011, 2010, 2010, 2010, 2012, 2010, 2010, 2010, ...
## $ To       <fct> 2020, 2014, 2020, 2019, 2020, 2012, 2020, 2017, ...
## $ G        <dbl> 622, 224, 826, 594, 555, 163, 699, 409, 813, 555...
## $ MP       <dbl> 34.8, 10.5, 34.3, 30.7, 30.9, 22.9, 34.3, 18.8, ...
## $ WS       <dbl> 75.2, 4.8, 133.3, 28.4, 36.4, -1.1, 103.2, 16.4,...
## $ WS48     <dbl> 0.167, 0.099, 0.226, 0.075, 0.102, -0.015, 0.207...
## $ Born2    <fct> USA, World, USA, USA, World, USA, USA, USA, USA,...
## $ College2 <fct> 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, ...
## $ Pos2     <chr> "F", "C", "G", "G-F", "G", "G", "G", "C-F", "G-F...

草稿数据集现在有 291 行长和 15 列宽（与原始的 293 × 26 维度相比），包含数值变量（int 和 dbl）和字符字符串（chr）的组合。

或者（或附加地），当调用基础 R 的 head() 和 tail() 函数时，R 返回数据集的前 n 行和后 n 行。这在 glimpse() 函数的转置输出不够直观时特别有用。默认情况下，R 为这两个函数显示数据集的前六行或后六行。以下两行代码返回了草稿数据集的前三行和后三行：

head(draft, 3) 
      Rk Year     Pk Tm    Player        Age Pos   Born  College
## <dbl> <dbl> <dbl> <chr> <chr>       <dbl> <chr> <chr> <chr>
## 1   1 2009      1 LAC   Blake Grif...  20.1 F     us    Oklaho...
## 2   2 2009      2 MEM   Hasheem Th...  22.1 C     tz    UConn  
## 3   3 2009      3 OKC   James Hard...  19.3 G     us    Arizon...
     From    To     G    MP    WS   WS48
##  <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl>
## 1 2011  2020    622  34.8  75.2  0.167
## 2 2010  2014    224  10.5   4.8  0.099
## 3 2010  2020    826  34.3 133\.   0.226

tail(draft, 3)
        Rk Year     Pk Tm    Player        Age Pos   Born  College
##   <dbl> <dbl> <dbl> <chr> <chr>       <dbl> <chr> <chr> <chr>
## 1   291 2000     27 IND   Primo_ Bre...  20.3 C     si    0     
## 2   292 2000     28 POR   Erick Bark...  22.1 G     us    St. Jo...
## 3   293 2000     29 LAL   Mark Madsen  24.2 F     us    Stanfo...
     From    To     G    MP    WS   WS48
##  <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl>
## 291  2002   2010    342  18.1  10.8 0.084
## 292  2001   2002     27   9.9   0.2 0.027
## 293  2001   2009    453  11.8   8.2 0.074

我们现在的一些字符字符串或数值变量应该转换为因子变量。我们将在下一步处理这个问题。

2.3.4 转换变量类型

一些字符字符串和数值变量实际上是分类变量或因子，即使它们没有被归类为这样的类型；这是因为它们只能取已知或固定的值集。以变量 Year 为例，我们可以提供一个例子。我们已经确定我们的数据集包括关于 2000 年至 2009 年 NBA 第一轮选秀的信息；因此，Year 只能等于 2000 年至 2009 年之间的某个值。或者，以变量 Tm 为例，它是 Team 的缩写。NBA 中只有这么多支球队；因此，Tm 有一个固定的可能性集合。如果您计划建模或可视化数据，将变量转换为真正的分类因子几乎是强制性的。

现在看看接下来的几行代码。在 R 中，$ 运算符用于从选定的数据集中提取或子集变量。例如，在这段代码的第一行中，我们正在从草稿数据集中提取或子集变量 Year，并将其转换为因子变量：

draft$Year <- as.factor(draft$Year)
draft$Tm <- as.factor(draft$Tm)
draft$Born <- as.factor(draft$Born)
draft$From <- as.factor(draft$From)
draft$To <- as.factor(draft$To)

为了直接确认这些操作中的任何一个，从而间接确认其他操作，我们接下来调用基础 R 的 class() 函数，并传递草稿变量 Year。我们可以看到，Year 现在实际上是一个因子变量。glimpse() 函数可以作为替代再次调用：

class(draft$Year)
## "factor"

很快，我们将围绕这些变量的一些水平或组来可视化和分析我们的数据，这些变量现在是因子。

2.3.5 创建派生变量

我们已经删除了变量并将其他变量转换为因子变量。接下来，我们将创建变量——实际上三个变量——并将它们依次追加到草稿数据集的末尾。对于前两个变量，我们将同时使用 dplyr mutate() 函数和基础 R 的 ifelse() 函数。这个强大的组合使得我们可以对一个或多个原始变量执行逻辑测试，并根据测试结果向新变量添加属性。对于第三个变量，我们将复制一个原始变量，然后通过调用 dplyr 的 recode() 函数来替换新变量的属性。

让我们从变量 Born 开始；这是一个两字节变量，表示球员的出生国家，例如，us 等于美国。

在以下代码块的第一行中，创建了一个新的或派生变量，称为 Born2。如果原始变量 Born 中的值等于 us，则草稿中相同的记录应等于 USA；如果 Born 中的值等于除 us 之外的其他任何值，则 Born2 应该等于 World。第二行代码将变量 Born2 转换为因子变量，因为每个记录只能取两个可能值之一，并且我们即将进行的分析实际上将按这些相同的级别进行分组：

mutate(draft, Born2 = ifelse(Born == "us", "USA", "World")) -> draft
draft$Born2 <- as.factor(draft$Born2)

注意顺便说一下，= 和 == 运算符并不相同；第一个是赋值或数学运算符，而第二个是逻辑运算符。

现在，让我们处理变量 College，它等于在草稿数据集中每个 NBA 第一轮选秀球员最后就读的大学或学院，无论他们可能注册了多长时间，无论他们是否毕业。然而，并非每个球员都就读过大学或学院；对于那些没有就读的球员，College 等于 NA。在 R 中，NA 或不可用相当于缺失值，因此不能忽略。在下一行代码中，我们调用基础 R 的 is.na() 函数将每个 NA 替换为 0。

在第二行代码中，我们再次调用 mutate() 和 ifelse() 函数来创建一个新变量 College2，并添加从原始变量 College 导出的值。如果该变量等于 0，则 College2 中也应等于 0；另一方面，如果 College 等于其他任何值，则 College2 应该改为等于 1。第三行代码将 College2 转换为因子变量：

draft$College[is.na(draft$College)] <- 0 
mutate(draft, College2 = ifelse(College == 0, 0, 1)) -> draft
draft$College2 <- as.factor(draft$College2)

最后，对变量 Pos（代表球员的位置）进行快速检查，揭示了另一个整理的机会——前提是我们之前在调用 glimpse() 函数时没有获得相同的信息。对基础 R 的 levels() 函数的调用返回 Pos 中的每个唯一属性。请注意，levels() 只与因子变量一起工作，因此我们将 levels() 与 as.factor() 函数结合使用，临时将 Pos 从一个类转换为另一个类：

levels(as.factor(draft$Pos))
## [1] "C" "C-F" "F" "F-C" "F-G" "G" "G-F"

我们很容易看出，例如，一些球员打中锋和前锋（C-F），而其他球员打前锋和中锋（F-C）。不清楚被标记为 C-F 的球员是否主要是中锋，而被标记为 F-C 的球员是否主要是前锋——或者这只是粗心大意的数据录入的结果。无论如何，这些球员由于体型和技能集而打相同的两个位置。

在接下来的代码的第一行中，我们创建了一个名为Pos2的新变量，它是Pos的精确副本。在接下来的几行代码中，我们调用recode()函数将Pos2属性替换为新的属性，如下所示（注意，我们在变量名周围应用引号，因为至少目前，Pos2仍然是一个字符串）：

• C被替换为Center。

• C-F和F-C被替换为Big。

• F被替换为Forward。

• G被替换为Guard。

• F-G和G-F被替换为Swingman。

然后，我们将变量Pos和Pos2转换为因子。最后，我们将Pos2传递给levels()函数以确认我们的重编码按计划进行：

draft$Pos2 <- draft$Pos
draft$Pos2 <- recode(draft$Pos2, 
                     "C" = "Center", 
                     "C-F" = "Big", 
                     "F" = "Forward", 
                     "F-C" = "Big", 
                     "F-G" = "Swingman", 
                     "G" = "Guard", 
                     "G-F" = "Swingman") 
draft$Pos <- as.factor(draft$Pos)
draft$Pos2 <- as.factor(draft$Pos2)
levels(draft$Pos2)
## [1] "Big"      "Center"   "Forward"  "Guard"    "Swingman"

在完成所有这些纠缠和整理工作——至少暂时如此——之后，对我们的工作数据集进行基准设置是有意义的，我们将在下一步进行。

2.4 变量分解

在删除了一部分原始变量、将其他变量转换为因子以及创建了三个新变量之后，选秀数据集现在包含以下 18 个变量：

• Rk—仅记录计数器，最大值为 293。当导入选秀数据集时，有 293 条记录，其中Rk从 1 开始，然后随着每条后续记录的增加而递增。由于数据不完整，随后删除了两条记录，从而将选秀的长度减少到 291 条记录，但Rk中的值在删除后保持不变。

• Year—表示球员在 NBA 选秀中被选中的年份，最小为 2000 年，最大为 2009 年。就其本身而言，data.world数据集实际上涵盖了 1989 年至 2016 年的 NBA 选秀；然而，10 年的数据对于我们的目的来说已经足够了。因为我们的意图（见第三章）是最终追踪职业轨迹，2009 年是一个合理甚至必要的截止点。我们有时会根据变量Year对数据进行分组总结。

• Pk—仅包含第一轮选区的草稿数据集。因此，这是第一轮的选区号或抽签号，例如，数字 7 表示第七个整体抽签。我们特别关注变量Pk的赢分；我们预计在首轮高选球员与其他首轮较晚选中的球员之间会看到差异。

• Tm—做出选秀选择的简写队名——例如，NYK代表纽约尼克斯或GSW代表金州勇士。

• Player—被选球员的姓名，采用名-姓格式（例如，斯蒂芬·库里）。

• Age—球员被选中时的年龄；例如，斯蒂芬·库里在 2009 年被勇士队以第七顺位选中时，年龄为 21.108 岁。

• Pos—每位球员的位置或位置，以缩写格式表示。

• Born—每位球员出生的国家，以缩写格式表示。

• College—每位球员在成为职业球员之前最后就读的大学或学院。当然，许多球员，尤其是那些在国外出生的球员，没有上大学；在这种情况下，记录现在等于 0。

• From—每位球员的第一个职业赛季，例如，2010 年等于 2009-10 赛季。典型的 NBA 常规赛从十月中旬开始，到下一年历年的四月中旬结束。因为选秀数据集从 2000 年的选秀开始，所以最小值等于2001。

• To—包含球员统计数据的最后一个赛季。这里的最大值是2020。

• G—每位球员在 2000-01 赛季至 2019-20 赛季之间参加的常规赛总场数。

• MP—每位球员在常规赛每场比赛的平均出场时间。

• WS—每位球员在 2000-01 赛季至 2019-20 赛季之间累积的胜利份额。胜利份额是一种高级统计数据，用于量化球员对其球队成功的贡献。它将每位球员的原始统计数据与球队和联盟统计数据相结合，产生一个代表每位球员对其球队胜利贡献的数字。任何球队的个人胜利份额总和应大致等于该球队的常规赛胜利总数。斯蒂芬·库里在 2009 年至 2020 年之间累积了 103.2 个胜利份额。换句话说，大约有 103 场金州勇士队在 10 年间的常规赛胜利与库里在进攻和防守上的表现有关。接下来的 EDA 大部分将关注胜利份额，包括其与其他变量的关联。

• WS48—每位球员每 48 分钟累积的胜利份额。NBA 比赛时长为 48 分钟，只要它们在常规时间内结束且不需要加时。

• Born2—不在原始数据集中。这是一个派生变量，如果一名球员出生在美国，则等于USA；如果球员出生在美国以外，则等于World。

• College2—不在原始数据集中。这是一个派生变量，如果球员没有上大学或学院，则等于0；如果上了大学，则等于1。

• Pos2—不在原始数据集中。这是一个派生变量，等于每位球员的完整位置名称，以便例如F-G和G-F都等于Swingman。

一支 NBA 球队可能有多达 15 名球员在其活跃名单上，但一次只能有 5 名球员上场。球队通常有两名后卫、两名前锋和一名中锋；更重要的是，还有控球后卫和得分后卫，以及小前锋和强力前锋，如以下所述：

• 控球后卫——篮球中的四分卫；他负责组织进攻，通常是最好的传球手和运球手。

• 得分后卫——通常是球队最好的射手和得分手。

• 小前锋——通常是一个非常多才多艺的球员；他可以在内线或外线得分，并防守矮个或高个球员。

• 大前锋——通常是一个好的防守者和篮板球手，但不一定是很好的射手或得分手。

• 中锋——球队最高的球员；他通常被指望防守篮筐、封盖投篮和篮板球。

草案数据集不区分控球后卫和得分后卫，也不区分小前锋和大前锋；但它确实突出了那些打多个位置的比赛者。摇摆人是一个能够打得分后卫或小前锋的球员，而大前锋是一个能够打大前锋或中锋的球员。

调用head()函数返回新改进的草案数据集中的前六个观测值：

head(draft)
        Rk Year     Pk Tm    Player            Age Pos    Born 
##   <dbl> <fct> <dbl> <fct> <chr>           <dbl> <fct> <fct>
## 1     1 2009      1 LAC   Blake Griffin    20.1 F     us   
## 2     2 2009      2 MEM   Hasheem Thabeet  22.1 C     tz   
## 3     3 2009      3 OKC   James Harden     19.3 G     us   
## 4     4 2009      4 SAC   Tyreke Evans     19.3 G-F   us   
## 5     5 2009      5 MIN   Ricky Rubio      18.3 G     es   
## 6     6 2009      6 MIN   Jonny Flynn      20.1 G     us   
     College       From  To        G    MP    WS   WS48
##   <chr>        <fct> <fct>  <dbl> <dbl> <dbl>  <dbl>
## 1 Oklahoma      2011  2020    622  34.8  75.2  0.167
## 2 UConn         2010  2014    224  10.5   4.8  0.099
## 3 Arizona State 2010  2020    826  34.3 133\.   0.226
## 4 Memphis       2010  2019    594  30.7  28.4  0.075
## 5 0             2012  2020    555  30.9  36.4  0.102
## 6 Syracuse      2010  2012    163  22.9  -1.1 -0.015
     Born2 College2  Pos2 
##   <fct> <fct>    <fct>
## 1 USA   1        Forward 
## 2 World 1        Center  
## 3 USA   1        Guard   
## 4 USA   1        Swingman
## 5 World 0        Guard   
## 6 USA   1        Guard

现在是时候探索和分析我们数据中的win shares和其他变量了。

2.5 探索性数据分析

再次强调，探索性数据分析（EDA）通常是计算基本统计量和创建视觉内容的混合。就我们的目的而言，特别是作为第三章的引言，接下来的 EDA 工作将集中在单个变量win shares上，但仍然提供了关于win shares与许多剩余的草案数据集变量相关联或未相关联的见解。因此，我们对草案数据集的调查将是一个单变量（一个变量）和多变量（多个变量）练习的组合。

2.5.1 计算基本统计量

基础 R 的summary()函数被调用以启动对草案数据集的探索和分析，这个过程将主要关注变量win shares；这是因为我们最终感兴趣的是了解当win shares与其他数据集中的变量挂钩时，球队可以从他们的选秀中期待多少生产力。summary()函数为草案中的每个变量返回基本统计信息。对于连续的或数值变量，如win shares，summary()函数返回最小值和最大值、第一四分位数和第三四分位数以及中位数和均值；对于如Born2这样的分类变量，另一方面，summary()函数返回每个级别的计数。为了详细说明，就连续变量而言

• 最小值代表最低值。

• 最大值代表最高值。

• 均值是平均值。

• 中位数是当数据按升序或降序排列时的中间值。当数据包含偶数个记录时，中位数是两个中间数的平均值。

• 第一四分位数是下四分位数；当数据按升序排列时，下四分位数代表 25%的分界点。

• 第三四分位数也称为上四分位数；再次强调，当数据按升序排列时，上四分位数代表 75%的分位数。

话虽如此，我们最终调用summary()函数：

summary(draft)
##       Rk             Year           Pk              Tm     
## Min.   :  1.0   2006   : 30   Min.   : 1.00   BOS    : 13  
## 1st Qu.: 73.5   2008   : 30   1st Qu.: 8.00   CHI    : 13  
## Median :148.0   2009   : 30   Median :15.00   POR    : 13  
## Mean   :147.3   2000   : 29   Mean   :15.12   MEM    : 12  
## 3rd Qu.:220.5   2003   : 29   3rd Qu.:22.00   NJN    : 12  
## Max.   :293.0   2004   : 29   Max.   :30.00   PHO    : 12  
##                 (Other):114                   (Other):216
##   Player               Age         Pos          Born    
## Length:291         Min.   :17.25   C  :42   us     :224  
## Class :character   1st Qu.:19.33   C-F:10   es     :  6  
## Mode  :character   Median :21.01   F  :88   fr     :  6  
##                    Mean   :20.71   F-C:24   br     :  4  
##                    3rd Qu.:22.05   F-G:10   si     :  4  
##                    Max.   :25.02   G  :95   de     :  3  
##                                    G-F:22   (Other): 44  
##   College               From           To     
## Length:291         2005   : 31   2020   : 46  
## Class :character   2009   : 31   2019   : 24  
## Mode  :character   2002   : 30   2013   : 23  
##                    2004   : 29   2017   : 23  
##                    2006   : 29   2015   : 22  
##                    2007   : 28   2018   : 18  
##                    (Other):113   (Other):135  
##       G                MP              WS              WS48         
## Min.   :   6.0   Min.   : 4.30   Min.   : -1.60   Min.   :-0.32600  
## 1st Qu.: 248.0   1st Qu.:15.60   1st Qu.:  4.05   1st Qu.: 0.05000  
## Median : 549.0   Median :21.60   Median : 19.60   Median : 0.07900  
## Mean   : 526.4   Mean   :21.53   Mean   : 29.35   Mean   : 0.07592  
## 3rd Qu.: 789.5   3rd Qu.:27.70   3rd Qu.: 43.85   3rd Qu.: 0.10600  
## Max.   :1326.0   Max.   :38.40   Max.   :236.10   Max.   : 0.24400  
##   Born2     College2       Pos2   
## USA  :224   0: 73    Center  :42  
## World: 67   1:218    Big     :34  
##                      Forward :88  
##                      Swingman:32  
##                      Guard   :95  

最有趣和有意义的收获包括以下内容：

• 职业胜利份额的差异极大。在 2000 年至 2009 年的 NBA 选秀中，至少有一位首轮新秀在其整个职业生涯中积累了负数的胜利份额。有球员积累了超过 236 个胜利份额。

• 其他职业统计数据也存在显著差异，尤其是常规赛比赛数和每场常规赛的平均分钟数。

• 回到胜利份额，平均值（对异常值或远离总体中心的观测值特别敏感）显著大于中位数，这表明平均值被数据集中的少数超级巨星所扭曲。

• 2000 年至 2009 年的首轮 NBA 选秀球员在选秀时的年龄在 17.25 至 25.02 岁之间。

• 在选秀中，超过四分之三的球员，确切地说，291 位球员中的 224 位，出生在美国。

• 几乎相同数量的球员——确切地说，218 位球员——曾就读于大学或学院。

然而，还有一些基本统计数据，summary()函数并没有返回。例如，基础 R 中的sd()函数计算连续变量（如常规赛比赛数G、每场常规赛的分钟数MP和职业生涯胜利份额WS）的标准差。再次强调，$运算符告诉 R 只计算并返回指定变量的结果：

sd(draft$G)
## [1] 319.6035
sd(draft$MP)
## [1] 7.826054
sd(draft$WS)
## [1] 33.64374

标准差是衡量数据相对于平均值的分散程度的指标。标准差低意味着数据集中在平均值附近；相反，标准差高意味着数据更分散。如果这些数据呈高斯分布或正态分布（想想钟形曲线），那么在大约 68%的选秀数据集中的球员将位于平均值的±一个标准差范围内，95%的球员将位于平均值的±两个标准差范围内，除了一两名球员外，所有球员都将位于平均值的±三个标准差范围内。以每场常规赛的分钟数为例——大约 68%的球员的平均分钟数可能在 13.71 至 29.35 分钟之间，这等于总体均值±标准差。我们可以通过平方标准差或通过将变量名传递给基础 R 的var()函数来得到任何连续变量的方差。

2.5.2 返回数据

在以下代码块中，我们通过调用sqldf包中的sqldf()函数运行一系列独立的SELECT语句。我们的目的是深入数据并获取summary()和其他函数不返回的一些具体信息：

sqldf("SELECT min(WS), Player, Tm, Pk, Year FROM draft")
##   min(WS)        Player  Tm Pk Year
## 1    -1.6 Mardy Collins NYK 29 2006
sqldf("SELECT max(WS), Player, Tm, Pk, Year FROM draft")
##   max(WS)       Player  Tm Pk Year
## 1   236.1 LeBron James CLE  1 2003
sqldf("SELECT min(G), Player, Tm, Pk, Year FROM draft")
##   min(G)          Player  Tm Pk Year
## 1      6 Pavel Podkolzin UTA 21 2004
sqldf("SELECT max(G), Player, Tm, Pk, Year FROM draft")
##   max(G)         Player  Tm Pk Year
## 1   1326 Jamal Crawford CLE  8 2000
sqldf("SELECT min(MP), Player, Tm, Pk, Year FROM draft")
##   min(MP)       Player  Tm Pk Year
## 1     4.3 Julius Hodge DEN 20 2005
sqldf("SELECT max(MP), Player, Tm, Pk, Year FROM draft")
##   max(MP)       Player  Tm Pk Year
## 1    38.4 LeBron James CLE  1 2003
sqldf("SELECT min(Age), Player, Tm, Pk, Year FROM draft")
##   min(Age)       Player  Tm Pk Year
## 1   17.249 Andrew Bynum LAL 10 2005
sqldf("SELECT max(Age), Player, Tm, Pk, Year FROM draft")
##   max(Age)          Player  Tm Pk Year
## 1   25.019 Mamadou N'Diaye DEN 26 2000

SELECT和FROM子句标识了要从哪个数据源中提取哪些变量。例如，第一个SELECT语句从草案中检索变量win shares等于数据集最小值的记录，返回赢分、球员的全名、选他的球队、选秀号码以及他被选中的年份。SELECT语句——易于编写且通常运行迅速——当你只需要一个数据点或可能是一短列表的记录时效果最佳。如果你需要创建一个可以随后用作进一步分析源的数据对象，dplyr是一个更好的选择。从现在起，我们将将注意力集中在赢分上，从一些频率分布分析开始。

2.5.3 计算和可视化频率分布

拉取数据是有建设性的。但可视化数据就像踩下油门——图片显示了变量之间的关系，显示了异常值，并展示了仅凭数字无法向我们揭示的趋势。特别是，频率分布是连续数据计数的视觉显示。它们通常以绝对频率或原始数据的表示形式显示，但有时相同的数据会被转换，以便显示百分比或比例。我们将使用直方图和箱线图来可视化原始数据，然后展示如何编写sqldf和dplyr代码以获得额外的见解。

直方图

毫无疑问，最常用的方法来可视化连续变量（如win shares）的频率分布是使用直方图；因此，绘制直方图是一个逻辑上的起点。直方图是表示一个连续变量分布的图形表示；它将数据划分为我们所说的“箱”，然后显示每个箱中观察值的频率或计数。

本章中的每个可视化都是使用ggplot2包创建的；ggplot2，既优雅又强大，是 R 在数据可视化领域领先的一个重要原因。构建ggplot2可视化非常类似于制作婚礼蛋糕——ggplot()函数建立基础，然后其他函数提供糖霜和装饰。请注意，在连续调用各种ggplot2函数以添加、更改或增强基本构建时，存在加号或加法运算符（+）：

• ggplot()函数初始化一个ggplot2对象。传递给ggplot()的第一个参数是数据源的指针，当然，是草案数据集。第二个参数是对aes()函数的调用，它定义了应该绘制哪些变量以及它们应该映射到哪些绘图参数或轴。

• geom_histogram() 函数——geom 是几何对象的简称——告诉 R 通过将 x 轴划分为指定数量的箱并计算每个箱内的观测值来可视化单个连续变量的分布。箱应着色并填充相同的皇家蓝色。

• labs() 函数为 x 轴和 y 轴添加标题、副标题和标签。

• theme() 函数将粗体字体应用于标题，以替代默认的普通字体。

• 基础 R 的 print() 函数打印出直方图，称为 p1；同时，仅 p1 本身也会执行相同的操作。

我们的直方图（见图 2.1）提供了对赢分数据的快照，只需几秒钟，就可以通过简单地观察数据行来了解分布，否则这将花费更长的时间，并可能导致错误的结论：

p1 <- ggplot(draft, aes(x = WS)) + 
  geom_histogram(fill = "royalblue3", color = "royalblue3", 
                 bins = 8) + 
  labs(title = "Career Win Shares Distribution of
       NBA First-Round Selections",
       subtitle = "2000-09 NBA Drafts",
       x = "Career Win Shares",
       y = "Frequency") +
  theme(plot.title = element_text(face = "bold"))
print(p1)

图 2.1 职业生涯赢分具有右偏斜，或正偏斜，的分布。

变量 win shares 具有右偏斜，或正偏斜，的分布——右偏斜是因为分布有一个长的右尾，正偏斜是因为长尾位于 x 轴的正方向。用通俗的话说，这意味着在 2000 年至 2009 年的 NBA 选秀中，许多首轮新秀在整个职业生涯中赢分很少，而只有少数球员赢分很多。

填充和颜色

如果你以实体书的形式阅读这本书，你现在肯定已经注意到每个图表都是以灰度打印的。尽管如此，我们展示了如何通过在几乎每个图表中添加自定义填充和颜色来增强你的可视化——无论是 ggplot2 还是其他——并在文本中引用相同的颜色。以下是一个 ggplot2 填充和颜色参考指南的网站，它非常实用：sape.inf.usi.ch/quick-reference/ggplot2/colour。此外，任何购买过这本书新副本的人都可以访问电子书版本（全彩）；如果你对查看全彩可视化感兴趣，请参阅该版本。

以下两个 SELECT 语句返回在选秀数据集中，职业生涯赢分数量大于或等于 75 或小于 75 的记录数。因此，我们得到了实际计数，而不是从我们的直方图中得到的近似计数。在 COUNT() 函数中包含星号确保我们得到任何包含 null 值的观测值作为结果集的一部分。更重要的是，WHERE 子句确定了任何观测值必须评估为 true 的条件，才能包含在结果中：

sqldf("SELECT COUNT (*) FROM draft WHERE WS >= 75")
##   COUNT (*)
## 1        27
sqldf("SELECT COUNT (*) FROM draft WHERE WS < 75")
##   COUNT (*)
## 1       264

在 2000 年至 2009 年的 NBA 选秀中，不到 10% 的首轮新秀在其各自的职业生涯中至少赢得了 75 分。事实上，超过 50% 的球员，即 291 名中的 169 名，赢分少于 25 分：

sqldf("SELECT COUNT (*) FROM draft WHERE WS <= 25")
##   COUNT (*)
## 1       169

箱线图

另一种可视化连续变量频率分布的方法是使用箱线图。我们的下一个可视化包含一个分面图内的两对箱线图，其中胜利份额的分布首先根据派生变量Born2进行分段，然后根据派生变量College2再次进行分段。

没有两个ggplot2可视化是完全相同的，尤其是在几何对象或几何形状之间；然而，它们都遵循相同的一般语法和结构。以下是一些关于我们的分面图的注意事项，其中数据被分解并在共享相同 x 轴和 y 轴的子图中可视化：

• stat_summary()函数在每个箱线图上添加一个实心白点，以表示总体均值。总体中位数由水平线表示，这是ggplot2自动添加的。

• facet_wrap()函数为变量Born2中的每个级别创建一个面板——因此为每个级别生成一对箱线图；因为Born2有两个级别，所以我们的分面图因此有两个面板。

• scale_x_discrete()函数通过将College2中的级别0和1分别转换为No College和College来硬编码 x 轴上的标签。准确或直观的标签对于提高你的视觉内容的可读性和可解释性有很大帮助。

我们的第二个可视化（见图 2.2）显示，胜利份额的分布因出生地以及玩家是否首先就读于大学或学院而有所不同：

p2 <- ggplot(draft, aes(x = College2, y = WS)) + 
  geom_boxplot(color = "orange4", fill = "orange1") +  
  labs(title = "Career Win Shares Distribution of 
       NBA First-Round Selections",
       x = "", 
       y = "Career Win Shares", 
       subtitle = "2000-09 NBA Drafts") + 
  stat_summary(fun = mean, geom = "point", shape = 20, 
               size = 8, color = "white", fill = "white") + 
  theme(plot.title = element_text(face = "bold")) +
  facet_wrap(~Born2) + 
  scale_x_discrete(breaks = c(0, 1),
                   labels = c("No College", "College"))
print(p2)

图 2.2 胜利份额的分布因出生地以及球员在成为职业球员之前是否首先就读于大学或学院而有所不同。

箱线图通过隔离以下与summary()函数输出相一致（但有时并不完全一致）的指标来显示连续变量的分布：

• 中位数——中间值，由水平线表示。

• 第一四分位数——最小数（不一定是“最小值”）和中位数之间的中间值，也称为 25 百分位数。

• 第三四分位数——中位数和最高值（不一定是“最大值”）之间的中间值，也称为 75 百分位数。

• 四分位距（IQR）——25 百分位数到 75 百分位数；基本上，就是箱子。这也可以通过计算第一四分位数和第三四分位数的差来得到。

• “最小值”——等于 Q1 - (1.5 * IQR)。这不一定是最小值；实际上，可能存在一个或多个数据点——异常值——超出所谓的最小值。

• “最大值”——等于 Q3 + (1.5 * IQR)。同样，这实际上可能并不代表最高值。

平均值不是箱线图的常规指标，这可能是为什么ggplot2不会自动添加它。胡须是延伸到 IQR（箱线图因此通常被称为箱线图和胡须图）下方和上方的线。超出“最小值”和“最大值”的点或圆圈是异常值。

这是一种对数据的迷人图形表示，揭示了几个真理：

• 出生在美国的球员通常比出生在美国以外的球员积累了更多的职业生涯胜利份额。

• 出生在美国并绕过大学的球员通常比那些出生在美国并上了大学或学院的球员积累了更多的职业生涯胜利份额。

• 或者，出生在除美国以外任何国家的球员，如果没有上大学或学院，通常在其职业生涯中积累的胜利份额比那些出生在美国并上了大学或学院的球员要少。

• 均值始终高于中位数，这当然表明，无论数据如何切割和重组，平均胜利份额都受到超级巨星产出的影响。

更多的箱线图显示了按年份或草稿类别划分的胜利份额分布（见图 2.3）：

p3 <- ggplot(draft, aes(x = Year, y = WS)) + 
  geom_boxplot(color = "dodgerblue4", fill = "dodgerblue" ) +
  labs(title = "Year-over-Year Win Shares Distribution of 
       NBA First-Round Selections",
       x = "", 
       y = "Win Shares", 
       subtitle = "2000-09 NBA Drafts") + 
  stat_summary(fun = mean, geom = "point", shape = 20, 
               size = 8, color = "white", fill = "white") + 
  theme(plot.title = element_text(face = "bold")) 
print(p3)

图 2.3 并非 2000 年至 2009 年间的每个草稿类别都相同。

表格

让我们再次深入挖掘我们的数据。与其再次编写一系列 SELECT 语句，我们将展示如何扩展你对 dplyr 包的使用，该包包含几个用于提取和操作数据的函数。再次强调，如果你只需要几个数据点，sqldf 就足够好了，但如果你需要一个可以随后传递给 ggplot2 或用于其他分析的结果集，你将需要——并且必须——熟悉 dplyr。

理解以下几行代码的第一个关键是要知道管道操作符 (%>%) 的工作原理。简而言之，管道操作符将每个函数的输出作为下一个函数的参数。可以把管道看作是将一个函数或操作的输出传输到另一个函数或操作的手段。你还可以把“然后”这个词看作是管道的伪代码替代： “获取草稿数据集然后计算一系列汇总统计量。”

第二个关键是要了解 dplyr summarize() 函数的工作原理；summarize() 函数与基础 R 的 summary() 函数有些相似，但 summarize() 函数要灵活得多，可扩展性也更强，尤其是在与 dplyr 的 group_by() 函数搭配使用时。在这里，我们指导 summarize() 函数计算标准箱线图类型的度量。

结果随后被推送到一个名为first_tibble的 tibble 中（请注意赋值运算符）。关于 R 特有的 tibble，最重要的是要知道它们与数据框共享许多相同的属性，这意味着它们可以被整理并用作视觉内容和其它分析的源数据。然而，当打印时，只返回前 10 行以及适合屏幕的列数；你将反复看到和体验到这一点。此外，一些基本的 R 函数和其他遗留代码与 tibble（或 tibble 与旧代码）不兼容。当这种情况发生时——我们将在稍后看到——只需通过传递给基本的 R as.data.frame()函数将 tibble 转换为数据框即可：

draft %>%
  summarize(MIN = min(WS),
            LQ = quantile(WS, .25),
            UQ = quantile(WS, .75),
            AVG = mean(WS),
            M = median(WS),
            MAX = max(WS)) -> first_tibble
print(first_tibble)
##    MIN   LQ    UQ      AVG    M   MAX
## 1 -1.6 4.05 43.85 29.34811 19.6 236.1

以下代码块将draft作为参数传递给group_by()函数，然后group_by()函数随后作为参数传递给summarize()函数。或许理解这几行代码的更好、更有效的方法是将summarize()函数视为按年份计算胜分均值的操作，而不是整体操作。结果随后被放入一个新的对象，或 tibble，称为second_tibble。这些结果与我们的之前的箱线图相一致：

draft %>%
  group_by(Year) %>%
  summarize(avg = mean(WS)) -> second_tibble
print(second_tibble)
## # A tibble: 10 × 2
##    Year    avg
##    <fct> <dbl>
##  1 2000   18.3
##  2 2001   39.0
##  3 2002   21.4
##  4 2003   37.9
##  5 2004   34.0
##  6 2005   30.6
##  7 2006   20.6
##  8 2007   28.6
##  9 2008   33.7
## 10 2009   29.6

在这里，dplyr tally()函数统计了在选秀数据集中积累了 75 个或更多胜分的球员数量，并且按变量Year中的每个因素或水平分解结果。显然，均值受到积累了相对较高职业胜分选秀球员数量的影响：

draft %>%
  group_by(Year) %>%
tally(WS >= 75) -> third_tibble
print(third_tibble) 
## # A tibble: 10 × 2
##    Year      n
##    <fct> <int>
##  1 2000      0
##  2 2001      7
##  3 2002      1
##  4 2003      5
##  5 2004      2
##  6 2005      3
##  7 2006      2
##  8 2007      2
##  9 2008      2
## 10 2009      3

现在，在dplyr代码和sqldf代码之间交替，下面的SELECT语句返回draft中的Player和Pk变量，其中WS大于或等于75，并且变量Year等于2001（只是为了展示 2001 年选秀中积累了 75 个或更多胜分的七名球员）：

sqldf("SELECT Player, Pk FROM draft WHERE WS >= 75 AND Year == 2001")
##              Player Pk
## 1    Tyson Chandler  2
## 2         Pau Gasol  3
## 3     Shane Battier  6
## 4       Joe Johnson 10
## 5 Richard Jefferson 13
## 6     Zach Randolph 19
## 7       Tony Parker 28

下一个SELECT语句返回相同的变量，其中WS再次大于或等于75，并且变量Year这次等于2003（只是为了展示 2001 年选秀中积累了 75 个或更多胜分的五名球员）。结果按胜分降序排列：

sqldf("SELECT Player, Pk, WS
      FROM draft WHERE WS >= 75 AND Year == 2003 ORDER BY WS DESC")
##            Player Pk    WS
## 1    LeBron James  1 236.1
## 2     Dwyane Wade  5 120.7
## 3      Chris Bosh  4 106.0
## 4 Carmelo Anthony  3 102.0
## 5      David West 18  85.9

在下一个 dplyr 代码块中，草稿数据集被子集化或过滤，仅包含变量 WS 大于或等于 75 的记录；在 group_by() 和 summarize() 函数之间，然后计算每个年份的 Pk 的平均值。结果被推送到一个 9 × 2 的 tibble，称为 fourth_tibble。您可能还记得，在 2000 年的选秀中，没有球员获得了超过 75 个职业生涯胜利份额；R 为那一年的选秀没有返回任何结果，因为当然，从零记录中无法计算任何东西。否则，请注意，当考虑到每个选秀中都有 29 或 30 个第一轮选择时，平均值有多低：

draft %>%
  filter(WS >= 75) %>%
  group_by(Year) %>%
  summarize(avg = mean(Pk)) -> fourth_tibble
print(fourth_tibble)
## # A tibble: 9 × 2
##   Year    avg
##   <fct> <dbl>
## 1 2001  11.6 
## 2 2002   9   
## 3 2003   6.2 
## 4 2004   5   
## 5 2005  12.3 
## 6 2006  13   
## 7 2007   2.5 
## 8 2008   4.5 
## 9 2009   3.67

我们可以使用 sqldf() 函数运行相对简单直接的计算。以下计算了变量 Pk 的平均值，其中变量 WS 大于或等于 75：

sqldf("SELECT AVG(Pk) FROM draft WHERE WS >= 75")
##    AVG(Pk)
## 1 8.111111

接下来，草稿数据集再次子集化，仅包含那些球员的职业生涯胜利份额总和等于或超过 75 的记录，这是通过调用 dplyr filter() 函数实现的。在 dplyr group_by() 和 summarize() 函数之间，通过变量 Year 计算了 Pk 的中位数，然后将其放入一个新的对象 fifth_tibble 中：

draft %>%
  filter(WS >= 75) %>%
  group_by(Year) %>%
  summarize(med = median(Pk)) -> fifth_tibble
print(fifth_tibble)
## # A tibble: 9 × 2
##   Year    med
##   <fct> <dbl>
## 1 2001   10  
## 2 2002    9  
## 3 2003    4  
## 4 2004    5  
## 5 2005    4  
## 6 2006   13  
## 7 2007    2.5
## 8 2008    4.5
## 9 2009    3

以下 SELECT 语句计算并返回整个草稿数据集中变量 Pk 的中位数，其中变量 WS 再次大于或等于 75。请注意，中位数（对异常值不敏感）比平均值低得多：

sqldf("SELECT MEDIAN(Pk) FROM draft WHERE WS >= 75")
##   MEDIAN(Pk)
## 1          4

如您现在可能想象的那样，当草稿数据集仅包含变量 WS 等于或大于 100 的记录时，变量 Pk 的平均值和中位数甚至更低。以下 dplyr 代码返回 Pk 的年度平均值，并将结果转换为一个名为 sixth_tibble 的对象：

draft %>%
  filter(WS >= 100) %>%
  group_by(Year) %>%
  summarize(avg = mean(Pk)) -> sixth_tibble
print(sixth_tibble)
## # A tibble: 8 × 2
##   Year    avg
##   <fct> <dbl>
## 1 2001  11   
## 2 2003   3.25
## 3 2004   1   
## 4 2005   4   
## 5 2006   2   
## 6 2007   2   
## 7 2008   4   
## 8 2009   5

下一个 SELECT 语句计算并返回 draft 中变量 WS 等于或超过 100 的 Pk 的平均值：

sqldf("SELECT AVG(Pk) FROM draft WHERE WS >= 100")
##    AVG(Pk)
## 1 4.928571

现在，让我们看看相同的操作集，只是用中位数代替了平均值。以下 dplyr 代码块计算了在草稿数据集之前已按变量 WS 等于或大于 100 进行子集化时，每个年份的 Pk 的中位数：

draft %>%
  filter(WS >= 100) %>%
  group_by(Year) %>%
  summarize(med = median(Pk)) -> seventh_tibble
print(seventh_tibble)
## # A tibble: 8 × 2
##   Year    med
##   <fct> <dbl>
## 1 2001    3  
## 2 2003    3.5
## 3 2004    1  
## 4 2005    4  
## 5 2006    2  
## 6 2007    2  
## 7 2008    4  
## 8 2009    5

以下 SELECT 语句随后计算并返回 WS 等于或超过 100 的 Pk 的中位数：

sqldf("SELECT MEDIAN(Pk) FROM draft WHERE WS >= 100")
##   MEDIAN(Pk)
## 1          3

让我们旋转并提取 WS 等于或小于 25 的某些数字：

draft %>%
  filter(WS <= 25) %>%
  group_by(Year) %>%
  summarize(avg = mean(Pk),
            med = median(Pk)) -> eighth_tibble
print(eighth_tibble)
## # A tibble: 10 × 3
##    Year    avg   med
##    <fct> <dbl> <dbl>
##  1 2000   15.8  14.5
##  2 2001   14.9  16  
##  3 2002   16.6  17  
##  4 2003   15.6  16  
##  5 2004   18.6  21  
##  6 2005   17.8  18  
##  7 2006   16.6  17.5
##  8 2007   16.2  16.5
##  9 2008   16.6  14  
## 10 2009   17.5  16

平均而言，获得较少胜利份额的球员在第一轮被选中的时间晚于获得更多胜利份额的其他球员。下一个 SELECT 语句计算并返回变量 Pk 在 WS 等于或小于 25 时的平均值和中位数：

sqldf("SELECT AVG(Pk), MEDIAN(Pk) FROM draft WHERE WS <= 25")
##    AVG(Pk) MEDIAN(Pk)
## 1 16.55621         16

让我们更进一步，看看当选秀名单仅包括在其职业生涯中赢得少于五个胜利份额的球员时，这些相同的数字看起来如何。再次使用dplyr获取年度结果，使用sqldf返回总体结果：

draft %>%
  filter(WS <= 5) %>%
  group_by(Year) %>%
  summarize(avg = mean(Pk),
            med = median(Pk)) -> ninth_tibble
print(ninth_tibble)
## # A tibble: 10 × 3
##    Year    avg   med
##    <fct> <dbl> <dbl>
##  1 2000   17.4  15  
##  2 2001   17.9  19  
##  3 2002   15.3  18  
##  4 2003   19.2  17  
##  5 2004   17.1  16  
##  6 2005   17.2  14.5
##  7 2006   18.5  18.5
##  8 2007   17.6  18  
##  9 2008   23.8  28.5
## 10 2009   16.9  17.5

sqldf("SELECT AVG(Pk), MEDIAN(Pk) FROM draft WHERE WS <= 5")
##    AVG(Pk) MEDIAN(Pk)
## 1 17.65854       17.5

2000-2009 年 NBA 选秀中的许多首轮选中的球员从未成为什么大人物。对于每个勒布朗·詹姆斯或斯蒂芬·库里，都有数十个其他首轮选中的球员，对于大多数职业篮球迷来说，他们今天几乎无人知晓。2000 年至 2009 年之间，近 30%的首轮选中的球员在其职业生涯中赢得了少于五个胜利份额。下一个SELECT语句提取了在选秀数据集中变量WS小于5的球员数量：

sqldf("SELECT COUNT (*) FROM draft WHERE WS < 5")
##   COUNT (*)
## 1        81

我们最后的SELECT语句提取了在选秀中结束 NBA 职业生涯时胜利份额为负数的球员数量：

sqldf("SELECT COUNT (*) FROM draft WHERE WS < 0")
##   COUNT (*)
## 1        20

显然，并非每个选秀批次都是平等的。以下是最新一批箱线图以及我们dplyr和sqldf代码块返回的最显著发现：

• 2001 届脱颖而出：2001 年 NBA 选秀的第一轮选中的球员在其职业生涯中平均赢得了 39 个胜利份额，这是 2000 年至 2009 年之间任何一批次首轮选中球员中最多的。只有 2001 届，IQR 的上限才超过 50 个胜利份额。

• 此外，同一批次的七名球员在其职业生涯中积累了 75 个或更多的胜利份额，这是选秀数据集中任何一批次中最多的。其中三名球员——泰森·钱德勒、保罗·加索尔和肖恩·巴蒂尔——当年排名前六；另外三名球员——乔·约翰逊、理查德·杰弗森和扎克·兰多夫——被选在 10 到 19 号签之间；然后还有托尼·帕克，他在第 28 顺位被选中，并在为圣安东尼奥马刺队效力期间积累了 111.3 个胜利份额。

• 2003 年 NBA 选秀的第一轮选中的球员平均赢得了 38 个胜利份额，与 2001 届第一轮选中的球员相当。勒布朗·詹姆斯、德维恩·韦德、克里斯·波什、卡梅隆·安东尼和戴维斯·韦斯特都在他们的职业生涯中赢得了超过 75 个胜利份额，这仅仅是到 2019-20 赛季为止。

• 参考的这五名球员中的四名——除了大卫·韦斯特——都是 2001 年首轮前五名被选中的球员。

• 相反，2000 届可能是最令人失望的；2000 届首轮选中的球员在其职业生涯中平均只赢得了 18 个胜利份额，这是选秀数据集中任何一批次中最低的平均值。不出所料，2000 届没有球员在其职业生涯中赢得了 75 个胜利份额。只有 2000 届，IQR 的上限才低于 25 个胜利份额。

• 到目前为止，积累了至少 75 个胜利份额的球员平均被选中为第八位；事实上，在九个至少有一名球员后来积累了 75 个或更多胜利份额的选秀批次中，有五个批次的平均胜利份额为 6 个或更少。中位数等于 4。

• 当对那些在其职业生涯中累积了至少 100 个胜利份额的球员进行子集时，平均选择数或选择编号等于 4，中位数是 3。

• 在选秀数据集中的 291 个首轮选择中，其中 81 个累积的职业生涯胜利份额少于 5，这 81 名球员中有 20 名球员累积的职业生涯胜利份额为负数。

• 看起来胜利份额与球员在首轮被选中的位置之间存在某种关系。累积相对较高胜利份额的球员通常在其他获得较少胜利份额的球员之前被选中。

现在我们来探讨 胜利份额 与数据集中其他连续变量之间的关联性，或者可能没有关联性。

2.5.4 计算和可视化关联性

关联性是一种统计度量，它量化了一对连续变量或数值变量之间的线性关系。这种关系可以是正的，也可以是负的。当为正时，变量以恒定的速率同时增加；当为负时，变量以恒定的速率变化，但一个增加而另一个减少。这种关系实际上也可能是中性的。

两个连续变量之间的关系是通过计算它们之间的关联系数来确定的。结果将始终等于 -1 和 +1 之间的某个数字。当关联系数等于或近似于 -1 时，则关系为负；当关联系数等于或近似于 +1 时，关系为正。作为一个经验法则，关联系数小于 -0.8 且大于 0.8 是强线性关系的迹象；关联系数在 -0.6 和 -0.8 之间以及 0.6 和 0.8 之间也是相当强线性关系的迹象；关联系数在或接近 0 时表示没有关系。仅仅因为一对连续变量可能高度相关，并不意味着一个变量影响另一个变量——关联性不等于因果关系。

在 R 中计算两个变量或一次计算多个变量对的关联系数非常容易。R 中也有许多选项用于可视化。我们将通过创建一个 ggplot2 热图来演示如何进行后者。热图是一种将不同的数据值与不同的颜色或阴影关联的图表。

考虑到这一点，我们的第一步是通过管道操作符 (%>%) 将 draft 传递给 dplyr select() 函数，创建一个新的对象 cor_draft，以对其原始数据集的五个连续变量：Age（年龄）、G（比赛次数）、MP（分钟数）、WS（胜利份额）和 WS48（48 分钟胜利份额）进行子集。毕竟，我们只计算连续变量之间的关联系数；如果我们尝试其他方式，R 会抛出错误。以下是第一步：

    draft %>%
          select(c(Age, G:WS)) -> cor_draft

第二步是将 cor_draft 大概转换为表格格式，通过传递给基本 R cor() 函数，该函数计算每对变量之间的相关系数。我们的结果被转换到一个名为 cor_matrix 的新对象中。随后的 print() 函数调用是可选的——这不是创建热图所必需的步骤——但它当然会返回结果并显示相关矩阵应该是什么样子。以下是第二步：

cor_matrix <- cor(cor_draft)
print(cor_matrix)
##             Age          G         MP         WS       WS48
## Age   1.0000000 -0.2189601 -0.2327846 -0.2509647 -0.1801535
## G    -0.2189601  1.0000000  0.7921621  0.8004797  0.6165429
## MP   -0.2327846  0.7921621  1.0000000  0.7758876  0.6597869
## WS   -0.2509647  0.8004797  0.7758876  1.0000000  0.6942061
## WS48 -0.1801535  0.6165429  0.6597869  0.6942061  1.0000000

例如，变量 MP 和 WS48 之间的相关系数等于 0.66（四舍五入）。我们实际上看到了两次，因为矩阵中的每一对变量在两个点上相交，这不是我们热图所希望的。

第三步需要调用 reshape2 包中的 melt() 函数。melt() 函数将 cor_matrix 中的每一对变量组合（标记为 Var1 和 Var2）进行排列和堆叠，并创建一个名为 value 的第三列，其中单元格填充了相应的相关系数。考虑到空间，而不是打印整个结果集，我们调用 head() 和 tail() 函数来仅返回我们新对象 cor_table 中的前三个和最后三个观测值。以下是第三步：

cor_table <- melt(cor_matrix)
head(cor_table, n = 3)
##   Var1 Var2      value
## 1  Age  Age  1.0000000
## 2    G  Age -0.2189601
## 3   MP  Age -0.2327846
tail(cor_table, n = 3)
##     Var1 Var2     value
## 23    MP WS48 0.6597869
## 24    WS WS48 0.6942061
## 25  WS48 WS48 1.0000000

现在我们有了格式完美的数据源，接下来的代码块生成了我们的热图：

• 与任何 ggplot2 可视化一样，对象是通过调用 ggplot() 函数初始化的，其中 cor_table 被传递为热图的数据源；cor_table 变量 Var1 和 Var2 分别是 x 轴和 y 轴变量；填充基于计算出的相关系数。

• geom_tile() 函数是 ggplot() 函数，用于绘制热图。

• scale_fill_gradient2() 函数在相关系数之间建立了一个双色调渐变方案。

• 当标签或注释有序时，会调用文本几何。通过调用 geom_text() 函数，我们用数据源中每对连续变量之间的实际相关系数来注释我们的相关矩阵。基本的 R round() 函数将我们的系数减少到小数点后两位。

热图或相关矩阵的目的是将颜色及其阴影与不同的相关系数相对应（见图 2.4）。正相关用一种颜色渐变表示，负相关用另一种颜色渐变表示。较深的阴影表示变量之间的更强关联，反之亦然。以下是我们的代码，紧接着是我们的热图，它是由相同的代码生成的：

p4 <- ggplot(data = draft_cor, aes(x = Var1, 
                                   y = Var2, fill = value)) +
  geom_tile() +
  scale_fill_gradient2(midpoint = 0.5, mid = "grey84", 
                       limits = c(-1, 1)) +
  labs(title = "Correlation Matrix", 
    subtitle = "Correlation Coefficients between 
    Win Shares and Other Continuous Variables",
    x = "", 
    y = "", 
    fill = "Correlation\nCoefficient", 
    caption = "Source: draft data set") +
  theme(plot.title = element_text(face = "bold"), 
  legend.title = element_text(face = "bold", color = "brown", 
                              size = 10)) +
  geom_text(aes(x = Var1, y = Var2, 
                label = round(value, 2)), color = "black", 
  fontface = "bold", size = 5)
print(p4)

图 2.4 拟数据集中所有连续变量之间的相关系数矩阵

至少有两个结论跃然纸上：

• 赢分与常规赛比赛次数、每场常规赛的分钟数以及每 48 分钟比赛时间的赢分之间存在正相关和强相关，或者至少相当强。请注意，相关系数并不能告诉我们哪个变量可能正在影响另一个变量，如果存在任何因果关系的话。

• 变量“赢分”和“年龄”之间也存在负相关关系，也就是说，2000 年至 2009 年间参加 NBA 选秀的年轻球员，通常比在“较老”年龄成为职业球员的球员积累了更多的职业赢分。然而，这些变量之间的相关性并不强。毫无疑问，这部分的真相可能是，年轻球员可能有更多的年份作为职业球员进行比赛，因此有更多机会积累更多的赢分。但这也可能是真的——至少很可能是这样——更好的球员比技能较低的球员更早成为职业球员。

接下来，我们将通过一系列条形图来可视化人口均值和中位数，以便我们可以确定在不同水平上我们的因素变量中的赢分如何比较。

2.5.5 计算和可视化均值和中位数

最后，我们将通过计算并可视化按我们之前创建的派生变量划分的均值和赢分中位数来切割和分解我们的数据集。以下dplyr代码块再次使用group_by()和summarize()函数来总结选秀数据集中的数据子集，从而计算按派生变量Born2划分的均值和赢分中位数。结果被推送到一个 2×3 的 tibble，称为tenth_tibble：

draft %>% 
  group_by(Born2) %>%
  summarize(meanWS = mean(WS),
            medianWS = median(WS)) -> tenth_tibble
print(tenth_tibble)
## # A tibble: 2 × 3
##   Born2 meanWS medianWS
##   <fct>  <dbl>    <dbl>
## 1 USA     31.1     21.5
## 2 World   23.5     12.8

这些结果随后在两个ggplopt2条形图中进行可视化，其中职业赢分的平均值表示在左侧，而中位数赢分表示在右侧（见图 2.5）。在典型的条形图中，因素变量中的每个水平都由一个单独的条形表示，每个条形的长度（不一定是高度，因为条形图也可以水平排列）对应于它所代表的数据值或频率。实际上，条形图在可视化分类数据方面特别有效，例如按地区划分的销售数据或按财政年度划分的净利润——当Born2等于USA或World时，也适用于均值和中位数。条形图有许多变体，甚至还有条形图的替代品，我们将在后续章节中展示许多这些变体。

图 2.5 按出生地划分的平均和职业赢分中位数

通过对ylim()函数的类似调用，两个图表之间的 y 轴被标准化；否则，两个可视化之间的 y 轴刻度将不同，条形的高度将相同，这样就无法展示均值和中位数之间的差异。

我们再次调用geom_text()函数将平均值和中位数放置在条形图顶部。但数值并不完全匹配tenth_tibble中的结果，因为我们还调用了基础 R 的trunc()函数，该函数将平均值和中位数四舍五入到最近的整数，仅出于美观原因。标签的位置可以通过vjust和hjust参数在垂直和/或水平方向上调整；准备好通过实验vjust和hjust参数直到你对最终的外观满意：

p5 <- ggplot(tenth_tibble, aes(x = Born2, y = meanWS)) + 
  geom_bar(stat = "identity", width = .5, fill  = "darkorchid4") + 
  labs(title = "Average Win Shares by Place of Birth",
       subtitle = "2000-09 NBA Drafts", 
       x = "Where Born", 
       y = "Average Career Win Shares") + 
  geom_text(aes(label = trunc(meanWS), vjust = -0.3)) +
  ylim(0, 35) +
  theme(plot.title = element_text(face = "bold"))

p6 <- ggplot(tenth_tibble, aes(x = Born2, y = medianWS)) + 
  geom_bar(stat = "identity", width = .5, fill  = "sienna1") + 
  labs(title = "Median Win Shares by Place of Birth",
       subtitle = "2000-09 NBA Drafts", 
       x = "Where Born", 
       y = "Median Career Win Shares") + 
  geom_text(aes(label = trunc(medianWS), vjust = -0.3)) +
  ylim(0, 35) +
  theme(plot.title = element_text(face = "bold"))

我们的图表暂时保存在内存中而不是立即打印出来。通过调用plot_layout()函数从patchwork包中，我们的图表被捆绑成一个单一的可视化对象，其中两个条形图并排打印（由于我们传递了ncol，即列数，参数使其等于2）：

p5 + p6 + plot_layout(ncol = 2)

从这两张条形图中可以得出两个重要的结论：

• 在美国出生的球员，平均而言，其职业生涯的胜利份额比在其他地方出生的球员更多。

• 平均值显著大于中位数。平均值对异常值敏感，而中位数则不敏感；平均值大于中位数表明它们受到了超级巨星生产的影响，其中超级巨星的胜利份额超过 100。

这里重复相同的练习，只是将变量Born2替换为派生变量College2（见图 2.6）：

draft %>% 
  group_by(College2) %>%
  summarize(meanWS = mean(WS),
            medianWS = median(WS)) -> eleventh_tibble
print(eleventh_tibble)
## # A tibble: 2 × 3
##   College2 meanWS medianWS
##   <fct>     <dbl>    <dbl>
## 1 0          30.3     19.6
## 2 1          29.0     19.6

p7 <- ggplot(eleventh_tibble, aes(x = College2, y = meanWS)) + 
  geom_bar(stat = "identity", width = .5, fill  = "darkorchid4") + 
  labs(title = "Average Win Shares: College / No College", 
       x = "College or No College",
       y = "Average Career Win Shares") + 
  scale_x_discrete(breaks = c(0, 1),
                        labels = c("No College", "College")) +
  geom_text(aes(label = trunc(meanWS), vjust = -0.3)) +
  ylim(0, 35) +
  theme(plot.title = element_text(face = "bold"))

p8 <- ggplot(eleventh_tibble, aes(x = College2, y = medianWS)) + 
  geom_bar(stat = "identity", width = .5, fill  = "sienna1") + 
  labs(title = "Median Win Shares: College / No College", 
       x = "College or No College",
       y = "Median Career Win Shares") + 
  scale_x_discrete(breaks = c(0, 1),
                        labels = c("No College", "College")) +
  geom_text(aes(label = trunc(medianWS), vjust = -0.3)) +
  ylim(0, 35) +
  theme(plot.title = element_text(face = "bold"))

图 2.6 那些最初就读于大学或学院和那些没有就读于大学或学院的球员的平均和中值胜利份额

然后，我们再次调用plot_layout()函数，将最后两个条形图打包成一个单一的可视化表示：

p7 + p8 + plot_layout(ncol = 2)

在College2变量的两个水平或因素之间，平均值和中位数基本上是相等的；然而，平均值再次显著大于中位数。

我们最后的dplyr代码块将选秀数据集传递给summarize()函数，并将Born2、College2以及变量Pos2传递给它，以计算这三个变量的每一种组合的平均和中值胜利份额。我们这样做是因为我们接下来打算通过一对互补的面板图来可视化Born2、College2和Pos2每一种组合的平均和中值胜利份额。twelfth_tibble中结果被转换的前三个和最后三个观察值是通过连续调用基础 R 的head()和tail()函数得到的：

draft %>% 
  group_by(Pos2, Born2, College2) %>%
  summarize(mean = mean(WS),
            median = median(WS)) -> twelfth_tibble
head(twelfth_tibble, n = 3)
## # A tibble: 3 × 5
## # Groups:   Pos2, Born2 [2]
##   Pos2  Born2 College2  mean median
##   <fct> <fct> <fct>    <dbl>  <dbl>
## 1 Big   USA   0         81.8   81.8
## 2 Big   USA   1         36.4   24.8
## 3 Big   World 0         39.9   22.1
tail(twelfth_tibble, n = 3)
## # A tibble: 3 × 5
## # Groups:   Pos2, Born2 [2]
##   Pos2     Born2 College2  mean median
##   <fct>    <fct> <fct>    <dbl>  <dbl>
## 1 Swingman USA   1         39.6   30.4
## 2 Swingman World 0         30.2   30.2
## 3 Swingman World 1         18.2   18.2

我们最终的可视化是一对面图——再次强调，面图是一种显示数据两个或更多子集的可视化类型，左边的平均值和右边的中位数被压缩到一个 2×2 的对象中。请注意，我们再次调用了theme()函数，将 x 轴标签旋转 45 度，而不是使用ggplot2的默认设置，后者当然是将标签水平排列（见图 2.7）：

new_labels <- c("0" = "No College", "1" = "College")
p9 <- ggplot(twelfth_tibble, aes(x = Pos2, y = mean)) + 
  geom_bar(stat = "identity", width = .5, fill  = "slateblue4") +  
  labs(title = "Average Win Shares by Place of Birth", 
       x = "", 
       y = "Win Shares",
       subtitle = "2000-09 NBA Drafts") + 
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  facet_grid(Born2 ~ College2, labeller = labeller(College2 = new_labels))

new_labels <- c("0" = "No College", "1" = "College")
p10 <- ggplot(twelfth_tibble, aes(x = Pos2, y = median)) + 
  geom_bar(stat = "identity", width = .5, fill  = "indianred3") +  
  labs(title = "Median Win Shares by Place of Birth",
       x = "", 
       y = "Win Shares",
       subtitle = "2000-09 NBA drafts") + 
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  facet_grid(Born2 ~ College2, labeller = labeller(College2 = new_labels))

图 2.7 按出生地、是否上大学和位置的平均和中等职业生涯胜利份额

再次强调，我们并没有分别打印两个面图，而是将它们打包成一个图形对象，然后相应地打印出来：

p9 + p10 + plot_layout(ncol = 2)

毫无疑问，我们两个面图中最明显和最吸引人的结果出现在左上角的板块。出生于美国、在进入 NBA 选秀前没有上过大学的大个子、中锋和摇摆人，平均获得的胜利份额显著高于其他位置上的球员，无论他们出生在哪里，无论他们是否首先上大学。

然而，与具有不同Born2和College2特征的球员相比，这些球员的中等胜利份额并不那么明显，这再次暗示了少数超级巨星可能产生的影响。

这标志着我们对草案数据集的探索告一段落。正如您所看到的，仅通过应用标准或传统探索方法，就可以从数据集中获取大量信息；无论主题是什么，都不一定需要测试或建模数据，以便获得有价值的见解。在继续之前，我们将保存一份草案的副本——毕竟，这是在数据整理之后——用于第三章。

2.6 写入数据

我们的第一步操作是调用read_csv()函数来导入之前保存为.csv 文件的数据集。现在，在完成我们的 EDA 之后，我们想要生成一个输出文件。为此，我们将调用基础 R 的write.csv()函数来创建一个新的.csv 文件。这个新文件将在第三章的开头导入。我们不会再次导入原始的草案数据集——然后重复相同的数据整理操作——而是导入一个副本，即draft2，它等于草案数据集的最终配置。只要您设置了工作目录，write.csv()的工作方式与read_csv()非常相似；也就是说，您只需要传递文件名：

draft -> draft2
write.csv(draft2, "draft2.csv")

在下一章中，我们将首先导入draft2进行分析，这超出了此处进行的分析——其影响可能是深远的，甚至可能令人不安。

摘要

• 我们学习了如何安装和加载包、读取和写入数据、整理数据、计算基本统计量以及创建可视化内容——在这个过程中我们还了解了胜利份额和其他 NBA 数据。

• 在现实世界中，大多数获取的数据都是杂乱的，或者至少不是适合后续分析的结构。因此，统计学家、数据科学家、商业分析师以及任何与数据打交道的人都需要花费大部分时间整理数据，而不是分析数据。

• 在数据整理方面，我们学习了如何删除变量、删除观测值、将变量从一类转换为另一类、创建新变量、按组汇总数据，甚至将数据集从宽格式转换为长格式。

• 我们首次了解了ggplot2包，我们用它创建了直方图、成对箱线图、分面图、相关热图和条形图；我们还调用了几个ggplot()函数来定制我们的视觉内容并应用最佳实践。

• 我们展示了如何全面探索数据集——但要有目的性和专注力。通过计算和可视化数据来探索数据是一项有价值的练习，它能带来有趣和可操作的见解，并为更深入的分析做好准备。

• 这里应用的方法适用于任何数据集，无论是健康记录、销售数据、客户服务统计还是胜利份额。

• 2000 年至 2009 年的第一轮 NBA 选秀球员有着非常不同的职业生涯。虽然一些球员在其职业生涯中积累了大量的胜利份额，但大多数球员累积的职业生涯胜利份额不到 25 个。

• 根据到目前为止进行的分析，似乎那些累积了最多职业生涯胜利份额的球员在第一轮被选中得非常高，而技能较低的球员则在第一轮的后期被选中。这一点将在第三章通过应用更先进的分析技术进行更深入的探讨。

3 分段分析

本章涵盖了

• 使用 c() 和 lapply() 加载包

• 使用条形图可视化均值和中位数

• 创建桑基图

• 计算期望值

• 执行层次聚类

• 创建和理解树状图

在上一章中，我们介绍了几种方法，通过这些方法我们可以探索数据集，作为进行任何统计测试或执行专业分析的前提。毫无疑问，第二章分析的最显著发现是，总体而言，那些职业生涯最成功的球员在 NBA 选秀的第一轮中被选中，而那些职业生涯平庸，甚至更差的球员通常在第一轮后被选中——至少基于 2000 年至 2009 年的选秀。这一发现为球队提供了明显的动力，希望 somehow 能进入选秀榜的首位。

摆烂是指在某个赛季故意输掉比赛，以确保在下个赛季的选秀中能获得更高的选秀顺位。NBA 选秀，每年在赛季结束后举行，是各支球队轮流选择美国和海外最佳合格球员的地方。与其他美国职业体育的选秀一样，NBA 选秀与精英制正好相反；它是一个“最差选先”的系统，将“奖励”给胜场数最少的球队以在选秀中优先选择的机会，从而获得选择最佳球员的权利。

根据上一章的发现，本章的假设是，对于想要成为赢家的输球球队来说，摆烂是一种合理且值得的策略。我们打算通过分段我们的数据，然后对它展示不同的、逐步更技术性的分析技术来探索这个假设。分段分析是根据一个或多个共同特征对数据进行划分的过程——通常客户，但这也可能是 NBA 首轮选秀球员的情况。

球队选择摆烂是因为这似乎有效；超级巨星是赢得冠军的绝对要求，而超级巨星几乎总是选秀前五名的选择（尽管前五名的选择并不总是超级巨星）。因此，球队必须输掉比赢得更多的比赛——如果需要的话，故意这样做——才能在选秀中选中潜在的超级巨星。但让我们看看数据对此有何说法。

3.1 关于摆烂和选秀的更多内容

对于那些不太熟悉 NBA 的你们来说，专注于获取超级巨星人才以赢得冠军的球队通常遵循两种行动计划之一：通过选秀或通过老将自由市场。NBA 选秀的一个无意中但持续的后果是，当球队的重建计划围绕它时，球队往往会摆烂；也就是说，球队通过交易他们的最佳球员和提升板凳球员来故意输掉比赛，以换取通过每年选秀权的累积而可能获得的长期竞争优势，尤其是高选秀权。

1985 年，在休斯顿火箭队摆烂到选秀榜顶端并选中了联盟历史上最伟大的球员之一哈基姆·奥拉朱旺之后，NBA 为最差的球队推出了一个抽签。 (火箭队随后赢得了两座联赛冠军。) 抽签通过随机化选秀顺序和剥夺球队基于胜负的保证结果来减少摆烂——在这个过程中也保护了比赛的完整性。某种程度上。

NBA 选秀仍然是一个坏政府，因为最差的球队在下一个赛季之前被奖励，因为摆烂给球队带来了至少是合理的获得高选秀权的可能性，而成功几乎没有任何机会。以费城 76 人队为例：从 2013 年到 2016 年，在第一次抽签近 30 年后，76 人队通过摆烂接近了选秀榜的顶端，在这个过程中赢得了 47 场常规赛，但在选中乔尔·恩比德和其他人之后，减去因 COVID-19 缩短的 2019-20 赛季，平均每赛季赢得 51 场比赛。顺便说一句，每个 NBA 球队都有一场 82 场的常规赛赛程；所以一个平均球队每赛季会有 41 场胜利。

冠军是通过超级巨星人才赢得的，而这种人才只能在选秀榜的顶端或附近才能获得。除了之前的交易，保证获得超级巨星人才的唯一方式就是摆烂。

以下分析旨在排除任何合理的怀疑，确定摆烂是否得到数据的支持。为此分析，我们将使用 R 的出色图形功能，扩展 R 的功能范围以计算预期值，甚至创建一个无监督学习算法。

3.2 加载包

第一件事是调用 R 的基础library()函数来加载包，然后才能超越基础 R 功能；如果不调用最新或最好的包和函数，你就不在用 R 的最好功能。作为提醒，包必须在使用时和地点加载；因为我们有一个脚本和章节之间的一对一关系，一些包被多次加载。此外，必须在调用任何函数之前加载包，这就是为什么在编写或运行其他代码行之前加载包是一个好习惯。

在第二章中，我们使用了三个包中的两个，即 tidyverse 和 patchwork。（这两个包，尤其是 tidyverse，将在此后的工作中被广泛使用。）我们在这里加载的新包是 networkD3 包，它使得创建桑基图或流程图以及其他独特的可视化成为可能。我们将创建的桑基图是本章中两个不是用 ggplot2 图形包（它是 tidyverse 的一部分）创建的可视化之一。然后我们通过调用 library() 函数三次来依次加载这些包：

library(tidyverse)
library(networkD3)
library(patchwork)

顺便说一句，有一种方法可以同时加载多个包，而不是依次调用 library() 函数。第一步是创建一个包含包名的向量作为参数；接下来，我们通过调用基础 R 的 c() 函数并传递 tidyverse、networkD3 和 patchwork 作为参数来创建一个名为 packages 的向量——实际上，你可以将其命名为任何你想要的名称。注意，每个包都被引号包围：

packages <- c("tidyverse", "networkD3", "patchwork")

第二步和最后一步是调用基础 R 的 lapply() 函数：

lapply(packages, library, character.only = TRUE)

从现在开始，我们将继续调用 library() 函数，但如果你的脚本需要很多包，c() 和 lapply() 的组合是一个很好的替代方案。现在我们已经加载了包，我们可以自由地调用任何所需的函数来执行我们的分析。

3.3 导入和查看数据

显然，在我们可以做其他任何事情之前，我们需要导入数据。我们通过执行以下操作结束了第二章：

• 创建了一个名为 draft2 的 tibble，它是 draft 数据集的副本。复制操作是在 draft 被整理之后进行的，其中，例如，许多原始变量被删除，创建了派生变量，并且删除了缺失数据的观测值。

• 然后调用了基础 R 的 write.csv() 函数来创建并保存 draft2 为 .csv 文件。

readr 的 read_csv() 函数现在被用来导入 draft2 数据集。因为我们导入的是 draft2 而不是 draft，所以没有必要重复执行上一章中进行的那些数据整理操作：

draft <- read_csv("draft2.csv")

dplyr 的 glimpse() 函数返回 draft2 的转置版本，其中列名或变量名垂直排列，数据的一个子集水平排列。在导入数据集后，一个自然且虽小但重要的下一步是获取其维度以及对其内容的预览；glimpse() 做得非常好：

glimpse(draft2)
## Rows: 291
## Columns: 18
## $ Rk       <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,...
## $ Year     <dbl> 2009, 2009, 2009, 2009, 2009, 2009, 2009, 2009...
## $ Pk       <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,...
## $ Tm       <chr> "LAC", "MEM", "OKC", "SAC", "MIN", "MIN", "GSW...
## $ Player   <chr> "Blake Griffin", "Hasheem Thabeet", "James Har...
## $ Age      <dbl> 20.106, 22.135, 19.308, 19.284, 18.252, 20.144...
## $ Pos      <chr> "F", "C", "G", "G-F", "G", "G", "G", "C-F", "G...
## $ Born     <chr> "us", "tz", "us", "us", "es", "us", "us", "us"...
## $ College  <chr> "Oklahoma", "UConn", "Arizona State", "Memphis...
## $ From     <dbl> 2011, 2010, 2010, 2010, 2012, 2010, 2010, 2010...
## $ To       <dbl> 2020, 2014, 2020, 2019, 2020, 2012, 2020, 2017...
## $ G        <dbl> 622, 224, 826, 594, 555, 163, 699, 409, 813, 5...
## $ MP       <dbl> 34.8, 10.5, 34.3, 30.7, 30.9, 22.9, 34.3, 18.8...
## $ WS       <dbl> 75.2, 4.8, 133.3, 28.4, 36.4, -1.1, 103.2, 16....
## $ WS48     <dbl> 0.167, 0.099, 0.226, 0.075, 0.102, -0.015, 0.2...
## $ Born2    <chr> "USA", "World", "USA", "USA", "World", "USA", ...
## $ College2 <dbl> 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1...
## $ Pos2     <chr> "F", "C", "G", "G-F", "G", "G", "G", "C-F", "G...

基础 R 的 dim() 函数仅返回对象的维度；也就是说，行数后面跟着列数。它是一个很好的 glimpse() 的替代品，特别是如果你想将 dim() 与 head() 和 tail() 函数配对以获取未转置的数据视图：

dim(draft2)
## [1] 291  18

我们将首先创建另一个派生变量，这在第二章中根本不需要，但事实上将驱动本章的大部分分析。我们将继续创建那个变量。

3.4 创建另一个派生变量

现在我们已经窥视了我们的数据，我们可以继续准备我们的数据，以便进行我们在这里的原因：进行分割分析。在第二章中，dplyr mutate() 函数和基础 R 的 ifelse() 函数同时被调用，以创建随后附加到选秀数据集（因此包含在 draft2 中）的变量。这些相同的函数在一段代码中被调用（见以下讨论），其中创建了一个名为 Pk2 的新变量，并用与原始变量 Pk 逻辑上相关的属性填充。为了按分割评估我们的数据，我们首先需要推导出这些分割，因为它们本身并不存在。

变量 Pk 是指 pick；它是一个表示选择或第一轮选择编号的数值变量。例如，詹姆斯·哈登在 2009 年 NBA 选秀中被选为第三位球员；因此，当变量 Player 等于 James Harden 时，变量 Pk 等于 3。由于最多有 30 个首轮选择，Pk 的最小值为 1，最大值为 30。以下是我们对分割的分析——我们的分析将集中在这些六个 Pk2 分割上，而不是 30 个 Pk 属性上：

• 当原始变量等于 1 到 5 之间的任何数字时，派生的变量 Pk2 等于 1-5。R 中的 %in% 操作符用于确定一个元素（如数字）是否包含在向量或数据框中。如果是肯定的，则将 Pk2 分配值为 1-5；否则，读取并执行下一行代码，依此类推。

• 当 Pk 等于 6 到 10 之间的任何数字时，Pk2 等于 6-10。

• 当 Pk 等于 11 到 15 之间的任何数字时，Pk2 等于 11-15。

• 当 Pk 等于 16 到 20 之间的任何数字时，Pk2 等于 16-20。

• 当 Pk 等于 21 到 25 之间的任何数字时，Pk2 等于 21-25。

• 当 Pk 等于 26 到 30 之间的任何数字时，Pk2 等于 26-30。

• 如果原始变量 Pk 不等于 1 到 30 之间的任何数字，则新变量 Pk2 将等于 NA。

虽然默认情况下 Pk2 是一个字符字符串，但它实际上是一个分类变量。选秀数据集 draft2 中的所有 291 名球员或首轮选择，应根据他们确切的选择位置分配到这六个类别或分割中的一个：

mutate(draft2, Pk2 = ifelse(Pk %in% 1:5, "1-5",
                     ifelse(Pk %in% 6:10, "6-10",
                     ifelse(Pk %in% 11:15, "11-15",
                     ifelse(Pk %in% 16:20, "16-20",
                     ifelse(Pk %in% 21:25, "21-25",
                     ifelse(Pk %in% 26:30, "26-30", "NA"))))))) -> draft2

实际上，我们下一行代码通过调用基础 R 的 as.factor() 函数将 Pk2 转换为因子变量。同样，这是对只能假设有限或固定值集的变量的一种最佳实践：

draft2$Pk2 <- as.factor(draft2$Pk2)

我们后续的分析——我们将从计算基本统计量和创建数据的视觉表示开始——将完全集中在这些和其他分割上。

3.5 可视化均值和中位数

你找不到比平均值和中位数更基本的统计指标了。这些指标是观察数据之间一般差异的有用指标，因此代表了我们分段分析的逻辑起点。在 draft2 数据集中，连续变量的平均值和中位数将通过一系列条形图进行可视化，这些条形图按我们刚刚创建的六个 Pk2 段进行细分：

• 总常规赛比赛数

• 每场常规赛的分钟数

• 职业生涯胜利份额

• 每 48 分钟比赛时间的胜利份额（NBA 比赛以常规时间结束，持续时间为 48 分钟）

我们想查看在这些绩效和生产率指标中，我们的六个 Pk2 段之间是否存在差异（如果有的话）以及是否存在相似性（如果有的话）。随着我们进入本节的剩余部分，我们将逐一检查这些变量。

根据我们对 2000 年至 2009 年 NBA 选秀的分析，我们最终得出结论——尽管是初步的——基于胜利份额，那些职业生涯最成功的球员通常在第一轮被选中，比其他球员更高。我们还发现，win shares 变量与常规赛比赛数、每场常规赛的分钟数以及每 48 分钟比赛时间的胜利份额高度正相关。因此，如果我们看到 1-5 段与其他五个段之间有明显的分离，那么这可能是摆烂的统计依据——这正是我们打算明确确定的事情。

3.5.1 常规赛比赛数

总常规赛比赛数是衡量才能的一个合理指标。除了伤病之外，NBA 最优秀和最可靠的球员职业生涯更长，因此他们在常规赛中的出场次数比那些经常被年轻和更有潜力的球员取代的球员更多。

在下面的 dplyr 代码块中，我们调用 summarize() 函数，首先按变量 Pk2 中的每个因子或段计算常规赛比赛的均值和中位数。然后，使用前面的代码行，我们指示 summarize() 计算每个 Pk2 段的常规赛比赛数占所有 291 名球员在 draft2 数据集中比赛总数的百分比。结果是名为 tibble1 的新 6 × 4 tibble：

sumG <- sum(draft2$G)
draft2 %>% 
  group_by(Pk2) %>%
  summarize(mean = mean(G),
            median = median(G),
            pct = sum(G)/sumG) -> tibble1
print(tibble1)
## # A tibble: 6 × 4
##   Pk2    mean median   pct
##   <fct> <dbl>  <dbl> <dbl>
## 1 1-5    716\.   750\. 0.234
## 2 11-15  444\.   400  0.142
## 3 16-20  498\.   550  0.163
## 4 21-25  453\.   420  0.148
## 5 26-30  456\.   478  0.125
## 6 6-10   579\.   602\. 0.189

这些结果通过一对表示平均值和中位数的 ggplot2 条形图进行可视化：

• 将 stat 参数设置为 "identity" 并传递给 geom_bar() 函数，告诉 R 计算按 x 轴变量分组的 y 轴变量的总和，并以矩形条形图的形式显示每个 Pk2 段的结果。否则，geom_bar() 将仅返回 x 轴变量中每个唯一属性的出现次数。此外，我们还将条形的宽度缩小到 ggplot2 默认宽度的 80%。

• 调用scale_x_discrete()函数来在 x 轴上硬编码Pk2段的序列，从左到右。否则，ggplot2会将Pk2段6-10放在最后，仅仅是因为 6 是一个在 1 或 2 之后的数字。

• 调用geom_text()函数来添加标签——通过将均值和中位数传递给基础 R 的trunc()函数，这些度量被截断为最接近的整数，然后在条形上方添加截断后的均值和中位数版本。

• 调用geom_label()函数来添加tibble1变量pct——截断并乘以 100——在条形内部。由于这些和其他图表的注释已被截断，以下结果可能看起来“不正确”，但实际上，总数和百分比只是四舍五入到最接近的整数。

• 调用ylim()函数来延长 y 轴的长度，使其从 0 开始，到 800 结束；如果调用geom_text()或geom_label()函数在条形上方添加标签，这通常是出于美观原因。

g1 <- ggplot(tibble1, aes(x = Pk2, y = mean)) + 
  geom_bar(stat = "identity", width = .8, 
           fill = "coral", color = "coral4") + 
  labs(title = "Average Career Games Played",
       subtitle = "First-Round Selections between
       2000 and 2009 NBA Drafts", 
       x = "Segment", 
       y = "Average Career Games Played",
       caption = "regular season games only") + 
  scale_x_discrete(limits = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30"),
                   labels = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30")) +
  geom_text(aes(label = trunc(mean), vjust = -0.3)) +
  geom_label(aes(label = trunc(pct*100), vjust = 1.2)) +
  ylim(0, 800) +
  theme(plot.title = element_text(face = "bold"))

g2 <- ggplot(tibble1, aes(x = Pk2, y = median)) + 
  geom_bar(stat = "identity", width = .8, 
           fill = "coral3", color = "coral4") + 
  labs(title = "Median Career Games Played",
       subtitle = "First-Round Selections between
       2000 and 2009 NBA Drafts", 
       x = "Segment", 
       y = "Median Career Games Played",
       caption = "regular season games only") + 
  scale_x_discrete(limits = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30"),
                   labels = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30")) +
  geom_text(aes(label = trunc(median), vjust = -0.3)) +
  geom_label(aes(label = trunc(pct*100), vjust = 1.2)) +
  ylim(0, 800) +
  theme(plot.title = element_text(face = "bold"))

随后调用plot_layout()函数从patchwork包将这两个可视化，g1和g2，捆绑成一个单一的图形对象，其中第一个可视化位于第二个之上（见图 3.1）。如果传递给plot_layout()的ncol参数等于2，这两个可视化将并排打印，而不是g1堆叠在g2之上：

g1 + g2 + plot_layout(ncol = 1)

图 3.1 第一轮段均值和中位数游戏，附加在条形上方。条形内部的白色框标签表示总游戏数的百分比。

可视化数据比阅读一排排数字更容易、更快速地解读。以下是我们从第一对条形图中得出的结论：

• 在1-5段内选出的球员在常规赛中比赛次数多于其他任何一组首轮选择。实际上，尽管这些球员大约代表了 17%的选秀记录，但他们共同参加了超过 23%的常规赛。

• 在6-10段内选出的球员在常规赛中比赛次数多于第一轮后期选出的球员。他们同样大约代表了 17%的选秀记录，但不少于 18%的总常规赛比赛。

• 因此，在选秀 2 中，大约 34%的首轮选择占到了总常规赛比赛数的 41%以上。

• 在其他任何段位中，常规赛比赛的比例都没有超过或等于它们各自在选秀 2 记录中的比例；换句话说，11-15、16-20、21-25和26-30这四个段位各自向选秀 2 数据集贡献了大约 17%的记录，然而这四个段位在常规赛中的总比赛比例始终低于 17%。这绝对支持了我们的假设——那些摆烂并因此提升选秀板位的球队更有可能选秀到一名将比其他球员参加更多比赛的球员。

3.5.2 每场比赛的出场时间

每场常规赛的出场时间可能实际上比比赛次数更有说明力；毕竟，许多球员由于健康和可靠性而拥有漫长的职业生涯，但并不一定在过程中获得大量的出场时间。话虽如此，我们的下一步行动基本上是重复我们刚刚完成的练习，但以下是一些变化：

• 将每场常规赛的出场时间变量插入到类似的dplyr和ggplot2代码块中，以代替常规赛的比赛。

• 我们随后的dplyr代码块产生了一个新的对象tibble2，然后将其传递给ggplot()函数。

• 然后我们向geom_bar()函数传递不同的填充和颜色。

• 由于变量交换，图表标题和 y 轴标签，即传递给labs()函数的两个参数，被更改了。

• 根据变量变化相应地调整 y 轴的比例，这也是由于变量变化。

否则，我们正在创建额外的成对ggplot2条形图，其中平均值显示在顶部，中位数显示在底部，当然，按我们的六个Pk2段位细分（见图 3.2）：

sumMP <- sum(draft2$MP)
draft2 %>% 
  group_by(Pk2) %>%
  summarize(mean = mean(MP),
            median = median(MP),
            pct = sum(MP)/sumMP) -> tibble2

mp1 <- ggplot(tibble2, aes(x = Pk2, y = mean)) + 
  geom_bar(stat = "identity", width = .8, 
           fill = "deepskyblue", color = "deepskyblue4") + 
  labs(title = "Average Minutes Played per Game",
       subtitle = "First-Round Selections between 
       2000 and 2009 NBA Drafts", 
       x = "Segment", 
       y = "Average Minutes Played per Game",
       caption = "regular season games only") + 
  scale_x_discrete(limits = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30"),
                   labels = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30")) +
  geom_text(aes(label = trunc(mean), vjust = -0.3)) +
  geom_label(aes(label = trunc(pct*100), vjust = 1.2)) +
  ylim(0, 30) +
  theme(plot.title = element_text(face = "bold"))

mp2 <- ggplot(tibble2, aes(x = Pk2, y = median)) + 
  geom_bar(stat = "identity", width = .8, 
           fill = "deepskyblue3", color = "deepskyblue4") + 
  labs(title = "Median Minutes Played per Game",
       subtitle = "First-Round Selections between 
       2000 and 2009 NBA Drafts", 
       x = "Segment", 
       y = "Median Minutes Played per Game",
       caption = "regular season games only") + 
  scale_x_discrete(limits = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30"),
                   labels = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30")) +
  geom_text(aes(label = trunc(median), vjust = -0.3)) +
  geom_label(aes(label = trunc(pct*100), vjust = 1.2)) +
  ylim(0, 30) +
  theme(plot.title = element_text(face = "bold"))

mp1 + mp2 + plot_layout(ncol = 1)

图 3.2 第一轮段位每场比赛平均和中值出场时间

这些结果与我们的第一组结果相似，但同时又更加明确。它们在这里为您总结：

• 在1-5段被选中的球员，平均每场比赛比6-10段的球员多出约 18%的出场时间，比其他四个段的球员多出约 33%的出场时间。

• 1-5段和6-10段之间存在明显的差异，而6-10段与其他所有段之间也存在进一步的差异。

• 在11-15、16-20、21-25和26-30段位之间几乎没有差异。

所有这些进一步支持我们的假设，即摆烂是有意义的——如果这是球队在1-5段或甚至6-10段选择，而不是第一轮其他任何地方的话。现在让我们来看看胜利份额。

3.5.3 职业胜利份额

如第二章所述，赢分基本上是将每位球员的进攻和防守统计数据汇总成一个单一指标。否则，它等于每位球员对其球队总赢分的整体贡献或份额。为了更清楚地说明，在其职业生涯中累积至少 50 个赢分的球员，大多数情况下是多年的全职首发；累积 75 到 100 个职业生涯赢分的球员通常是频繁的全明星球员；而累积超过 100 个职业生涯赢分的球员无疑是名人堂材料。另一方面，赢分在 25 个或更少的球员通常是替补、边缘球员，有时甚至更糟。

卡里姆·阿卜杜尔-贾巴尔，被密尔沃基雄鹿队选中，但后来在洛杉矶湖人队度过了大部分职业生涯，曾在一个赛季中累积了创纪录的 25.4 个赢分，他的 273.4 个职业生涯赢分仍然是历史记录。仍在比赛的勒布朗·詹姆斯并不落后。

以下代码块与我们的先前dplyr和ggplot2代码块类似，除了我们用赢分替换了它们。对geom_bar()、labs()和ylim()函数的相应更改也适用：

sumWS <- sum(draft2$WS)
draft2 %>% 
  group_by(Pk2) %>%
  summarize(mean = mean(WS),
            median = median(WS),
            pct = sum(WS)/sumWS) -> tibble3

ws1 <- ggplot(tibble3, aes(x = Pk2, y = mean)) + 
  geom_bar(stat = "identity", width = .8, 
           fill = "springgreen", color = "springgreen4") + 
  labs(title = "Average Career Win Shares",
       subtitle = "First-Round Selections between 
       2000 and 2009 NBA Drafts", 
       x = "Segment", 
       y = "Average Career Win Shares",
       caption = "regular season games only") + 
  scale_x_discrete(limits = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30"),
                   labels = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30")) +
  geom_text(aes(label = trunc(mean), vjust = -0.3)) +
  geom_label(aes(label = trunc(pct*100), vjust = 1.2)) +
  ylim(0, 60) +
  theme(plot.title = element_text(face = "bold"))

ws2 <- ggplot(tibble3, aes(x = Pk2, y = median)) + 
  geom_bar(stat = "identity", width = .8, 
           fill = "springgreen3", color = "springgreen4") + 
  labs(title = "Median Career Win Shares",
       subtitle = "First-Round Selections between 
       2000 and 2009 NBA Drafts", 
       x = "Segment", y = "Median Career Win Shares",
       caption = "regular season games only") + 
  scale_x_discrete(limits = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30"),
                   labels = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30")) +
  geom_text(aes(label = trunc(median), vjust = -0.3)) +
  geom_label(aes(label = trunc(pct*100), vjust = 1.2)) +
  ylim(0, 70) +
  theme(plot.title = element_text(face = "bold"))

第三次，我们的最终目标是两个ggplot2条形图，它们被压缩在一个图形表示中，显示了每个Pk2段位的计算平均值，位于顶部，以及每个Pk2段位的计算中位数，位于底部（见图 3.3）：

ws1 + ws2 + plot_layout(ncol = 1)

图 3.3 第一轮段位的平均和中位职业生涯赢分

哇，段位之间的差距——1-5与6-10，以及6-10与其他四个段位之间的差距——甚至比我们之前看到的更加明显。更具体地说，考虑以下：

• 在1-5段位的球员，平均而言，累积的职业生涯赢分是6-10段位球员的两倍，是其他任何段位球员的三倍左右。

• 这些相同的球员——再次，占选秀 2 人口的 17%——占所有赢分的 34%，而排名前两段的球员，大约占选秀 2 人口的 34%，占所有赢分的至少 53%。

• 虽然在选秀的前端存在显著差异，但在11-15到26-30段位之间几乎没有差异。

• 这是我们迄今为止最好的证据，证明我们的初始假设是正确的；在最重要的指标上，我们看到了顶级段位与其他段位之间最大的差异。

最后，让我们来检查我们的第二个赢分变量，WS48。这个变量代表每 48 分钟常规赛比赛时间的累积赢分。

3.5.4 每 48 分钟的赢分

下面的dplyr代码计算了每个Pk2段位的变量WS48的平均值和中位数，以及用于可视化的ggplot2代码：

sumWS48 <- sum(draft2$WS48)
draft2 %>% 
  group_by(Pk2) %>%
  summarize(mean = mean(WS48),
            median = median(WS48),
            pct = sum(WS48)/sumWS48) -> tibble4

ws3 <- ggplot(tibble4, aes(x = Pk2, y = mean)) + 
  geom_bar(stat = "identity", width = .8, 
           fill = "gold", color = "gold4") + 
  labs(title = "Average Win Shares per 48 Minutes",
       subtitle = "First-Round Selections between 
       2000 and 2009 NBA Drafts", 
       x = "Segment", 
       y = "Average Win Shares per 48 Minutes",
       caption = "regular season games only") + 
  scale_x_discrete(limits = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30"),
                   labels = c("1-5", "6-10", "11-15",
                              "16-20", "21-25", "26-30")) +
  geom_text(aes(label = round(mean, 2), vjust = -0.3)) +
  geom_label(aes(label = trunc(pct*100), vjust = 1.2)) +
  ylim(0, 0.13) +
  theme(plot.title = element_text(face = "bold"))

ws4 <- ggplot(tibble4, aes(x = Pk2, y = median)) + 
  geom_bar(stat = "identity", width = .8, 
           fill = "gold3", color = "gold4") + 
  labs(title = "Median Win Shares per 48 Minutes",
       subtitle = "First-Round Selections between 
       2000 and 2009 NBA Drafts", 
       x = "Segment", y = "Median Win Shares per 48 Minutes",
       caption = "regular season games only") + 
  scale_x_discrete(limits = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30"),
                   labels = c("1-5", "6-10", "11-15", 
                              "16-20", "21-25", "26-30")) +
  geom_text(aes(label = round(median, 2), vjust = -0.3)) +
  geom_label(aes(label = trunc(pct*100), vjust = 1.2)) +
  ylim(0, 0.13) +
  theme(plot.title = element_text(face = "bold"))

ws3 + ws4 + plot_layout(ncol = 1)

紧接着是第四对和最后一对条形图——当然，这是不同的指标，但布局大致相同，结果也差不多（见图 3.4）。

图 3.4 第一轮各段每 48 分钟的平均和中位胜分

由于每 48 分钟比赛时间的胜分与其他指标相比显著降低，因此顶尖和底部段之间的差异可能看起来不那么明显，但它们与我们之前的结果非常相似。以下是我们为您总结的发现：

• 1-5段的球员在每 48 分钟比赛时间的胜分比6-10段的球员多近 20%，比其他段的球员多近 40%。

• 换句话说，6-10段与剩余四个段之间，每 48 分钟比赛时间的胜分差异超过 20%。

• 与其他指标一样，1-5段和6-10段之间存在明显的差异，而6-10段与剩余段之间也有进一步的差异。

• 在11-15到26-30段之间，性能和生产力是随机的。这是我们的假设正确的进一步证据：摆烂绝对是合理的，特别是对于意图通过选秀重建阵容的球队来说……如果故意输球能够让他们提升到足以选择1-5段或最坏的情况是6-10段的球员。

现在我们已经计算并可视化了最重要的选秀 2 变量的平均值和众数——在这个过程中，我们展示了选秀顶端与其他第一轮之间的明显差异——我们接下来应该记录我们到目前为止最重要的发现。

3.6 初步结论

那么，我们到目前为止都确定了什么？有什么影响？以及我们还有什么没有确定的？

• 无论从哪个角度衡量，1-5段选出的球员与6-10段选出的球员在性能和生产力上都有明显的差异，而6-10段与11-15段选出的球员之间也有进一步的差异。

• 在第一轮的11-15段以及之后的比赛中，几乎没有任何性能或生产力的差异，无论从哪个角度来衡量。

• 因此，对于想要——或者需要——选择潜在超级巨星的球队来说，有一个明确的激励让他们设法达到选秀榜的顶端或非常接近顶端。如果球队想要——或者需要——选择一个潜在超级巨星，那么在选秀榜上选择或在接近顶端的位置选择无疑是最好的。

• 但如何达到这个目标呢？向上交易几乎是不可能的，因为这当然需要另一支球队向下交易。只要 NBA 继续奖励输球队伍以高选秀权，球队就会——并且应该——摆烂，这当然会损害比赛的完整性。

• 最后，我们需要避免得出超出我们分析范围的泛泛结论。20 世纪 70 年代也有球队摆烂；他们可能这么做是因为他们想增加选中潜在超级巨星的几率。但我们无法合理化这一点。我们只能说，根据对 2000 年至 2009 年 NBA 选秀以及那些在首轮被选中的球员随后职业生涯的分析，摆烂是有道理的。永远不要将结果应用于测试和分析范围之外的情况。

说到这里，请记住，在 draft2 数据集中，拥有 100 多场胜利贡献值的球员中，除了两个球员外，所有球员在进入 NBA 选秀时都是前五顺位的选择；只有托尼·帕克，2001 年被圣安东尼奥以第 28 顺位选中，以及斯蒂芬·库里，2009 年被金州勇士以第七顺位选中，他们的选秀顺位不在前五，并且拥有超过 100 场胜利贡献值。NBA 冠军球队通常至少有两名前五顺位的选择（自 2000 年以来，只有两个联盟冠军只有一名前五顺位的选择，而且从那时起没有一支冠军球队没有前五顺位的选择）；然而，前五顺位的选择并不一定能保证赢得冠军。在我们数据集中的 50 名前五顺位的选择中，只有 11 名后来赢得了联盟冠军。

3.7 桑基图

我们接下来的技术是尝试将我们的结果整合成一个单一的图形对象。桑基图是一种流程图，其中一对节点之间的连接器或链接的宽度与数量成比例。创建一个桑基图特别繁琐——正如你即将发现的那样——但回报绝对值得投资。桑基图不仅看起来令人印象深刻，而且还能提供揭示性和可操作的见解。你可能对桑基图并不那么熟悉，但你应该熟悉，因为它们有大量的应用场景。例如，考虑以下：

• 人力资源领导者分析他们公司从端到端的就业申请流程，从功能组织和工作需求开始；然后包括简历和申请的接收渠道，包括职位发布板、招聘公司和内部推荐；最后，对每个候选人的状态进行分解。他们可能会决定在吸引最多或最佳候选人的两个职位发布板上发布新的机会。

• 非营利组织的管理者跟踪他们组织的收入来源，包括捐赠、补助金和会员费；资本和运营费用；以及用于教育、科学、宗教和文学目的的奖项的货币价值。管理者可能会决定提高会员费，寻求更多针对科学追求的补助金，或者寻找更便宜的办公空间。

• 一位没有机器学习背景的市场经理，通过细分客户的学历、职业类型和婚姻状况，绘制了针对直接营销活动的肯定/否定响应图。最后成对的节点——客户是否对活动做出响应——相当于机器学习模型中的目标或响应变量。经理可能会通过针对具有特定人口统计特征的客户来修改营销活动，而忽略其他具有其他特征的客户。

图 3.5 显示了一个相对简单的桑基图，仅用于说明。我们有一个虚构的 NBA 球队试图出售下一场主场比赛的最后几张剩余门票。球队向其啦啦队中的男性和女性发送营销电子邮件或短信。记录在案的移动电话号码比电子邮件地址多得多；此外，啦啦队中的男性比女性多得多。然后，大多数男性购买了一张或多张门票，而大多数女性则放弃。

图 3.5 仅用于说明目的的桑基图样本。垂直的长方形是节点，连接一对节点的带状物是链接。链接的宽度是数量的表示。在这个例子中，发送的短信比电子邮件多，收到某种类型数字通信的男性比女性多，然后大多数男性做出肯定回应，而大多数女性则没有。

我们接下来的代码块生成一个桑基图，从左到右的节点分组源自这些派生变量：

• Born2—在第二章中创建的二进制变量，等于USA或World。

• College2—在第二章中创建的另一个二进制变量，分别对应“无大学”和“大学”时等于0或1。

• Age2—一个新变量（在以下列表中讨论），原始变量Age被截断为整数。在 draft2 数据集中，每位球员在成为职业球员时年龄在 17 到 25 岁之间。

• Pos2—在第二章中创建的变量，将原始变量Pos中的球员位置合并并拼写出来；此变量等于Big、Center、Forward、Guard或Swingman。

• Pk2—从原始变量Pk派生出的变量，等于1-5、6-10、11-15、16-20、21-25或26-30。

• WS3—一个新变量（在以下列表中讨论），原始变量WS（简称win shares）被截断为整数，然后分配到六个类别或细分市场之一。

我们的第一项任务是创建变量Age2，然后是WS3。关于Age2，我们将draft2数据集传递给dplyr的mutate()函数，并将Age2赋值为原始变量Age的截断版本。对于WS3，我们首先调用mutate()创建一个名为WS2的变量，它是原始变量WS的截断版本；然后我们将WS2通过管道传递到mutate()和case_when()函数（case_when()是基础 R 的ifelse()函数的dplyr等价物）来创建WS3，它是WS2分成六个部分。例如，如果WS2等于47，那么WS3应该等于40-59。创建Age2和WS3的净效果是减少桑基图中的节点和链接数量，从而减少我们需要编写的代码量：

draft2 %>%
  mutate(Age2 = trunc(Age)) -> draft2

draft2 %>%
  mutate(draft2, WS2 = trunc(WS)) %>%
  mutate(WS3 = case_when(WS2 <= 19 ~ "<20",
                            WS2 >= 20 & WS2 <= 39 ~ "20-39",
                            WS2 >= 40 & WS2 <= 59 ~ "40-59",
                            WS2 >= 60 & WS2 <= 79 ~ "60-79",
                            WS2 >= 80 & WS2 <= 99 ~ "80-99",
                            WS2 >= 100 ~ "100+")) -> draft2

我们的第二项任务是创建节点。变量和节点分组之间应该存在一对一的关系，这意味着我们的桑基图将包含六个节点分组。此外，六个变量之间的唯一属性和节点总数之间也应该存在一对一的关系。例如，Born2和College2都是二元变量，因此这两个节点分组各自应包含两个节点。实际上，我们的桑基图将包含 30 个节点。接下来的代码块通过组合基础 R 的data.frame()和c()函数创建了一个单向量数据框，称为nodes：

nodes <- data.frame(
"name" = c("USA", "World",
                "0", "1",
                "17", "18", "19", "20", "21", "22", "23", "24", "25",
                "Big",  "Center", "Forward", "Guard",  "Swingman",
                "1-5",  "6-10", "11-15", "16-20", "21-25", "26-30",
                "<20", "20-39", "40-59", "60-79", "80-99", "100+"))

我们的第三项任务是创建另一个数据框，称为links。链接数据框中的每一组三个数字代表连接两个节点的链接，其中序列中的第一个数字是连接的节点（源），第二个数字表示连接到的节点（目标），第三个数字表示它们之间流动的值或数量（值）：

links <- as.data.frame(matrix(c(
  0,2,21, 0,3,203,
  1,2,51, 1,3,16,
  2,4,1, 2,5,20, 2,6,19, 2,7,15, 2,8,12, 2,9,5, 2,10,0, 2,11,0, 2,12,0,
  3,4,0, 3,5,3, 3,6,32, 3,7,50, 3,8,58, 3,9,58, 3,10,14, 3,11,3, 3,12,1,
  4,13,0, 4,14,0, 4,15,1, 4,16,0, 4,17,0,
  5,13,2, 5,14,8, 5,15,6, 5,16,2, 5,17,5,
  6,13,11, 6,14,6, 6,15,15, 6,16,14, 6,17,5,
  7,13,7, 7,14,12, 7,15,19, 7,16,24, 7,17,3,
  8,13,9, 8,14,7, 8,15,19, 8,16,25, 8,17,10,
  9,13,5, 9,14,5, 9,15,23, 9,16,24, 9,17,6,
  10,13,0, 10,14,1, 10,15,4, 10,16,6, 10,17,3,
  11,13,0, 11,14,1, 11,15,2, 11,16,0, 11,17,0,
  12,13,0, 12,14,1, 12,15,0, 12,16,0, 12,17,0, 
  13,18,7, 13,19,6, 13,20,8, 13,21,3, 13,22,2, 13,23,8,
  14,18,7, 14,19,6, 14,20,7, 14,21,7, 14,22,6, 14,23,9,
  15,18,16, 15,19,18, 15,20,13, 15,21,13, 15,22,13, 15,23,15,
  16,18,15, 16,19,13, 16,20,15, 16,21,22, 16,22,18, 16,23,12,
  17,18,5, 17,19,6, 17,20,7, 17,21,5, 17,22,3, 17,23,6,
  18,24,12, 18,25,9, 18,26,9, 18,27,6, 18,28,2, 18,29,12,
  19,24,19, 19,25,15, 19,26,5, 19,27,7, 19,28,3, 19,29,1,
  20,24,33, 20,25,9, 20,26,3, 20,27,3, 20,28,1, 20,29,0,
  21,24,27, 21,25,12, 21,26,8, 21,27,1, 21,28,2, 21,29,0,
  22,24,30, 22,25,10, 22,26,7, 22,27,2, 22,28,1, 22,29,0,
  23,24,26, 23,25,10, 23,26,2, 23,27,3, 23,28,0, 23,29,1),
  byrow = TRUE, ncol = 3))
names(links) = c("source", "target", "value")

我们第四和最后一项任务是调用networkD3包中的sankeyNetwork()函数来绘制桑基图（参见图 3.6）。传递给sankeyNetwork()函数的参数是强制性的且固定的：

sankeyNetwork(Links = links, Nodes = nodes,
                Source = "source", Target = "target",
                Value = "value", NodeID = "name",
                fontSize = 12, nodeWidth = 30)  

图 3.6 显示相邻节点集之间流动或数量的桑基图。从左到右看，2000 年至 2009 年 NBA 选秀第一轮被选中的大多数球员出生在美国（USA）而不是其他国家（世界）。选择大学或学院（1）的球员比没有选择（0）的球员多。大多数球员在 19 至 22 岁时进入 NBA 选秀。被选为前锋和后卫的球员比其他位置的球员多。球员被分配到六个相等的“选择”段，这取决于他们在第一轮被选中的位置。所有球员都积累了一定数量的胜利份额；只有一小部分首轮选秀球员积累了大量胜利份额，而且大多数都是在1-5段被选中的。

桑基图在 RStudio 中是交互式的。当你将光标移至一个节点上时，R 会突出显示节点之间的链接，并产生一个小弹出窗口，提供节点名称和从该节点流出的流量量。当你将光标移至链接上时，R 会突出显示它，并产生一个弹出窗口，标识连接的节点以及它们之间的流量量。

以下dplyr代码返回之前提供给链接数据框的数字或值。draft2数据集被count()函数管道五次，该函数计算draft2观察值在相邻节点分组之间的每个组合中的数量：

draft2 %>%
  count(Born2, College2)
draft2 %>%
  count(College2, Age2)
draft2 %>%
  count(Age2, Pos2)
draft2 %>%
  count(Pos2, Pk2)
draft2 %>%
  count(Pk2, WS3)

由于空间考虑，结果在此未重复，但它们当然反映在我们桑基图的构建中。

你现在可能明白了为什么桑基图并不那么普遍。想象一下，如果还有更多的节点。然而，这张图表有效地可视化了我们导出的变量的定量分解以及它们之间的关系。桑基图之所以有效，是因为这里描绘的“过程”是序列的或线性的。例如，我们可以轻松地看到以下内容：

• 在 2000 年至 2009 年的 NBA 选秀中，首轮选秀球员中出生在美国的人数是其他国家的四倍左右。

• 大多数在美国出生的首轮选秀球员在转为职业球员之前都曾在大学里打球，而大多数在美国以外出生的首轮选秀球员则没有在大学里打球。

• 更多首轮选秀球员，无论他们出生在哪里以及他们是否在大学里首次亮相，当他们进入 NBA 选秀时，年龄都在 19 到 22 岁之间。当他们转为职业球员时，很少有球员年龄小于 19 岁或大于 22 岁。

• 首轮选秀中，前锋和后卫比其他位置的球员更多。

• 在各自的职业生涯中拥有 100 次或更多胜场的球员大多数都是在选秀的非常顶端或附近被选中的。

• 职业胜场数在 80 到 99 之间的球员大多数是在1-5和6-10 Pk2段之间被选中的。

• 职业胜场数少于 20 次的球员来自所有Pk2段，但其中大多数球员是在11-15和26-30 Pk2段之间被选中的。

在1-5或6-10段被选中的球员，尤其是1-5段的球员，在职业胜场数的六个段中大致平均分配，但之后被选中的球员，从11-15段开始，更有可能在他们的职业生涯中获得少于 20 次胜场。在决定是否摆烂时，球队应考虑我们首次分段分析的结果，但他们也应记住最佳可用球员的人口统计和其他属性。

3.8 预期值分析

到目前为止，我们的分析清楚地表明，NBA 球队应该对前五名选秀权和任何其他首轮选秀权有非常不同的期望。让我们通过计算 2000 年至 2009 年 NBA 选秀的结果来计算前五名选秀权的预期值，与任何其他首轮选秀权的预期值进行比较。预期值是通过将可能结果乘以其概率然后汇总这些结果来计算的；它是一系列简单的数学计算，当结果不确定时进行计算，但我们仍然可以根据每个可能性的加权平均得到一个可能的价值。预期值是一种在金融和风险分析中最普遍的技术，但它也适用于许多其他领域和事业。以下是关于预期值的一些具体信息：

• 预期值代表可以预期的平均价值或回报，通常来自特定的决策或行动，当有多种可能结果时。

• 预期值是通过将每个可能结果乘以其发生的概率然后汇总这些乘积来计算的。因此，预期值 = (结果[1] × 概率[1]) + (结果[2] × 概率[2]) + ... + (结果[N] × 概率[N])。项数必须等于潜在结果的数量。

• 当必须做出决策，而外部环境不确定且可能具有风险时，预期值是一种常见的分析技术。应该考虑具有最高预期值的选项为最佳选择。

• 虽然可能不言而喻，但必须事先知道结果和概率，或者，作为替代，可以从历史数据中准确估计。

根据每个球员在首轮选秀中的位置（1-5或6-30），将 draft2 数据集划分为两个群体，然后根据每个球员赢得或已赢得的胜场数再次划分（一些球员仍在活跃中）。为了这次练习，以下指定被使用：

• 职业胜场数达到 100 或以上的球员被指定为超级巨星。

• 职业胜场数在 75 到 100 之间的球员是明星球员。

• 职业胜场数在 50 到 75 之间的球员被指定为首发球员。

• 职业胜场数在 25 到 50 之间的球员被指定为预备球员。

• 职业胜场数少于 25 的球员被指定为边缘球员。

现在，看看表 3.1 和表 3.2。它们结构相同（意味着它们有相同的列和行），但表 3.1 是针对1-5段的，而表 3.2 是针对6-30段的。

表 3.1 NBA 选秀中1-5段的预期值

段（A）	胜场数（B）	概率（C）	中位数（D）	预期值（E）
超级巨星	> 100	0.24	127.00	30.48
星级	75-99.99	0.08	79.65	6.37
首发球员	50-74.99	0.16	59.90	9.58
预订	25-49.99	0.20	39.95	7.99
边缘球员	< 25	0.32	9.70	3.10
		1.00		57.53¹

表 3.2 从 11-15 到 26-30 段的 NBA 招募挑选期望值

段落（A）	胜利份额（B）	概率（C）	中间值（D）	期望值（E）
超级巨星	> 100	0.01	107.25	1.07
明星	75-99.99	0.04	83.00	3.32
首发	50-74.99	0.11	60.60	6.67
替补	25-49.99	0.21	35.00	7.35
边缘	< 25	0.63	5.00	3.15
		1.00		21.21²

从左到右，我们有以下内容：

• 段落（A）和胜利份额（B）列一起代表之前列表中总结的球员细分；也就是说，我们的两个表格都必然有五行——每一行对应于球员指定的每个部分。

• 概率（C）列实际上是一个条件概率。例如，当球队拥有前五顺位之一时，他们有 24% 的机会选中未来的超级巨星（等于 50 名拥有 100 个或更多胜利份额的球员中的 12 名）；而在第一轮的其他位置选秀的球队，选中未来超级巨星的概率仅为 1%（等于 50 名拥有 100 个或更多胜利份额的球员中的 2 名）。因此，每个表格中的五个概率数字加起来等于 1。

• 中间值（D）列代表每个段落（A）和胜利份额（B）组合的职业生涯胜利份额的中位数。例如，那些在 1-5 段落中被选中并积累了 100 个或更多胜利份额的球员的中位胜利份额为 127。在这里选择中位数而不是平均值是为了减轻异常值的影响。

• 期望值（E）列代表概率（C）和中间值（D）的乘积。然后通过将每个结果的和相加，我们得到 1-5 挑选与 6-30 挑选的期望值（E）。根据 2000 年至 2009 年的 NBA 招募，1-5 段落中被选中的球员的期望值为 57.53；换句话说，任何一位所有者、总经理、球迷——任何人——都可以预期在 1、2、3、4 或 5 号位置被选中的球员在其职业生涯中积累大约 58 个胜利份额。相比之下，被选中为第六位或以下的球员——这些球员在其各自的职业生涯中可以预期积累仅 21 个胜利份额。这就是多年全职首发与最多只是一个职业生涯替补之间的区别。

在 R 中有许多方法可以执行期望值分析，这些方法之间并不一定有哪一个比其他更好。在这里，我们调用基础 R 的 c() 函数来创建一个名为 probs1 的向量。probs1 的值是通过 dplyr 代码创建的；将 draft2 数据集反复通过 dplyr filter() 函数，该函数对 draft2 进行子集化，例如，变量 Pk 小于 6 且变量 WS 大于 100。剩余的 draft2 通过 dplyr tally() 函数计数，然后除以 50，这等于在 NBA 招募中首先被选中至第五位的球员人数。

这一系列操作重复四次，返回一个向量，其值等于表 3.1 中提供的概率：

c(draft2 %>%
  filter(Pk < 6 & WS > 100) %>%
  tally() / 50,
draft2 %>%
  filter(Pk < 6 & WS > 75 & WS < 100) %>%
  tally() / 50,
draft2 %>%
  filter(Pk < 6 & WS > 50 & WS < 75) %>%
  tally() / 50,
draft2 %>%
  filter(Pk < 6 & WS > 25 & WS < 50) %>%
  tally() / 50,
draft2 %>%
  filter(Pk < 6 & WS < 25) %>%
  tally() / 50) -> probs1
print(probs1)
## $n
## [1] 0.24
## 
## $n
## [1] 0.08
## 
## $n
## [1] 0.16
## 
## $n
## [1] 0.2
## 
## $n
## [1] 0.32

c()函数再次被调用，这次是为了创建一个名为vals1的向量。在c()函数内部，我们调用filter()函数来像之前一样对 draft2 数据集进行子集化；然而，这一次，结果被传递到dplyr summarize()函数，该函数计算中位数胜利份额。最终结果是第二个向量，其值等于表 3.1 中的中位数：

c(draft2 %>%
  filter(Pk < 6 & WS > 100) %>%
  summarize(med = median(WS)),
draft2 %>%
  filter(Pk < 6 & WS > 75 & WS < 100) %>%
  summarize(med = median(WS)),
draft2 %>%
  filter(Pk < 6 & WS > 50 & WS < 75) %>%
  summarize(med = median(WS)),
draft2 %>%
  filter(Pk < 6 & WS > 25 & WS < 50) %>%
  summarize(med = median(WS)),
draft2 %>%
  filter(Pk < 6 & WS < 25) %>%
  summarize(med = median(WS))) -> vals1
print(vals1)
## $med
## [1] 127
## 
## $med
## [1] 79.65
## 
## $med
## [1] 59.9
## 
## $med
## [1] 39.95
## 
## $med
## [1] 9.7

基础 R 的sum()函数通过将probs1和vals1相乘来计算前五名挑选的期望值，这两个值都通过基础 R 的as.numeric()函数的两次调用转换为数值变量：

sum(as.numeric(probs1) * as.numeric(vals1))
## [1] 57.53

下一段代码首先生成一对向量，其中

• probs2与probs1大致相同，只是每个 draft2 子集的计数被除以 241，这是在 draft2 中被选中第六名或以下的第一个轮次挑选的人数：

• vals2在其他方面与vals1“相等”：

最后一行代码包括对sum()函数的第二次调用，以计算在6-30段选择时的第一轮挑选的期望值：

c(draft2 %>%
  filter(Pk > 5 & WS > 100) %>%
  tally() / 241,
draft2 %>%
  filter(Pk > 5 & WS > 75 & WS < 100) %>%
  tally() / 241,
draft2 %>%
  filter(Pk > 5 & WS > 50 & WS < 75) %>%
  tally() / 241,
draft2 %>%
  filter(Pk > 5 & WS > 25 & WS < 50) %>%
  tally() / 241,
draft2 %>%
  filter(Pk > 5 & WS < 25) %>%
  tally() / 241) -> probs2
print(probs2)
## $n
## [1] 0.008298755
## 
## $n
## [1] 0.0373444
## 
## $n
## [1] 0.1120332
## 
## $n
## [1] 0.2074689
## 
## $n
## [1] 0.6348548
c(draft2 %>%
  filter(Pk > 5 & WS > 100) %>%
  summarize(med = median(WS)),
draft2 %>%
  filter(Pk > 5 & WS > 75 & WS < 100) %>%
  summarize(med = median(WS)),
draft2 %>%
  filter(Pk > 5 & WS > 50 & WS < 75) %>%
  summarize(med = median(WS)),
draft2 %>%
  filter(Pk > 5 & WS > 25 & WS < 50) %>%
  summarize(med = median(WS)),
draft2 %>%
  filter(Pk > 5 & WS < 25) %>%
  summarize(med = median(WS))) -> vals2
print(vals2)
## $med
## [1] 107.25
## 
## $med
## [1] 83
## 
## $med
## [1] 60.6
## 
## $med
## [1] 35
## 
## $med
## [1] 5
sum(as.numeric(probs2) * as.numeric(vals2))
## [1] 21.21452

接下来，最后一个支持我们假设的视角：我们将生成所谓的层次聚类算法，然后创建一个名为树状图的图表来可视化结果：

3.9 层次聚类

层次聚类是一种聚类算法类型（我们将在下一章演示另一种聚类方法），它根据数据点的相似性或差异性对数据进行分组或聚类。层次聚类是一种无监督学习方法，它首先将每个观察值或数据点分配到其自己的聚类中；然后算法不断迭代，通过每次迭代减少聚类数量，直到我们只剩下一个聚类。（它被认为是无监督的，因为我们不是试图预测响应变量的值，而是寻找数据集中的结构。）我们通过绘制树状图来获得最终结果，它大致类似于倒置的树，但更重要的是，它代表了聚类的层次结构：

毫无疑问，聚类（包括层次聚类）最常见的使用案例是在市场营销中。市场营销组织通常根据收入、先前购买和人口统计数据来细分客户，然后构建最适合每个细分市场或聚类的定制营销活动，从而产生比其他情况下更高的响应率。总的来说，层次聚类是一种强大但相对复杂的发现数据集中模式和关系的技巧，其中没有缺乏用例，不仅限于市场营销领域，还包括生物和社会科学等领域。与 k-means 不同，层次聚类不需要我们事先确定最佳聚类数量，这一点将在第十一章中演示。此外，结果相对容易解释。然而，层次聚类可能会在大数据集上变得缓慢，所以要有意识。

我们将围绕 draft2 的两个变量：Pk 和 WS 来构建我们的层次聚类算法。因此，我们首先调用 dplyr select() 函数来对 draft2 进行子集化，在这个过程中创建一个新的对象 draft_clust：

draft2 %>%
  select(Pk, WS) -> draft_clust

然后，我们将 draft_clust 输送到 group_by() 和 summarize() 函数中，以计算变量 Pk 中每个值（1-30）的平均或平均职业生涯胜率。我们的结果随后被转换成一个 30 × 2 的 tibble，称为 draft_clust_final。随后的 head() 和 tail() 函数调用分别返回前三个和最后三个观测值：

draft_clust %>%
  group_by(Pk) %>%
  summarize(ws = mean(WS)) -> draft_clust_final

head(draft_clust_final, n = 3)
## # A tibble: 3 × 2
##      Pk    ws
##   <int> <dbl>
## 1     1  69.6
## 2     2  51.5
## 3     3  66.9

tail(draft_clust_final, n = 3)
## # A tibble: 3 × 2
##      Pk    ws
##   <int> <dbl>
## 1    28 25.6 
## 2    29  8.12
## 3    30 19.7

这就是事情变得稍微复杂的地方。我们的下一步是计算并打印所谓的距离矩阵，通过连续调用基础 R 的 dist() 和 print() 函数。dist() 函数接受两个参数：数据源和首选的距离度量。首选的距离度量，有时称为成对差异度量，需要一些解释。

在层次聚类算法中，计算两点之间距离的最常见方法无疑是欧几里得距离。看看 draft_clust_final 中前三个观测值中的两个：当变量 Pk 等于 1 时，变量 ws 等于 69.6；当 Pk 等于 3 时，ws 等于 66.9。因此，被选中作为第一轮选秀的球员与被选中作为第三轮选秀的球员之间的平均胜率差异为 2.7，或者说差异在 69.6 和 66.9 之间。

但这不是这些点之间的欧几里得距离。为了计算（近似）欧几里得距离，数据点必须被绘制在二维空间中的坐标，其中每个观测值都有一个 x 坐标和一个 y 坐标。两点（x1, y1）和（x2, y2）之间的欧几里得距离是通过以下步骤计算的：

• 将 x2 和 x1 之间的差异平方，然后再将 y2 和 y1 之间的差异平方

• 将两个差异相加

• 计算总和的平方根

因此，draft_clust_final 中前三个观测值之间的近似欧几里得距离等于 3.36，其中 x2 和 x1 分别等于 Pk 值 1 和 3，而 y2 和 y1 分别等于 ws 值 69.6 和 66.9：

euclidean_distance <- sqrt((1 - 3)² + (69.6 - 66.9)²)
euclidean_distance
## [1] 3.36006

这是一个相当短的距离。让我们用第二个 draft_clust_final 观测值替换第一个，并计算它与第三个观测值之间的欧几里得距离：

euclidean_distance <- sqrt((2 - 3)² + (51.5 - 66.9)²)
euclidean_distance
## [1] 15.43243

这仍然是一个较短的距离，但显然，draft_clust_final 的第一个和第三个观测值彼此之间比第二个和第三个观测值更相似。

现在，我们可以调用 dist``() 和 print``(). 注意，为了节省空间，这里只显示了距离矩阵的前 30 行；否则，总输出将占用大约两页额外的空间：

distance_matrix <- dist(draft_clust_final, method = "euclidean")
print(distance_matrix)
##            1         2         3         4         5         6         7
## 2  18.177527                                                            
## 3   3.384213 15.452391                                                  
## 4  10.105568  8.732125  6.991881                                        
## 5  19.661193  3.195309 16.640625  9.651943                              
## 6  44.660770 26.533241 41.757903 34.787539 25.149889                    
## 7  27.297562  9.844308 24.232416 17.242981  7.646202 17.778147          
## 8  44.671852 26.654097 41.690911 34.701310 25.050287  2.016829 17.518564
## 9  30.536550 13.309485 27.404883 20.440949 10.974899 15.208817  3.473557
## 10 38.944218 21.299474 35.850043 28.870359 19.298953  7.623654 11.652794
## 11 53.777929 35.838472 50.744577 43.753584 34.121666  9.827085 26.513470
## 12 50.932042 33.125465 47.853944 40.870606 31.273478  8.038812 23.634932
## 13 53.366656 35.592450 50.274575 43.295756 33.712943 10.347193 26.069847
## 14 53.144528 35.471459 50.024394 43.057339 33.511168 10.729515 25.865228
## 15 54.209011 36.606125 51.069850 44.113472 34.596740 12.034953 26.954547
## 16 56.102438 38.542549 52.950627 46.002697 36.506658 13.917701 28.868753
## 17 50.217129 33.050000 47.003371 40.114866 30.785102 11.461605 23.232324
## 18 41.866784 25.698484 38.566577 31.851721 23.029983 13.470501 16.008026
## 19 49.573341 32.790877 46.311679 39.499008 30.360560 13.125399 22.947627
## 20 57.849197 40.688083 54.622780 47.750394 38.437639 17.357062 30.879768
## 21 46.428547 30.414840 43.107875 36.456309 27.731255 15.203631 20.716489
## 22 60.004701 42.994925 56.754827 49.918269 40.682202 19.898465 33.165892
## 23 54.745017 38.258599 51.446671 44.717227 35.743173 17.946100 28.429738
## 24 50.376903 34.572950 47.037943 40.458978 31.856316 18.005377 24.897311
## 25 54.678670 38.584458 51.351339 44.717674 35.955728 19.584752 28.814059
## 26 45.252607 30.967481 41.872426 35.664056 27.966782 21.079744 21.999730
## 27 59.204528 43.044182 55.876754 49.241564 40.446552 22.773144 33.248062
## 28 51.632161 36.670691 48.260112 41.911927 33.794343 22.003111 27.259208
## 29 67.587685 51.083493 64.278116 57.575848 48.603809 28.681148 41.242735
## 30 57.727872 42.344010 54.363814 47.929847 39.564406 24.629986 32.729058

虽然我们已截断结果，但距离矩阵仍然返回 draft_clust_final 中每对观测值之间的欧几里得距离。因此，我们可以将我们之前的计算与我们对 dist``() 函数的调用返回值进行比较。draft_clust_final 的第一个和第三个观测值之间的欧几里得距离位于（列）1 和（行）3 的交点处。它等于 3.38，这足够接近 3.36。紧接其右的是第二个和第三个观测值之间的欧几里得距离。它等于 15.45，这与我们之前计算的 15.43 相比是有利的。

然后我们调用 base R 的 hclust() 函数，它执行层次聚类。算法首先将每个 30 个 draft_clust_final 记录分配给它们自己的聚类；然后它迭代 30 次，每次基于欧几里得距离合并最相似的聚类，直到每个数据点都滚入同一个聚类。

hclust() 函数接受两个参数：我们的距离矩阵 distance_matrix 是第一个，而首选的聚类方法是第二个。完全方法（也称为 完全链接方法）通过找到来自不同聚类的点之间的最大距离来确定一对聚类彼此之间有多接近，或者可能不是很接近。R 支持其他方法，但这是最常见的方法：

hc <- hclust(distance_matrix, method = "complete")

现在我们有了我们的层次聚类对象，我们可以通过调用 base R 的 plot() 函数来可视化结果。我们得到一棵树状图，它显示了不同相似度级别上聚类的合并（见图 3.7）：

• as.dendrogram() 函数，同样来自 base R，是可选的；然而，通过添加它而不是仅仅调用 plot() 函数，我们可以获得更清晰的可视化。

• cex 参数是一个数字，表示文本和符号相对于默认值的缩放比例；当设置为 0.6 时，我们告诉 R 打印标签的大小为默认大小的 60%。

• hang参数调整树状图叶子的高度，或者倒置树的端点；当设置为-1时，我们告诉 R 沿着 x 轴的宽度对齐或调整它们。

• 基础 R 的rect.hclust()函数也是可选的；它在树状图上绘制了k个透明框，以进一步区分簇或段。考虑到我们之前的分析集中在选择 1 至 5 与其他所有第一轮选择上，因此将k设置为2并等待结果是合理的。

• 内置的par()函数用于设置基础 R 图形的参数。在这里，我们只是指示 R 在我们的树状图后面绘制一个深海绿色背景：

bg = par(bg = "darkseagreen1")
plot(as.dendrogram(hc, cex = 0.6, hang = -1),
     main = "Cluster Dendrogram:\nWin Shares by First-Round Selection",
     xlab = "First-Round Selection Number\n2000-2009 NBA Drafts",
     ylab = "Height (aka Euclidian Distance")
rect.hclust(hc, k = 2)

图 3.7 显示基于赢分和选择编号的层次聚类的树状图

令人惊讶的是，R 在第一轮选择 1 至 5 周围绘制了一段线段，并在剩余的选择编号周围绘制了另一段线段。否则，这就是我们如何解释我们的树状图：

• 树状图最底部的每个“叶子”代表来自draft_clust_final的单独观察值。

• 当我们沿着树状图向上移动时，彼此相似的观察值会融合形成分支。例如，当我们的 x 轴等于 1 和 3 时——或者说，用不同的方式说，当draft_clust_final变量Pk等于1和3时——这些观察值会在 y 轴，即欧几里得距离等于 3.38 的地方聚集在一起。

• 观察彼此越接近，它们就越相似；反之，它们越远，就越不相似。

• 连接选择编号 1 至 5 的分支高度等于 19.66，因为我们选择了一种计算任何一对“类似”组件之间最大距离的聚类方法。再仔细看看我们的距离矩阵——第一轮选择 1 至 5 之间的最大欧几里得距离是在选择 1 和 5 之间。

• 同样，连接选择 1 至 5 和其他选择编号的分支高度等于 67.59；再次，这是因为 1 至 5 之间任何选择编号与任何其他选择编号之间最大的欧几里得距离是在选择 1 和 29 之间，等于 67.59（再最后看看距离矩阵以确认）。

• 这些结果与我们预期的价值分析和我们之前的发现完全一致。

在本章中，我们通过四种不同的、逐步提高的统计技术讲述了相同的故事。在任何 NBA 选秀中，只有少数几位潜在超级巨星可供选择，根据当前联赛规则，任何球队想要控制自己的命运，并可能选中这些潜在超级巨星的唯一方法就是摆烂。换句话说，我们应用的数据和方法整体上支持我们在一开始提出的假设。在下一章中，我们将介绍一种球队可以最好地组建阵容的方法，这不是通过摆烂选秀，而是通过自由球员市场。

摘要

• 我们展示了有比连续调用library()函数更好的方法来一次性加载许多包。

• 在 R 中，有许多方法可以从原始数据中创建分割。我们在本章和上一章中调用了mutate()和ifelse()函数，稍后还与case_when()函数一起调用了mutate()。

• 我们演示了多种进行分割分析的方法，包括数学运算和复杂的可视化技术。

• 例如，我们进一步演示了如何使用ggplot2条形图来可视化均值和中位数，以显示分割之间的方差和相似性。

• 了解如何创建和解释桑基图是许多用例的关键高级分析技术。我们展示了如何创建一个包含六个节点分组和总共 30 个节点的相当复杂的桑基图。

• 期望值是另一种具有许多用例的技术——投资机会和结果、不确定的天气模式、赌博等等。我们展示了在 R 中计算期望值的一种方法。

• 我们演示了如何进行层次聚类以及如何可视化和解释结果。

• 无论采用何种方法，很明显，并非所有首轮选秀球员都是平等的。在 NBA 选秀中，被选中或接近顶端的球员与其他几乎所有可用球员之间有明显的区别。

• 对于想要组建冠军级阵容的球队来说，吸引超级巨星人才是绝对必要的。

• 因此，球队必须拥有前几个选秀权之一，才有可能选择一个潜在的超级巨星，最终带领他们赢得冠军。

• 即使有乐透选秀，选择超级巨星的唯一机会也在于在前一个赛季有输球记录；更好的是，球队应该摆烂以确保他们的记录比其他球队更差。

---

1. 行的总和实际上等于 57.52；57.53 是 R 的输出。

2. 再次强调，打印的总和来自 R 的输出，而不是行的总和；方差是由于小数点右边的四舍五入造成的。

4 约束优化

本章涵盖

• 在 R 代码中添加注释

• 使用密度图可视化数据分布

• 同时可视化两个变量的相关性

• 定义约束优化

• 应用约束优化方法

你有多少次被要求在资源有限的情况下做更多的事情？换句话说，你真正被要求的是在不利情况下最大限度地利用一个受限制的情况。约束优化是针对这一目标的运筹学和定量解决方案。在本章中，我们将展示如何组织和执行一个典型的约束优化问题。为了实现这一目标，我们有一个虚构的 NBA 球队，专注于从自由球员市场上收购老将球员。他们的目标不是收购五个最好的球员，而是五个符合他们具体需求和要求的最佳球员。因此，我们的假设是，约束优化可以成功地隔离出这个球队应该收购的最佳自由球员组合，而不会违反事先设定的任何约束。

4.1 什么是约束优化？

约束优化是一种方法或技术，旨在在受到限制的情况下最小化或最大化某个函数，这些限制限制了行动的自由度。一种方法可能最小化成本或资源的消耗；另一种方法可能最大化利润率。约束是有效的边界，在计算最大化或最小化某个定义的函数时，不能越界。约束优化有许多应用案例：

• 首席财务官在审查一份长长的资本项目清单，以应对严重的预算和资源限制时，需要批准其中的一部分项目，以最大化收入并平衡不同部门的项目。

• 三项铁人运动员在自行车上需要以下物品：工具和备用零件，以防出现爆胎或机械故障；水和能量饮料以保持水分；盐片以治疗抽筋；以及一些能量棒、能量凝胶和士力架巧克力棒的组合，以保持能量。在一只鞍包、两个水瓶架和运动衫后口袋之间，铁人运动员必须事先决定如何最好地利用这些空间。

• 就我们的目的而言，一个 NBA 球队的总经理正在评估自由球员市场上的几位球员。

我们的虚构 NBA 球队打算通过自由球员市场而不是选秀来重建阵容：

• 该团队正在评估 24 名自由球员，他们打算签约正好5 名球员。这是他们的第一个要求或约束（在本章中，这些术语可以互换使用）。

• 他们希望每个位置都有一个球员：一个控球后卫、一个得分后卫、一个中锋、一个大前锋和一个小前锋。这是他们的第二个要求。

• 球员的薪资要求是已知且固定的。球队愿意为五名他们收购的球员支付的年薪总额不超过 9000 万美元（M）。这是他们的第三项要求。90 M 美元如何分配无关紧要；重要的是总额。

• 他们收购的五名球员的平均年龄必须等于或小于 30 岁。这是他们的第四和最后一项要求。个别年龄无关紧要；重要的是平均值必须等于或小于 30。

方程的另一方面是应该最小化或，在我们的情况下，最大化的函数。球队的评估包括基于前几个赛季的实际赢分、职业生涯轨迹、年龄和其他因素，对每个 24 名自由球员的年度赢分预测。我们虚构的 NBA 球队希望在遵守所有这些约束条件的情况下最大化赢分。让我们开始吧。

4.2 加载包

我们有四个包需要加载：tidyverse 和 patchwork，我们在前面的章节中已经加载并使用过，还有两个新包，如本节所述：

• lpSolve 包包含解决线性规划问题的几个函数，包括需要约束优化的函数。

• scales 包是 ggplot2 包的一部分，当然，ggplot2 包也是 tidyverse 包宇宙的一部分——它包含用于转换 ggplot2 轴标签的函数。尽管 scales 包与 tidyverse 相关联，但如果 scales 包没有首先单独且独立于 tidyverse 包加载，R 在调用 scales 函数时可能会抛出错误。

警告 注意到 lpSolve 包中的 S 是大写的。R 是一种区分大小写的编程语言。即使是“无害”的小写和大写误用也会生成错误信息——其中一些可能是直接的，而另一些则不然——并阻止你的代码运行。

在我们连续四次调用 library() 函数来加载这四个包之前，让我们首先介绍在代码块中添加注释的概念。尽管注释与你的代码混合在一起，但它们根本不是代码；实际上，当你执行 R 脚本时，它们会被完全忽略。注释是一种添加可读描述的做法，有助于减轻将来在需要修复或其他更改时的潜在痛苦，尤其是在这些更改随后分配给其他程序员时。

与许多其他编程语言不同，R 只允许单行注释；多行注释只能通过“合并”两个或多个单行注释来实现。要给一段代码添加注释，只需在前面加上井号（#）符号：

# single line comment example: lpSolve is for constrained optimization
library(lpSolve)

# multi-line example: tidyverse includes dplyr and tidyr
# mult-line example continued: tidyverse also includes ggplot2
# mult-line example continued: tidyverse also includes readr
library(tidyverse)

# scales package is part of tidyverse, but it’s best to load
# this as a standalone package
library(scales)

# we use the patchwork package to bundle multiple plots into one object
library(patchwork)

我们接下来将导入我们的数据集，并进一步展示注释的使用。

4.3 导入数据

使用 readr 的 read_csv() 函数导入我们的数据集，这是一个之前保存为 .csv 扩展名的 Microsoft Excel 文件。通过赋值运算符，我们将数据集标记为 free_agents。

free_agents 数据集（在数据集创建时）包含从 Sportrac 网站抓取的现实生活中的即将成为自由球员的数据，然后根据从 www.basketball-reference.com 收集的历史数据，结合了说明性的年薪和赢球份额预测。一旦球员的合同到期，NBA 球员就会成为自由球员；在那个时刻，自由球员可以自由地与任何球队谈判并签订新合同，包括他们最近效力的球队。

注意，我们添加了一条注释，但这次是在代码行末尾而不是单独的一行。R 将执行以下代码块，直到看到 # 符号；然后它将忽略该行之后的所有内容：

free_agents <- read_csv("free_agents.csv") # saved in default directory

接下来，我们将学习我们刚刚导入的数据的基本知识，然后可视化以获得更深入的见解。

4.4 了解数据

R 提供了几个函数来快速获得对数据集的基本理解。一个是基础 R 的 dim() 函数，它返回行数和列数：

dim(free_agents)
## [1] 24  7

首先提供行数，然后是列数。

另一个是来自 dplyr 包的 glimpse() 函数。该函数也返回数据集的维度，但以旋转 90 度的数据的截断视图返回：

glimpse(free_agents)
## Rows: 24
## Columns: 7
## $ player        <chr> "Chris Paul", "Kawhi Leonard", "Blake Griff...
## $ current_team  <chr> "PHX", "LAC", "DET", "DAL", "DEN", "LAL", "...
## $ age           <dbl> 37, 31, 33, 29, 28, 28, 27, 36, 31, 29, 30,...
## $ position1     <chr> "PG", "SF", "PF", "SG", "SG", "PF", "SG", "...
## $ position2     <chr> "PG1", "SF1", "PF1", "SG1", "SG2", "PF2", "...
## $ annual_salary <dbl> 32000000, 37000000, 35000000, 11000000, 225...
## $ win_shares    <dbl> 6.9, 9.4, 5.2, 3.0, 3.7, 4.2, 3.8, 2.3, 4.7...

顺便说一句，glimpse() 函数在基础 R 中有一个等价函数：str() 函数。glimpse() 函数比 str() “更干净”，因此是两者之间的首选，但这两个函数都以某种类似格式返回相同的信息：

str(free_agents)
## 'data.frame':    24 obs. of  7 variables:
## $ player       : chr [1:24] "Chris Paul" "Kawhi Leonard" ... 
## $ current_team : chr [1:24] "PHX" "LAC" "DET" "DAL" ...
## $ age          : num [1:24] 37 31 33 29 28 28 27 36 31 29 ...
## $ position1    : chr [1:24] "PG" "SF" "PF" "SG" ...
## $ position2    : chr [1:24] "PG1" "SF1" "PF1" "SG1" ...
## $ annual_salary: num [1:24] 32000000 37000000 35000000 11000000 ... 
## $ win_shares   : num [1:24] 6.9 9.4 5.2 3 3.7 4.2 3.8 2.3 4.7 2.1 ...

变量 position1 和 position2 应该是因子而不是字符字符串（chr），所以我们调用基础 R 的 as.factor() 函数两次，将两个变量从一种类型或类转换为另一种类型：

free_agents$position1 <- as.factor(free_agents$position1)
free_agents$position2 <- as.factor(free_agents$position2)

让我们运行基本的 R levels() 函数来返回两个变量的唯一属性。你必须将变量转换为因子后才能运行 levels() 函数，而不是在此之前：

levels(free_agents$position1)
## [1] "C"  "PF" "PG" "SF" "SG"
levels(free_agents$position2)
## [1] "C1"  "C2"  "C3"  "C4"  "PF1" "PF2" "PF3" "PF4" "PF5" "PF6"
## [11] "PG1" "PG2" "PG3" "PG4" "PG5" "PG6" "SF1" "SF2" "SF3" "SF4"
## [21] "SF5" "SG1" "SG2" "SG3"

变量 position1 包含五个水平，每个位置一个，这当然是我们所希望或预期的。因此，我们至少确认了 position1 没有错别字或其他异常。同时，变量 position2 包含 24 个水平，等于 free_agents 数据集的记录数，这是一个好事。

即使这两个变量中的任何一个出现最小的错误，也会损害我们的约束优化问题，这就是为什么检查两个变量的完整性值得我们去做。

如果你不喜欢 glimpse() 或 str()，head() 和 tail() 函数是很好的替代品；默认情况下，head() 返回前六条记录，而 tail() 返回最后六条。以下两行代码返回了 free_agents 的前三个和最后三个观测值：

head(free_agents, n = 3)
##   player        current_team   age position1 position2
##   <chr>         <chr>        <dbl> <fct>     <fct>
## 1 Chris Paul    PHX             37 PG        PG1      
## 2 Kawhi Leonard LAC             31 SF        SF1      
## 3 Blake Griffin DET             33 PF        PF1 
##   annual_salary win_shares
##           <dbl>      <dbl>
## 1      32000000        6.9
## 2      37000000        9.4
## 3      35000000        5.2 

tail(free_agents, n = 3)
##   player           current_team   age position1 position2
##   <chr>            <chr>        <dbl> <fct>     <fct>
## 1 Robert Covington POR             31 PF        PF6      
## 2 Serge Ibaka      LAC             33 C         C3       
## 3 Aron Baynes      TOR             35 C         C4
##   annual_salary win_shares
##           <dbl>      <dbl>
## 1      13500000        3.1
## 2      12000000        2.9
## 3       7000000        2.5

最后，summary() 函数是一个基础 R 通用函数，它返回传递给它的任何数据对象的基线统计信息。它主要用于返回各种模型拟合函数的结果（在第五章中讨论）；在这里，它返回 free_agents 数据集中每个变量的基线统计信息和其它数据。再次强调，summary() 返回连续变量的箱线图样度量，以及因子变量的水平计数：

summary(free_agents)
##    player          current_team            age        position1
## Length:24          Length:24          Min.   :23.00   C :4     
## Class :character   Class :character   1st Qu.:28.00   PF:6     
## Mode  :character   Mode  :character   Median :30.50   PG:6     
                                         Mean   :30.42   SF:5     
                                         3rd Qu.:33.00   SG:3     
                                         Max.   :37.00  
## C1     : 1   Min.   : 6500000   Min.   :1.700  
## C2     : 1   1st Qu.:13500000   1st Qu.:2.975  
## C3     : 1   Median :14750000   Median :3.800  
## C4     : 1   Mean   :17312500   Mean   :3.992  
## PF1    : 1   3rd Qu.:18750000   3rd Qu.:4.700  
## PF2    : 1   Max.   :37000000   Max.   :9.400  
## (Other):18  

summary() 函数返回一些有用且有趣的信息，但对于像 free_agents 这样的短数据集，始终最好也可视化数据以更好地理解它。

但首先，还需要一个额外的清理项目：基础 R 中的 options() 函数，带有参数 scipen = 999，告诉 R 不要以科学记数法（即 e+10）打印任何结果，而是无例外地以全数字形式返回它们。我们实际上是在指示 R 在结果大于 scipen 位数字长时返回固定记数法的结果。因此，任何大的 scipen 数字都足够，但 999 是最常用的数字：

options(scipen = 999)

可以通过再次调用 options() 函数并添加参数 scipen = 000 来撤销此设置；这次，任何小的数字都可以，但 000 是首选。顺便说一下，options() 函数并非通用——它仅适用于它被调用的脚本。

4.5 可视化数据

在我们设置并运行约束优化问题之前，让我们首先更好地了解我们的数据。我们将通过首先创建一系列密度图来覆盖变量 annual_salary、win_shares 和 age；一系列针对这些相同变量的箱线图，但按变量 position1 分组；一个变量 annual_salary 和 win_shares 之间的单一相关性图；最后，一个显示按变量 position1 分组的球员数量的条形图。

4.5.1 密度图

自由球员数据集的第一个图形表示是一系列围绕连续变量薪水（annual_salary）、赢分（win_shares）和年龄（age）的密度图。密度图本质上是对直方图的平滑版本，就像直方图一样，密度图显示连续或数值数据的分布。（之后，我们将创建箱线图、相关性图和条形图。）

密度图相较于直方图最显著的优势在于，密度图能更准确地反映实际的分布形状，因为没有程序员选项可以调整箱数，否则可能会影响外观。但尽管 x 轴代表值的范围，就像直方图一样，y 轴代表一个不太直观的密度函数，或概率密度函数，而不是频率。然而，最终，概率密度函数实际上与频率有很好的相关性；换句话说，当频率低时，概率密度函数等于一个低数值，反之，当频率高时，概率密度函数等于一个高数值（或至少是一个更高的数值）。无论如何，密度图对于可视化连续变量的潜在分布、识别峰值或模式以及评估偏度或对称性非常有用。

这里是三个 ggplot2 密度图中的第一个的演示：

• ggplot() 函数始终首先被调用以初始化任何 ggplot2 对象。

• geom_density() 函数计算平滑估计并绘制图表。传递给 geom_density() 的 alpha 参数使填充透明，以便 ggplot2 网格线在整个图表中保持可见。为了实现这种效果，alpha 应该等于接近 0 的数值，例如 .3。

• geom_vline() 函数被调用两次以绘制一对垂直虚线，一条代表总体均值，另一条代表总体中位数。可以通过修改 size 参数上下调整线的厚度；默认值为 1，因此任何调整都是相对于 ggplot2 默认值的相对调整。

• scale_x_continuous() 函数与 scales 包一起使用，在 x 轴刻度标记上添加逗号，因此 10000000 转换为更易读的 10,000,000。

• annotate() 函数在提供的 x 和 y 坐标处添加垂直文本：

p1 <- ggplot(free_agents, aes(x = annual_salary)) +
  geom_density(alpha = .3, fill = "salmon") +
  geom_vline(aes(xintercept = mean(annual_salary, na.rm = TRUE)),
             color = "red", linetype = "longdash", size = .8) +
  geom_vline(aes(xintercept = median(annual_salary, na.rm = TRUE)),
             color = "blue", linetype = "longdash", size = .8) +
  labs(title = "Annual Salary Distribution",
       subtitle = "Shortlisted Free Agents",
       x = "Annual Salary", 
       y = "Density",
       caption = "Salary data is illustrative only") +
  scale_x_continuous(labels = comma) +
  theme(plot.title = element_text(face = "bold")) +
  annotate("text", x = 18000000, 
           y = .000000025, label = "Mean", color = "black",
           size = 4, fontface = "bold", angle = 90) +
  annotate("text", x = 14000000, 
           y = .000000025, label = "Median", color = "black",
           size = 4, fontface = "bold", angle = 90)

第二个和第三个密度图——分别是 p2 和 p3——与 p1 类似，只是做了一些修改：

• 将变量 annual_salary 替换为变量 win_shares 和 age。

• 已经包含了标签更改。

• scale_x_continuous() 函数和 scales 包不再需要——毕竟，图表 p2 和 p3 没有需要转换的标签，因此已经被移除：

p2 <- ggplot(free_agents, aes(x = win_shares)) +
  geom_density(alpha = .3, fill = "salmon") +
  geom_vline(aes(xintercept = mean(win_shares, na.rm = TRUE)),
             color = "red", linetype = "longdash", size = .8) +
  geom_vline(aes(xintercept = median(win_shares, na.rm = TRUE)),
             color = "blue", linetype = "longdash", size = .8) +
  labs(title = "Projected Annual Win Shares Distribution",
       subtitle = "Shortlisted Free Agents",
       x = "Win Shares", y = "Density",
       caption = "Win Shares data is illustrative only") +
  theme(plot.title = element_text(face = "bold")) +
  annotate("text", x = 4.1, 
           y = .1, label = "Mean", color = "black",
           size = 4, fontface = "bold", angle = 90) +
  annotate("text", x = 3.7, 
           y = .1, label = "Median", color = "black",
           size = 4, fontface = "bold", angle = 90)

p3 <- ggplot(free_agents, aes(x = age)) +
  geom_density(alpha = .3, fill = "salmon") +
  geom_vline(aes(xintercept = mean(age, na.rm = TRUE)),
             color = "red", linetype = "longdash", size = .8) +
  geom_vline(aes(xintercept = median(age, na.rm = TRUE)),
             color = "blue", linetype = "longdash", size = .8) +
  labs(title = "Age Distribution", subtitle = "Shortlisted Free Agents",
       x = "Age", y = "Density",
       caption = "Player ages are real; source: Spotrac") +
  theme(plot.title = element_text(face = "bold")) +
  annotate("text", x = 30.2, 
           y = .04, label = "Mean", color = "black",
           size = 4, fontface = "bold", angle = 90) +
  annotate("text", x = 30.7,
           y = .04, label = "Median", color = "black",
           size = 4, fontface = "bold", angle = 90)

plot_layout() 函数从 patchwork 包中将三个密度图捆绑成一个对象（见图 4.1），其中图表 p1 和 p2 占据顶部一行，而图表 p3，假设与 p1 和 p2 相同的宽度，显示在底部一行：

p1 + p2 - p3 + plot_layout(ncol = 1)

图 4.1 密度图用于可视化数值数据的分布。密度图有时会替代直方图或箱线图。

我们的前三个可视化展示了以下关于数据的信息：

• 年薪—这些数字代表我们 24 名自由球员的年度基本工资的逐年预期，它们是右偏斜的，或者说正偏斜。有两种方法可以推断这一点：（1）大多数值明显聚集在分布的左尾，而右尾较长，并且（2）因此，均值大于中位数。

• 赢分—对于年度赢分数据，也可以说同样的话，这些数据代表每个球员在每个赛季预计获得的赢分数量。考虑到 annual_salaries 和 win_shares 的均值和中位数，我们可以合理地得出结论，大约 1500 万美元的薪水相当于大约 3.5 到 4 个赢分。

• 年龄—与变量 annual_salaries 和 win_shares 不同，变量 age 通常呈正态分布；均值和中位数都大约等于 30.5。

4.5.2 箱线图

我们接下来的可视化系列再次显示了这些相同变量的分布，但这次是通过箱线图，并且按变量 position1 的每个级别细分。这些箱线图与我们之前章节中创建的箱线图类似，但请注意，我们现在使用 scales 包来转换我们的 y 轴刻度标记，而不是 x 轴上的刻度标记。因此，我们调用 scale_y_continuous() 函数而不是 scale_x_continuous() 函数：

p4 <- ggplot(free_agents, aes(x = position1, y = annual_salary)) + 
  geom_boxplot(color = "sienna4", fill = "sienna1" ) +
  labs(title = "Annual Salary Distribution by Position",
       subtitle = "Shortlisted Free Agents",
       x = "Position", 
       y = "Annual Salary", 
       caption = "Salary data is illustrative only") + 
  scale_y_continuous(labels = comma) +
  stat_summary(fun = mean, geom = "point", 
               shape = 20, size = 8, color = "white", fill = "white") + 
  theme(plot.title = element_text(face = "bold")) 

p5 <- ggplot(free_agents, aes(x = position1, y = win_shares)) + 
  geom_boxplot(color = "steelblue4", fill = "steelblue1" ) +
  labs(title = "Annual Win Shares Distribution by Position",
       subtitle = "Shortlisted Free Agents",
       x = "Position", 
       y = "Annual Win Shares", 
       caption = "Win Share data is illustrative") + 
  stat_summary(fun = mean, geom = "point", 
               shape = 20, size = 8, color = "white", fill = "white") + 
  theme(plot.title = element_text(face = "bold")) 

p6 <- ggplot(free_agents, aes(x = position1, y = age)) + 
  geom_boxplot(color = "gold4", fill = "gold1" ) +
  labs(title = "Age Distribution by Position",
       subtitle = "Shortlisted Free Agents",
       x = "Position", 
       y = "Age", 
       caption = "Player ages are real; source: Spotrac") + 
  stat_summary(fun = mean, geom = "point",
               shape = 20, size = 8, color = "white", fill = "white") + 
  theme(plot.title = element_text(face = "bold")) 

然后，我们再次调用 plot_layout() 函数，该函数从内存中检索三个可视化效果，并将它们显示为一个 3 × 1 的图形对象（见图 4.2）：

p4 + p5 + p6 + plot_layout(ncol = 1)

图 4.2 另一系列对数值数据分布的观察

以下是一些关于我们箱线图的说明：

• 由于 annual_salary 的方差以及 free_agents 数据集中记录的低数量，特别是 position1 的五个级别中的每一个，分布差异很大。

• 虽然 win_shares 分布的分散度较低，但按位置查看似乎与 annual_salary 相同。

• 虽然我们之前发现 age 是正态分布的，但按位置查看时，其分布仍然相当不同。例如，大多数中锋和控球后卫的年龄都超过 30 岁，而大多数小前锋和得分后卫的年龄都低于 30 岁。

4.5.3 相关图

在第二章中，我们展示了如何同时计算多个连续变量之间的相关系数，并在热图或相关矩阵中显示相同的结果。在这里，我们只想计算两个变量之间的相关系数，然后将结果作为相关图的副标题添加，该图通过一个变量沿 x 轴运行，另一个变量沿 y 轴运行来可视化相同的内容。也就是说，我们将变量 annual_salary 和 win_shares 传递给基础 R 的 cor() 函数来计算它们之间的相关系数：

cor(free_agents$annual_salary, free_agents$win_shares)
## [1] 0.7571507

相关系数等于 0.76（四舍五入），这意味着工资和赢分之间存在着正面的强相关性，这意味着当一个变量移动时，另一个变量也会向同一方向移动。

我们接下来的代码块绘制了一个ggplot2相关图，其中annual_salary是 x 轴变量，win_shares是 y 轴变量（见图 4.3）。geom_density()被调用以绘制ggplot2密度图，geom_boxplot()被调用以绘制ggplot2箱线图，而geom_point()告诉 R 绘制相关图，有时也称为散点图。通过将size = 3参数传递给geom_point()，我们指示 R 绘制点的大小是默认大小的三倍。

图 4.3 工资和赢分之间存在着正面的高度相关性。这条线是最优拟合回归线，它最小化了与数据的距离。

当将method = lm参数传递给geom_smooth()函数时，会在数据上绘制一条线性回归线（lm是线性模型的缩写）。回归线，或最优拟合线，是一种注释，旨在可视化数据系列中的趋势；线被绘制以最小化与数据的距离。线越陡，相关性越强。

geom_smooth()函数会自动在回归线上绘制一个 95%的置信区间，除非有其他指示。实际上，置信区间可以向上或向下调整，或者完全删除。我们选择删除它，通过传递se = FALSE参数（se是标准误差的缩写）：

p7 <- ggplot(free_agents, aes(x = annual_salary, y = win_shares)) + 
  geom_point(size = 3) +
  labs(title = "Annual Salaries vs. Win Shares",
       subtitle = "correlation coefficient = 0.76",
       x = "Annual Salaries", 
       y = "Win Shares") + 
  geom_smooth(method = lm, se = FALSE) +
  scale_x_continuous(label = scales::comma) +
  theme(plot.title = element_text(face = "bold"))
print(p7)

4.5.4 条形图

在我们接下来的代码块中，我们通过管道操作符将 free_agents 数据集传递给dplyr的group_by()和tally()函数。group_by()和tally()函数一起计算变量position1中每个级别的 free_agents 观察值的数量，结果被放入一个名为 tibble1 的 tibble 中：

free_agents %>%
  group_by(position1) %>%
  tally() -> tibble1
print(tibble1)
## # A tibble: 5 × 2
##   position1     n
##   <fct>     <int>
## 1 C             4
## 2 PF            6
## 3 PG            6
## 4 SF            5
## 5 SG            3

在这个第二个代码块中，我们将 free_agents 传递给dplyr summarize()函数，以计算变量position1中每个级别的annual_salary、win_shares和age的平均值。结果被转换成一个名为 tibble2 的 tibble：

free_agents %>% 
  group_by(position1) %>%
  summarize(meanSalary = mean(annual_salary),
            meanWinShares = mean(win_shares),
            meanAge = mean(age)) -> tibble2
print(tibble2)
## # A tibble: 5 × 4
##   position1 meanSalary meanWinShares meanAge
##   <fct>          <dbl>         <dbl>   <dbl>
## 1 C          12000000           3.58    31.5
## 2 PF         20083333\.          3.8     29.5
## 3 PG         17250000           4.4     32.8
## 4 SF         19900000           4.36    29.2
## 5 SG         14666667\.          3.5     28

在这个第三个也是最后一个代码块中，我们调用dplyr left_join()函数，将我们刚刚创建的两个 tibbles 根据它们的类似变量position1进行连接。左连接是一种操作，通过它一个对象中的所有行都会与第二个对象中的相应值合并或匹配。在这个过程中，我们还得到了每个唯一的列返回。结果是另一个 tibble，tibble3：

left_join(tibble1, tibble2, by = "position1") -> tibble3
print(tibble3)
## A tibble: 5 × 5
## position1     n meanSalary meanWinShares meanAge
##  <fct>     <int>      <dbl>         <dbl>   <dbl>
## 1 C             4  12000000           3.58    31.5
## 2 PF            6  20083333\.          3.8     29.5
## 3 PG            6  17250000           4.4     32.8
## 4 SF            5  19900000           4.36    29.2
## 5 SG            3  14666667\.          3.5     28  

现在我们已经有了下一个和最后一个可视化所需的数据源，一个ggplot2条形图：

• 调用 geom_text() 函数将 position1 每个级别的计数固定在条形图顶部。vjust 参数移动或调整 ggplot2 图表元素（如标签、标题和副标题）的垂直位置；还有一个 hjust 参数，这里没有调用，它调整类似的图表元素的水平位置。你可能需要或需要根据每个图表的不同设置进行实验，以获得最佳的美观效果。

• geom_label() 函数被调用了三次，用于在条形图中标注代表 annual_salaries、win_shares 和 age 的截断值，这些值位于条形图内部。

• 通过调用 ylim() 函数，y 轴被扩展或固定在最小和最大值上，以确保所有这些都能适应，并且不会损害美观。

这些附加功能增强了我们的条形图的美观（见图 4.4），将其从一种非常普通的图形数据表示转变为一个（希望）能吸引我们更多注意的对象。更重要的是，这些功能提供了足够的信息，而不会包含其他信息。我们希望通知我们的观众，而不是让他们感到不知所措。以下是我们 ggplot2 条形图的代码：

p8 <- ggplot(tibble3, aes(x = position1, y = n)) + 
  geom_bar(stat = "identity", width = .8, 
           fill = "darkorchid1", color = "darkorchid4") + 
  labs(title = "Position Counts",
       subtitle = "Shortlisted Free Agents", 
       x = "Position", 
       y = "Counts",
       caption = "Salary mean ($M)\nWin Shares mean\nAge mean") + 
  geom_text(aes(label = n, vjust = -0.3)) +
  geom_label(aes(label = trunc(meanSalary*.000001), vjust = 1.2)) +
  geom_label(aes(label = trunc(meanWinShares), vjust = 2.4)) +
  geom_label(aes(label = trunc(meanAge), vjust = 3.6)) +
  ylim(0, 8) +
  theme(plot.title = element_text(face = "bold"))
print(p8)

图 4.4 按位置统计的候选自由球员数量。注意右下角的图例，它解释了条形图内部从上到下白色框内的标签。

我们的条形图还包括一个标题，默认情况下位于图表下方和右侧，从上到下解释固定在条形图内部的三个标签。将不同职位的平均值汇总，我们得到了所谓的“墙上的标记”：对于 91 M（轻微的约束违规，但仍然是违规），我们的虚构 NBA 球队可以从五个平均年龄为 29.8 的球员那里获得 17 个胜利份额。

本章的其余部分致力于组织和执行一个约束优化问题，希望它能比我们的“墙上的标记”提供更好的解决方案——当然，没有任何约束违规。无论我们最终在哪里，约束优化都消除了猜测，并产生了最优的解决方案。

4.6 约束优化设置

我们即将演示如何设计和开发一个约束优化问题。通过仅替换要最大化或最小化的函数以及更改约束条件，代码可以轻松地转移到其他用例。

同时，我们有一个虚构的 NBA 球队，需要一场重大的重建努力。这个球队最近在选秀中失败，没有下个选秀的顶尖选择，并且无法通过交易提升排名；因此，球队的总经理（GM）决定通过在自由球员市场上收购老将球员来升级阵容。这些球员的合同即将到期，他们可以与任何球队签约并打球。

让我们回顾一下我们的要求。总经理有空间签约五名球员（第一约束）。必须有一名控球后卫、一名得分后卫、一名中锋、一名大前锋和一名小前锋（第二约束）。年薪总额不得超过 9000 万美元（第三约束）。最后，这五名球员在签约时的平均年龄必须等于或低于 30 岁（第四约束）。

为了这次练习，让我们假设球队可以签约任何它想要的自由球员；换句话说，没有风险是任何被追求的球员会选择签约另一支球队。因此，free_agents 数据集是球队的短期自由球员名单，以下变量：

• player—该团队评估的每位球员的全名，采用名-姓格式（例如，Chris Paul）；free_agents 数据集有 24 行，因此我们总共有 24 名球员。当数据从 Spotrac 抓取时，这些球员实际上即将进入自由球员市场。

• current_team—球队的简称——例如，PHX 代表凤凰城太阳队——每个球员在创建 free_agents 数据集时正在为该队效力。

• age—在创建 free_agents 时，每位球员的年龄，以整数表示。

• position1—24 名球员中的每一位球员的主要位置——C 代表中锋，PF 代表大前锋，PG 代表控球后卫，SF 代表小前锋，SG 代表得分后卫。

• position2—主要位置加上从 1 开始的个位数整数，随着我们在 free_agents 数据集中向下移动，每个位置递增一个。例如，Chris Paul 在我们的数据集中是第一位控球后卫，因此 Chris Paul 的position2变量等于PG1；Rajon Rondo 是我们第二位控球后卫，因此 Rondo 的position2变量等于PG2。Jonas Valančiūnas 是我们第一位中锋，因此 Valančiūnas 的position2变量等于C1；最后四位中锋中的最后一位是 Aron Baynes，因此他的position2变量等于C4。当我们进一步设置和运行我们的约束优化问题时，这个变量将是必需的。

• annual_salary—每位球员预期的年薪。这些数字大致基于从www.basketball-reference.com收集的先前薪资信息，但除此之外具有说明性。

• win_shares—每位球员每赛季预计获得的胜利份额。这些数字与从www.basketball-reference.com抓取的先前赛季的实际胜利份额相关联，但像annual_salary变量一样，这些数字具有说明性。我们的约束优化问题将在遵守之前提到的硬约束的同时最大化胜利份额。

表 4.1 显示了球队的 24 名球员或自由球员的短期名单；current_team和position2变量不包括在这个表中。球员没有按照任何特定的顺序列出，除了按位置分组。

表 4.1 可用自由球员列表

球员	年龄	位置	年薪	胜场分
Chris Paul	37	PG	$32,000,000	6.9
Rajon Rondo	36	PG	$6,500,000	2.3
Ricky Rubio	31	PG	$18,500,000	4.7
Patrick Beverley	34	PG	$16,500,000	4.2
Marcus Smart	28	PG	$15,500,000	4.7
Cory Joseph	31	PG	$14,500,000	3.6
Josh Richardson	29	SG	$11,000,000	3.0
Gary Harris	28	SG	$22,500,000	3.7
Zach LaVine	27	SG	$10,500,000	3.8
Jonas Valančiūnas	30	C	$15,000,000	5.1
Jusuf Nurkić	28	C	$14,000,000	3.8
Serge Ibaka	33	C	$12,000,000	2.9
Aron Baynes	35	C	$7,000,000	2.5
Blake Griffin	33	PF	$35,000,000	5.2
Montrezl Harrell	28	PF	$26,000,000	4.2
Thaddeus Young	34	PF	$17,000,000	3.9
Marvin Bagley III	23	PF	$14,500,000	4.7
Taurean Prince	28	PF	$14,500,000	1.7
Robert Covington	31	PF	$13,500,000	3.1
Kawhi Leonard	31	SF	$37,000,000	9.4
Rodney Hood	29	SF	$19,500,000	2.1
Will Barton	31	SF	$14,500,000	3.8
Justise Winslow	26	SF	$15,000,000	2.8
TJ Warren	29	SF	$13,500,000	3.7

尽管我们的问题场景似乎相当复杂，但您可能会对 R 和约束优化提供的解决方案的简单性感到惊讶。让我们在 4.7 节构建问题和 4.8 节得到结果之间转向那个解决方案。

4.7 约束优化构建

开始构建我们的约束优化问题（请注意，这些步骤无论在何种用例中都是相同的）。这个过程的第一步是通过调用 dplyr arrange() 函数创建一个“副本”的 free_agents 数据集，称为 free_agents_sort，数据按变量 position2 排序。打印的结果有意限制为六个观测值，仅考虑空间因素，同时也调用了基础 R 的 head() 函数：

head(free_agents_sort <- arrange(free_agents, position2))
##              player current_team age position1 position2 annual_salary
##   <chr>             <chr>      <dbl> <fct>     <fct>             <dbl>
## 1 Jonas Valanciunas          MEM  30         C        C1      15000000
## 2      Jusuf Nurkic          POR  28         C        C2      14000000
## 3       Serge Ibaka          LAC  33         C        C3      12000000
## 4       Aron Baynes          TOR  35         C        C4       7000000
## 5     Blake Griffin          DET  33        PF       PF1      35000000
## 6  Montrezl Harrell          LAL  28        PF       PF2      26000000
##   win_shares
##        <dbl>
## 1        5.1
## 2        3.8
## 3        2.9
## 4        2.5
## 5        5.2
## 6        4.2

第二，将 free_agents_sort 数据集子集化，仅包括我们约束优化问题绝对需要的变量；调用 dplyr 包中的 select() 函数将 free_agents_sort 简化为仅包含变量 player、age、position2、annual_salary 和 win_shares。打印的结果再次通过再次调用 head() 函数被限制：

head(free_agents_sort <- select(free_agents_sort, player, age, 
                                position2, annual_salary, win_shares))
##              player age position2 annual_salary win_shares
##   <chr>            <dbl> <fct>            <dbl>      <dbl>
## 1 Jonas Valanciunas  30        C1      15000000        5.1
## 2      Jusuf Nurkic  28        C2      14000000        3.8
## 3       Serge Ibaka  33        C3      12000000        2.9
## 4       Aron Baynes  35        C4       7000000        2.5
## 5     Blake Griffin  33       PF1      35000000        5.2
## 6  Montrezl Harrell  28       PF2      26000000        4.2

第三，构建一个约束矩阵，通过它创建了五个向量（注意 $ 操作符分隔对象和变量名），称为 centers、power_forwards、point_guards、small_forwards 和 shooting_guards，然后将它们附加到 free_agents_sort 数据集上。然后我们使用二进制编码用一和零填充这些向量，代表真和假，取决于 position2 中的对应值。

为了详细说明，每个向量包含 24 个元素，这当然与 free_agents_sort 的长度相匹配。以向量 centers 为例，前四个值等于 1，因为在我们对数据进行排序后，担任中锋位置的球员占据了 free_agents_sort 的前四条记录。其余的值等于 0，因为我们的数据集中的其他球员扮演的是除中锋以外的其他位置。这些结果随后被完整打印出来：

free_agents_sort$centers = c(1,1,1,1,0,0,0,0,0,0,
                   0,0,0,0,0,0,0,0,0,0,0,0,0,0) 
free_agents_sort$power_forwards = c(0,0,0,0,1,1,1,1,1,1,
                          0,0,0,0,0,0,0,0,0,0,0,0,0,0)  
free_agents_sort$point_guards = c(0,0,0,0,0,0,0,0,0,0,
                        1,1,1,1,1,1,0,0,0,0,0,0,0,0) 
free_agents_sort$small_forwards = c(0,0,0,0,0,0,0,0,0,0,
                             0,0,0,0,0,0,1,1,1,1,1,0,0,0) 
free_agents_sort$shooting_guards = c(0,0,0,0,0,0,0,0,0,0,
                           0,0,0,0,0,0,0,0,0,0,0,1,1,1) 
print(free_agents_sort)
##               player age position2 annual_salary win_shares centers
## 1  Jonas Valanciunas  30        C1      15000000        5.1       1
## 2       Jusuf Nurkic  28        C2      14000000        3.8       1
## 3        Serge Ibaka  33        C3      12000000        2.9       1
## 4        Aron Baynes  35        C4       7000000        2.5       1
## 5      Blake Griffin  33       PF1      35000000        5.2       0
## 6   Montrezl Harrell  28       PF2      26000000        4.2       0
## 7     Thaddeus Young  34       PF3      17000000        3.9       0
## 8  Marvin Bagley III  23       PF4      14500000        4.7       0
## 9     Taurean Prince  28       PF5      14500000        1.7       0
## 10  Robert Covington  31       PF6      13500000        3.1       0
## 11        Chris Paul  37       PG1      32000000        6.9       0
## 12       Rajon Rondo  36       PG2       6500000        2.3       0
## 13       Ricky Rubio  31       PG3      18500000        4.7       0
## 14  Patrick Beverley  34       PG4      16500000        4.2       0
## 15      Marcus Smart  28       PG5      15500000        4.7       0
## 16       Cory Joseph  31       PG6      14500000        3.6       0
## 17     Kawhi Leonard  31       SF1      37000000        9.4       0
## 18       Rodney Hood  29       SF2      19500000        2.1       0
## 19       Will Barton  31       SF3      14500000        3.8       0
## 20   Justise Winslow  26       SF4      15000000        2.8       0
## 21       T.J. Warren  29       SF5      13500000        3.7       0
## 22   Josh Richardson  29       SG1      11000000        3.0       0
## 23       Gary Harris  28       SG2      22500000        3.7       0
## 24       Zach LaVine  27       SG3      10500000        3.8       0
##    power_forwards point_guards shooting_forwards shooting_guards
##             <dbl>        <dbl>             <dbl>           <dbl>
## 1               0            0                 0               0
## 2               0            0                 0               0
## 3               0            0                 0               0
## 4               0            0                 0               0
## 5               1            0                 0               0
## 6               1            0                 0               0
## 7               1            0                 0               0
## 8               1            0                 0               0
## 9               1            0                 0               0
## 10              1            0                 0               0
## 11              0            1                 0               0
## 12              0            1                 0               0
## 13              0            1                 0               0
## 14              0            1                 0               0
## 15              0            1                 0               0
## 16              0            1                 0               0
## 17              0            0                 1               0
## 18              0            0                 1               0
## 19              0            0                 1               0
## 20              0            0                 1               0
## 21              0            0                 1               0
## 22              0            0                 0               1
## 23              0            0                 0               1
## 24              0            0                 0               1

第四，我们调用基础 R 的 rbind() 函数（简称行绑定），它基本上就是按行将两个或多个向量（或矩阵或数据集）连接成一个单一的对象。在这里，我们调用 rbind() 函数将几个向量组合成一个新的对象，称为 constraint_matrix，其维度由变量 position2 以及最初建立的硬约束决定：

constraint_matrix <- as.matrix(rbind(free_agents_sort$centers,
                                    free_agents_sort$centers,
                                    free_agents_sort$power_forwards,
                                    free_agents_sort$power_forwards,
                                    free_agents_sort$point_guards,
                                    free_agents_sort$point_guards,
                                    free_agents_sort$small_forwards,
                                    free_agents_sort$small_forwards,
                                    free_agents_sort$shooting_guards,
                                    free_agents_sort$shooting_guards,
                                     t(rep(1, length = 24)),
                                    free_agents_sort$annual_salary,
                                    free_agents_sort$age))

最后，我们调用基础 R 的 dimnames() 函数一次性设置行和列名。现在我们有一个 13 行长的对象，其中每一行代表一个预定的约束，24 列宽，其中每一列都与变量 position2 的值相关联：

constraint_matrix <- as.matrix(rbind(free_agents_sort$centers,
                                    free_agents_sort$centers,
                                    free_agents_sort$power_forwards,
                                    free_agents_sort$power_forwards,
                                    free_agents_sort$point_guards,
                                    free_agents_sort$point_guards,
                                    free_agents_sort$small_forwards,
                                    free_agents_sort$small_forwards,
                                    free_agents_sort$shooting_guards,
                                    free_agents_sort$shooting_guards,
                                     t(rep(1, length = 24)),
                                    free_agents_sort$annual_salary,
                                    free_agents_sort$age))
dimnames(constraint_matrix) <- 
  list(c("OneCenterMax",
         "OneCenterMin",
         "OnePowerForwardMax",
         "OnePowerForwardMin",
         "OnePointGuardMax",
         "OnePointGuardMin",
         "OneSmallForwardMax",
         "OneSmallForwardMin",
         "OneShootingGuardMax",
         "OneShootingGuardMin",
         "FivePlayerMax",
         "SalaryMax",
         "AgeMax"),
       free_agents_sort$position2)
print(constraint_matrix)
##                           C1       C2       C3      C4      PF1      PF2
## OneCenterMax               1        1        1       1        0        0
## OneCenterMin               1        1        1       1        0        0
## OnePowerForwardMax         0        0        0       0        1        1
## OnePowerForwardMin         0        0        0       0        1        1
## OnePointGuardMax           0        0        0       0        0        0
## OnePointGuardMin           0        0        0       0        0        0
## OneSmallForwardMax         0        0        0       0        0        0
## OneSmallForwardMin         0        0        0       0        0        0
## OneShootingGuardMax        0        0        0       0        0        0
## OneShootingGuardMin        0        0        0       0        0        0
## FivePlayerMax              1        1        1       1        1        1
## SalaryMax           15000000 14000000 12000000 7000000 35000000 26000000
## AgeMax                    30       28       33      35       33       28
##                          PF3      PF4      PF5      PF6      PG1     PG2
## OneCenterMax               0        0        0        0        0       0
## OneCenterMin               0        0        0        0        0       0
## OnePowerForwardMax         1        1        1        1        0       0
## OnePowerForwardMin         1        1        1        1        0       0
## OnePointGuardMax           0        0        0        0        1       1
## OnePointGuardMin           0        0        0        0        1       1
## OneSmallForwardMax         0        0        0        0        0       0
## OneSmallForwardMin         0        0        0        0        0       0
## OneShootingGuardMax        0        0        0        0        0       0
## OneShootingGuardMin        0        0        0        0        0       0
## FivePlayerMax              1        1        1        1        1       1
## SalaryMax           17000000 14500000 14500000 13500000 32000000 6500000
## AgeMax                    34       23       28       31       37      36
##                          PG3      PG4      PG5      PG6      SF1
## OneCenterMax               0        0        0        0        0
## OneCenterMin               0        0        0        0        0
## OnePowerForwardMax         0        0        0        0        0
## OnePowerForwardMin         0        0        0        0        0
## OnePointGuardMax           1        1        1        1        0
## OnePointGuardMin           1        1        1        1        0
## OneSmallForwardMax         0        0        0        0        1
## OneSmallForwardMin         0        0        0        0        1
## OneShootingGuardMax        0        0        0        0        0
## OneShootingGuardMin        0        0        0        0        0
## FivePlayerMax              1        1        1        1        1
## SalaryMax           18500000 16500000 15500000 14500000 37000000
## AgeMax                    31       34       28       31       31
##                          SF2      SF3      SF4      SF5      SG1
## OneCenterMax               0        0        0        0        0
## OneCenterMin               0        0        0        0        0
## OnePowerForwardMax         0        0        0        0        0
## OnePowerForwardMin         0        0        0        0        0
## OnePointGuardMax           0        0        0        0        0
## OnePointGuardMin           0        0        0        0        0
## OneSmallForwardMax         1        1        1        1        0
## OneSmallForwardMin         1        1        1        1        0
## OneShootingGuardMax        0        0        0        0        1
## OneShootingGuardMin        0        0        0        0        1
## FivePlayerMax              1        1        1        1        1
## SalaryMax           19500000 14500000 15000000 13500000 11000000
## AgeMax                    29       31       26       29       29
##                          SG2      SG3
## OneCenterMax               0        0
## OneCenterMin               0        0
## OnePowerForwardMax         0        0
## OnePowerForwardMin         0        0
## OnePointGuardMax           0        0
## OnePointGuardMin           0        0
## OneSmallForwardMax         0        0
## OneSmallForwardMin         0        0
## OneShootingGuardMax        1        1
## OneShootingGuardMin        1        1
## FivePlayerMax              1        1
## SalaryMax           22500000 10500000
## AgeMax                    28       27

剩余的工作是编写和运行约束优化算法，打印结果，并执行一系列简单的检查。

4.8 结果

我们现在可以通过调用 lp() 函数从 lpSolve 包中解决我们的约束优化问题——即计算这支 NBA 球队应该签下哪五名自由球员。我们调用的是一个 线性 编程函数，因为我们的变量是连续的，并且所有变量都有 1 的幂，这意味着它们是相加和相减，而不是相乘或相除。以下是它是如何工作的：

• const.mat 参数引用了一个数值约束系数矩阵，其中必须为每个约束有一个行，为每个变量有一个列，这当然正是我们构建 constraint_matrix 的方式。

• objective 参数等于应该优化的函数，即胜利份额。

• direction 参数是一个表示优化方向的字符串（这必须等于 min 或 max）。

• const.rhs 参数是一个表示我们约束的数值向量——场上的每个位置至少有一名球员，每个位置最多有一名球员（即 10 个约束），最多五名球员，年薪最高为 9000 万美元，年龄最高为 150 岁。

• const.dir 参数是一个表示每个约束方向的字符串向量——每个位置不多也不少地有一名球员，总共五名球员，年薪不超过 9000 万美元，总年龄不超过 150 岁（从而确保平均年龄等于或低于 30 岁）。

• int.vec 参数是一个指定整数变量数量的数值向量。

结果是一个名为 co_object 的新对象。在下一个代码块结束时没有调用 print() 函数；虽然它会返回目标函数的结果——即每年从最佳自由球员中可以期望获得多少胜利份额——但它不会返回其他任何内容：

co_object <-
  lp(const.mat = constraint_matrix,
     objective = free_agents_sort$win_shares,
     direction = "max",
     const.rhs = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, 90000000, 150), 
     const.dir = c("<=", ">=","<=", ">=", "<=", ">=", 
                   "<=", ">=", "<=", ">=", "<=", "<=", "<="), 
     int.vec = 1:24, all.bin = TRUE)

以下代码行返回一个名为 df 的对象形式的完整结果。通过调用 select() 函数，将 df 限制为仅包含位置 1 到 5 的变量，这些变量是 player、age、position2、annual_salary 和 win_shares：

print(df <- select(free_agents_sort[as.logical(co_object$solution),], 1:5))
##               player age position2 annual_salary win_shares
##   <chr>            <dbl> <fct>             <dbl>      <dbl>
## 3        Serge Ibaka  33        C3      12000000        2.9
## 8  Marvin Bagley III  23       PF4      14500000        4.7
## 15      Marcus Smart  28       PG5      15500000        4.7
## 17     Kawhi Leonard  31       SF1      37000000        9.4
## 24       Zach LaVine  27       SG3      10500000        3.8

我们有五名球员，每个位置都有一个球员。

调用基础 R 的 sum() 函数计算变量 win_shares 的总和：

sum(df$win_shares)
## [1] 25.5

另一次调用 sum() 函数计算变量 annual_salary 的总和。结果是，这个球队将为每个胜利份额支付大约 $3.5 M 的薪水：

sum(df$annual_salary) 
## [1] 89500000

最后，调用基础 R 的 mean() 函数来计算五名自由球员收购的平均年龄：

mean(df$age) 
## [1] 28.4

任何其他球员组合要么会导致胜利份额总和不增加，要么不可避免地违反事先设定的至少一个硬约束。因此，我们证实了我们的假设，即约束优化可以在同时遵守多个约束的情况下最大化一个函数；我们的虚构 NBA 球队实际上在略低的成本下获得了显著更多的胜利份额，这比我们探索数据后计算的大致估计要高得多。

到目前为止，我们已经确定了 NBA 球队如何通过约束优化最好地利用选秀权，或者在本例中，通过自由球员市场来构建他们的阵容。在接下来的几章中，我们将应用几种统计技术，其中大多数尚未介绍，用于比赛中的使用。这些相同的技术可以转移到其他数据和现实世界的场景中。

摘要

• 我们展示了如何为你的代码添加注释。注释可以提高代码的可读性，在代码审查和后期维护期间特别有用。R 忽略并以 # 符号开头的脚本中的行，因此不会执行这些行。

• 我们介绍了如何绘制 ggplot2 密度图，作为显示单个连续变量分布以及 ggplot2 相关性图来可视化两个连续变量之间相关性的方法。

• 有时，对可视化的一些小改动可以大大提高其美学和可解释性。scales 包使得在不重新格式化数据的情况下转换 ggplot2 标签成为可能。实际上，我们将在未来的章节中应用其他 scales 转换。

• 约束优化是一种相对直接的运筹学技术，通过消除猜测并产生最佳可能解决方案，定量解决困难和现实世界的问题。从lpSolve包中调用lp()函数只是 R 中实现这一目标的一种方法。

• 无论问题大小，在不太理想的环境下减少可用选项时，最佳解决方案是通过约束优化方法。

• 约束优化问题很容易转移到其他用例；一个算法应用于 NBA 自由球员市场后，只需替换最大或最小函数并修改约束，就可以在其他地方使用。

• 更多的时候，你可能是在寻求最小化成本（获取成本、仓储成本、供应商成本、薪资和福利等）或时间（路线和配送、上市时间、服务水平响应、延误和停机时间等）。

• 当然，你对最大化你业务的一些方面也同等感兴趣，可能是利润率、货架空间或时间表的遵守。再次强调，每次你寻求最小化或最大化一个函数，其中一个或多个约束限制了你的选择时，你都可以也应该应用约束优化来找到最佳选项。

5 个回归模型

本章涵盖

• 识别和处理异常值

• 运行和解释正态性统计测试

• 计算和可视化连续变量之间的相关性

• 调整和解释多重线性回归

• 调整和解释回归树

在本章中，我们将展示如何拟合回归模型，即多重线性回归和回归树。我们的因变量，或目标变量，将是常规赛胜利，我们的自变量，或预测变量，将是 NBA 在 2016-17 赛季开始记录的完整忙碌统计数据集。这些统计数据包括但不限于盖帽、挡球和抢断。因此，我们将对胜利进行一系列忙碌统计数据的回归。

我们的假设是，至少一些这些忙碌统计数据对胜负有有意义的影响，但哪些统计数据？以及影响有多大？在彻底探索数据的过程中——在此期间，我们将专注于识别和处理异常值、检验正态分布以及计算相关系数——我们将首先拟合多重线性回归作为初步测试，然后拟合回归树作为第二次测试。

多重线性回归是一个模型，通过产生一个穿过数据的直线方程来估计连续目标变量（如常规赛胜利）与两个或更多预测变量（通常是连续变量）之间的关系。（简单线性回归是一个模型，它执行相同的操作，但只有一个预测变量。）目标是理解和量化两个或更多预测变量共同如何影响目标变量的方差。

另一方面，回归树通常被称为决策树回归，它生成一系列的 if-else 规则以最佳拟合数据。此类模型根据预测变量的值递归地将数据划分为子集，并为每个子集预测目标变量的连续值。结果以图形方式显示，可能最能反映我们的决策过程；因此，它们比线性回归更容易解释并解释给他人——但通常预测性较差。哪一种可能更好取决于数据。

在加载我们的包、导入我们的数据以及继续我们的分析和测试之前，让我们进一步设定您的期望：

• 线性建模基于目标变量与预测变量之间存在线性关系的假设。只有当这个假设成立时，线性建模才是解释过去和预测未来的最佳检验。当这个假设被违反时，数据中的异常值有时是根本原因。线性模型对异常值特别敏感；实际上，在一个长数据集中，只有几个异常值就可以极大地改变回归线的斜率，从而使线性模型无法捕捉数据的整体模式，并返回不准确的结果。话虽如此，在 5.4 节中，我们将识别并处理数据中的每个异常值。

• 每个变量，尤其是预测变量，都应该呈正态分布。处理异常值可能足以将连续变量从非正态分布转换为正态分布，也可能不足以做到。在 5.5 节中，在识别出异常值并相应处理之后，我们将绘制密度图，并演示如何运行和解释一个常见的正态性统计检验。那些未能通过正态性检验的预测变量将被排除在模型开发之外。

• 与目标变量高度相关的预测变量，无论是正相关还是负相关，更有可能对目标变量的方差产生统计上显著的影响，比其他潜在的预测变量。因此，在 5.6 节中，我们将计算胜利与我们的剩余预测变量之间的相关系数，以隔离那些与胜利有强烈或相对强烈关系的变量，并将那些在模型开发中不具有这种关系的变量排除在外。

• 我们将在 5.7 节中拟合我们的多元线性回归，并演示如何解释和应用结果。在这个过程中，我们还将提供在拟合模型前后应用最佳实践的指导。

• 在 5.8 节中，我们将拟合和绘制回归树，并指导您如何解释结果，以及如何将结果与我们的线性模型进行比较和对比。

现在我们可以开始加载我们的包，导入我们的数据，并开始我们的分析。

5.1 加载包

关于我们的多元线性回归，我们将调用基础 R 的lm()函数来拟合模型，然后调用一系列包装函数来返回结果。相反，关于我们的回归树，我们将从tree包中调用tree()函数来拟合模型，然后调用一对内置函数来可视化结果。

总体来说，我们介绍了四个之前未加载或使用的包，包括tree包和以下包：

• 从GGally包，这是一个ggplot2的扩展，我们将调用ggpairs()函数来返回一个相关矩阵，该矩阵可以一次性可视化数据集中每个连续或数值变量之间的关系。在 R 中有很多方法可以可视化相关性；实际上，GGally的功能远超我们在第二章中创建的热图。

• 从car包中，将调用vif()函数，即方差膨胀因子，以检查我们的线性回归中独立变量或预测变量之间的多重共线性。多重共线性指的是两个或更多预测变量之间高度相关。当存在多重共线性时，至少应该移除一个预测变量，并拟合一个新的或简化的模型，以确保最高水平的有效性和可靠性。

• 从broom包中，将调用一系列函数以返回我们的线性模型结果。

这些包，包括tidyverse和patchwork包，通过连续调用library()函数来加载：

library(tidyverse)
library(GGally)
library(car)
library(broom)
library(tree)
library(patchwork)

现在我们已经加载了这些包，我们准备使用它们的函数，然后继续下一步。

5.2 导入数据

我们首先通过调用readr的read_csv()函数创建一个名为 hustle 的对象或数据集，该函数导入一个也称为 hustle 的.csv 文件。hustle 数据集包含从 NBA 官方网站（www.nba.com）抓取的数据：

hustle <- read_csv("hustle.csv")

read_csv()函数在运行时自动导入 hustle 数据集，因为文件存储在我们的默认工作目录中。如果 hustle.csv 存储在其他任何地方，前面的代码将失败。

设置或更改工作目录的方式不止一种。最佳方式——因为其他选项可能会随着后续软件版本的发布而改变——是调用基础 R 的setwd()函数，并在一对单引号或双引号之间添加完整目录：

setwd("/Users/garysutton/Library/Mobile Documents/com~apple~CloudDocs")

以下代码行通过用工作目录替换基础 R 的file.choose()函数来交互式地导入一个.csv 文件。如果您的.csv 文件存储在工作目录之外，或者您选择不定义工作目录，这是一个不错的选择：

hustle <- read_csv(file.choose()

在运行时打开一个对话框，提示您导航计算机并选择要导入的.csv 文件。

5.3 了解数据

现在我们已经导入了数据集，让我们开始了解它。与前面的章节一样，我们调用dplyr包中的glimpse()函数，以返回 hustle 数据集的转置版本：

glimpse(hustle)
## Rows: 90
## Columns: 12
## $ team               <fct> Atlanta Hawks, Boston Celtics, Brooklyn...
## $ season             <fct> 2018-19, 2018-19, 2018-19, 2018-19, 201...
## $ team_season        <fct> ATL 19, BOS 19, BKN 19, CHA 19, CHI 19,...
## $ screen_assists     <dbl> 8.0, 8.6, 11.0, 11.1, 8.3, 9.8, 8.5, 9....
## $ screen_assists_pts <dbl> 18.2, 20.0, 26.2, 25.7, 18.6, 22.4, 20....
## $ deflections        <dbl> 14.5, 14.1, 12.1, 12.6, 12.6, 11.8, 11....
## $ loose_balls        <dbl> 9.5, 8.3, 8.0, 8.1, 7.9, 7.6, 8.4, 8.6,...
## $ charges            <dbl> 0.5, 0.7, 0.3, 0.6, 0.4, 0.5, 0.8, 0.4,...
## $ contested_2pt      <dbl> 38.0, 35.9, 44.5, 39.2, 36.5, 34.6, 38....
## $ contested_3pt      <dbl> 25.2, 26.4, 22.2, 25.3, 24.9, 23.9, 24....
## $ contested_shots    <dbl> 63.2, 62.3, 66.7, 64.5, 61.3, 58.4, 62....
## $ wins               <int> 29, 49, 42, 39, 22, 19, 33, 54, 41, 57,...

hustle 数据集有 90 行长，14 列宽。它包含作为字符字符串的变量team、season和team_season；几个 hustle 统计数据作为数值变量；以及常规赛胜利数。

我们有一个必要且立即的行动：将前三个变量从字符字符串转换为因子。因此，我们调用基础 R 的as.factor()函数三次。再次强调，当变量可以假设仅为固定或有限集合的值时，将字符字符串转换为因子是一种最佳实践：

hustle$team <- as.factor(hustle$team)
hustle$season <- as.factor(hustle$season)
hustle$team_season <- as.factor(hustle$team_season)

然后，我们调用基础 R 的summary()函数，以返回 hustle 数据集中每个变量的基本或描述性统计信息：

summary(hustle)
##                   team        season    team_season screen_assists  
##  Atlanta Hawks      : 3   2016-17:30   ATL 17 : 1   Min.   : 6.800  
##  Boston Celtics     : 3   2017-18:30   ATL 18 : 1   1st Qu.: 8.425  
##  Brooklyn Nets      : 3   2018-19:30   ATL 19 : 1   Median : 9.350  
##  Charlotte Hornets  : 3                BKN 17 : 1   Mean   : 9.486  
##  Chicago Bulls      : 3                BKN 18 : 1   3rd Qu.:10.500  
##  Cleveland Cavaliers: 3                BKN 19 : 1   Max.   :13.100  
##  (Other)            :72                (Other):84                   
##  screen_assists_pts  deflections    off_loose_balls def_loose_balls
##  Min.   :15.90      Min.   :11.40   Min.   :0.000   Min.   :0.000  
##  1st Qu.:19.30      1st Qu.:13.32   1st Qu.:0.000   1st Qu.:0.000  
##  Median :21.55      Median :14.45   Median :3.400   Median :4.500  
##  Mean   :21.65      Mean   :14.38   Mean   :2.394   Mean   :3.181  
##  3rd Qu.:23.90      3rd Qu.:15.30   3rd Qu.:3.700   3rd Qu.:4.900  
##  Max.   :30.30      Max.   :18.70   Max.   :4.500   Max.   :5.500  
##   
##   loose_balls      charges       contested_2pt   contested_3pt  
##  Min.   :6.20   Min.   :0.2000   Min.   :34.00   Min.   :18.10  
##  1st Qu.:7.30   1st Qu.:0.4000   1st Qu.:37.73   1st Qu.:21.40  
##  Median :8.00   Median :0.5000   Median :39.90   Median :22.95  
##  Mean   :7.93   Mean   :0.5444   Mean   :40.19   Mean   :22.92  
##  3rd Qu.:8.50   3rd Qu.:0.7000   3rd Qu.:42.23   3rd Qu.:24.65  
##  Max.   :9.60   Max.   :1.1000   Max.   :49.10   Max.   :28.90  
##  
##  contested_shots      wins      
##  Min.   :55.30   Min.   :17.00  
##  1st Qu.:61.38   1st Qu.:32.25  
##  Median :63.15   Median :42.00  
##  Mean   :63.11   Mean   :41.00  
##  3rd Qu.:64.67   3rd Qu.:49.00  
##  Max.   :74.20   Max.   :67.00  
##  

从我们的数据中我们可以推断出以下内容：

• 我们的数据集涵盖了过去三个 NBA 常规赛赛季，即 COVID-19 之前（参见 season 变量的结果）；2019-20 赛季因疫情而缩短，特别是那些在赛季恢复后未能进入泡泡比赛（in-bubble play）的球队。 (一旦 2019-20 赛季恢复，所有比赛都在佛罗里达州奥兰多的一个中立、受控的场地进行。)

• 变量 team 和 season 被连接起来创建了一个额外的变量 team_season，例如，2016-17 赛季的亚特兰大老鹰队变为 ATL 17。

• 变量 off_loose_balls 和 def_loose_balls 分别代表进攻和防守中失去的球，它们的取值范围最小为 0，这表明至少在一个赛季中，NBA 只追踪了总失去的球数。一个被找回的球就是这样——进攻队失去了对球的控制，但不一定失去了球权，随后球被进攻方或防守方找回并控制。

• 变量 charges 上的统计数据不多，它们之间的差异可以忽略不计。当一个持球进攻球员在运球并向篮筐突破时，如果他与防守球员发生接触，就会被判个人犯规（除非接触轻微且没有严重影响比赛）。在 NBA 与大学篮球不同，运球突破到篮筐的接触通常会导致阻挡犯规或对防守方的犯规。但偶尔，进攻方会被判犯规；当这种情况发生时，防守方会被记为一次犯规，或者更具体地说，是一次引诱犯规。这样的变量，其频率很少且差异很小，不太可能对目标变量有太大影响。

• 除了 wins（胜利）之外，我们观察到以下变量的变化最大：

  • screen_assists_pts——这个变量等于每场比赛中，当一名球员在队友通过挡拆（将身体置于队友和防守球员之间）后立即投篮得分时的总得分。

  • contested_2pt——这个变量等于对手两分球尝试的平均防守紧密程度。

  • contested_shots——这个变量等于总投篮尝试的平均次数——包括两分球和三分球——它们的防守紧密程度较高。所有投篮（投篮得分）尝试根据距离篮筐的距离，每球得分为两分或三分。

• 这些变量之间存在中等程度的差异：

  • contested_3pt——这个变量等于对手三分球尝试的平均防守紧密程度。

  • screen_assists——这个变量等于每场比赛中设置的挡拆平均次数，无论随后场上的情况如何。

  • deflections——这个变量等于每场比赛中平均破坏或挡掉对手传球次数。

基于对进攻性 loose balls 恢复与防御性 loose balls 恢复的不一致跟踪，我们调用dplyr包中的select()函数，从 hustle 数据集中移除变量 off_loose_balls 和 def_loose_balls；在这种情况下，告诉 R 删除什么比保留什么要容易得多——因此，在随后的c()函数调用之前有一个减号运算符：

hustle %>% 
  select(-c(off_loose_balls, def_loose_balls)) -> hustle

我们随后调用基础 R 的dim()函数，通过返回数据集的新维度来确认此操作的执行成功：

dim(hustle)
## [1] 90 12

我们的数据集现在包含 90 行和仅 12 列，而之前它有 14 列。

5.4 识别异常值

如前所述，线性回归模型假设——实际上，要求——源数据不包含任何异常值。仅仅几个异常值，我们可能知道，可能是由于测量错误、数据输入错误或罕见事件，可能会压倒剩余数据点的 影响，从而给任何回归模型注入偏差。因此，将识别出与剩余数据整体模式或分布显著偏离的数据点，并随后对其进行修改，以有效地将其作为异常值消除。这可能会让一些人觉得过于夸张，但当我们处理 hustle 这样的短数据集时，改变极端值（称为 winsorization）是删除观测值并缩短数据长度的完全可接受和合法的替代方案。

5.4.1 原型

识别异常值有 很多 方法。视觉方法可能需要最多的工作，但它是理解数据最有效的方法。最简单的方法可能是一种统计测试：Dixon 的 Q 测试和 Grubbs 测试，两者都需要outliers包。然而，Dixon 的 Q 只适用于小数据集，其中 n，即记录数，小于 30；另一方面，Grubbs 测试具有更大的扩展性，但它只返回一个最显著的异常值，即使存在其他异常值。

让我们用变量 deflections 来演示视觉方法。有三种可视化选项可以用来发现异常值：散点图、直方图和箱线图。

仅使用 x 轴变量创建散点图与创建可视化 x 轴和 y 轴变量之间关系的关联图并不相同。话虽如此，我们不会调用ggplot2包中的ggplot()函数，而是首先通过调用qplot()函数创建我们的散点图，qplot()是快速绘图的意思。其次，我们将seq_along()函数传递给qplot()以创建一个均匀分布的数字向量。散点图的缺点是异常值并不总是那么明显。

对于直方图也是如此。它们通常是显示连续变量分布的第一个选项，但最终，在尾部标记（或不标记）值作为异常值通常是一个主观的练习。相比之下，箱线图专门设计用来隔离胡须外的值，并将它们确定为异常值。

为了比较目的，以下代码块返回了变量deflections周围的散点图（sp1）、直方图（hist1）和箱线图（bp1）（见图 5.1）。然而，对于 hustle 数据集中的剩余变量，只将创建箱线图：

sp1 <- qplot(seq_along(hustle$deflections), hustle$deflections) +
  labs(title = "Deflections", 
       subtitle = "scatterplot", 
       x = "", 
       y = "Value") +
  theme(plot.title = element_text(face = "bold")) +
  annotate("text", x = 65, y = 18.5, 
           label = "Outlier?", color = "red",
           size = 3, fontface = "bold") +
  annotate("text", x = 85, y = 18.3, 
           label = "Outlier?", color = "red",
           size = 3, fontface = "bold") 

hist1 <- ggplot(hustle, aes(x = deflections)) + 
  geom_histogram(fill = "snow1", color = "dodgerblue4", bins = 8) + 
  labs(title  ="Deflections", 
       subtitle = "histogram",
       x = "",           
       y  = "Frequency") +
  theme(plot.title = element_text(face = "bold")) +
  annotate("text", x = 18.75, y = 3, 
           label = "  Outliers?", color = "red",
           size = 3, fontface = "bold") 

bp1 <- ggplot(hustle, aes(x = "", y = deflections)) + 
  labs(title = "Deflections", 
       subtitle = "boxplot", 
       x = "", 
       y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "snow1", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8,
               color = "dodgerblue4", fill = "dodgerblue4") + 
  annotate("text", x = "", y = 18.6, 
           label = "                  Outliers",
           color = "red", size = 3, fontface = "bold") +
  theme(plot.title = element_text(face = "bold"))

图 5.1 从左到右，hustle 数据集中变量deflections周围的散点图、直方图和箱线图。与散点图和直方图相比，在识别异常值时，箱线图的主观性较低。

开放引号和Outliers注释（例如，" Outliers"）之间的空格是有意为之的；它们被插入以最佳定位文本在直方图和箱线图中，出于美观考虑。否则，plot_layout()函数从patchwork包中打印出我们的三个可视化作为单个水平对象：

sp1 + hist1 + bp1 + plot_layout(ncol = 3)

变量deflections确实包含一对异常值。因此，我们的下一步是通过减少这两个异常值的值，使它们刚好等于最大值来 winsorize 数据。回想一下，箱线图上的最大值是胡须的顶端（而最小值是底部胡须的端点）。

以下行代码修改了变量deflections中大于 17.8 的任何值，使其等于 17.8，这是bp1顶部胡须的大约端点：

hustle$deflections[hustle$deflections > 17.8] = 17.8

变量deflections的最大值最初为 18.70（检查summary()函数返回）。基础 R 中的max()函数返回新的最大值 17.8，因此当你只需要返回一个统计值时，无需再次调用summary()函数：

max(hustle$deflections)
## [1] 17.8

第二个箱线图（见图 5.2）显示了变量deflections在 winsorization 后的新分布：

bp2 <- ggplot(hustle, aes(x = "", 
                          y = deflections)) + 
  labs(title = "Deflections", 
       subtitle = "post-winsorization boxplot", 
       x = "", y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "grey65", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) 
print(bp2)

图 5.2 变量deflections在 winsorization 后的新或修订分布。注意异常值（即任何超出胡须长度的数据点）的缺失。

以下总结了我们迄今为止所做的工作：

• 我们选择了一种视觉方法而不是两种统计方法来在 hustle 数据集中检测异常值。

• 我们选择了箱线图而不是散点图和直方图，因为与使用其他可视化类型相比，在箱线图中识别异常值的主观性较低。此外，当决定如何减少或增加异常值的值以有效地消除它们时，箱线图比替代方案有更好的视觉效果。

• 我们没有从数据中移除异常值，而是由于 hustle 数据集只有 90 行长，我们决定采用 winsorization。

• 通过调用基础 R 的 max() 函数并创建第二个箱线图，我们两次确认变量 deflections 中的异常值已经消失。

在下一节中，这个过程将对 hustle 数据集中的剩余变量重复进行。

5.4.2 识别其他异常值

在紧随其后的长段代码中，我们将为 hustle 数据集中的每个剩余变量创建一个箱线图。对于包含一个或多个异常值的变量，我们的箱线图包括一个第二主题，通过在边缘添加红色边条来表示。否则，每个图表的语法都是完全相同的，这意味着你可以查看我们第一个箱线图的代码，然后跳转到叙述继续的地方，如果你愿意的话：

bp3 <- ggplot(hustle, aes(x = "", y = wins)) +
  labs(title = "Wins", 
       x = "", 
       y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "snow1", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8,
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) 

bp4 <- ggplot(hustle, aes(x = "", y = screen_assists)) +
  labs(title = "Screens", 
       x = "", 
       y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "snow1", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8,
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) 

bp5 <- ggplot(hustle, aes(x = "", y = screen_assists_pts)) + 
  labs(title = "Points off Screens", x = "", y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "snow1", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8,
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) 

bp6 <- ggplot(hustle, aes(x = "", y = loose_balls)) +
  labs(title = "Loose Balls Recovered", 
       x = "", 
       y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "snow1", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8,
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) 

bp7 <- ggplot(hustle, aes(x = "", y = charges)) + 
  labs(title = "Charges Drawn", 
       x = "", 
       y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "snow1", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8,
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) 

bp8 <- ggplot(hustle, aes(x = "", y = contested_2pt)) + 
  labs(title = "Contested 2pt Shots", 
       x = "", 
       y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "snow1", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8,
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) +
  theme(panel.background = element_rect(color = "red", size = 2))

bp9 <- ggplot(hustle, aes(x = "", y = contested_3pt)) +
  labs(title = "Contested 3pt Shots", 
       x = "", 
       y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "snow1", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8,
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) 

bp10 <- ggplot(hustle, aes(x = "", y = contested_shots)) +
  labs(title ="Contested Shots", 
       x = "", 
       y ="") +
  geom_boxplot(color = "dodgerblue4", fill = "snow1", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8,
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) +
  theme(panel.background = element_rect(color = "red", size = 2))

我们的前四个箱线图（见图 5.3）通过再次调用 plot_layout() 函数从 patchwork 包中组合成一个单一的图形对象。然后，剩余的四个图表被组合成另一个对象（见图 5.4）。将超过四个可视化组合成一个图形表示通常没有意义——至少从美学角度来看是这样，也许从实用角度来看也是如此：

bp3 + bp4 + bp5 + bp6 + plot_layout(ncol = 2)
bp7 + bp8 + bp9 + bp10 + plot_layout(ncol = 2) 

图 5.3 变量 wins、screens_assists、screen_assists_pts 和 loose_balls 的箱线图。这些变量中没有任何异常值。

除了变量 deflections 之外，hustle 数据集中只有另外两个变量包含异常值：contested_2pt 和 contested_shots。变量 contested_2pt 有一个异常值超过了最大值，而变量 contested_shots 有成对的异常值高于最大值，还有两个异常值低于最小值。

图 5.4 为 hustle 数据集中变量 charges、contested_2pt、contested_3pt 和 contested_shots 的箱线图。其中有两个变量存在异常值。

下一段代码将那些高于最大值的异常值降低，将那些低于最小值的异常值增加：

hustle$contested_2pt[hustle$contested_2pt > 48.5] = 48.5
hustle$contested_shots[hustle$contested_shots > 69.3] = 69.3
hustle$contested_shots[hustle$contested_shots < 57.4] = 57.4

对 max() 函数的调用确认了变量 contested_2pt 的最大值已从 49.10 降低到 48.5：

max(hustle$contested_2pt)
## [1] 48.5

然后绘制第二个箱线图（见图 5.5），显示变量 contested_2pt 现在没有任何异常值：

bp11 <- ggplot(hustle, aes(x = "", y = contested_2pt)) + 
  labs(title = "Contested 2pt Shots",
       subtitle = "post-winsorization boxplot", 
       x = "", 
       y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "grey65", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) +
  print(bp11)

图 5.5 winsorization 后变量 contested_2pt 的新或修订分布

紧接着对 max() 函数的调用之后，紧接着调用基础 R 的 min() 函数，返回变量 contested_shots 的新最大值和最小值：

max(hustle$contested_shots)
## [1] 69.3
min(hustle$contested_shots)
## [1] 57.4

contested_shots 的最大值从 74.20 降低到 69.30，最小值从 55.30 增加到 57.40。

我们接下来的可视化显示了变量contested_ shots的新分布，现在它不再包含任何异常值，而之前它包含了四个（见图 5.6）：

bp12 <- ggplot(hustle, aes(x = "", y = contested_shots)) + 
  labs(title = "Contested Shots",
       subtitle = "post-winsorization boxplot", 
       x = "", 
       y = "") +
  geom_boxplot(color = "dodgerblue4", fill = "grey65", width = 0.5) +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "dodgerblue4", fill = "dodgerblue4") + 
  theme(plot.title = element_text(face = "bold")) 
print(bp12)

图 5.6 经过 winsorization 后的变量contested_shots的新或修订分布

线性回归也期望目标变量以及特别是预测变量呈正态分布以获得最佳结果（这就是为什么非正态变量通常会被转换以使其呈正态分布）。尽管 hustle 数据集现在没有异常值，但这并不意味着我们的变量现在具有正态或高斯分布。接下来，我们将使用一系列密度图来可视化每个变量的分布，并通过针对每个变量的统计测试来补充我们的持续视觉方法，以确定每个变量是否呈正态分布。

5.5 检查正态性

现在已经处理了异常值，接下来我们将创建一系列密度图，作为可视化每个变量频率分布或形状的手段。此外，在创建每个密度图之前，我们将调用基础 R 中的shapiro.test()函数来运行 Shapiro-Wilk 测试，以确定每个变量，无论其分布看起来是否正常或不太正常，是否满足正态分布。Shapiro-Wilk 测试只是几种正态性测试中的一种，尽管无疑是最常见的。另一种相当常见的正态性测试是 Kolmogorov-Smirnov 测试。R 支持这些和其他类似的测试。

Shapiro-Wilk 测试的零假设是数据呈正态分布。因此，如果 p 值——定义为观察到的差异可能偶然发生的概率——小于或等于 0.05，我们将拒绝零假设，并得出结论说数据是非正态的。另一方面，当 p 值大于 0.05 时，我们反而会得出结论说数据是正态分布的，并且零假设不应该被拒绝。

假设检验和 p 值

让我们暂时休息一下，来讨论一下假设检验和 p 值的一些额外要点。假设检验，或称统计推断，主要是测试一个假设，并从一组或多组数据系列中得出结论。假设检验本质上评估结果有多不寻常或不太不寻常，以及它们是否过于极端或不可能是偶然的结果。

我们应该始终假设的是所谓的零假设，表示为 H[0]，它表明在一个变量或两个数据系列之间不存在任何统计上显著或不寻常的情况。因此，我们需要非凡的证据来拒绝零假设，并接受备择假设，表示为 H[1]**。

这个证据是 p 值，特别是通常接受的 5% 的显著性阈值。虽然 5% 可能有些武断，但我们同意这是一个非常小的数字，所以我们设定了一个很高的标准来推翻或拒绝零假设。

如前所述，线性建模期望变量是正态分布的，因此任何在 Shapiro-Wilk 测试结果中 p 值小于或等于 0.05 的预测变量将被排除在模型开发之外。将不会应用数据转换或其他纠正措施。

5.5.1 原型

再次，我们将使用变量 deflections 来原型化所有这些（见图 5.7）。但首先，我们调用基础 R 的 options() 函数来禁用科学记数法；我们更喜欢结果以完整数字形式返回，而不是以科学记数法形式。

图 5.7 变量 deflections 的密度图。由于 Shapiro-Wilk 正态性测试返回的 p 值大于 0.05，我们可以得出结论，deflections 假设正态分布。

作为提醒，密度图是直方图的平滑版本，不允许我们通过实验不同的箱数来扭曲分布形状。我们只向 ggplot() 函数传递一个 hustle 变量，然后调用 geom_density() 函数来绘制密度图。R 随后返回一个图表，y 轴变量不是频率或计数，而是一个概率密度函数，其中频率低时概率低，频率高时概率高。否则，x 轴代表数据中的值范围，就像直方图一样：

options(scipen = 999)

shapiro.test(hustle$deflections)
## 
##  Shapiro-Wilk normality test
## 
## data:  hustle$deflections
## W = 0.98557, p-value = 0.4235
dp1 <- ggplot(hustle, aes(x = deflections)) +
  geom_density(alpha = .3, fill = "dodgerblue4") +
  labs(title = "Deflections",
       subtitle = "Shapiro-Wilk test of normality: p-value = 0.42",
       x = "", 
       y = "Density") +
  theme(plot.title = element_text(face = "bold")) 
print(dp1)

变量 deflections 似乎 是正态分布的，并且根据 Shapiro-Wilk 测试结果，p 值显著高于 0.05 的显著性阈值，是 正态分布的。如果可以称之为这个过程的话，它将在下一节中重复应用于 hustle 数据集中的每个剩余变量。

5.5.2 检查其他分布的正态性

在我们的下一个代码块中，我们再次采取逐变量方法。我们将通过调用 shapiro.test() 函数运行一系列 Shapiro-Wilk 测试，并绘制一系列密度图。结果随后分为两个面板（见图 5.8 和 5.9）。任何显示非正态分布的图表都将根据 Shapiro-Wilk 测试结果绘制红色边框。同样，代码在从一个图表到下一个图表之间几乎是可重复的：

shapiro.test(hustle$wins)
## 
##  Shapiro-Wilk normality test
## 
## data:  hustle$wins
## W = 0.98034, p-value = 0.1907
dp2 <- ggplot(hustle, aes(x = wins)) +
  geom_density(alpha = .3, fill = "dodgerblue4") +
  labs(title = "Wins",
       subtitle = "Shapiro-Wilk test of normality: p-value = 0.19",
       x = "", 
       y = "Density") +
  theme(plot.title = element_text(face = "bold"))

shapiro.test(hustle$screen_assists)
## 
##  Shapiro-Wilk normality test
## 
## data:  hustle$screen_assists
## W = 0.98309, p-value = 0.2936
dp3 <- ggplot(hustle, aes(x = screen_assists)) +
  geom_density(alpha = .3, fill = "dodgerblue4") +
  labs(title = "Screens",
       subtitle = "Shapiro-Wilk test of normality: p-value = 0.29",
       x = "", 
       y = "Density") +
  theme(plot.title = element_text(face = "bold"))

shapiro.test(hustle$screen_assists_pts)
## 
##  Shapiro-Wilk normality test
## 
## data:  hustle$screen_assists_pts
## W = 0.9737, p-value = 0.06464
dp4 <- ggplot(hustle, aes(x = screen_assists_pts)) +
  geom_density(alpha = .3, fill = "dodgerblue4") +
  labs(title = "Points off Screens",
       subtitle = "Shapiro-Wilk test of normality: p-value = 0.06",
       x = "", 
       y = "Density") +
  theme(plot.title = element_text(face = "bold"))
shapiro.test(hustle$loose_balls)
## 
##  Shapiro-Wilk normality test
## 
## data:  hustle$loose_balls
## W = 0.98109, p-value = 0.2148
dp5 <- ggplot(hustle, aes(x = loose_balls)) +
  geom_density(alpha = .3, fill = "dodgerblue4") +
  labs(title = "Loose Balls Recovered",
       subtitle = "Shapiro-Wilk test of normality: p-value = 0.21",
       x = "", 
       y = "Density") +
  theme(plot.title = element_text(face = "bold"))

shapiro.test(hustle$charges)
## 
##  Shapiro-Wilk normality test
## 
## data:  hustle$charges
## W = 0.95688, p-value = 0.004562
dp6 <- ggplot(hustle, aes(x = charges)) +
  geom_density(alpha = .3, fill = "dodgerblue4") +
  labs(title = "Charges Drawn",
       subtitle = "Shapiro-Wilk test of normality: p-value = 0.00",
       x = "", 
       y = "Density") +
  theme(plot.title = element_text(face = "bold")) +
  theme(panel.background = element_rect(color = "red", size = 2))

shapiro.test(hustle$contested_2pt)
## 
##  Shapiro-Wilk normality test
## 
## data:  hustle$contested_2pt
## W = 0.97663, p-value = 0.1045
dp7 <- ggplot(hustle, aes(x = contested_2pt)) +
  geom_density(alpha = .3, fill = "dodgerblue4") +
  labs(title = "Contested 2pt Shots",
       subtitle = "Shapiro-Wilk test of normality: p-value = 0.10",
       x = "", 
       y = "Density") +
  theme(plot.title = element_text(face = "bold"))

shapiro.test(hustle$contested_3pt)
## 
##  Shapiro-Wilk normality test
## 
## data:  hustle$contested_3pt
## W = 0.98301, p-value = 0.2899
dp8 <- ggplot(hustle, aes(x = contested_3pt)) +
  geom_density(alpha = .3, fill = "dodgerblue4") +
  labs(title = "Contested 3pt Shots",
       subtitle = "Shapiro-Wilk test of normality: p-value = 0.29",
       x = "", 
       y = "Density") +
  theme(plot.title = element_text(face = "bold"))

shapiro.test(hustle$contested_shots)
## 
##  Shapiro-Wilk normality test
## 
## data:  hustle$contested_shots
## W = 0.98106, p-value = 0.2138
dp9 <- ggplot(hustle, aes(x = contested_shots)) +
  geom_density(alpha = .3, fill = "dodgerblue4") +
  labs(title = "Contested 2pt Shots",
       subtitle = "Shapiro-Wilk test of normality: p-value = 0.21",
       x = "", 
       y = "Density") +
  theme(plot.title = element_text(face = "bold")) 

图 5.8 变量 wins、screens_assists、screen_assists_pts 和 loose_balls 的密度图。由于 Shapiro-Wilk 测试返回的 p 值高于 0.05 的显著性阈值，这四个变量都是正态分布的。

然后，我们的密度图被打包成一对 4 × 2 矩阵：

dp2 + dp3 + dp4 + dp5 + plot_layout(ncol = 2)
dp6 + dp7 + dp8 + dp9 + plot_layout(ncol = 2) 

图 5.9 变量 charges、contested_2pt、contested_3pt 和 contested_shots 的密度图。只有“Charges Drawn”不是正态分布。

结果表明，只有变量 charges 的分布不符合正态分布，根据 Shapiro-Wilk 测试，在 p 值等于预定义的 5% 显著性阈值时划出了一条界线。变量 screen_assists_pts 和 contested_2pt 的 Shapiro-Wilk p 值仅略高于 0.05，这表明它们的分布几乎是非正态的。但再次强调，我们正在应用 0.05 的 p 值作为硬截止点；因此，我们将从线性建模中保留变量 charges。

尽管如此，我们仍有几个变量在考虑范围内。在下一节中，我们将可视化和测试剩余预测变量与变量 wins 之间的相关性，以确定其中哪些可能是最佳候选者，用于解释甚至预测常规赛的胜利。

5.6 可视化和测试相关性

总结一下，我们首先识别了数据中的异常值，然后相应地将这些数据点限制在最大值或最小值。其次，我们测试了变量的正态性，以确定哪些可以继续使用，哪些需要从任何进一步的分析和测试中保留。

现在，我们将计算变量 wins 与剩余变量之间的相关系数，并使用相关矩阵进行可视化。相关系数始终等于介于 -1 和 +1 之间的某个值。当一对变量的相关系数等于或接近 +1 时，我们可以得出结论，它们之间存在正相关关系；如果它们的相关系数相反等于 -1 或接近那个值，我们可以交替得出结论，它们之间存在负相关关系；如果它们的相关系数接近 0，那么它们之间根本不存在有意义的关联。

我们在这里的目的在于确定哪些变量可能是最佳拟合，或者根本不适合，作为线性回归模型中的预测变量。当处理宽数据集时，这是一个特别相关的练习，因为它使得进一步检查数据并识别高潜力预测变量比在模型中包含每个独立变量（无论是否增加任何值）更有意义。

5.6.1 原型

变量 deflections 将再次用于演示目的。调用基本的 R cor() 函数来计算变量 deflections 和 wins 之间的相关系数。

然后创建一个 ggplot2 相关性图来可视化这两个相同变量之间的关系，其中 x 轴变量是潜在的预测变量 deflections，y 轴变量是未来的因变量或目标变量 wins（见图 5.10）。相关系数被添加为副标题，并调用 geom_smooth() 函数来通过数据绘制回归线。我们得到一个相关性图，就像我们在上一章中绘制的那样：

cor(hustle$deflections, hustle$wins) 
## [1] 0.2400158
cor1 <- ggplot(hustle, aes(x = deflections, y = wins)) + 
  geom_point(size = 3) +
  labs(title = "Deflections and Wins", 
       subtitle = "correlation coefficient = 0.24",
       x = "Deflections per Game", 
       y = "Regular Season Wins") + 
  geom_smooth(method = lm, se = FALSE) +
  theme(plot.title = element_text(face = "bold")) 
print(cor1)

图 5.10 一个可视化 deflections 和 wins 变量之间关系的相关性图

当 deflections 和 wins 之间的相关系数为 0.24 时，两者之间存在正相关，但除此之外，这种关联并不引人注目。让我们看看这种关联与其他预测变量与 wins 变量之间的相关系数相比如何。

5.6.2 可视化和测试其他相关性

作为按顺序绘制相关性的替代方案，有一个大爆炸选项，只需要两行代码。在下一个代码块的第一行中，我们创建了一个名为 hustle2 的数据集，它是 hustle 的副本，但不包括连续变量 deflections 和 charges 以及因子变量 team、season 和 team_season。被丢弃的变量位于 1-3、6 和 8 位置。

然后，我们调用 GGally 包中的 ggpairs() 函数，从而生成一个矩阵，该矩阵使用 ggplot2 的外观和感觉来可视化左边的相关性，在右边显示相关系数，并在中间绘制变量分布。然后，我们添加或附加对 theme() 函数的调用，以便将 x 轴标签旋转 90 度。（见图 5.11。）根据您的系统，这可能需要几秒钟才能运行：

hustle %>% 
  select(-c(1:3, 6, 8)) -> hustle2
ggpairs(hustle2) + 
  theme(axis.text.x = element_text(angle = 90, hjust = 1))

图 5.11 一个可视化并计算 hustle 数据集变量子集之间相关性的相关性矩阵

结果表明，剩余的 hustle 变量中没有任何一个与 wins 有强烈的正相关或负相关；事实上，没有一个与 wins 的相关系数等于或像 deflections 和 wins 之间的相关系数那样有意义。

调用基础 R 的 cor() 函数返回这些相同结果的表格视图，这是调用 ggpairs() 函数并渲染相关性矩阵的更快的替代方案：

cor(hustle2)
##                    screen_assists screen_assists_pts loose_balls
## screen_assists         1.00000000         0.98172006 -0.36232361
## screen_assists_pts     0.98172006         1.00000000 -0.31540865
## loose_balls           -0.36232361        -0.31540865  1.00000000
## contested_2pt          0.20713399         0.21707461 -0.24932814
## contested_3pt         -0.33454664        -0.31180170  0.45417789
## contested_shots        0.01946603         0.04464369  0.05003144
## wins                   0.12180282         0.16997124  0.12997385
##                    contested_2pt contested_3pt contested_shots
## screen_assists         0.2071340   -0.33454664      0.01946603
## screen_assists_pts     0.2170746   -0.31180170      0.04464369
## loose_balls           -0.2493281    0.45417789      0.05003144
## contested_2pt          1.0000000   -0.38772620      0.77579822
## contested_3pt         -0.3877262    1.00000000      0.25889619
## contested_shots        0.7757982    0.25889619      1.00000000
## wins                   0.1854940   -0.09666249      0.13024121
##                           wins
## screen_assists      0.12180282
## screen_assists_pts  0.16997124
## loose_balls         0.12997385
## contested_2pt       0.18549395
## contested_3pt      -0.09666249
## contested_shots     0.13024121
## wins                1.00000000

这就完成了所有线性回归的前期工作。我们已识别并调整了异常值，测试了正态性，然后确定了要向前推进的 hustle 变量子集，并测试了潜在预测变量与变量wins之间的相关性。通过这个过程，我们确定deflections、contested_2pt和screen_assists_pts可能比其他预测变量对胜利有更大的影响，因为它们的相关系数较高，而wins与完全中性的距离最远。

5.7 多元线性回归

与仅对一个预测变量（例如wins对deflections）进行简单线性回归测试的目标变量不同，多元线性回归测试的目标变量与两个或更多预测变量。线性回归必须包含一个连续的目标变量；预测变量通常是连续的，但也可以是分类的。换句话说，线性模型旨在预测目标变量在某个范围内的变化，例如 0-100 分的测试分数或 0-82 分的常规赛胜利。相比之下，逻辑回归（见第十四章）包含一个二元目标变量，例如哪些学生会或不会获得及格成绩，或者哪些 NBA 球队会或不会以胜利的记录完成常规赛。

我们的主要目标是展示以下内容：

• 如何将数据集中的观测值随机分成两个互斥的子集，其中一个将用于模型拟合，另一个用于生成预测

• 如何拟合多元线性回归

• 如何返回模型结果并解释

• 如何检查多重共线性

• 如何运行模型诊断并解释图表

• 如何比较两个具有相同目标变量（即每个模型也包含不同混合的预测变量）的竞争性线性模型

• 如何预测

话虽如此，让我们开始我们的回归测试。

5.7.1 将数据子集到训练集和测试集

我们的多元回归练习首先将 75%的 hustle 观测值子集到一个名为 train 的数据集中，将剩余的 25%子集到 test 中；我们将对 train 拟合线性模型，然后在 test 上进行预测。如果我们对 100%的记录进行拟合和预测，我们就有可能过度拟合我们的模型；也就是说，它们基本上会记住数据，而不一定对新数据有良好的响应。

以下dplyr代码块首先从 hustle 数据集中提取（即过滤）每第四个观测值，并将结果永久地转换到一个名为 test 的新对象中；因此，test 的行数等于 23，大约是 hustle 中 90 个观测值的 25%。然后我们调用anti_join()函数创建一个名为 train 的对象，它包含 67 个尚未分配给 test 的 hustle 观测值：

hustle %>%
  filter(row_number() %% 4 == 1) -> test
train <- anti_join(hustle, test)

然后，我们两次调用dim()函数来返回 train 和 test 的维度，从而确认我们的训练和测试分割按设计工作：

dim(train)
## [1] 67 12
dim(test)
## [1] 23 12

5.7.2 拟合模型

来自基础 R 的lm()函数被用来拟合线性模型。我们的第一个模型，fit1，将wins对变量screen_assists_pts、deflections、loose_balls、contested_2pt和contested_shots进行回归。这些变量是基于我们刚刚计算出的相关系数被选为预测变量的。

语法简单直接。目标变量通过波浪号与预测变量分隔，预测变量通过加号分隔，并指向我们的数据源：

fit1 <- lm(wins ~ screen_assists_pts + deflections + loose_balls + contested_2pt + contested_shots, data = train)

5.7.3 返回和解释结果

然后，我们调用broom包中的一系列函数，逐步返回结果。tidy()函数的调用特别返回一个 6 × 5 的 tibble，其中最重要的是包含系数估计和 p 值：

tidy(fit1)
## # A tibble: 6 × 5
##   term               estimate std.error statistic p.value
##   <chr>                 <dbl>     <dbl>     <dbl>   <dbl>
## 1 (Intercept)         -62.9      38.6      -1.63   0.108 
## 2 screen_assists_pts    1.04      0.441     2.35   0.0219
## 3 deflections           2.23      0.882     2.53   0.0138
## 4 loose_balls           5.38      2.19      2.45   0.0170
## 5 contested_2pt         0.525     0.763     0.688  0.494 
## 6 contested_shots      -0.241     0.790    -0.305  0.761

p 值等于或小于 0.05 的变量对wins的方差有统计学上的显著影响。否则，我们可以将tidy()函数返回的系数估计与 hustle 数据集的实际值结合起来，创建一个线性方程，该方程相对于 fit1 具有以下形式：

y = B[0] + B[1]X[1] + B[2]X[2] + B[3]X[3] + B[4]X[4] + B[5]X[5]

在这个方程中，请注意以下内容：

• y是因变量wins的预测值。

• B[0]是 y 截距，或常数项；它表示拟合回归线与 y 轴交叉的值。

• B[1]X[1]是第一个 fit1 预测变量screen_assists_pts的回归系数，其中B[1]等于 1.04，而X[1]是每场比赛通过挡拆得分平均得分点数。

• B[2]X[2]是第二个预测变量deflections的回归系数，其中B[2]等于 2.23，而X[2]是每场比赛的平均折返次数。

• B[3]X[3]是loose_balls的回归系数，即 5.38 乘以每场比赛平均找回的松球次数。

• B[4]X[4]是contested_2pt的回归系数，即 0.53 乘以每场比赛平均被争抢的两分投篮次数。

• B[5]X[5]是contested_shots的回归系数，即-0.24 乘以每场比赛平均被争抢的总投篮次数。

让我们将 2016-17 赛季迈阿密热火的相关 hustle 统计数据插入 fit1 线性方程中，以展示这些结果。在 2016-17 赛季常规赛中，热火每场比赛平均通过挡拆得分 22.3 分，14.2 次折返，7.2 次找回松球，45.5 次被争抢的两分投篮次数，以及 64.7 次被争抢的总投篮次数。连续调用dplyr filter()和select()函数从 hustle 数据集中提取 MIA 17 记录的子集：

hustle %>%
  filter(team_season == "MIA 17") %>%
  select(wins, screen_assists_pts, deflections, loose_balls,
         contested_2pt, contested_shots)
##    wins screen_assists_pts deflections loose_balls contested_2pt 
## 1    41               22.3        14.2         7.2          45.5 
##    contested_shots
## 2             64.7

因此，我们的线性回归将“预测”（这些数字是从训练数据生成的，而不是测试数据）迈阿密的胜场总数如下：

wins = -62.91 + (1.04 * 22.3) + (2.23 * 14.2) + (5.38 * 7.2) + 
  (0.52 * 45.5) - (0.24 * 64.7)
print(round(wins))
## [1] 39

减去误差项后，fit1 预测 2016-17 热队将赢得 39 场胜利（这是通过将 print() 函数与基础 R 的 round() 函数结合来四舍五入到最接近的整数），而该赛季热队实际上赢得了 41 场比赛。这还不错；然而，后续的证据将揭示，fit1 在预测 .500 级别球队（如 2016-17 热队）的常规赛胜场数时比预测像 2017-18 胡斯顿火箭队（赢得 65 场比赛）或 2018-19 纽约尼克斯队（仅赢得 17 场比赛）这样的球队时更加准确。（每个 NBA 球队都参加 82 场常规赛的比赛。）

现在让我们假设热队实际上每场比赛回收了 8.2 个松散的球，而不是 7.2 个；在这种情况下，fit1 将预测 44 场胜利（同样，这已经被四舍五入到最接近的整数）。我们通过将线性方程中的 7.2 替换为 8.2 来得到这个结果。然而，从根本上说，对于变量 loose_balls 的每单位增加（或减少），对 wins 的预测值将增加（或减少）5.38。同样，如果热队能够每场比赛多拦截一次传球，fit1 将预测多赢得 2.23 场胜利（其他条件保持不变）：

wins = -62.91 + (1.04 * 22.3) + (2.23 * 14.2) + (5.38 * 8.2) + 
  (0.52 * 45.5) - (0.24 * 64.7)
print(round(wins))
## [1] 44

然而，并非所有 fit1 预测变量都对胜场数有统计学上的显著影响。只有 screen_assists_pts、deflections 和 loose_balls 这三个变量的 p 值低于通常接受的和预定义的 0.05 显著性阈值，而 contest_2pt 和 contested_shots 这两个变量的 p 值则显著高于 5% 的阈值。因此，我们的第一次多元线性回归揭示了只有 一些 疯狂统计数据对常规赛胜场数有显著影响。

来自 broom 包的 augment() 函数返回了诸如实际胜场数以及相同数据的拟合值等数据；结果被转换为一个名为 fit1_tbl 的 tibble。然后我们调用 head() 函数两次，首先返回变量 wins 的前六个值，其次返回变量 .fitted 的前六个值：

augment(fit1) -> fit1_tbl
head(fit1_tbl$wins)
## [1] 49 42 39 19 33 54
head(fit1_tbl$.fitted)
## [1] 37.84137 41.64023 40.52752 31.68228 33.81274 38.46419

然后，在下面的 dplyr 代码块中，我们首先调用 mutate() 函数创建一个新变量 wins_dif，它是 fit1_tbl 变量 wins 和 .fitted 之间的绝对差值（注意对基础 R 的 abs() 函数的调用）。然后我们调用基础 R 的 mean() 函数来计算实际胜场数和拟合胜场数之间的平均差异：

fit1_tbl %>%
  mutate(wins_dif = abs(wins - .fitted)) -> fit1_tbl
mean(fit1_tbl$wins_dif)
## [1] 8.274887

平均而言，我们的 fit1 线性方程返回的常规赛胜场数比实际常规赛胜场数多 8.27 场或少 8.27 场。

最后，broom包中的glance()函数返回最重要的 R-squared（R²）和调整后的 R²统计量。R²是一个统计量，表示目标变量中由预测因子解释的方差比例。因此，它等于 0 到 1 之间的某个数字，其中 1 表示预测因子解释了所有方差，而 0 表示预测因子未能解释任何方差。

调整后的 R²是 R²的修改版，它考虑了预测因子的数量。虽然当其他预测因子被添加到回归模型中时，R²自然会增加，但如果这些相同的预测因子没有对模型的预测能力做出贡献，调整后的 R²实际上会减少。模型越复杂，R²和调整后的 R²的差异就越大：

glance(fit1)
## # A tibble: 1 × 12
##   r.squared adj.r.squared sigma statistic p.value    df logLik 
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <dbl>  <dbl>
## 1     0.202         0.137  10.9      3.09  0.0150     5  -252\.  
##        AIC   BIC deviance df.residual  nobs
##      <dbl> <dbl>    <dbl>       <int> <int>
## 1     518\.  533\.    7230\.          61    67

因为 R²等于 0.20，所以 fit1 预测因子共同解释了常规赛胜利变化的约 20%，无论它们的各自 p 值如何。

但调整后的 R²仅为 0.14，毫无疑问，这是由于 fit1 包含一对预测因子contested_2pt和contested_shots，由于它们的各自 p 值高于 5%的阈值，因此对胜利没有统计学上的显著影响。换句话说，我们的模型包含噪声。因此，根据这个度量，实际上更准确的说法是 fit1 最好解释了胜利变化的 14%，而不是 20%。

5.7.4 检查多重共线性

现在，让我们检查 fit1 中的多重共线性。再次强调，多重共线性是指两个或更多预测因子高度相关的情况；也就是说，它们之间的相关系数等于或接近+1。多重共线性的最显著后果是它人为地增加了解释的方差。正如我们刚才提到的，随着每个额外预测因子的增加，R²会自动和递增地增加；同时，调整后的 R²会减少，但如果额外的预测因子本身在统计学上是显著的，那么减少的幅度不会很大。但是，当存在多重共线性时，我们实际上是在重复计算；因此，R²和调整后的 R²度量都会被人为地提高。

我们从car包中调用vif()函数来测试多重共线性。根据我们之前进行的相关性测试，fit1 可能不包含多重共线性，但无论如何，测试它是一个最佳实践，以确保我们没有过度拟合：

vif(fit1)
## screen_assists_pts        deflections        loose_balls      
##           1.155995           1.062677           1.314189           
## contested_2pt    contested_shots 
##      3.052934           2.637588

如果 fit1 预测因子的方差膨胀因子中任何一个超过 5，我们应该丢弃这些变量，然后拟合一个简化模型，即具有较少预测因子的模型。但正如我们所看到的，fit1 所有预测因子的方差膨胀因子都小于 5。

5.7.5 运行和解释模型诊断

来自基础 R 的plot()函数返回关于线性和正态性的模型诊断（见图 5.12）。当plot()函数前有基础 R 的par()函数时，这些诊断信息会以 2×2 矩阵的形式打印出来。这些图表明 fit1 满足线性和正态性的先决条件，从而验证了我们第一个模型的完整性，即使我们可能对结果并不完全满意：

par(mfrow = c(2, 2))
plot(fit1)

图 5.12 第一个多元线性回归模型的模型诊断

诊断图帮助我们评估拟合优度，并验证关于线性和正态性的初始假设。让我们逐一分析。

上左象限的残差与拟合值图显示了模型残差沿 y 轴和拟合值沿 x 轴。残差是从实际值到拟合回归线的垂直距离的度量；模型残差或误差应该遵循正态分布。数据点大致围绕水平线浮动，而不是遵循某种明显的模式，这是好事，因为它强烈表明残差确实遵循正态分布。

右上象限的正常 Q-Q 图是检查残差是否遵循正态分布的另一种检查。它将残差（已分为分位数，或四个相等大小的比例）与理论正态分布的分位数进行比较；前者沿 y 轴绘制，后者沿 x 轴绘制。请注意，这两个数据系列都已转换为标准化尺度。残差应遵循对角线，没有任何严重的偏差，正如它们应该的那样。当然，对齐并不完美，我们确实看到两端有一些中等程度的偏差，但这里没有什么可以引起我们对正态性和线性或缺乏线性有任何严重担忧的。

左下象限的尺度-位置图，也称为散点-位置图或标准化残差的平方根图，用于评估所谓的同方差性。它还沿 y 轴绘制标准化残差的平方根，沿 x 轴绘制拟合值。同方差性是指回归分析中的一个统计假设，即残差（即实际值与拟合值之间的差异）的方差在所有预测变量的水平上都是恒定的。换句话说，它期望残差的分布或分散在整个独立变量的范围内大致相同。尺度-位置图应该并且确实类似于残差与拟合值图。

在右下象限的残差与杠杆作用图，更常被称为库克距离图，用于隔离任何观察值——基本上是异常值——它们对拟合回归线有过度的影响。它还沿 y 轴绘制了标准化残差，以及称为杠杆值的 x 轴。杠杆值代表每个观察值的影响。我们特别关注任何低于标注为库克距离的虚线水平线的数据点，当然，我们有一些这样的数据点。但我们的实际关注点应该集中在那条线以下和右下角的数据点，我们看到只有一个观察值同时满足这两个条件。我们的结果并不完美（在现实世界中很少完美），但我们没有理由感到恐慌或改变方向。

5.7.6 模型比较

合理的下一步是将那个观察值从训练数据中移除，然后重新运行我们的回归，但我们将采取更大的下一步。因为只有 fit1 预测器中的一部分对胜利有统计学上的显著影响，我们现在将拟合第二个多重回归模型，其中预测器 screen_assist_pts、deflections 和 loose_balls 仍然有效，但预测器 contested_2pt 和 contested_shots 被排除在外。因此，我们的第二个回归，命名为 fit2，仅仅是 fit1 的简化版本。随后的 tidy()、augment()、glance() 等函数调用返回结果，图 5.13 显示了诊断结果：

fit2 <- lm(wins ~ screen_assists_pts + deflections + loose_balls, 
           data = train)

tidy(fit2)
## # A tibble: 4 × 5
##   term               estimate std.error statistic p.value
##   <chr>                 <dbl>     <dbl>     <dbl>   <dbl>
## 1 (Intercept)          -56.1     25.5       -2.20 0.0317 
## 2 screen_assists_pts     1.12     0.422      2.65 0.0101 
## 3 deflections            2.35     0.859      2.74 0.00805
## 4 loose_balls            4.81     1.98       2.42 0.0182
augment(fit2) -> fit_tbl2
print(fit_tbl2)
# A tibble: 67 × 10
##    wins screen_assists_pts deflections loose_balls .fitted  .resid   
##   <int>              <dbl>       <dbl>       <dbl>   <dbl>   <dbl>  
## 1    49               20          14.1         8.3    39.3   9.66  
## 2    42               26.2        12.1         8      40.1   1.85  
## 3    39               25.7        12.6         8.1    41.2  -2.24  
## 4    19               22.4        11.8         7.6    33.3 -14.3   
## 5    33               20.1        11.5         8.4    33.8  -0.825 
## 6    54               19.9        13.9         8.6    40.2  13.8   
## 7    57               26.3        14.2         8.7    48.6   8.44  
## 8    53               16.6        14.9         8.4    37.9  15.1   
## 9    48               20.2        14.2         8.6    41.2   6.76  
##10    37               20.1        11.9         8.5    35.2   1.75  
##         hat .sigma  .cooksd .std.resid
##       <dbl>  <dbl>    <dbl>      <dbl>
## 1    0.0224   10.8 0.00472      0.907 
## 2    0.0726   10.8 0.000626     0.179 
## 3    0.0568   10.8 0.000691    -0.214 
## 4    0.0647   10.7 0.0324      -1.37  
## 5    0.0749   10.9 0.000128    -0.0797
## 6    0.0316   10.7 0.0138       1.30  
## 7    0.0792   10.8 0.0144       0.817 
## 8    0.0550   10.7 0.0303       1.44  
## 9    0.0298   10.8 0.00312      0.637 
##10    0.0632   10.9 0.000478     0.168 
## # ... with 57 more rows

fit_tbl2 %>%
  mutate(wins_dif = abs(wins - .fitted)) -> fit_tbl2
mean(fit_tbl2$wins_dif)
## [1] 8.427093
glance(fit2)
## # A tibble: 1 × 12
##   r.squared adj.r.squared sigma statistic p.value    df logLik   
##       <dbl>         <dbl> <dbl>     <dbl>   <dbl> <dbl>  <dbl> 
## 1     0.194         0.156  10.8      5.06 0.00334     3  -252\.  
##        AIC   BIC deviance df.residual  nobs
##       dbl> <dbl>    <dbl>       <int> <int>
## 1     514\.  525\.    7302\.          63    67

vif(fit2)
## screen_assists_pts        deflections        loose_balls 
##           1.085184           1.031128           1.098619
par(mfrow = c(2,2))
plot(fit2)

图 5.13 第二个，或简化的，多重线性回归模型模型诊断

在两个拟合回归模型中，fit2 模型相对于 fit1 模型来说是一个更好的模型，至少有以下原因：

• fit2 模型中没有噪声——所有 fit2 预测器的 p 值都低于预定义的 0.05 显著性阈值。

• 我们的第二个回归模型仅仅是第一个模型的简化版本，但 fit2 模型比 fit1 模型更好地解释了胜利的方差，尽管这种改善很小：fit2 的调整 R² 统计量为 0.16，而 fit1 的为 0.14。这并不是说 fit2 能够很好地解释胜利的方差——但请记住这个想法。

• 我们的第二个模型比第一个模型具有更低的 AIC 得分，因此更好。AIC 是glance()函数返回的度量之一；或者，您也可以调用基础 R 的AIC()函数来返回相同的值。根据 AIC，最佳拟合模型是使用最少的预测因子来解释目标变量中大部分变差的模型；因此，它使用独立变量计数和对数似然估计作为输入。AIC 本身没有太大意义，但它是比较竞争模型的关键度量。此外，有一个经验法则表明，当一个模型的 AIC 得分比竞争模型低两个或更多单位时，具有较低 AIC 的模型比其他模型显著更好。嗯，fit1 的 AIC 为 518，fit2 的 AIC 为 514。

• 与 fit1 相比，fit2 的诊断结果略好，主要是因为残差与杠杆作用图没有包含任何低于 Cook 距离线的观测值。

然而，实际和拟合胜利次数之间的平均差异在 fit2（8.43）中略大于 fit1（8.27），但考虑到所有其他结果，这几乎微不足道。

5.7.7 预测

现在我们来看看 fit2 在测试中的表现。因此，我们调用基础 R 的predict()函数来预测常规赛胜利次数，上下限分别为 95%的置信区间（CI）。置信区间是一个范围，其中包含小于和大于预测值 y 的值，我们可以有 95%的信心认为它包含 y 的实际值。

predict()函数传递了三个参数：模型和数据源是必需的，而置信区间（CI），默认为 95%，是可选的。结果被转换成一个名为 fit2_pred 的对象，其中 fit 等于预测的常规赛胜利次数，lwr代表置信区间的下限，upr代表置信区间的上限：

fit2_pred <- predict(fit2, data.frame(test), interval = "confidence")
print(fit2_pred)
##         fit      lwr      upr
## 1  44.03632 37.33518 50.73746
## 2  32.32559 27.22836 37.42282
## 3  36.66966 31.99864 41.34067
## 4  33.97327 29.54744 38.39910
## 5  34.30091 28.39030 40.21152
## 6  43.32909 35.93216 50.72603
## 7  41.24102 35.64396 46.83807
## 8  44.46051 40.78216 48.13886
## 9  38.46246 34.58980 42.33511
## 10 41.12360 36.88138 45.36582
## 11 44.69284 40.73769 48.64799
## 12 37.34022 33.95924 40.72119
## 13 45.32616 39.41971 51.23261
## 14 50.02897 43.31042 56.74753
## 15 37.18162 33.31884 41.04439
## 16 42.25199 35.84835 48.65562
## 17 33.46908 27.89836 39.03979
## 18 34.15238 26.87326 41.43151
## 19 41.70479 36.39175 47.01783
## 20 34.30830 28.03565 40.58094
## 21 33.20151 27.19351 39.20951
## 22 43.30823 36.75603 49.86043
## 23 36.77234 29.78770 43.75698

然后我们调用dplyr包中的select()函数，将测试数据集减少到只包含变量wins：

test %>%
  select(wins) -> test

接下来，我们调用基础 R 中的cbind()函数将 fit2_pred 和 test 垂直连接，然后调用dplyr中的mutate()函数创建一个名为wins_dif的新变量，该变量等于变量wins和fit之间的绝对差值。结果被放入一个名为 fit_tbl_pred 的新对象中。

最后，我们使用基础 R 中的mean()函数计算wins_dif的平均值。结果等于 9.94，这表明我们的第二个回归在测试中的表现不如在训练中好：

cbind(fit2_pred, test) %>%
  mutate(wins_dif = abs(wins - fit)) -> fit_tbl_pred
mean(fit_tbl_pred$wins_dif)
## [1] 9.936173

ggplot2直方图绘制了 fit_tbl_pred 变量wins_dif的频率分布，即实际和预测胜利次数之间的差异（见图 5.14）：

p1 <- ggplot(fit_tbl_pred, aes(x = wins_dif)) +
  geom_histogram(fill = "snow1", color = "dodgerblue4", bins = 6) + 
  labs(title = "Frequency of Differences between
       Actual and Predicted Wins",
       subtitle = "Wins ~ Points Off Screens + Deflections + 
       Loose Balls Recovered",
       x = "Difference between Actual and Predicted Wins", 
       y = "Frequency") +
  theme(plot.title = element_text(face = "bold"))
print(p1)

图 5.14 显示预测胜利与实际常规赛胜利之间绝对差异的频率分布

当实际常规赛胜利为 41 或左右时，我们得到更准确的结果；相反，当球队在一个 82 场的赛程中赢得的比赛非常少或非常多时，我们得到的结果就不那么准确了。

以下简短的 dplyr 代码块返回 fit_tbl_pred 记录，其中变量 wins_dif 大于 15，以及当同一变量小于 5 时的记录：

fit_tbl_pred %>%
  filter(wins_dif > 15)
##         fit      lwr      upr wins wins_dif
## 1  44.03632 37.33518 50.73746   29 15.03632
## 5  34.30091 28.39030 40.21152   60 25.69909
## 10 41.12360 36.88138 45.36582   24 17.12360
## 11 44.69284 40.73769 48.64799   65 20.30716
## 12 37.34022 33.95924 40.72119   22 15.34022
 fit_tbl_pred %>%
  filter(wins_dif < 5)
##         fit      lwr      upr wins  wins_dif
## 3  36.66966 31.99864 41.34067   41 4.3303443
## 13 45.32616 39.41971 51.23261   48 2.6738414
## 14 50.02897 43.31042 56.74753   52 1.9710281
## 16 42.25199 35.84835 48.65562   43 0.7480111
## 18 34.15238 26.87326 41.43151   37 2.8476181
## 22 43.30823 36.75603 49.86043   41 2.3082288

第二个 ggplot2 对象，一个折线图，比较实际胜利与预测胜利，预测值上方和下方的阴影区域代表上、下置信区间（见图 5.15）。

图 5.15 预测胜利与实际常规赛胜利的另一种视角

但首先，我们调用 dplyr arrange() 函数按变量 wins 的升序对 fit_tbl_pred 进行排序，然后添加一个名为 row.num 的新变量。这种方法有助于更明显地看出 fit2 在预测胜率接近或等于 .500 的球队方面做得比极端常规赛胜利数的球队要好得多：

fit_tbl_pred %>%
  arrange(wins) -> fit_tbl_pred

fit_tbl_pred$row_num <- seq.int(nrow(fit_tbl_pred))

p2 <- ggplot(fit_tbl_pred, aes(x = row_num, y = wins, group = 1)) + 
  geom_line(aes(y = wins), color = "navy", size = 1.5) +
  geom_line(aes(y = fit), color = "gold3", size = 1.5) +
  geom_ribbon(aes(ymin = lwr, ymax = upr), alpha = 0.2) +
  labs(title = "Actual Wins versus Predicted Wins",
       subtitle = "Results on test data set (23 observations)",
       x = "2016-17 through 2018-19\nSorted in Ascending Order
           by Actual Wins", 
       y = "Wins",             
       caption = "Actuals in dark\nPredictions in light") +
  theme(plot.title = element_text(face = "bold")) 
print(p2)

如果我们的目标是拟合一个多元线性回归，主要解释 2016-17 到 2018-19 NBA 常规赛季胜利的方差，那么我们需要一个更广泛的数据集来包括诸如投篮命中和尝试、罚球命中和尝试、失误率等变量。毕竟，我们的回归都没有很好地解释或预测常规赛胜利。

但我们的目标更为谦逊，或者至少与这个目标大相径庭。我们的目的是确定哪些 hustle 统计数据可能对胜利有统计学上的显著影响，并量化这种影响的效果。为此，我们已经表明，出界、折射和失球回收解释了常规赛胜利中大约 16% 的方差，这远非微不足道。我们还发现了球员何时何地应该全力以赴，何时何地并不存在等价的回报。现在，让我们看看回归树可能揭示出什么样的见解。

5.8 回归树

回归树，通常被称为决策树回归，相对容易构建，同样容易解释和说明；它们的缺点是通常不如其他监督学习方法准确。因此，数据科学家有时会转向 bagging、随机森林和 boosting 模型；这些方法中的每一种都涉及生成 许多 树，而不是仅仅一棵，然后将这些树组合起来形成一个单一的预测。

在非常基本的层面上，回归树将数据分割成多个预测空间区域。跳过一些内容，我们的回归树顶部将数据分割成两个区域：一个 screen_assists_pts 大于 26.05 的区域，另一个是相同变量小于 26.05 的区域。倒置树顶部的分割比底部或接近底部的分割更显著。

通过从 tree 包调用 tree() 函数来拟合回归树。顺便说一句，还有其他 R 包和函数用于拟合基于树的模型并可视化结果；事实上，在 R 中，几乎所有事情通常都有不止一个选项或替代方案，而且一个不一定比其他的好或坏。

我们的模式包含来自原始多元线性回归的五个预测因子；此外，我们将从名为 train 的 hustle 数据集的前 75%分割用作我们的数据源。请注意，语法与多元回归非常相似。对 summary() 函数的后续调用返回结果：

fit3 <- tree(formula = wins ~ screen_assists_pts + deflections + 
               loose_balls + contested_2pt + contested_shots, data = train)
summary(fit3)
## 
## Regression tree:
## tree(formula = wins ~ screen_assists_pts + deflections + loose_balls + 
##     contested_2pt + contested_shots, data = train)
## Number of terminal nodes:  10 
## Residual mean deviance:  82.83 = 4722 / 57 
## Distribution of residuals:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -17.2500  -5.6670   0.2857   0.0000   6.3330  21.0000

并非每个回归树都必须使用模型中的每个预测因子构建，但根据 fit3 的结果，我们的树将包含每个预测变量的一或多个分支。我们知道这一点，或者至少可以假设如此，因为模型输出否则会指出构建树时使用的 子集 预测因子。我们还知道我们的树将包含 10 个终端节点（即叶子节点）——这些是树底部的端点，预测的常规赛胜利数将附加在这些端点上。最后，残差均方差的平方根，等于 9.10，大致相当于我们多元回归中预测胜利数与实际胜利数之间的平均差异，这使得 fit3 与 fit2 具有竞争力，尽管精度较低。

要绘制我们的回归树，我们连续调用基础 R 中的 plot() 和 text() 函数（见图 5.16）；plot() 绘制树，text() 添加变量名称和条件：

plot(fit3)
text(fit3)

图 5.16 我们回归树的可视化结果

根据我们的回归树

• 每场比赛平均得分超过 26.05 分的球队预计将在 50 或 51 场常规赛中获胜。

• 或者，每场比赛平均得分少于 26.05 分的球队预计将在 27 到 51 场常规赛中获胜，具体取决于其他变量和其他分割。

• 每场比赛平均得分少于 26.05 分且防守反击次数少于 12.85 次的球队预计将在 27 到 37 场常规赛中获胜。

• 每场比赛平均得分少于 26.05 分但防守反击次数超过 12.85 次的球队预计将在 31 到 51 场常规赛中获胜。

如果-否则规则与树形图中的分支之间存在一一对应的关系。因此，我们的回归树产生的结果不仅与我们的多重回归相吻合，而且通过一系列如果-否则规则提供了线性模型无法提供的额外见解。根据这里测试的两种模型类型，预测因子screen_assists_pts、deflections和loose_balls比contested_2pt和contested_shots更为重要。尽管这两种模型都无法非常准确地预测胜利，但我们的目标是确定这些努力统计数据中哪一个对常规赛胜利的影响比其他类似统计数据更大。

最终，我们确定在进攻端设置掩护，创造无拘无束的投篮机会；在防守端挡掉传球，扰乱对手的进攻；以及在进攻或防守时抢断球，都值得付出百分之一百的努力，而其他所谓的努力表现则不然。因此，我们证实了我们的假设，即某些努力统计数据确实对胜负有统计学上的显著影响。

因此，我们的线性回归和回归树隔离出相同的三个变量——相同的三个努力统计数据——对胜利影响最大。它们还提供了不同的见解。根据我们的简化线性模型，根据涵盖三个 NBA 赛季的数据集，掩护得分、传球挡截和抢断球数占常规赛胜利差异的大约 16%。另一方面，我们的回归树基于一系列如果-否则规则返回了一系列预测胜利的结果。

在未来，我们将挑战一些传统智慧，并通过数据和统计技术来证明这些公认的惯例并不一定正确。在第六章中，我们将探讨一个观点，即比赛是在第四季度赢得的。

摘要

• 正确进行线性回归首先需要对数据进行彻底分析。应识别并处理异常值，对非正态分布的变量应进行转换或完全不予考虑，应优先考虑与目标变量相关性最强的潜在预测因子，尤其是在处理宽数据集时。

• 最好将您的数据分成两部分，用其中一部分来开发模型，然后用另一部分来预测，以避免过度拟合。

• 避免过度拟合的另一种方法是检查多重共线性，并在必要时采取纠正措施，通过从模型中移除违规变量来实施。

• 线性回归绘制一条直线，以最小化回归与数据之间的差异。虽然线性模型相当常见，可能比其他模型类型更普遍，其中因变量（即目标变量）是连续的，但重要的是要理解数据并不总是线性的。

• 我们的线性回归模型并没有以很高的准确性解释或预测胜利，但我们仍然成功地识别出了三个 hustle 统计量——屏幕外的得分、传球拦截和失球回收——这三个统计量共同解释了在测试的三个赛季中常规赛胜利的 16% 的变异性。因此，我们发现球员应该在哪些方面全力以赴，在必要时可以休息。

• 我们的回归树将与我们数据集中其他 hustle 统计量相比，识别出相同的三个变量更为重要；此外，它通过一系列的 if-else 规则预测了常规赛的胜利。

• 线性回归有几种应用场景，例如基于在线、广播和电视广告的多渠道广告策略的产品销售；基于犯罪率、每单位平均房间数和当地学校师生比例的单户住宅中位数价格；基于年龄、性别和最近 10K 和半程马拉松配速的马拉松表现；基于宏观经济指标信用卡违约率；以及基于职位年限和股价年度变化的 CEO 薪酬。线性回归需要一个连续的目标变量。在第十四章中，我们将拟合一个逻辑回归，它需要一个二进制目标变量。

• 基于树的模型是这些相同用例的良好替代品。此外，您还可以调用 tree() 函数来拟合一个分类树；它的语法与回归树相同，但您的目标变量必须是二进制而不是连续的。

6 更多数据处理和可视化

本章涵盖

• 数据集的子集化

• 分离和连接数据集

• 变量的重命名和转换

• 排序数据和返回累积总和

• 转换数据集

• 记录索引

• 将sqldf代码转换为dplyr

• 创建和自定义条形图

根据传统智慧，无疑受到比赛后期偏见的影响，即一场接近的比赛中的最后几秒创造最难以忘怀的记忆，NBA 比赛是在第四节赢得的。换句话说，无论前三节发生了什么，赢得第四节并发挥最佳水平的队伍通常都会获胜。这表明 NBA 比赛的最后 12 分钟比前 36 分钟（NBA 比赛时长为 48 分钟，分为四个 12 分钟的季度）更重要。

我们的假设是这种传统智慧是错误的。我们将检查两个连续赛季中几乎每一场 NBA 常规赛，然后绘制获胜队伍在第四节与其他三个季度相比的表现。在这个过程中，我们将展示大量数据处理技术，这些技术将在你的职业或学术生涯中大有裨益，例如通过重塑整个数据集和排序向量来更改布局，提取符合逻辑标准的记录，通过名称选择或取消选择列，对数据进行分组和汇总，重命名现有变量并创建新的变量，以及垂直和水平地连接数据集。而且，通过我们的ggplot2条形图，我们将展示如何巧妙地通过突出显示一些内容并淡化其他内容来展示结果。

6.1 加载包

我们首先加载三个我们将需要的包，以超越基础 R 的能力进行数据处理、查询和可视化。我们通过一系列对library()函数的调用，并将所需的包作为参数传递。现在这些包应该对你来说都很熟悉：

library(tidyverse)
library(sqldf)
library(patchwork)

由于我们面前有大量的数据处理工作，如果不依赖基础 R，我们将比其他包装函数更频繁地调用dplyr和tidyr函数。再次强调，dplyr和tidyr是tidyverse包的一部分。

6.2 导入数据

我们有两个.csv 文件需要导入，这两个文件都是从网站www.bigdataball.com下载的。第一个文件，设置为 nba1819，包含 2018-19 赛季每个常规赛和季后赛比赛的得分数据；第二个文件，设置为 nba1920，包含 2019-20 赛季每个常规赛和季后赛比赛的类似得分数据。

我们从tidyverse包中的readr包调用两次read_csv()函数，以逐个导入这两个文件：

nba1819 <- read.csv("nba_boxscore_1819.csv")
nba1920 <- read.csv("nba_boxscore_1920.csv")

比赛得分数据主要是团队层面和球员层面的基本统计数据的组合，如下所示：

• 总得分

• 每节得分

• 尝试和命中的投篮

• 尝试和命中的罚球

• 进攻和防守篮板

• 助攻

• 犯规

• 两队的首发阵容

包括比赛级别的属性；例如，比赛的日期和比赛地点，被分配来叫比赛官员的名字，以及开盘和收盘赔率。我们只需要分析中的一些数据。

基础 R 中的dim()函数返回维度——即行数和列数——在 nba1819 和 nba1920 数据集中：

dim(nba1819) 
## [1] 2624   57
dim(nba1920) 
## [1] 2286   57

这两个数据集都有 57 列，或变量。但与 nba1819 相比，nba1920 有更少的行，或观测值，因为 COVID-19 缩短了 2019-20 赛季；当然，比赛越少，数据行就越少。

6.3 数据整理

在开始时，我们的大部分数据处理操作将围绕数据子集（包括或排除满足或未满足某些逻辑标准的观测值，或通过删除不会影响我们分析的因素的变量来减少整个数据集的宽度）以及合并或连接一对数据集到一个对象。最终，我们需要能够转换成一系列互补的ggplot2可视化数据源，这些可视化可以按季度显示整数和百分比结果。我们离用我们两个.csv 文件做到这一点还有很长的路要走。

6.3.1 数据子集

我们首先通过调用dplyr包中的filter()函数来对 nba1819 数据集进行子集化，以便 nba1819 只包含变量DATASET等于NBA 2018-2019 Regular Season并且变量MIN（简称分钟数）等于240的观测值。这随后将 nba1819 数据集缩减到只有常规赛比赛，这些比赛以常规时间结束（240 是 48 分钟乘以场上的五名球员的结果）；或者换句话说，我们排除了进入加时赛的常规赛比赛和所有季后赛比赛。

R 语言中有一个与dplyr filter()函数等价的基函数，即subset()函数——它们操作类似，并返回相同的结果。但如果你在处理更大的数据集时，可能会发现filter()函数在性能上优于subset()。记住，R 区分=和==运算符；前者是赋值运算符，而后者是等于运算符。此外，当过滤 nba1819 数据集，其中变量DATASET等于NBA 2018-2019 Regular Season并且变量MIN（代表分钟数）等于240时，我们是在指示 R 对满足这两个条件的数据子集进行操作，而不仅仅是其中一个或另一个。

我们随后调用dim()函数来检查 nba1819 的新维度：

nba1819 %>%
  filter(DATASET == "NBA 2018-2019 Regular Season" & MIN == 240) -> nba1819
dim(nba1819) 
## [1] 2326   57

导入时，nba1819 数据集有 2,624 行，现在长度为 2,326 行。

关于 2019-20 赛季的 NBA，由于 COVID-19 大流行而暂时暂停比赛，然后在奥兰多一个中立场地（对于大多数球队，不是所有球队）恢复（对于大多数球队，不是所有球队），我们将 nba1920 数据集子集化，只包括暂停比赛之前的常规赛比赛，这些比赛也以常规时间结束。因此，我们将 nba1920 子集化，使得变量GAME_ID等于或小于21900973，并且变量MIN等于240：

nba1920 %>%
  filter(GAME_ID <= 21900973 & MIN == 240) -> nba1920

然后我们再次调用dim()函数，当然，它会返回 nba1920 数据集的新维度。现在它有 1,820 行，而最初它包含了 2,286 个观测值：

dim(nba1920) 
## [1] 1820   57

现在我们将演示一些合并技术。

6.3.2 数据集合并

基础 R 和dplyr函数可用于将两个或多个数据集合并成一个对象。虽然dplyr函数可能在处理大型数据集或在小型机器上工作时表现最佳，但基础 R 和dplyr函数在其他情况下操作类似，并返回相同的结果。在这里，我们将调用一个基础 R 函数，然后调用一个dplyr函数来合并数据集，同时混合其他数据处理操作。

话虽如此，我们首先调用基础 R 中的rbind()函数，将 nba1819 和 nba1920 数据集行绑定到一个名为 nbadf1 的新对象中。这是因为两个数据集具有相同的宽度和相同的变量名；任何差异都会导致 R 抛出错误。变量不需要按相同的顺序排列，此操作才能成功。

紧接着调用dim()函数来返回我们新对象的维度：

nbadf1 <- rbind(nba1819, nba1920)
dim(nbadf1)
## [1] 4146   57

我们可以看到 nbadf1 包含 57 个变量和 4,146 个观测值，包括来自 nba1819 的 2,326 个观测值和来自 nba1920 的 1,820 个观测值。

接着，我们通过调用dplyr包中的select()函数来对新的工作数据集进行子集化，只保留位于DATASET和MIN之间的 16 个变量；再次调用dim()函数确认 nbadf1 的宽度实际上已经从 57 列减少到仅 16 列。我们代码中的分号告诉 R 接受从DATASET到MIN之间的所有变量，这比列出所有 16 个变量要好得多：

nbadf1 %>%
  select(DATASET:MIN) -> nbadf1
dim(nbadf1) 
## [1] 4146   16

接下来，我们通过两次调用dplyr filter()函数将 nbadf1 分成相等的两半：一次是变量VENUE等于R（客场），这些观测值被放入一个名为 road 的数据集中，然后是VENUE等于H（主场），这些观测值被放入一个名为 home 的数据集中。（除非有特殊情况，NBA 比赛——常规赛和季后赛——永远不会在中立场地进行。无论如何，球队总是被指定为客场或主场。）两个调用都显示在这里：

nbadf1 %>%
  filter(VENUE == "R") -> road
dim(road) 
## [1] 2073   16

nbadf1 %>%
  filter(VENUE == "H") -> home
dim(home) 
## [1] 2073   16

dim()函数为两个对象返回相同的维度，这是好事，因为应该有相等数量的客场和主场观测值。

我们即将合并客场和主场的横向数据集，但首先我们需要给它们赋予唯一的变量名。dplyr包中的rename()函数允许我们重命名变量，其中赋值运算符左侧的变量名是新变量名，右侧的变量名是旧变量名或现有变量名：

road %>%
  rename(dataset = DATASET, ID = GAME_ID, date = DATE, 
         teamR = TEAM, venueR = VENUE, Q1R = Q1, Q2R = Q2, 
         Q3R = Q3, Q4R = Q4, OT1R = OT1,       
         OT2R = OT2, OT3R = OT3, OT4R = OT4, 
         OT5R = OT5, FR = F, MINR = MIN) -> road
home %>%
  rename(dataset = DATASET, ID = GAME_ID, date = DATE, 
         teamH = TEAM, venueH = VENUE, Q1H = Q1, Q2H = Q2,
         Q3H = Q3, Q4H = Q4, OT1H = OT1,       
         OT2H = OT2, OT3H = OT3, OT4H = OT4, 
         OT5H = OT5, FH = F, MINH = MIN) -> home 

大多数新的变量名都附加了字母 R 或 H 来区分客场和主场，否则变量是相同的。有三个例外，现在命名为dataset、ID和date的变量。

然后，我们通过调用dplyr left_join()函数在客场和主场之间执行左连接，通过匹配行来合并两个数据集；我们特别通过变量dataset、ID和date来匹配客场和主场。

然后，我们立即调用dim()函数再次检查工作数据集 nbadf2 的维度；nbadf2 包含 2,073 行（4,146 行的一半）和 29 个变量（16 个来自客场数据集，另外 16 个来自主场数据集，减去共同的变量dataset、ID和date）：

left_join(road, home, by = c("dataset", "ID", "date")) -> nbadf2 
dim(nbadf2)
## [1] 2073   29

再次，我们调用dplyr select()函数来删除不必要的或重复的变量（注意在基础 R c()函数之前的前导减号）；再次，我们调用dim()函数来返回行和列计数。提醒一下，当我们需要创建向量或将多个对象连接成一个向量时，会调用c()函数：

nbadf2 %>% 
  select(-c(OT1R:OT5R, MINR, OT1H:OT5H, MINH)) -> nbadf2
dim(nbadf2) 
## [1] 2073   17

现在，我们有了包含 2,073 行和 17 列的数据集 nbadf2。

接下来，我们通过连续调用基础 R 的as.factor()函数将 nbadf2 剩余的五个变量转换为因子变量。当你的变量是分类的或有序的，并且有一个固定的可能值集合时，这是一个好的做法：

nbadf2$dataset <- as.factor(nbadf2$dataset)
nbadf2$teamR <- as.factor(nbadf2$teamR)
nbadf2$venueR <- as.factor(nbadf2$venueR)
nbadf2$teamH <- as.factor(nbadf2$teamH)
nbadf2$venueH <- as.factor(nbadf2$venueH)

最后，我们调用dplyr glimpse()函数来返回 nbadf2 数据集的转置快照：

glimpse(nbadf2)
## Rows: 2,073
## Columns: 17
## $ dataset <fct> NBA 2018-2019 Regular Season, NBA 2018-2019 Regular...
## $ ID      <int> 21800001, 21800002, 21800003, 21800004, 21800005, 2...
## $ date    <chr> "10/16/18", "10/16/18", "10/17/18", "10/17/18", "10...
## $ teamR   <fct> Philadelphia, Oklahoma City, Milwaukee, Brooklyn, M...
## $ venueR  <fct> R, R, R, R, R, R, R, R, R, R, R, R, R, R, R, R, R, ...
## $ Q1R     <int> 21, 23, 36, 29, 16, 31, 24, 25, 35, 23, 30, 29, 24,...
## $ Q2R     <int> 21, 24, 31, 22, 23, 20, 25, 22, 36, 29, 38, 30, 22,...
## $ Q3R     <int> 24, 32, 26, 25, 19, 27, 35, 28, 30, 31, 25, 15, 27,...
## $ Q4R     <int> 21, 21, 20, 24, 25, 23, 23, 29, 30, 25, 30, 33, 27,...
## $ FR      <int> 87, 100, 113, 100, 83, 101, 107, 104, 131, 108, 123...
## $ teamH   <fct> Boston, Golden State, Charlotte, Detroit, Indiana, ...
## $ venueH  <fct> H, H, H, H, H, H, H, H, H, H, H, H, H, H, H, H, H, ...
## $ Q1H     <int> 21, 31, 23, 24, 27, 25, 23, 28, 29, 31, 34, 24, 37,...
## $ Q2H     <int> 26, 26, 31, 27, 29, 29, 49, 32, 25, 25, 21, 30, 19,...
## $ Q3H     <int> 30, 26, 29, 32, 20, 25, 34, 30, 30, 25, 32, 18, 27,...
## $ Q4H     <int> 28, 25, 29, 20, 35, 25, 20, 26, 28, 31, 30, 26, 38,...
## $ FH      <int> 105, 108, 112, 103, 111, 104, 126, 116, 112, 112, 1...

下面是 nbadf2 变量按变量分解的说明：

• dataset—等于NBA 2018-2019 常规赛季或NBA 2019-2020 常规赛季。

• ID—为每场比赛提供一个唯一的标识符，按时间顺序递增。

• date—表示比赛进行的日期，格式为MM/DD/YY。

• teamR—表示客场或访问球队，例如Golden State等于Golden State Warriors，Boston等于Boston Celtics。

• venueR—始终等于R，这是客场（road）的简称。

• Q1R—等于第一季度客场球队所得的分数。

• Q2R—等于第二季度客场球队所得的分数。

• Q3R—等于第三季度客场球队所得的分数。

• Q4R—等于第四季度客场球队所得的分数。

• FR—等于整个比赛期间客场球队所得的总分数。因为我们之前从数据集中移除了加时赛，所以FR总是等于前四个变量的总和。

• teamH—与变量teamR相同的格式。

• venueH—始终等于H。

• Q1H—等于主队在第一节得到的分数。

• Q2H—等于主队在第二节得到的分数。

• Q3H—等于主队在第三节得到的分数。

• Q4H—等于主队在第四节得到的分数。

• FH—等于主队在整个比赛中得到的总分数；也等于前四个变量的总和。

在成功整理和合并我们的数据集后，我们准备开始进行一些分析。

6.4 分析

我们的分析工作将是一个三管齐下的攻击：

• 首先，我们将计算并可视化每节与比赛结束时的结果，以确定获胜队伍在第四节相对于第一、第二和第三节是否更成功。

• 其次，我们将数据集子集化到 2018-19 和 2019-20 NBA 常规赛中最成功的六支球队和最不成功的六支球队，然后计算并可视化它们在一节获胜与另一节获胜时的胜率，按客场与主场的比赛进行细分。

• 第三，我们将数据集缩减到只包括半场平局的游戏，然后比较第三、四节的结果与比赛结束时的结果。

我们会发现，大量证据支持这样一个观点：比赛通常不是在第四节赢得，而是在第三节赢得，从而证实了我们的假设。

6.4.1 第一节

我们的第一步是创建一个新的数据集，nbadf3，通过调用filter()函数来对 nbadf2 数据集进行子集化，其中变量Q1R和Q1H不相等；基本上，我们通过消除观察值或比赛来子集化 nbadf2，这些观察值或比赛在第一节结束时得分持平。NOT (!)运算符将!TRUE语句评估为FALSE，将!FALSE语句评估为TRUE：

nbadf2 %>%
  filter(Q1R != Q1H) -> nbadf3
dim(nbadf3)
## [1] 1990   17

nbadf3 数据集有 1,990 行。

在以下代码块中，我们调用了一对dplyr函数，mutate()和case_when()，来创建一个新的名为Q1vF的变量，该变量将根据条件逻辑填充四个值之一：

• 当主队在第一节得到的分数多于客队并且随后赢得比赛时，Q1vF将等于HH。

• 当客队在第一节得到的分数多于主队并且随后赢得比赛时，Q1vF将等于RR。

• 当主队在第一节得到的分数多于客队，但随后客队赢得比赛时，Q1vF将等于HR。

• 当客队在第一节得到的分数多于主队，但随后主队赢得比赛时，Q1vF将等于RH。

然后，我们将我们的新变量转换为因子：

nbadf3 %>% mutate(Q1vF = case_when(Q1H > Q1R & FH > FR ~ "HH",
                                   Q1R > Q1H & FR > FH ~ "RR",
                                   Q1H > Q1R & FR > FH ~ "HR",
                                   Q1R > Q1H & FH > FR ~ "RH")) -> nbadf3

nbadf3$Q1vF <- as.factor(nbadf3$Q1vF)

然后，我们创建了一个比之前章节中创建的其他 tibble 更复杂的数据框：

• 我们首先调用来自 dplyr 包的 count() 函数；它计算 nbadf3 中每个 Q1vF 导出变量四个级别的观测数，并将相同的结果传递给一对其他 dplyr 函数，arrange() 和 desc()，以便将结果堆叠在名为 n 的变量中，并按降序排序。

• 然后，我们将新对象传递给一系列对 mutate() 函数的调用，以创建三个额外的 tbl1 变量。我们第一次调用 mutate() 创建了一个名为 pct_total 的变量，该变量等于 n 除以 nbadf3 行数，然后乘以 100。

• 我们第二次调用 mutate() 创建了一个名为 cum_n 的变量，该变量等于 n 的累积和；cumsum() 是一个内置函数，它返回从另一个向量中的原始数据派生的累积和向量。例如，如果我们有一个包含数字 1、2 和 3 的向量，cumsum() 将返回 1、3 和 6。

• 我们对 mutate() 的第三次也是最后一次调用创建了一个名为 cum_pct_total 的变量，该变量将 cum_n 中的值转换为相对于 nbadf3 数据集中总记录数的百分比。

• 然后，通过调用基础 R 的 round() 函数，将 pct_total 和 cum_pct_total 变量格式化，以便只返回小数点后两位数字。

最终结果是包含四行五列的 tibble。

count(nbadf3, Q1vF) %>% arrange(desc(n)) -> tbl1
tbl1 %>%
  mutate(pct_total = n/nrow(nbadf3)*100) %>%
  mutate(cum_n = cumsum(n)) %>%
  mutate(cum_pct_total = cumsum(pct_total)) -> tbl1
tbl1$pct_total <- round(tbl1$pct_total, digits = 2)
tbl1$cum_pct_total <- round(tbl1$cum_pct_total, digits = 2)
print(tbl1)
##   Q1vF   n pct_total cum_n cum_pct_total
## 1   HH 783     39.35   783         39.35
## 2   RR 550     27.64  1333         66.98
## 3   RH 365     18.34  1698         85.33
## 4   HR 292     14.67  1990        100.00

为了检查或协调我们的结果，我们随后对 sqldf() 函数进行了一系列调用，该函数来自 sqldf 包。SELECT 和 COUNT(*) 返回与 tbl1 中的变量 n 相等的 nbadf3 记录计数：

sqldf("SELECT COUNT(*) FROM nbadf3 WHERE Q1H > Q1R AND FH > FR") 
##   COUNT(*)
## 1      783
sqldf("SELECT COUNT(*) FROM nbadf3 WHERE Q1R > Q1H AND FR > FH") 
##   COUNT(*)
## 1      550
sqldf("SELECT COUNT(*) FROM nbadf3 WHERE Q1R > Q1H AND FR < FH") 
##   COUNT(*)
## 1      365
sqldf("SELECT COUNT(*) FROM nbadf3 WHERE Q1H > Q1R AND FH < FR") 
##   COUNT(*)
## 1      292

通过用管道运算符代替 FROM 并将 sqldf() 的 WHERE 子句传递给 count() 函数，我们可以轻松地将我们的 SELECT 语句转换为 dplyr 代码。但请注意，dplyr 使用 &，而 sqldf() 使用 AND，并且 dplyr 为 TRUE 和 FALSE 观测返回计数，而 sqldf() 只返回实际满足逻辑的记录计数：

nbadf3 %>% 
  count(Q1H > Q1R & FH > FR)
## # A tibble: 2 × 2
##   `Q1H > Q1R & FH > FR`     n
##   <lgl>                 <int>
## 1 FALSE                  1207
## 2 TRUE                    783

nbadf3 %>% 
  count(Q1R > Q1H & FR > FH)
## # A tibble: 2 × 2
##   `Q1R > Q1H & FR > FH`     n
##   <lgl>                 <int>
## 1 FALSE                  1440
## 2 TRUE                    550

nbadf3 %>% 
  count(Q1R > Q1H & FR < FH)
## # A tibble: 2 × 2
##   `Q1R > Q1H & FR < FH`     n
##   <lgl>                 <int>
## 1 FALSE                  1625
## 2 TRUE                    365

nbadf3 %>% 
  count(Q1H > Q1R & FH < FR)
## # A tibble: 2 × 2
##   `Q1H > Q1R & FH < FR`     n
##   <lgl>                 <int>
## 1 FALSE                  1698
## 2 TRUE                    292

幸运的是，无论如何检查都是正确的。

现在让我们用一对互补的 ggplot2 条形图来可视化我们的结果。其中第一个，plot1a，显示了获胜次数。记住，这些是 2018-19 赛季和 2019-20 赛季之间的常规赛季获胜次数，减去在奥兰多进行的比赛、进入加时赛的比赛以及来自我们导出变量 Q1vF 的四个因素之间的首节平局比赛。

我们的第二个可视化，plot1b，几乎返回相同的视图，只是用获胜百分比代替了获胜次数。因此，plot1a 和 plot1b 之间有相似的外观，从不同的、但互补的度量中获得了类似的结果。

需要强调几点：

• 在两个图表中，我们调用基础 R 的reorder()函数，按tbl1变量n（在 plot1a 的情况下）和pct_total（在 plot1b 的情况下）的降序对Q1vF因子进行排序。注意变量名前面的负号；如果没有这个负号，结果将按升序排序。

• 添加了一个自定义的颜色和填充方案来强调在第一季度赢得比赛并且赢得比赛的队伍，同时降低相反结果的重要性；我们为前者选择了明亮的颜色，为后者选择了浅灰色。

• 栏状图顶部的标签与 y 轴变量相关联，并使用粗体字体格式化。

• 由于四舍五入，胜率可能相差十分之一。

两个可视化的代码如下：

plot1a <- ggplot(tbl1, aes(x = reorder(Q1vF, -n), y = n)) + 
  geom_bar(color = c("orange1", "orange1", "gray74", "gray74"),
           fill = c("orange1", "orange1", "gray74", "gray74"), 
           stat = "identity") + 
  labs(title = "Teams Winning the First Quarter", 
       subtitle = "Win-Loss Record = 1,333-657",
       x = "Win Combinations", 
       y = "Wins") + 
  geom_text(aes(x = Q1vF, y = n, label = n, vjust = -0.3, 
                fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

plot1b <- ggplot(tbl1, aes(x = reorder(Q1vF, -pct_total), y = pct_total)) + 
  geom_bar(color = c("orange1", "orange1", "gray74", "gray74"),
           fill = c("orange1", "orange1", "gray74", "gray74"), 
           stat = "identity") + 
  labs(title = "Teams Winning the First Quarter", 
       subtitle = "Winning Percentage = 66.98%",
       x = "Win Combinations", 
       y = "Winning Percentage") + 
  geom_text(aes(x = Q1vF, y = pct_total, label = pct_total, 
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

然后，我们将两个可视化并排配对成一个单一的对象（见图 6.1），这是通过调用patchwork包中的plot_layout()函数实现的。

plot1a + plot1b + plot_layout(ncol = 2)

图 6.1 第一季度赢得比赛的队伍有超过三分之二的时间赢得相同的比赛

在第一季度赢得比赛的公司随后有大约 67%的时间赢得比赛（等于 plot1b 中的 39.35% + 27.64%）。在第一季度赢得比赛的主队整体胜率几乎等于 73%（等于 783 / 783 + 292 来自 plot1a）；另一方面，客场队在赢得第一季度比赛后有大约 60%的时间获胜（等于 550 / 550 + 365 来自 plot1a）。

6.4.2 第二季度

接下来，我们再次进行完整的练习，但现在我们的目的是比较第二季度结果和最终得分。我们调用filter()函数创建一个新的对象 nbadf4，它等于 nbadf2 数据集，减去任何客场队和主队在第二季度得分相同的观测值：

nbadf3 %>% 
  filter(Q2R != Q2H) -> nbadf4

我们随后调用mutate()和case_when()函数来创建一个新的变量Q2vF，这个变量是之前创建并附加到nbadf3上的派生变量Q1vF的第二季度版本。然后，我们通过调用基础 R 中的as.factor()函数将新变量转换为因子：

nbadf4 %>% mutate(Q2vF = case_when(Q2H > Q2R & FH > FR ~ "HH",
                                   Q2R > Q2H & FR > FH ~ "RR",
                                   Q2H > Q2R & FR > FH ~ "HR",
                                   Q2R > Q2H & FH > FR ~ "RH")) -> nbadf4

nbadf4$Q2vF <- factor(nbadf4$Q2vF)

在下面的代码块中，我们创建了一个名为 tbl2 的 tibble，它只是我们第一个 tibble，tbl1 的第二季度版本。tbl1 和 tbl2 之间没有区别，除了我们已经替换了数据源（用 nbadf4 代替 nbadf3）和派生变量（用Q2vF替换Q1vF）：

count(nbadf4, Q2vF) %>% arrange(desc(n)) -> tbl2
tbl2 %>% 
  mutate(pct_total = n/nrow(nbadf4)*100) %>%
  mutate(cum_n = cumsum(n)) %>%
  mutate(cum_pct_total = cumsum(pct_total)) -> tbl2
tbl2$pct_total <- round(tbl2$pct_total, digits = 2)
tbl2$cum_pct_total <- round(tbl2$cum_pct_total, digits = 2)
print(tbl2)
##   Q2vF   n pct_total cum_n cum_pct_total
## 1   HH 711     37.84   711         37.84
## 2   RR 502     26.72  1213         64.56
## 3   RH 371     19.74  1584         84.30
## 4   HR 295     15.70  1879        100.00

最后，我们创建第二对ggplot2条形图，然后将两个可视化捆绑成一个单一的图形对象（见图 6.2）：

plot2a <- ggplot(tbl2, aes(x = reorder(Q2vF, -n), y = n)) + 
  geom_bar(color = c("skyblue3", "skyblue3", "gray74", "gray74"),
           fill = c("skyblue3", "skyblue3", "gray74", "gray74"), 
           stat = "identity") + 
  labs(title = "Teams Winning the Second Quarter", 
       subtitle = "Win-Loss Record = 1,266-692",
       x = "Win Combinations", 
       y = "Wins") + 
  geom_text(aes(x = Q2vF, y = n, label = n,
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

plot2b <- ggplot(tbl2, aes(x = reorder(Q2vF, -pct_total), y = pct_total)) + 
  geom_bar(color = c("skyblue3", "skyblue3", "gray74", "gray74"),
           fill = c("skyblue3", "skyblue3", "gray74", "gray74"), 
           stat = "identity") + 
  labs(title = "Teams Winning the Second Quarter", 
       subtitle = "Winning Percentage = 64.66%",
       x = "Win Combinations", 
       y = "Winning Percentage") + 
  geom_text(aes(x = Q2vF, y = pct_total, label = pct_total, 
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

plot2a + plot2b + plot_layout(ncol = 2)

图 6.2 中赢得第二季度的队伍有大约 65%的时间赢得相同的比赛，这个数字略低于我们之前看到的第一季度结果。

赢得第二季度的球队随后赢得同一场比赛的比例几乎达到 65%，这个数字比我们之前看到的第一季度结果低两个百分点以上。主场赢得第二季度的球队的整体获胜比例约为 71%，而主场赢得第一季度的球队获胜比例为 73%；客场赢得第二季度的球队获胜比例约为 58%，而客场赢得第一季度的球队获胜比例为 60%。

6.4.3 第三节

让我们现在来看看第三节结果与比赛结束结果。这次，我们的代码被合并成一个块，以另一对ggplot2条形图结束（见图 6.3）：

nbadf2 %>%
  filter(Q3R != Q3H) -> nbadf5

nbadf5 %>% mutate(Q3vF = case_when(Q3H > Q3R & FH > FR ~ "HH",
                                   Q3R > Q3H & FR > FH ~ "RR",
                                   Q3H > Q3R & FR > FH ~ "HR",
                                   Q3R > Q3H & FH > FR ~ "RH")) -> nbadf5

nbadf5$Q3vF <- factor(nbadf5$Q3vF)

count(nbadf5, Q3vF) %>% arrange(desc(n)) -> tbl3
tbl3 %>% 
  mutate(pct_total = n/nrow(nbadf5)*100) %>%
  mutate(cum_n = cumsum(n)) %>%
  mutate(cum_pct_total = cumsum(pct_total)) -> tbl3
tbl3$pct_total <- round(tbl3$pct_total, digits = 2)
tbl3$cum_pct_total <- round(tbl3$cum_pct_total, digits = 2)
print(tbl3)
##   Q3vF   n pct_total cum_n cum_pct_total
## 1   HH 748     38.03   748         38.03
## 2   RR 574     29.18  1322         67.21
## 3   RH 378     19.22  1700         86.43
## 4   HR 267     13.57  1967        100.00

plot3a <- ggplot(tbl3, aes(x = reorder(Q3vF, -n), y = n)) + 
  geom_bar(color = c("springgreen3", "springgreen3", "gray74", "gray74"),
           fill = c("springgreen3", "springgreen3", "gray74", "gray74"), 
           stat = "identity") + 
  labs(title = "Teams Winning the Third Quarter", 
       subtitle = "Win-Loss Record = 1,322-645",
       x = "Win Combinations", 
       y = "Wins") + 
  geom_text(aes(x = Q3vF, y = n, label = n, 
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

plot3b <- ggplot(tbl3, aes(x = reorder(Q3vF, -pct_total), y = pct_total)) + 
  geom_bar(color = c("springgreen3", "springgreen3", "gray74", "gray74"),
           fill = c("springgreen3", "springgreen3", "gray74", "gray74"), 
           stat = "identity") + 
  labs(title = "Teams Winning the Second Quarter", 
       subtitle = "Winning Percentage = 67.21%",
       x = "Win Combinations", 
       y = "Winning Percentage") + 
  geom_text(aes(x = Q3vF, y = pct_total, label = pct_total, 
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

plot3a + plot3b + plot_layout(ncol = 2)

图 6.3 赢得第三节的球队随后赢得同一场比赛的比例超过 67%，这是迄今为止最高的获胜比例。

主场和客场赢得第三节的球队随后赢得了超过 67%的相同比赛——这是迄今为止最高的数字。主场球队的表现主要对这些结果负责：74%的时间，当主场球队赢得第三节时，它随后赢得了同一场比赛，而客场球队的获胜比例仅为 60%。

6.4.4 第四节

我们再次运行了季度结束与比赛结束的结果，这次专注于第四节。我们的代码再次被合并成一个块，我们的结果再次通过一对ggplot2条形图可视化，这些图表被压缩在一个单一的数据图形表示中（见图 6.4）：

nbadf2 %>%
  filter(Q4R != Q4H) -> nbadf6

nbadf6 %>% mutate(Q4vF = case_when(Q4H > Q4R & FH > FR ~ "HH",
                                   Q4R > Q4H & FR > FH ~ "RR",
                                   Q4H > Q4R & FR > FH ~ "HR",
                                   Q4R > Q4H & FH > FR ~ "RH")) -> nbadf6

nbadf6$Q4vF <- factor(nbadf6$Q4vF)

count(nbadf6, Q4vF) %>% arrange(desc(n)) -> tbl4
tbl4 %>% 
  mutate(pct_total = n/nrow(nbadf6)*100) %>%
  mutate(cum_n = cumsum(n)) %>%
  mutate(cum_pct_total = cumsum(pct_total)) -> tbl4
tbl4$pct_total <- round(tbl4$pct_total, digits = 2)
tbl4$cum_pct_total <- round(tbl4$cum_pct_total, digits = 2)
print(tbl4)
##   Q4vF   n pct_total cum_n cum_pct_total
## 1   HH 767     39.05   767         39.05
## 2   RR 524     26.68  1291         65.73
## 3   RH 374     19.04  1665         84.78
## 4   HR 299     15.22  1964        100.00

plot4a <- ggplot(tbl4, aes(x = reorder(Q4vF, -n), y = n)) + 
  geom_bar(color = c("darkorchid3", "darkorchid3", "gray74", "gray74"),
           fill = c("darkorchid3", "darkorchid3", "gray74", "gray74"), 
           stat = "identity") + 
  labs(title = "Teams Winning the Fourth Quarter", 
       subtitle = "Win-Loss Record = 1,291-673",
       x = "Win Combinations", 
       y = "Wins") + 
  geom_text(aes(x = Q4vF, y = n, label = n,
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

plot4b <- ggplot(tbl4, aes(x = reorder(Q4vF, -pct_total), y = pct_total)) + 
  geom_bar(color = c("darkorchid3", "darkorchid3", "gray74", "gray74"),
           fill = c("darkorchid3", "darkorchid3", "gray74", "gray74"), 
           stat = "identity") + 
  labs(title = "Teams Winning the Fourth Quarter", 
       subtitle = "Winning Percentage = 65.73%",
       x = "Win Combinations", 
       y = "Winning Percentage") + 
  geom_text(aes(x = Q4vF, y = pct_total, label = pct_total, 
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

plot4a + plot4b + plot_layout(ncol = 2)

图 6.4 赢得第四节的球队随后赢得同一场比赛的比例接近 66%，这是除了我们第二季度结果之外最低的获胜比例。

在第四节获胜的球队在我们的数据集中也几乎在 66%的相关比赛中赢得了比赛。主场赢得第四节的球队也大约有 72%的时间获胜；客场球队在第四节得分最高的比赛中获胜的比例约为 58%。

要说何时赢得比赛，尤其是当选择是某一节对另一节时，这很困难，甚至可能不可能。尽管如此，获胜的球队赢得第三节比赛的比例高于赢得第四节比赛的比例，或者任何其他节比赛的比例，这当然是对传统观点的挑战，即比赛是在第四节赢得的。

我们接下来的分析将关注 2018-19 赛季和 2019-20 赛季常规赛中表现最佳和最差的六支球队。

6.4.5 比较最佳和最差球队

现在，让我们通过在包括 2018-19 和 2019-20 赛季常规赛中赢得最多常规赛比赛的六个团队的数据集上重复我们的分析来做一个更深更专注的深入研究（不包括因 COVID-19 停赛后的中立场地比赛）。这六个团队是密尔沃基雄鹿（116 胜），多伦多猛龙（111），丹佛掘金（100），波士顿凯尔特人（97），休斯顿火箭（97）和洛杉矶快船（97）。然后，我们将在仅包括这六个最差团队的数据集上执行相同的分析。

最佳 6

要实现这一点，我们首先通过调用 dplyr filter() 函数创建一个名为 nbadf7 的数据集，它是 nbadf3 的一个子集，只包含上述六个团队中任一团队被指定为客场球队的观测。而 AND (&) 运算符接受两个或多个逻辑值，只有当所有值实际上都是 TRUE 时才返回 TRUE，而 OR (|) 运算符如果至少有一个值是 TRUE 就返回 TRUE。

然后，我们在那些变量 Q1vF 等于 RR 或 RH 的观测上对 nbadf7 进行子集化。结果保存在一个名为 nbadf8 的新对象中：

nbadf3 %>% 
  filter(teamR == "Milwaukee" | teamR == "Toronto" | 
           teamR == "Boston" | teamR == "Denver" | 
           teamR == "Houston" | teamR == "LA Clippers") -> nbadf7

nbadf7 %>%
  filter(Q1vF == "RR" | Q1vF == "RH") -> nbadf8

然后，我们调用 count() 函数来统计 nbadf8 中 Q1vF 等于 RR 与 RH 的观测数量，然后调用 arrange() 函数按降序排序结果；结果被转换成一个名为 tbl5 的 tibble。然后我们调用 mutate() 函数创建一个名为 pct_total 的变量，该变量计算 n 与总记录数的百分比；该变量随后被缩减到只保留小数点后两位：

count(nbadf8, Q1vF) %>% arrange(desc(Q1vF)) -> tbl5
tbl5 %>% 
  mutate(pct_total = n/nrow(nbadf8)*100) -> tbl5
tbl5$pct_total <- round(tbl5$pct_total, digits = 2)
print(tbl5)
##   Q1vF   n pct_total
## 1   RR 151     70.89
## 2   RH  62     29.11

这个练习重复了三次，首先是通过将第二季度替换为第一季度，通过将变量 Q1vF 替换为 Q2vF 来实现的：

nbadf4 %>% 
  filter(teamR == "Milwaukee" | teamR == "Toronto" | 
           teamR == "Boston" | teamR == "Denver" | 
           teamR == "Houston" | teamR == "LA Clippers") -> nbadf9

nbadf9 %>%
  filter(Q2vF == "RR" | Q2vF == "RH") -> nbadf10

count(nbadf10, Q2vF) %>% arrange(desc(Q2vF)) -> tbl6
tbl6 %>% 
  mutate(pct_total = n/nrow(nbadf10)*100) -> tbl6
tbl6$pct_total <- round(tbl6$pct_total, digits = 2)
print(tbl6)
##   Q2vF   n pct_total
## 1   RR 149     73.04
## 2   RH  55     26.96

接下来，我们将变量 Q2vF 替换为 Q3vF：

nbadf5 %>%
  filter(teamR == "Milwaukee" | teamR == "Toronto" | 
           teamR == "Boston" | teamR == "Denver" | 
           teamR == "Houston" | teamR == "LA Clippers") -> nbadf11

nbadf11 %>% 
  filter(Q3vF == "RR" | Q3vF == "RH") -> nbadf12

count(nbadf12, Q3vF) %>% arrange(desc(Q3vF)) -> tbl7
tbl7 %>% 
  mutate(pct_total = n/nrow(nbadf12)*100) -> tbl7
tbl7$pct_total <- round(tbl7$pct_total, digits = 2)
print(tbl7)
##   Q3vF   n pct_total
## 1   RR 157     75.12
## 2   RH  52     24.88

最后，我们通过将变量 Q4vF 插入 Q3vF 的位置来统计第四季度的结果：

nbadf6 %>% 
  filter(teamR == "Milwaukee" | teamR == "Toronto" | 
           teamR == "Boston" | teamR == "Denver" | 
           teamR == "Houston" | teamR == "LA Clippers") -> nbadf13

nbadf13 %>%
  filter(Q4vF == "RR" | Q4vF == "RH") -> nbadf14

count(nbadf14, Q4vF) %>% arrange(desc(Q4vF)) -> tbl8
tbl8 %>% 
  mutate(pct_total = n/nrow(nbadf14)*100) -> tbl8
tbl8$pct_total <- round(tbl8$pct_total, digits = 2)
print(tbl8)
##   Q4vF   n pct_total
## 1   RR 142        71
## 2   RH  58        29

我们接下来从头创建一个名为 df1 的数据集，通过调用基础 R 的 data.frame() 函数来存储变量 Q1vF、Q2vF、Q3vF 和 Q4vF 等于 RR 的结果。然后我们调用基础 R 的 c() 函数向我们的数据框中添加一对向量。我们的第一个向量是一个名为 quarter 的字符串（注意属性周围的引号），我们的第二个向量是一个名为 win_pct 的数值变量（注意没有引号）。从头创建数据集只有在设计上保持行和列计数最小的情况下才有意义；否则，应该进行自动化投资：

df1 <- data.frame(quarter = c("1Q", "2Q", "3Q", "4Q"),
                 win_pct = c(70.89, 72.81, 75.12, 71.01))
print(df1)
##   quarter win_pct
## 1      1Q   70.89
## 2      2Q   72.81
## 3      3Q   75.12
## 4      4Q   71.01

然后我们将结果可视化在条形图中。我们将暂时将我们的绘图保存在内存中，然后将其作为单一对象与另一个 ggplot2 条形图一起打印：

plot5 <- ggplot(df1, aes(x = quarter, y = win_pct)) + 
  geom_bar(color = c("gray74", "gray74", "skyblue", "gray74"),
           fill = c("gray74", "gray74", "skyblue", "gray74"), 
           stat = "identity") + 
  labs(title = "Top 6 Teams on the Road", 
       subtitle = "Winning Percentages when Winning each Quarter",
       x = "Quarter", 
       y = "Winning Percentage") + 
  geom_text(aes(x = quarter, y = win_pct, label = win_pct, 
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

现在，让我们看看这些相同的团队在主场的表现：

nbadf3 %>%
  filter(teamH == "Milwaukee" | teamH == "Toronto" | 
           teamH == "Boston" | teamH == "Denver" | 
           teamH == "Houston" | teamH == "LA Clippers") -> nbadf15

nbadf15 %>% 
  filter(Q1vF == "HR" | Q1vF == "HH") -> nbadf16

count(nbadf16, Q1vF) %>% arrange(Q1vF) -> tbl9
tbl9 %>% 
  mutate(pct_total = n/nrow(nbadf16)*100) -> tbl9
tbl9$pct_total <- round(tbl9$pct_total, digits = 2)
print(tbl9)
##   Q1vF   n pct_total
## 1   HH 219     84.88
## 2   HR  39     15.12

nbadf4 %>% 
  filter(teamH == "Milwaukee" | teamH == "Toronto" | 
           teamH == "Boston" | teamH == "Denver" | 
           teamH == "Houston" | teamH == "LA Clippers") -> nbadf17

nbadf17 %>% 
  filter(Q2vF == "HR" | Q2vF == "HH") -> nbadf18

count(nbadf18, Q2vF) %>% arrange(Q2vF) -> tbl10
tbl10 %>% 
  mutate(pct_total = n/nrow(nbadf18)*100) -> tbl10
tbl10$pct_total <- round(tbl10$pct_total, digits = 2)
print(tbl10)
##   Q2vF   n pct_total
## 1   HH 200     84.03
## 2   HR  38     15.97

nbadf5 %>% 
  filter(teamH == "Milwaukee" | teamH == "Toronto" | 
           teamH == "Boston" | teamH == "Denver" | 
           teamH == "Houston" | teamH == "LA Clippers") -> nbadf19

nbadf19 %>% 
  filter(Q3vF == "HR" | Q3vF == "HH") -> nbadf20

count(nbadf20, Q3vF) %>% arrange(Q3vF) -> tbl11
tbl11 %>% 
  mutate(pct_total = n/nrow(nbadf20)*100) -> tbl11
tbl11$pct_total <- round(tbl11$pct_total, digits = 2)
print(tbl11)
##   Q3vF   n pct_total
## 1   HH 208     87.76
## 2   HR  29     12.24

nbadf6 %>% 
  filter(teamH == "Milwaukee" | teamH == "Toronto" | 
           teamH == "Boston" | teamH == "Denver" | 
           teamH == "Houston" | teamH == "LA Clippers") -> nbadf21

nbadf21 %>% 
  filter(Q4vF == "HR" | Q4vF == "HH") -> nbadf22

count(nbadf22, Q4vF) %>% arrange(Q4vF) -> tbl12
tbl12 %>% 
  mutate(pct_total = n/nrow(nbadf22)*100) -> tbl12
tbl12$pct_total <- round(tbl12$pct_total, digits = 2)
print(tbl12)
##   Q4vF   n pct_total
## 1   HH 200     82.99
## 2   HR  41     17.01
df2 <- data.frame(quarter = c("1Q", "2Q", "3Q", "4Q"),
                  win_pct = c(84.88, 84.15, 87.76, 82.99))
print(df2)
##   quarter win_pct
## 1      1Q   84.88
## 2      2Q   84.15
## 3      3Q   87.76
## 4      4Q   82.99

plot6 <- ggplot(df2, aes(x = quarter, y = win_pct)) + 
  geom_bar(color = c("gray74", "gray74", "brown3", "gray74"),
           fill = c("gray74", "gray74", "brown3", "gray74"), 
           stat = "identity") + 
  labs(title = "Top 6 Teams at Home", 
       subtitle = "Winning Percentages when Winning each Quarter",
       x = "Quarter", 
       y = "Winning Percentage") + 
  geom_text(aes(x = quarter, y = win_pct, label = win_pct, 
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

再次，我们调用 plot_layout() 函数将最后两个条形图 plot5 和 plot6 打包成一个单一的对象（见图 6.5）：

plot5 + plot6 + plot_layout(ncol = 2)

图 6.5 在 2018-19 和 2019-20 赛季常规赛中，NBA 最优秀的球队在赢得比赛时比其他季度更频繁地赢得了第三季度。这在客场和主场的比赛中都适用。

因此，联赛中最优秀的球队在赢得比赛时，最常在客场和主场的第三季度获胜。同时，这些球队在第四季度，当客场和主场的成绩合并时，最不成功。

最差 6 队

那么，关于最差的球队——我们是否看到了类似或不同的结果？接下来，我们将重用我们的代码，并将其应用于 2018-19 和 2019-20 赛季常规赛中最差的六支球队。这些球队是明尼苏达森林狼（55 胜）、菲尼克斯太阳（53 胜）、亚特兰大老鹰（49 胜）、芝加哥公牛（44 胜）、克利夫兰骑士（38 胜）和纽约尼克斯（38 胜）。结果被总结并在另一对ggplot2条形图中可视化（见图 6.6）：

nbadf3 %>%
  filter(teamR == "Minnesota" | teamR == "Phoenix" | 
           teamR == "Atlanta" | teamR == "Chicago" | 
           teamR == "Cleveland" | teamR == "New York") -> nbadf23

nbadf23 %>%
  filter(Q1vF == "RR" | Q1vF == "RH") -> nbadf24

count(nbadf24, Q1vF) %>% arrange(desc(Q1vF)) -> tbl13
tbl13 %>% 
  mutate(pct_total = n/nrow(nbadf24)*100) -> tbl13
tbl13$pct_total <- round(tbl13$pct_total, digits = 2)
print(tbl13)
##   Q1vF  n pct_total
## 1   RR 58     42.03
## 2   RH 80     57.97

nbadf4 %>% 
  filter(teamR == "Minnesota" | teamR == "Phoenix" | 
           teamR == "Atlanta" | teamR == "Chicago" | 
           teamR == "Cleveland" | teamR == "New York") -> nbadf25

nbadf25 %>%
  filter(Q2vF == "RR" | Q2vF == "RH") -> nbadf26

count(nbadf26, Q2vF) %>% arrange(desc(Q2vF)) -> tbl14
tbl14 %>% 
  mutate(pct_total = n/nrow(nbadf26)*100) -> tbl14
tbl14$pct_total <- round(tbl14$pct_total, digits = 2)
print(tbl14)
##   Q2vF  n pct_total
## 1   RR 43      34.4
## 2   RH 82      65.6

nbadf5 %>%
  filter(teamR == "Minnesota" | teamR == "Phoenix" | 
           teamR == "Atlanta" | teamR == "Chicago" | 
           teamR == "Cleveland" | teamR == "New York") -> nbadf27

nbadf27 %>%
  filter(Q3vF == "RR" | Q3vF == "RH") -> nbadf28

count(nbadf28, Q3vF) %>% arrange(desc(Q3vF)) -> tbl15
tbl15 %>% 
  mutate(pct_total = n/nrow(nbadf28)*100) -> tbl15
tbl15$pct_total <- round(tbl15$pct_total, digits = 2)
print(tbl15)
##   Q3vF   n pct_total
## 1   RR  64      38.1
## 2   RH 104      61.9

nbadf6 %>% 
  filter(teamR == "Minnesota" | teamR == "Phoenix" | 
           teamR == "Atlanta" | teamR == "Chicago" | 
           teamR == "Cleveland" | teamR == "New York") -> nbadf29

nbadf29 %>%
  filter(Q4vF == "RR" | Q4vF == "RH") -> nbadf30

count(nbadf30, Q4vF) %>% arrange(desc(Q4vF)) -> tbl16
tbl16 %>% 
  mutate(pct_total = n/nrow(nbadf30)*100) -> tbl16
tbl16$pct_total <- round(tbl16$pct_total, digits = 2)
print(tbl16)
##   Q4vF  n pct_total
## 1   RR 54     37.76
## 2   RH 89     62.24
df3 <- data.frame(quarter = c("1Q", "2Q", "3Q", "4Q"),
                  win_pct = c(42.03, 33.33, 38.11, 37.76))
print(df3)
##   quarter win_pct
## 1      1Q   42.03
## 2      2Q   33.33
## 3      3Q   38.11
## 4      4Q   37.76

plot7 <- ggplot(df3, aes(x = quarter, y = win_pct)) + 
  geom_bar(color = c("orange", "gray74", "gray74", "gray74"),
           fill = c("orange", "gray74", "gray74", "gray74"), 
           stat = "identity") + 
  labs(title = "Bottom 6 Teams on the Road", 
       subtitle = "Winning Percentages when Winning each Quarter",
       x = "Quarter", 
       y = "Winning Percentage") + 
  geom_text(aes(x = quarter, y = win_pct, label = win_pct, 
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

nbadf3 %>% 
  filter(teamH == "Minnesota" | teamH == "Phoenix" | 
           teamH == "Atlanta" | teamH == "Chicago" | 
           teamH == "Cleveland" | teamH == "New York") -> nbadf31

nbadf31 %>%
  filter(Q1vF == "HR" | Q1vF == "HH") -> nbadf32

count(nbadf32, Q1vF) %>% arrange(Q1vF) -> tbl17
tbl17 %>% 
  mutate(pct_total = n/nrow(nbadf32)*100) -> tbl17
tbl17$pct_total <- round(tbl17$pct_total, digits = 2)
print(tbl17)
##   Q1vF  n pct_total
## 1   HH 78     45.35
## 2   HR 94     54.65

nbadf4 %>%
  filter(teamH == "Minnesota" | teamH == "Phoenix" | 
           teamH == "Atlanta" | teamH == "Chicago" | 
           teamH == "Cleveland" | teamH == "New York") -> nbadf33

nbadf33 %>% 
  filter(Q2vF == "HR" | Q2vF == "HH") -> nbadf34

count(nbadf34, Q2vF) %>% arrange(Q2vF) -> tbl18
tbl18 %>% 
  mutate(pct_total = n/nrow(nbadf34)*100) -> tbl18
tbl18$pct_total <- round(tbl18$pct_total, digits = 2)
print(tbl18)
##   Q2vF  n pct_total
## 1   HH 86     51.81
## 2   HR 80     48.19

nbadf5 %>% 
  filter(teamH == "Minnesota" | teamH == "Phoenix" | 
           teamH == "Atlanta" | teamH == "Chicago" | 
           teamH == "Cleveland" | teamH == "New York") -> nbadf35
nbadf35 %>%
  filter(Q3vF == "HR" | Q3vF == "HH") -> nbadf36

count(nbadf36, Q3vF) %>% arrange(Q3vF) -> tbl19
tbl19 %>% 
  mutate(pct_total = n/nrow(nbadf36)*100) -> tbl19
tbl19$pct_total <- round(tbl19$pct_total, digits = 2)
print(tbl19)
##   Q3vF  n pct_total
## 1   HH 78     49.37
## 2   HR 80     50.63

nbadf6 %>%
  filter(teamH == "Minnesota" | teamH == "Phoenix" | 
           teamH == "Atlanta" | teamH == "Chicago" | 
           teamH == "Cleveland" | teamH == "New York") -> nbadf37

nbadf37 %>%
  filter(Q4vF == "HR" | Q4vF == "HH") -> nbadf38

count(nbadf38, Q4vF) %>% arrange(Q4vF) -> tbl20
tbl20 %>% 
  mutate(pct_total = n/nrow(nbadf38)*100) -> tbl20
tbl20$pct_total <- round(tbl20$pct_total, digits = 2)
print(tbl20)
##   Q4vF  n pct_total
## 1   HH 97     52.72
## 2   HR 87     47.28

df4 <- data.frame(quarter = c("1Q", "2Q", "3Q", "4Q"),
                  win_pct = c(45.35, 52.02, 49.37, 52.72))
print(df4)
##   quarter win_pct
## 1      1Q   45.35
## 2      2Q   52.02
## 3      3Q   49.37
## 4      4Q   52.72

plot8 <- ggplot(df4, aes(x = quarter, y = win_pct)) + 
  geom_bar(color = c("gray74", "gray74", "gray74", "orchid"),
           fill = c("gray74", "gray74", "gray74", "orchid"), 
           stat = "identity") + 
  labs(title = "Bottom 6 Teams at Home", 
       subtitle = "Winning Percentages when Winning each Quarter",
       x = "Quarter", 
       y = "Winning Percentage") + 
  geom_text(aes(x = quarter, y = win_pct, label = win_pct, 
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

plot7 + plot8 + plot_layout(ncol = 2)

图 6.6 在 2018-19 和 2019-20 赛季常规赛中，NBA 最差的球队。当它们设法获胜时，最常在客场赢得第一季度，在主场赢得第四季度。

当在客场作战时，NBA 最不成功的球队在赢得比赛时最常在第一季度获胜。当在主场作战时，这些球队在赢得比赛时最常在第四季度获胜。

到目前为止，大部分证据表明第三季度最为重要，尽管有这些最新的结果；至少，几乎没有证据表明第四季度的结果比前三个季度的结果更为显著。再次，这一发现进一步证实了我们的假设。但让我们再仔细看看。

6.4.6 半场结果

在我们的最终分析中，我们将调查第三季度和第四季度的结果，数据集仅包括 2018-19 和 2019-20 赛季常规赛中半场平局的比赛。因此，我们将最后两个季度相互配对，在这个过程中，我们忽略了前两个季度；换句话说，在这个最终分析中，我们正在检查根据传统智慧认为是决定性的季度（即第四季度）与根据我们到目前为止的分析确实是决定性的季度（即第三季度）之间的比较。

因此，我们调用dplyr filter()函数对 nbadf2 数据集进行子集化，选取那些在第一和第二季度之间双方球队得分相同的观测值。结果被转换成一个新的对象，称为 nbadf39：

nbadf2 %>%
  filter(Q1R + Q2R == Q1H + Q2H) -> nbadf39

我们再次调用filter()函数，这次是为了对 nbadf39 数据集进行子集化，选取那些第三季度或第四季度结束时双方球队得分相同的观测值。因此，nbadf39 数据集包含了每个第三季度和第四季度的获胜球队：

nbadf39 %>% 
  filter(Q3R != Q3H & Q4R != Q4H) -> nbadf39
dim(nbadf39)
## [1] 61 17

通过运行dim()函数，我们看到 nbadf39 只有 61 行。

在接下来的代码块中，我们将 nbadf39 数据集通过管道传递到一对dplyr函数：tally()函数计算 nbadf39 中group_by()函数中指定的每个结果组合的记录数。

传递给group_by()函数的参数映射到第三季度、第四季度和比赛结束之间的所有可能的结果组合。例如，第一个参数——其中Q3H大于Q3R，Q4H大于Q4R，FH大于FR——表示主队在第三和第四季度得分超过客队，并且最终赢得比赛。最后一个参数——其中Q3R小于Q3H，Q4R大于Q4H，FR大于FH——表示主队在第三季度得分超过客队，客队在第四季度得分超过主队，并且客队赢得比赛。

这可能不用说，但对于半场平局的游戏，数学上不可能的结果组合不包括在内。例如，客队不可能赢得第三和第四季度，然后不赢得比赛，因此没有传递给group_by()函数的参数来考虑这种情况。结果被转换为一个名为 tbl21 的 tibble：

nbadf39 %>%
  group_by(Q3H > Q3R & Q4H > Q4R & FH > FR,
           Q3H > Q3R & Q4H < Q4R & FH > FR,
           Q3H < Q3R & Q4H > Q4R & FH > FR,
           Q3R > Q3H & Q4R > Q4H & FR > FH,
           Q3R > Q3H & Q4R < Q4H & FR > FH,
           Q3R < Q3H & Q4R > Q4H & FR > FH) %>%
tally() -> tbl21
print(tbl21)
## # A tibble: 6 × 7
## # Groups:   Q3H > Q3R & Q4H > Q4R & FH > FR, 
## # Q3H > Q3R & Q4H < Q4R & FH > FR, 
## # Q3H < Q3R & Q4H > Q4R & FH > FR, 
## # Q3R > Q3H & Q4R > Q4H & FR > FH, 
## # Q3R > Q3H & Q4R < Q4H & FR > FH [6]
## # `Q3H > Q3R & Q4H > Q4R & FH > FR` `Q3H > Q3R & Q4H < Q4R & FH > FR` 
##   <lgl>                             <lgl>                               
## 1 FALSE                             FALSE         
## 2 FALSE                             FALSE                 
## 3 FALSE                             FALSE                        
## 4 FALSE                             FALSE                     
## 5 FALSE                             TRUE                               
## 6 TRUE                              FALSE                         
## # `Q3H < Q3R & Q4H > Q4R & FH > FR` `Q3R > Q3H & Q4R > Q4H & FR > FH`
##   <lgl>                             <lgl>                               
## 1 FALSE                             FALSE                              
## 2 FALSE                             FALSE                
## 3 FALSE                             TRUE                        
## 4 TRUE                              FALSE                    
## 5 FALSE                             FALSE                               
## 6 FALSE                             FALSE                 
## # `Q3R > Q3H & Q4R < Q4H & FR > FH` `Q3R < Q3H & Q4R > Q4H & FR > FH` 
##   <lgl>                             <lgl>                               
## 1 FALSE                             TRUE               
## 2 TRUE                              FALSE             
## 3 FALSE                             FALSE                
## 4 FALSE                             FALSE              
## 5 FALSE                             FALSE                               
## 6 FALSE                             FALSE                   
## #     n 
##   <int>                             
## 1     6                             
## 2     8                             
## 3    13                            
## 4     8                                                           
## 5     8                                                             
## 6    18                            

这些结果没有以快速或易于解读的方式格式化；因此，我们将运行一系列数据处理操作，以生成一个可以很好地转换为简单表格的 tibble，这样的表格更容易解释。

首先，我们调用基础 R 的colnames()函数来设置，或者说是重命名，tbl21 的列。请注意，在colnames()和c()函数之间，我们正在实现 tbl21 列名的完全替换，因此向量的长度必须等于 tbl21 的宽度，以防止 R 抛出错误；因此，没有必要像我们之前通过调用rename()函数那样在我们的代码中包含原始和更改后的列名。

基础 R 的head()函数，其中n = 1，返回 tbl21 的新标题信息以及数据的第一行：

colnames(tbl21) <- c('HHH', 'HRH', 'RHH', 'RRR', 'RHR', 'HRR', 'count')
head(tbl21, n = 1)
## # A tibble: 1 × 7
## # Groups:   HHH, HRH, RHH, RRR, RHR [1]
##   HHH   HRH   RHH   RRR   RHR   HRR   count
##   <lgl> <lgl> <lgl> <lgl> <lgl> <lgl> <int>
## 1 FALSE FALSE FALSE FALSE FALSE TRUE      6

避免使用特殊字符和空格

在更改或创建变量名时，不要使用特殊字符或空格，因为根据被调用的函数，R 可能会抛出错误。所以，例如，表示主队在第三季度、第四季度和比赛中获胜的列HHH——不应该被命名为以下类似的内容：

H_H_H

H H H

H-H-H

H@H@H

我们的大部分变量都是逻辑数据类型，通过将逻辑变量转换为数值，我们的数据处理操作将变得更加容易。我们通过反复调用基础 R 的as.numeric()函数来实现这一点：

tbl21$HHH <- as.numeric(tbl21$HHH)
tbl21$HRH <- as.numeric(tbl21$HRH)
tbl21$RHH <- as.numeric(tbl21$RHH)
tbl21$RRR <- as.numeric(tbl21$RRR)
tbl21$RHR <- as.numeric(tbl21$RHR)
tbl21$HRR <- as.numeric(tbl21$HRR)

之前等于FALSE的值现在等于0，之前等于TRUE的值现在等于1。

然后，我们通过应用开闭方括号来索引现在等于1的六个值，以便它们可以被修改为等于计数列中的相应值。例如，当变量HHH等于1时——第 6 行和第 1 列——我们将它改为等于 18，因为 tbl21 包含 18 条记录，其中主队在第三节、第四节和比赛中获胜：

tbl21[6, 1] = 18
tbl21[5, 2] = 8
tbl21[4, 3] = 8
tbl21[3, 4] = 13
tbl21[2, 5] = 8
tbl21[1, 6] = 6

由于不再需要计数列，我们调用dplyr select()函数来对 tbl21 进行子集化，仅包括从HHH到HRR的变量，从而排除计数列：

tbl21 %>% 
  select(HHH:HRR) -> tbl21

然后，我们调用tidyr pivot_longer()函数，该函数通过将列转换为行来将数据对象从宽格式转换为长格式。pivot_longer()函数本质上要求我们指出要折叠的现有列以及随后要创建的新列，以下条件是成立的：

• cols等于要旋转的列名。

• names_to等于新字符列的名称。

• values_to等于新值列的名称。

基础 R 的head()函数返回 tbl21 中的前六个观察结果。现在，每个结果组合（例如，HHH、HRH等）下都有六个行，其中只有一个是实际的记录计数：

tbl21 %>% 
  pivot_longer(cols = c("HHH", "HRH", "RHH", "RRR", "RHR", "HRR"),
                    names_to = "result",
                    values_to = "count") -> tbl21
head(tbl21)
## # A tibble: 6 × 2
##   result count
##   <chr>  <dbl>
## 1 HHH        0
## 2 HRH        0
## 3 RHH        0
## 4 RRR        0
## 5 RHR        0
## 6 HRR        6

通过再次调用filter()函数并子集化 tbl21，其中变量计数大于 0，我们最终得到一个 6×2 的 tibble，可以轻松分析：

tbl21 %>% 
  filter(count > 0)
print(tbl21)
## # A tibble: 6 × 2
##   result count
##   <chr>  <dbl>
## 1 HRR        6
## 2 RHR        8
## 3 RRR       13
## 4 RHH        8
## 5 HRH        8
## 6 HHH       18

与可视化这些结果相比，实际上可能更有效地将它们放入一个简单的表格中（见表 6.1）。

表 6.1 常规赛季比赛中半场平局的总结结果

结果组合	说明	计数
HHH	主队赢得第三节主队赢得第四节主队赢得比赛	18
HRH	主队赢得第三节客队赢得第四节主队赢得比赛	8
RHH	客队赢得第三节主队赢得第四节主队赢得比赛	8
RRR	客队赢得第三节客队赢得第四节客队赢得比赛	13
RHR	客队赢得第三节主队赢得第四节客队赢得比赛	8
HRR	主队赢得第三节客队赢得第四节客队赢得比赛	6

结果并不引人注目，因为这里没有什么可以触发我们之前结论的任何转换。不仅 NBA 比赛通常不在第四节获胜，而且我们对 2018-19 和 2019-20 赛季常规赛的分析显示，第三节是最关键的：

• 在 tbl21 中的 61 次观察，或者说比赛，主队赢了 34 次，客队赢了 27 次。这实际上非常接近整个常规赛中主客场胜负的分布。

• 在那些比赛中，主队在第三节和第四节各赢了 26 次。

• 在那些客队获胜的比赛中，客队在第三节赢了 21 次，在第四节赢了 19 次。

• 因此，对于半场平局的游戏，第三节和第四节都不是主导的。

在下一章中，我们将继续进行游戏分析，探讨 NBA 主场优势背后的潜在原因。

摘要

• 就像这本书中的其他几乎所有内容一样，没有可用的数据集理想地结构化以支持这里所进行的广泛分析。幸运的是，在 R 中，任何数据集都可以以任何方式被处理；从创建变量到重命名、转换或删除它们；从子集数据集到重塑它们或与其他数据集合并；以及从切割和切片数据到可视化相同的数据。

• 数据驱动的分析推翻那些从未基于数据而是基于看似合理的传统观点，这并不罕见。但如果是这种情况，你需要的是更多数据，而不仅仅是某些数据，才能改变人们的观念。

• 同时，没有证据支持传统观点，即第四季度比前三个季度更重要。

• 事实上，第三季度最为关键；毕竟，获胜的球队，尤其是联赛中的最佳球队，赢得第三季度的比赛次数比赢得其他任何季度的次数都要多，至少在 2018-19 赛季和 2019-20 赛季的大部分时间里是这样的。

• 在调查那些半场结束时平局的比赛时，第四季度与第三季度“竞争”的情况，没有哪个季度比另一个季度更突出。虽然这并没有进一步支持我们之前的发现，即第三季度实际上比第四季度或任何其他季度都重要，但它确实进一步削弱了先入为主的替代假设。

7 t 检验和效应量测试

本章涵盖

• 运行和解释连续数据的显著性统计测试

• 可视化显著性统计测试

• 运行和解释连续数据的效应量测试

即使你只是个篮球爱好者，你也可能知道，主队赢得比赛的概率远远高于输掉比赛（其他运动也是如此）。在第九章中，我们将探讨主队和客队在不同休息日排列下的实际胜负百分比，但在此期间，我们想确定是否存在可能解释主场优势的裁判偏见。我们将比较主队和客队的犯规次数和罚球尝试次数，然后进行统计测试以确定这些计数中的任何差异是否具有统计学意义以及它们的效果量可能是什么。要运行哪些统计测试主要取决于数据。由于我们将比较两组（仅两组）结果为数字的数据，因此我们的计划是运行 t 检验以确定是否存在任何具有统计学意义的差异，并运行 Cohen 的 d 效应量测试来衡量这些差异的大小。

我们的初始假设，或零假设，是客场和主场的个人犯规或罚球尝试之间没有统计学上显著的差异；因此，我们首先假设任何差异都是由于偶然而不是有意的。我们需要从 t 检验中获得压倒性的证据来拒绝我们的零假设，然后得出结论，我们观察到的任何数据差异都不是由于偶然。Cohen 的 d 测试返回关于这些相同差异的定量和定性度量，独立于 t 检验结果；我们不会根据效应量测试的结果拒绝或未能拒绝零假设。

我们将在后面详细介绍 t 检验和效应量测试，但这里是一个我们旅程的快照：

• 我们将从加载包开始，导入与第六章中导入的相同的数据集对，然后运行一系列数据整理操作。

• 关于 2018-19 赛季，我们将对个人犯规和罚球（通常在对方球队犯规后判给一支球队）进行 t 检验，这些数据分为常规赛和季后赛。然后，我们将运行效应量测试来补充我们的 t 检验。

• 关于受 COVID-19 影响的 2019-20 赛季，我们还将运行一系列 t 检验和效应量测试，但这次数据仅分为常规赛。我们首先将在 COVID-19 暂时暂停比赛之前进行的常规赛比赛数据集上运行我们的测试，然后在赛季恢复时，所有比赛都在佛罗里达州奥兰多的中立场地进行。

让我们通过加载我们的包开始我们的旅程。

7.1 加载包

如同往常，我们将调用基础 R 和包装函数的混合来导入数据，整理数据，进行显著性测试，可视化结果，并计算基本统计量。我们的首要任务是调用基础 R 的library()函数来加载tidyverse、ggpubr、sqldf、effsize和patchwork包：

library(tidyverse)
library(ggpubr)
library(sqldf)
library(effsize)
library(patchwork)

ggpubr包包括用于定制ggplot2可视化的简单直接函数。effsize包包括一个执行效应量测试的函数。本章中所有超出基础 R 的内容都与这五个包中的一个相关联。

7.2 导入数据

我们现在调用readr的read_csv()函数来导入我们在上一章中加载的相同两个.csv 文件——nba_boxscore_1819.csv和nba_boxscore_1920.csv——这两个文件都是从网站www.bigdataball.com下载的，并随后存储在我们的默认工作目录中：

df1 <- read_csv("nba_boxscore_1819.csv")
df2 <- read_csv("nba_boxscore_1920.csv")

我们将这些设置为 df1 和 df2 数据集，分别对应。

7.3 整理数据

回到第二章，我们保存了我们原始数据集的一个经过大量修改的版本，然后通过调用基础 R 的write.csv()函数将内容导出为.csv 文件。这样做是为了避免在第三章中重复第二章的数据整理操作。尽管我们导入的文件与上一章首次导入的文件相同，但我们的目的与第六章中的目的完全不同，因此我们的数据整理操作将完全不同。换句话说，在第六章中没有调用write.csv()函数并没有失去任何机会。

话虽如此，我们将从包含在 df1 中的 2018-19 赛季得分数据开始。我们调用dplyr filter()函数来对 df1 数据集进行子集化，选择变量VENUE等于R的观测值，并将结果保存在一个新的对象 df3 中。因此，我们的新数据集仅包含客场队伍的数据：

df1 %>%
  filter(VENUE == "R") -> df3

接下来，我们调用select()函数，也是来自dplyr包的，将 df3 数据集减少到只包含未来需要的变量：

df3 %>%
  select(DATASET, TEAM, VENUE, FT, FTA, PF) -> df3

其中一些你可能从上一章中熟悉，而另一些可能不熟悉：

• DATASET—现在是一个字符串，但本质上包括两个级别，用于区分常规赛比赛和季后赛比赛。

• TEAM—另一个字符串；这等于队伍名称，例如，密尔沃基等于密尔沃基雄鹿，丹佛等于丹佛掘金。

• VENUE—始终等于R，作为代表客场队伍的标识（与代表主场队伍的H相对）。

• FT—等于客场队伍在任何特定比赛中做出的罚球次数。当球员在尝试投篮时被对方犯规时，他们最常获得罚球。

• FTA—等于客场队伍尝试的罚球次数。

• PF—等于客场队伍在任何特定比赛中犯的个人犯规次数。

这些相同的变量随后被重命名，以便在以后区分它们与主队的等效变量（除了DATASET，我们只是将其转换为小写）。使用dplyr的rename()函数将赋值运算符右侧的变量名转换为左侧的名称：

df3 %>% 
  rename(dataset = DATASET, teamR = TEAM, venueR = VENUE, ftR = FT, 
         ftaR = FTA, pfR = PF) -> df3

我们将 df3 中的三个变量——dataset、teamR和venueR——通过三次调用基础 R 的as.factor()函数转换为因子变量。这同样是对具有有限可能值的变量的一种最佳实践：

df3$dataset <- as.factor(df3$dataset)
df3$teamR <- as.factor(df3$teamR)
df3$venueR <- as.factor(df3$venueR)

这些相同的步骤被重复执行以创建一个名为 df4 的数据集。这个数据集与 df3 相似，只是它包含的是主队的得分数据而不是客队的得分数据（并且没有DATASET变量）：

df1 %>%
  filter(VENUE == "H") -> df4

df4 %>% 
  select(TEAM, VENUE, FT, FTA, PF) -> df4

df4 %>% 
  rename(teamH = TEAM, venueH = VENUE, ftH = FT, ftaH = FTA,
               pfH = PF) -> df4

df4$teamH <- as.factor(df4$teamH)
df4$venueH <- as.factor(df4$venueH)

接下来，我们通过两次调用基础 R 的dim()函数来指示 R 返回 df3 和 df4 的维度：

dim(df3) 
## [1] 1312    6
dim(df4)
## [1] 1312    5

两个数据集都包含 1,312 行；df3 有六个变量，而 df4 只有五个变量，因为我们保留了前者的变量dataset，而没有在后者中保留。

接下来，我们通过调用基础 R 的cbind()函数将 df3 和 df4 数据集合并成一个名为 fouls1819 的单个对象（回想一下，我们现在正在专门使用 2018-19 数据）。cbind()函数使得将多个数据集横向合并成一个数据集成为可能。然后我们再次调用dim()函数来检查 fouls1819 中的行和列计数：

fouls1819 <- cbind(df3, df4)
dim(fouls1819) 
## [1] 1312   11

而 df3 有 1,312 行和 6 列，df4 有 1,312 行和 5 列，我们的 fouls1819 数据集有 1,312 行和 11 列。现在我们有一个包含 2018-19 常规赛和季后赛数据的数据集，可以进行分析了。

7.4 对 2018-19 数据的分析

我们的分析将分为两部分。首先，我们将计算并测试 2018-19 常规赛期间主队和客队在犯规和罚球尝试方面的方差。然后，我们将对 2018-19 季后赛进行相同的计算和测试。

7.4.1 2018-19 常规赛分析

我们需要首先对 fouls1819 数据集进行子集化，使其仅包含常规赛比赛。因此，我们将 fouls1819 数据集传递（或管道）到filter()函数，该函数将 fouls1819 减少到一个新的数据集，称为 fouls1819reg，其中变量dataset等于NBA 2018-2019 Regular Season。

然后，我们调用基础 R 的sum()和mean()函数来计算使用我们的新数据集作为源的关键度量在客场和主场球队之间的方差。目前，我们只是对获取基线数据感兴趣：

fouls1819 %>% 
  filter(dataset == "NBA 2018-2019 Regular Season") -> fouls1819reg

sum(fouls1819reg$pfR) - sum(fouls1819reg$pfH)
## [1] 470
mean(fouls1819reg$pfR) - mean(fouls1819reg$pfH)
## [1] 0.3821138
mean(fouls1819reg$ftaR) - mean(fouls1819reg$ftaH)
## [1] -0.6504065
sum(fouls1819reg$ftR) / sum(fouls1819reg$ftaR) 
## [1] 0.7655742
sum(fouls1819reg$ftH) / sum(fouls1819reg$ftaH) 
## [1] 0.7670176

以下是对这些结果的总结：

• 在 2018-19 常规赛期间，客场球队被吹罚的个人犯规比主场球队多 470 次；确切地说，客场球队总共被吹罚了 25,947 次个人犯规，而主场球队为 25,477 次。

• 因此，客场球队在每场比赛中被吹罚大约 0.38 次更多的个人犯规，比主场球队多。

• 因此，主队每场比赛尝试的罚球次数比客队多大约 0.65 次。

• 尽管主队平均每场比赛尝试的罚球次数更多，但主队和客队在这方面的效率是相同的；主队和客队在他们的罚球尝试中成功率都是 77%。

这些差异可能看起来微不足道，但我们的数据集的长度也必须考虑。显著性检验允许考虑这两个因素——统计显著性取决于组均值、方差和记录数。例如，在短数据上的“大”方差可能是统计上不显著的；相反，在长数据上的“小”方差可能是统计上显著的。t 检验就是这样一种统计检验，其中比较的是两组——并且不超过两组——数据是连续的。我们的零假设始终是，无论测量方法如何，均值在客队和主队之间基本上没有不同。因此，任何测试中的 p 值必须等于或低于 0.05 的显著性阈值，以拒绝均值在统计上相等的零假设，并接受替代假设。虽然 5%的截止值相当任意，但它无疑是一个很小的数字，因此可以被视为拒绝零假设的高标准。

t 检验有很多应用案例；例如：

• 一家制药公司想要测试一种新的降胆固醇药物与市场上已经存在多年的药物的效果。受影响的病人被随机选择，并被分配使用其中一种药物。t 检验将确定哪种药物在治疗高胆固醇水平方面比另一种药物更有效，或者任何结果差异仅仅是偶然造成的。

• 一所大学想要测试和比较一组随机选择的学生（他们亲自上课）与另一组随机选择的学生（他们在线上课）之间的商业分析 101 考试分数。t 检验将确定一种学习方法是否真正优于另一种学习方法。

• 一家运营两个分支机构的社区银行进行了一项调查，参与调查的客户被要求根据 1 到 10 的评分标准对所接受的服务进行评分。t 检验将确定是否有一个分支机构提供更优质的客户服务，或者任何差异都是微不足道的。

数据必须否则是连续的（在第九章中，我们将对分类数据进行卡方检验），并且比较的组数不应超过两个。（在随后的章节中，我们将拟合方差分析[ANOVA]模型来比较超过两个组。）

t 检验：个人犯规

在 R 中运行 t-test 非常简单；我们只需调用现成的t.test()函数，并将我们比较的两个变量作为参数传递。我们的第一个 t-test 比较了客场和主场球队在个人犯规中的平均值。因为 R 默认会以科学记数法返回我们的 t-test 结果，所以我们首先调用基础 R 的options()函数来禁用科学记数法，以便使用它们的完整数值等价物：

options(scipen = 999)

t.test(fouls1819reg$pfR, fouls1819reg$pfH)
## 
##  Welch Two Sample t-test
## 
## data:  fouls1819reg$pfR and fouls1819reg$pfH
## t = 2.2089, df = 2457.8, p-value = 0.02727
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.04290002 0.72132763
## sample estimates:
## mean of x mean of y 
##  21.09512  20.71301

p 值等于 0.03，这当然低于接受的或预定义的显著性阈值 0.05。换句话说，如果零假设实际上是真的，观察到相同或更极端差异的概率仅为 3%。因此，我们可以拒绝零假设，并得出结论，2018-19 NBA 常规赛期间客场和主场球队在个人犯规计数上的方差不是由于偶然；换句话说，数据指向的趋势很可能是有因果关系的。

t-test：罚球尝试

让我们现在运行第二个 t-test，这次比较客场和主场球队的罚球尝试次数：

t.test(fouls1819reg$ftaR, fouls1819reg$ftaH)
## 
##  Welch Two Sample t-test
## 
## data:  fouls1819reg$ftaR and fouls1819reg$ftaH
## t = -2.1619, df = 2457.9, p-value = 0.03072
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -1.24035782 -0.06045519
## sample estimates:
## mean of x mean of y 
##  22.74715  23.39756

这个方差同样具有显著性。因为 p 值再次等于 0.03，我们可以再次拒绝零假设，并自信地得出结论，2018-19 常规赛期间客场和主场球队在罚球尝试次数上的方差是有意义的。

顺便说一下，说“客场球队总是被判更多的犯规”或“客场和主场球队在罚球尝试次数上的差异显著”并不准确。最好具体说明在什么数据上进行了哪些测试，并且不要得出更大的结论；2018-19 NBA 常规赛期间的情况可能并不适用于，比如说，1978-79 赛季。

可视化方差

可视化这些差异的最佳方式是使用配对箱线图。我们首先创建格式化为ggplot2可读性的临时数据集。对于我们的第一组配对箱线图，我们调用dplyr包中的select()函数来创建一个名为 temp1 的数据集，它只包含犯规 1819reg 数据集中的pfR和pfH变量。

然后，我们调用tidyr包中的pivot_longer()函数——tidyr也是tidyverse包宇宙的一部分——通过将列折叠成行来重塑 temp1；temp1 仍然有两个列，但现在它们被命名为team和fouls。之前pfR和pfH的列现在成为team变量的级别，它们对应的计数现在占据fouls变量的单元格。

接下来，我们调用基础 R 的head()函数，它将 temp1 中的前六个观测值打印出来，以提供我们结果的视觉展示：

temp1 <- select(fouls1819reg, c(pfR, pfH))
temp1 %>%
  pivot_longer(cols = c(pfR, pfH),
               names_to = "team",
               values_to = "fouls") -> temp1
head(temp1)
## # A tibble: 6 × 2
##   team  fouls
##   <chr> <int>
## 1 pfR      20
## 2 pfH      20
## 3 pfR      21
## 4 pfH      29
## 5 pfR      25
## 6 pfH      19

现在，对于我们的ggplot2箱线图（见图 7.1），我们做以下操作：

• 首先，我们调用基础 R 的c()函数来创建一个向量，称为 tempt1.text，包含Home Team和Road Team的值。tempt1.text 随后被转换为scale_x_discrete()函数，这样Home Team和Road Team就是我们的 x 轴标签。

• 我们的箱线图其他来源是 temp1，其中team作为我们的 x 轴变量，fouls作为我们的 y 轴变量。

• stat_summary()函数在每个箱线图中添加一个白点来表示均值，这对于特别重要，因为 t 检验是在比较两组的均值，而不是中位数。

• ggpubr包中的stat_compare_means()函数本质上通过比较我们可视化的两个变量的均值来执行独立 t 检验，并将结果插入其中，就像ggplot2的geom_text()或annotate()函数一样，其中指定的 x 和 y 坐标交叉。

图 7.1：主队和客队每场比赛个人犯规的配对箱线图（左侧）和每场比赛主队和客队罚球尝试的配对箱线图（右侧）。白点代表总体均值。数据来自 2018-19 赛季。这两个方差都经过统计检验，具有统计学意义。

以下是完全的代码块：

temp1.text <- c("Home Team", "Road Team")
p1 <- ggplot(temp1, aes(x = team, y = fouls, fill = team)) + 
  geom_boxplot() +
  labs(title = "Personal Foul Calls: Home vs. Road Teams", 
       subtitle = "2018-19 Regular Season",
       x = "", 
       y = "Personal Fouls per Game") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(legend.position = "none") +
  scale_x_discrete(labels = temp1.text) +
  theme(plot.title = element_text(face = "bold")) +
  stat_compare_means(method = "t.test", 
                     label.x = 1.4, label.y = 34)

我们现在用罚球尝试代替个人犯规来做同样的事情。我们首先创建一个名为 temp2 的数据源，其结构与 temp1 相同，然后调用ggplot()函数创建第二组与第一组相似的箱线图：

temp2 <- select(fouls1819reg, c(5,10)) 
temp2 %>%
  pivot_longer(cols = c(ftaR, ftaH),
               names_to = "team",
               values_to = "ftattempts") -> temp2
head(temp2)
##   team ftattempts
## 1 ftaR         23
## 2 ftaH         14
## 3 ftaR         37
## 4 ftaH         18
## 5 ftaR         20
## 6 ftaH         22

temp2.text <- c("Home Team", "Road Team")
p2 <- ggplot(temp2, aes(x = team, y = ftattempts, fill = team)) + 
  geom_boxplot() +
  labs(title = "Free Throw Attempts: Home vs. Road Teams", 
       subtitle = "2018-19 Regular Season",
       x = "", 
       y = "Free Throw Attempts per Game") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(legend.position = "none") +
  scale_x_discrete(labels = temp2.text) +
  theme(plot.title = element_text(face = "bold")) +
  stat_compare_means(method = "t.test", 
                     label.x = 1.4, label.y = 48)

我们通过调用patchwork包中的plot_layout()函数，将我们的两个可视化，p1 和 p2，打包成一个单独的图形对象：

p1 + p2 + plot_layout(ncol = 2)

我们的双箱线图清晰地显示了主队和客队之间人口均值（由箱内的白点表示）以及长度或四分位距的额外差异（仅由箱体表示）的方差。

我们可能被这两个图中的异常值分心。例如，在 2018-19 赛季的常规赛季中，至少有五次球队被要求至少 34 次个人犯规，至少有两次球队尝试了超过 50 次罚球。

然后，我们调用sqldf包中的sqldf()函数，以返回 fouls1819reg 数据集中至少有一支球队被要求 34 次或更多个人犯规的观测值：

sqldf("SELECT * from fouls1819reg WHERE pfH >= 34 OR pfR >= 34")
##                         dataset         teamR venueR ftR ftaR pfR         
## 1  NBA 2018-2019 Regular Season   LA Clippers      R  33   43  26 
## 2  NBA 2018-2019 Regular Season       Phoenix      R  13   24  34  
## 3  NBA 2018-2019 Regular Season   LA Clippers      R  37   47  22       
## 4  NBA 2018-2019 Regular Season  Philadelphia      R  41   54  30       
## 5  NBA 2018-2019 Regular Season       Phoenix      R  15   21  34        
## 6  NBA 2018-2019 Regular Season      Brooklyn      R  26   34  23     
## 7  NBA 2018-2019 Regular Season Oklahoma City      R  16   25  34        
## 8  NBA 2018-2019 Regular Season       Chicago      R  35   48  30       
## 9  NBA 2018-2019 Regular Season Oklahoma City      R  17   26  34   
## 10 NBA 2018-2019 Regular Season      Brooklyn      R  33   54  23   
##            teamH venueH ftH ftaH pfH
## 1  Oklahoma City      H  23   32  35
## 2  Philadelphia       H  31   42  27
## 3  Atlanta            H  17   19  38
## 4  Phoenix            H  30   36  34
## 5  Dallas             H  32   45  17
## 6  Cleveland          H  13   18  37
## 7  Denver             H  26   35  28
## 8  Atlanta            H  17   25  34
## 9  LA Clippers        H  31   46  26
## 10 Atlanta            H  26   32  37    

结果表明，在 2018-19 赛季的常规赛季中，有 10 场比赛至少有一支参赛队伍被要求至少 34 次个人犯规——这通常发生在主队。

接下来，我们再次调用sqldf()函数，这次是为了获取 fouls1819reg 中客队或主队至少尝试了 50 次罚球的全部记录。在我们的三次尝试中，有两次实际上是客队受益：

sqldf("SELECT * from fouls1819reg WHERE ftaH > 50 OR ftaR > 50")
##                        dataset        teamR venueR ftR ftaR pfR        
## 1 NBA 2018-2019 Regular Season      Detroit      R  28   41  32 
## 2 NBA 2018-2019 Regular Season Philadelphia      R  41   54  30      
## 3 NBA 2018-2019 Regular Season     Brooklyn      R  33   54  23      
##          teamH venueH ftH ftaH pfH
## 1 Philadelphia      H  44   51  31
## 2 Phoenix           H  30   36  34
## 3 Atlanta           H  26   32  37

所以在 2018-19 赛季实际上有三场比赛一支球队尝试了超过 50 次罚球。其中两场比赛与我们的第一次sqldf查询结果相关联，这并不奇怪；毕竟，个人犯规往往会导致尝试罚球。但有一场比赛不是这样，这就是为什么我们要测试主客场球队之间的个人犯规以及同一比赛中的罚球尝试。现在让我们使用相同的方法来检查 2018-19 赛季季后赛的相同措施。

7.4.2 2019 赛季分析

由于并非每个 NBA 球队都符合季后赛资格，而且每个回合球队都会被淘汰，我们的分析将针对比之前短得多的数据集进行。而 fouls1819reg 数据集包含 1,230 条记录，我们现在将处理一个只有 82 行长的数据集。因此，为了再次获得具有统计学意义的成果，我们的方差可能需要比之前更大。

我们首先将 fouls1819 数据集通过dplyr filter()函数传递，以创建一个新的对象 fouls1819post，它只包括那些变量dataset等于NBA 2019 Playoffs的 82 条 fouls1819 记录。

然后，我们调用sum()和mean()函数来计算之前所做的相同措施上的相同方差；唯一的不同是我们已经更换了数据源。再一次，我们只是在尝试对数据进行初步了解：

fouls1819 %>% 
  filter(dataset == "NBA 2019 Playoffs") -> fouls1819post

sum(fouls1819post$pfR) - sum(fouls1819post$pfH)
## [1] 48
mean(fouls1819post$pfR) - mean(fouls1819post$pfH)
## [1] 0.5853659
mean(fouls1819post$ftaR) - mean(fouls1819post$ftaH)
## [1] -1.280488
sum(fouls1819post$ftR) / sum(fouls1819post$ftaR) 
## [1] 0.7857143
sum(fouls1819post$ftH) / sum(fouls1819post$ftaH) 
## [1] 0.7821068

这里是我们结果的总结，包括与 2018-19 赛季常规赛季的比较：

• 在 2019 赛季季后赛中，客队比主队多被吹罚 48 次个人犯规。更具体地说，客队在 2019 赛季季后赛中被吹罚了总共 1,843 次犯规，而主队被吹罚了 1,795 次个人犯规。

• 这平均下来是 0.59 的方差，也就是说，客队在每场季后赛中被吹罚的个人犯规比主队多 0.59 次。常规赛季的差异等于 0.38。

• 因此，主队在季后赛中每场比赛尝试的罚球比客队多 1.28 次；这个方差大约是常规赛季比赛的两倍。

• 客队在罚球尝试中命中了几乎 79%，而主队在尝试的罚球中成功率为大约 78%。这些数字略高于常规赛季。

T-test: 个人犯规

让我们运行一对 t-test 来确定这些方差是否具有统计学上的显著性，从个人犯规开始：

t.test(fouls1819post$pfR, fouls1819post$pfH)
## 
##  Welch Two Sample t-test
## 
## data:  fouls1819post$pfR and fouls1819post$pfH
## t = 1.0133, df = 161.46, p-value = 0.3124
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.5553998  1.7261315
## sample estimates:
## mean of x mean of y 
##  22.47561  21.89024

p 值等于 0.31。因为它大于 0.05——实际上大得多——我们应该拒绝零假设，因此可以得出结论，主客场球队之间被吹罚的个人犯规的方差不显著；均值基本上是相等的。虽然原始数据与 2018-19 赛季的常规赛季方向一致，但结果却是中性的。结果发现，记录数量的下降对 t-test 结果的影响大于方差增加的影响。

t 检验：罚球尝试

我们接下来的 t 检验将告诉我们，2019 年季后赛期间客场和主场球队在尝试罚球次数上的方差是否具有统计学意义：

t.test(fouls1819post$ftaR, fouls1819post$ftaH)
## 
##  Welch Two Sample t-test
## 
## data:  fouls1819post$ftaR and fouls1819post$ftaH
## t = -1.1997, df = 159.16, p-value = 0.232
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -3.3884143  0.8274387
## sample estimates:
## mean of x mean of y 
##  24.07317  25.35366

因为 p 值再次大于显著性水平的 0.05 阈值——确切地说，是 0.23——所以我们再次得出结论，总体均值基本上是相等的，因此无法拒绝零假设。虽然结果再次与我们的常规赛结果方向一致，但我们仍然被迫再次将结果定性为中性。

可视化方差

我们随后像之前一样可视化和打包我们的结果（见图 7.2）。以下代码块与我们之前的代码块非常相似，只是我们改变了数据源：

temp3 <- select(fouls1819post, c(6,11)) 
temp3 %>%
  pivot_longer(cols = c(pfR, pfH),
               names_to = "team",
               values_to = "fouls") -> temp3
head(temp3)
##   team fouls
## 1  pfR    19
## 2  pfH    19
## 3  pfR    27
## 4  pfH    24
## 5  pfR    22
## 6  pfH    22

temp3.text <- c("Home Team", "Road Team")
p3 <- ggplot(temp3, aes(x = team, y = fouls, fill = team)) + 
  geom_boxplot() +
  labs(title = "Personal Foul Calls: Home vs. Road Teams", 
       subtitle = "2019 Playoffs",
       x = "", 
       y = "Personal Fouls per Game") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(legend.position = "none") +
  scale_x_discrete(labels = temp1.text) +
  theme(plot.title = element_text(face = "bold")) +
  stat_compare_means(method = "t.test", label.x = 1.4, label.y = 34)
temp4 <- select(fouls1819post, c(5,10)) 
temp4 %>%
  pivot_longer(cols = c(ftaR, ftaH),
               names_to = "team",
               values_to = "ftattempts") -> temp4
head(temp4)
##   team ftattempts
## 1 ftaR         20
## 2 ftaH         14
## 3 ftaR         26
## 4 ftaH         42
## 5 ftaR         22
## 6 ftaH         20

temp4.text <- c("Home Team", "Road Team")
p4 <- ggplot(temp4, aes(x = team, y = ftattempts, fill = team)) +
  geom_boxplot() +
  labs(title = "Free Throw Attempts: Home vs. Road Teams", 
       subtitle = "2019 Playoffs",
       x = "", 
       y = "Free Throw Attempts per Game") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(legend.position = "none") +
  scale_x_discrete(labels = temp2.text) +
  theme(plot.title = element_text(face = "bold")) +
  stat_compare_means(method = "t.test", label.x = 1.4, label.y = 48)

p3 + p4 + plot_layout(ncol = 2)

图 7.2：每场比赛个人犯规次数和每场比赛尝试的罚球次数的配对箱线图，客场与主场的对比。由白色点表示的总体均值差异很明显。尽管结果与我们的第一组测试方向一致，但这些差异在统计学上并不显著。数据来自 2019 年季后赛比赛。

以下总结了我们从 2018-19 赛季得出的发现：

• 在常规赛期间，个人犯规次数和罚球尝试次数的方差在客场和主场球队之间具有统计学意义。客场球队被吹罚的个人犯规次数多于主场球队，而主场球队尝试的罚球次数多于客场球队。这些差异在整个常规赛期间都很重要。

• 在季后赛期间，这两项指标的方差与我们的常规赛结果方向一致，但却是中性的；它们在统计学上并不显著，这主要是因为记录数量低。正是出于这个原因，我们接下来将进行一对效应量测试。

7.4.3 效应量测试

虽然 t 检验告诉我们两个总体均值之间是否存在统计学上的显著差异（以及我们应该拒绝还是无法拒绝零假设），但它们并没有告诉我们差异有多大，或者有多小。这就是效应量测试发挥作用的地方。效应量最常用的测量方法之一是 Cohen 的 d 值，它计算两个均值之间的差异，并将其除以相同两个总体之间的平均标准差，从而得到一个既量化又分类的效应量。效应量测试的结果对我们的零假设没有任何影响；结果仅仅告诉我们方差有多大或有多小。在很大程度上，这是因为 Cohen 的 d 测试不考虑记录数量。

Cohen’s d 理论上可能在数据较少的情况下返回较大的效果量，而之前的 t 测试返回了统计上不显著的结果；另一方面，Cohen’s d 理论上可能在数据较多的情况下返回较小或甚至可忽略的效果量，而之前的 t 测试返回了统计上显著的结果。这表明，尽管 t 测试和 Cohen’s d 测试很好地互补，但它们不一定返回“相关”很强的结果，因此不应这样比较。

让我们看看一对 Cohen’s d 测试的结果如何，记住我们的 t 测试在数据方向上是一致的，但结果却相互矛盾。在 R 中运行 Cohen’s d 测试和 t 测试一样简单——我们只需从effsize包中调用cohen.d()函数，并将我们正在测试的数据作为参数传递。

在下面的代码块中，我们两次调用cohen.d()函数——首先测量 2018-19 赛季客场与主场球队之间的个人犯规效果量，然后再次测量 2019 赛季季后赛中的相同效果量：

cohen.d(fouls1819reg$pfR, fouls1819reg$pfH)
## 
## Cohen's d
## 
## d estimate: 0.08907251 (negligible)
## 95 percent confidence interval:
##       lower       upper 
## 0.009960997 0.168184021

cohen.d(fouls1819post$pfR, fouls1819post$pfH)
## 
## Cohen's d
## 
## d estimate: 0.158254 (negligible)
## 95 percent confidence interval:
##      lower      upper 
## -0.1506272  0.4671351

两个测试都返回了相同的结果；无论是否存在均值上的统计显著性差异，Cohen’s d 测试告诉我们，客场与主场球队、常规赛与季后赛之间的个人犯规方差是微不足道的。这是因为 d 估计值，它代表了均值之间标准差的数目，对于两个测试来说都是如此微不足道。在我们的两个测试中，第一个测试中，对客场球队判定的个人犯规比主场球队多 0.09 个标准差（0.09 等于 d 估计值）；在第二个测试中，对客场球队的犯规比主场球队多 0.16 个标准差。如果 d 估计值为负，这仅仅意味着传递给cohen.d()函数的第二组具有两个标准差中的较高值。为了使效果量被标记为小，d 估计值需要至少等于 0.20，正负；相比之下，为了使效果量获得大的定性评价，d 估计值需要至少等于 0.80，正负。

让我们在尝试的罚球方面做同样的处理：

cohen.d(fouls1819reg$ftaR, fouls1819reg$ftaH)
## 
## Cohen's d
## 
## d estimate: -0.08717524 (negligible)
## 95 percent confidence interval:
##       lower       upper 
## -0.16628510 -0.00806538
cohen.d(fouls1819post$ftaR, fouls1819post$ftaH)
## 
## Cohen's d
## 
## d estimate: -0.1873661 (negligible)
## 95 percent confidence interval:
##      lower      upper 
## -0.4964408  0.1217086

根据我们进行的第二轮 Cohen’s d 测试，尝试的罚球之间的实际差异——客场与主场的球队，常规赛与季后赛，之前是否有统计显著性——在两种情况下都是微不足道的。然而，至少再强调一次，但稍微有所不同，我们不应该因为后续的 Cohen’s d 测试返回了可忽略的效果量就对我们的 t 测试结果泼冷水，这些 t 测试结果显示了统计显著性。一方面，人们会考虑记录数，另一方面则不会。当记录数较少时，两个样本或两个群体之间的均值差异应该不那么重要，而当我们有更多数据时，这种差异应该更加重要。

7.5 对 2019-20 数据的分析

这就是我们对 2018-19 数据集的分析。但你可能还记得我们导入了两个赛季的数据——所以现在是时候探索 2019-20 NBA 赛季了。

7.5.1 2019-20 常规赛分析（疫情前）

我们将使用相同的衡量标准和统计测试，但我们的 2019-20 分析将仅限于常规赛比赛，包括疫情前后。在疫情之前，2019-20 NBA 常规赛的进行方式与任何之前的赛季一样。COVID 突然暂停了所有比赛，一旦赛季恢复，剩余的所有比赛都在奥兰多的中立场地进行，没有球迷在场。因此，我们不会再次测试常规赛和季后赛，而是测试疫情前后的常规赛。我们之前用于整理 2018-19 数据的步骤在下面的代码块中得到了复制，并应用于 2019-20 赛季。

我们首先通过调用filter()函数，创建一个新的数据集 df5，它等于 df2，其中变量VENUE等于R，代表客队：

df2 %>%
  filter(VENUE == "R") -> df5

然后我们调用select()函数来减少 df5 数据集的宽度。注意我们保留了一个额外的变量GAME_ID，我们之前从 2018-19 数据中丢弃了它：

df5 %>%
  select(DATASET, GAME_ID, TEAM, VENUE, FT, FTA, PF) -> df5

在准备进一步的数据整理操作之前，我们调用rename()函数来重命名 df5 变量，有时在末尾附加一个大写 R，以便稍后区分客队和主队的相同衡量标准：

df5 %>% 
  rename(dataset = DATASET, gameID = GAME_ID, teamR = TEAM, venueR = VENUE, 
         ftR = FT, ftaR = FTA, pfR = PF) -> df5

通过连续调用基础 R 的as.factor()函数，将变量dataset、teamR和venueR转换为因子变量：

df5$dataset <- as.factor(df5$dataset)
df5$teamR <- as.factor(df5$teamR)
df5$venueR <- as.factor(df5$venueR)

现在我们调用这些相同的函数来创建一个名为 df6 的数据集，它基本上是 df5 的主队版本：

df2 %>%
  filter(VENUE == "H") -> df6

df6 %>%
  select(TEAM, VENUE, FT, FTA, PF) -> df6

df6 %>% 
  rename(teamH = TEAM, venueH = VENUE, ftH = FT, ftaH = FTA,
               pfH = PF) -> df6
df6$teamH <- as.factor(df6$teamH)
df6$venueH <- as.factor(df6$venueH)

接下来，我们通过调用基础 R 的cbind()函数将 df5 和 df6 数据集连接起来：

fouls1920 <- cbind(df5, df6)
dim(df5) 
## [1] 1143    7
dim(df6) 
## [1] 1143    5
dim(fouls1920) 
## [1] 1143   12

根据dim()函数的返回值，df5 包含 1,143 行和 7 列；df6 数据集包含 1,143 行和 5 列；fouls1920，df5 和 df6 的汇总，包含 1,143 行和 12 列。

为了将 fouls1920 数据集子集化，使其仅包括在疫情前进行的比赛，我们调用filter()函数来子集化 fouls1920，其中变量gameID等于或小于21900973。结果是名为 fouls1920a 的新对象。

然后我们通过调用基础 R 的sum()和mean()函数，使用 fouls1920a 作为数据源来计算我们的关键衡量标准的方差：

fouls1920 %>% 
  filter(gameID <= 21900973) -> fouls1920a

sum(fouls1920a$pfR) - sum(fouls1920a$pfH)
## [1] 378
mean(fouls1920a$pfR) - mean(fouls1920a$pfH)
## [1] 0.3892894
mean(fouls1920a$ftaR) - mean(fouls1920a$ftaH) 
## [1] -0.5983522
sum(fouls1920a$ftR) / sum(fouls1920a$ftaR) 
## [1] 0.7707593
sum(fouls1920a$ftH) / sum(fouls1920a$ftaH) 
## [1] 0.7712117

我们的结果如下：

• 客队被吹罚的个人犯规比主队多 378 次，等于 20,171 次犯规和 19,793 次犯规之间的差异。

• 因此，客队每场比赛被吹罚的个人犯规比主队多 0.39 次（2018-19 常规赛的每场比赛平均值为 0.38）。

• 主队每场比赛尝试的罚球比客队多 0.60 次（前一个常规赛的每场比赛平均值为 0.65）。

• 路线和主队成功率为 77%的罚球尝试。

t 检验：个人犯规

现在我们再进行另一个 t 检验，这次是为了确定 2019-20 赛季常规赛（在 COVID-19 之前）中，路线和主队在个人犯规判罚上的方差是否有统计学意义：

t.test(fouls1920a$pfR, fouls1920a$pfH)
## 
##  Welch Two Sample t-test
## 
## data:  fouls1920a$pfR and fouls1920a$pfH
## t = 1.9686, df = 1937.3, p-value = 0.04914
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.001474823 0.777103962
## sample estimates:
## mean of x mean of y 
##  20.77343  20.38414

如果使用 0.05 作为分界线的 p 值，结果几乎不显著。话虽如此，我们仍然应该拒绝总体均值相等的零假设。

t 检验：罚球尝试

让我们再进行另一个 t 检验，这次比较路线和主队在罚球尝试上的差异：

t.test(fouls1920a$ftaR, fouls1920a$ftaH)
## 
##  Welch Two Sample t-test
## 
## data:  fouls1920a$ftaR and fouls1920a$ftaH
## t = -1.8004, df = 1936.4, p-value = 0.07196
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -1.25014956  0.05344513
## sample estimates:
## mean of x mean of y 
##  22.59732  23.19567

这次，我们的结果几乎不显著；因此，我们必须拒绝零假设，并接受总体均值基本上是相等的——再次，因为我们使用 5%作为预定义的截止点。但除此之外，我们的结果表明，如果零假设实际上是真的，观察到至少相等结果的可能性仅为 7%。因此，虽然方差在技术上并不显著，但 p 值很低，显然非常接近我们预定义的显著性阈值。

可视化方差

我们将结果可视化和打包，就像我们处理 2018-19 年的数据那样（见图 7.3）：

temp5 <- select(fouls1920a, c(7,12)) 
temp5 %>%
  pivot_longer(cols = c(pfR, pfH),
               names_to = "team",
               values_to = "fouls") -> temp5
head(temp5)
##   team fouls
## 1  pfR    34
## 2  pfH    24
## 3  pfR    24
## 4  pfH    25
## 5  pfR    20
## 6  pfH    18

temp5.text <- c("Home Team", "Road Team")
p5 <- ggplot(temp5, aes(x = team, y = fouls, fill = team)) +
  geom_boxplot() +
  labs(title = "Personal Foul Calls: Home vs. Road Teams", 
       subtitle = "2019-20 Regular Season (pre-COVID)",
       x = "", 
       y = "Personal Fouls per Game") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(legend.position = "none") +
  scale_x_discrete(labels = temp1.text) +
  theme(plot.title = element_text(face = "bold")) +
  stat_compare_means(method = "t.test", label.x = 1.4, label.y = 43)

temp6 <- select(fouls1920a, c(6,11)) 
temp6 %>%
  pivot_longer(cols = c(ftaR, ftaH),
               names_to = "team",
               values_to = "ftattempts") -> temp6
head(temp6)
##   team ftattempts
## 1 ftaR         20
## 2 ftaH         38
## 3 ftaR         21
## 4 ftaH         24
## 5 ftaR         22
## 6 ftaH         16

temp6.text <- c("Home Team", "Road Team")
p6 <- ggplot(temp6, aes(x = team, y = ftattempts, fill = team)) + 
  geom_boxplot() +
  labs(title = "Free Throw Attempts: Home vs. Road Teams", 
       subtitle = "2019-20 Regular Season (pre-COVID)",
       x = "", 
       y = "Free Throw Attempts per Game") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(legend.position = "none") +
  scale_x_discrete(labels = temp1.text) +
  theme(plot.title = element_text(face = "bold")) +
  stat_compare_means(method = "t.test", label.x = 1.4, label.y = 48)

p5 + p6 + plot_layout(ncol = 2)

图 7.3 这组成对箱线图代表了在 COVID-19 暂时暂停比赛之前 2019-20 赛季常规赛的结果。

与 2018-19 年的数据相比，这两对箱线图的长度或分散度似乎没有太大差异，无论是常规赛还是季后赛。尽管如此，我们可以清楚地看到，总体均值并不完全一致。

在下一节中，我们将通过检查和测试 2019-20 赛季剩余的常规赛来比较和对比这些结果。

7.5.2 2019-20 赛季常规赛分析（COVID-19 之后）

现在我们来检查 2019-20 赛季剩余的常规赛，其中每场比赛都在没有观众的情况下在奥兰多进行。我们需要一个数据集，所以我们调用filter()函数，对 fouls1920 进行子集处理，其中变量dataset等于NBA 2019 -2020 Regular Season 和 变量gameID大于21901231，以得到一个新的对象 fouls1920b。然后，我们运行这些数字：

fouls1920 %>% 
  filter(dataset == "NBA 2019-2020 Regular Season" & 
           gameID >= 21901231) -> fouls1920b

sum(fouls1920b$pfR) - sum(fouls1920b$pfH)  
## [1] 54
mean(fouls1920b$pfR) - mean(fouls1920b$pfH) 
## [1] 0.6067416
mean(fouls1920b$ftaR) - mean(fouls1920b$ftaH) 
## [1] -0.2359551
sum(fouls1920b$ftR) / sum(fouls1920b$ftaR) 
## [1] 0.7927369
sum(fouls1920b$ftH) / sum(fouls1920b$ftaH) 
## [1] 0.7915753

我们得到以下结果：

• 路线队——尽管奥兰多在技术上是一个中立场地，但球队仍然被指定为路线和主队，NBA 用主队的标志和颜色装饰了场地——被吹罚了 54 次更多的个人犯规，比主队多。在 89 场比赛的赛程中，大约相当于典型的季后赛，指定的路线队犯了 2,064 次个人犯规，而指定的主队犯了 2,010 次个人犯规。这等于每场比赛的方差为 0.61，这比我们观察到的其他情况略高。

• 然而，这种差异并没有完全转化为罚球尝试次数。主队平均每场比赛比客队多尝试 0.24 次罚球，这可能表明大量的个人犯规判罚是进攻犯规或球权犯规，在这些情况下不会判罚罚球。

• 路队和主队在尝试的罚球中成功率达到大约 79%。

t 测试：个人犯规和罚球尝试

让我们看看这些原始数据如何转化为对统计显著性的测试：

t.test(fouls1920b$pfR, fouls1920b$pfH)
## 
##  Welch Two Sample t-test
## 
## data:  fouls1920b$pfR and fouls1920b$pfH
## t = 0.93709, df = 173.63, p-value = 0.35
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.6711954  1.8846785
## sample estimates:
## mean of x mean of y 
##  23.19101  22.58427

t.test(fouls1920b$ftaR, fouls1920b$ftaH)
## 
##  Welch Two Sample t-test
## 
## data:  fouls1920b$ftaR and fouls1920b$ftaH
## t = -0.20855, df = 175.79, p-value = 0.835
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -2.468889  1.996979
## sample estimates:
## mean of x mean of y 
##  25.37079  25.60674

第一点，尽管客队每场比赛被吹罚的个人犯规比主队多 0.61 次，但这在我们的第一个 t 测试中并没有显现出来。尽管我们的数据集只有 89 行长，但计算出的 p 值等于 0.35，远高于显著性阈值 0.05，因此我们不得不拒绝零假设，并得出这些均值基本上是相等的结论。

第二点，鉴于客队和主队每场比赛尝试的罚球次数差异很小，以及我们的数据中的记录计数很小，我们的第二个 t 测试返回了一个非常高的 p 值（0.84）。因此，结果基本上是中立的。然而，这两个结果的方向性与我们之前的结果一致。

可视化方差

如前所述，我们使用配对箱线图来可视化我们的结果，这些箱线图被组合成一个单一的图形表示（见图 7.4）：

temp7 <- select(fouls1920b, c(7,12)) 
temp7 %>%
  pivot_longer(cols = c(pfR, pfH),
               names_to = "team",
               values_to = "fouls") -> temp7
head(temp7)
##   team fouls
## 1  pfR    23
## 2  pfH    25
## 3  pfR    30
## 4  pfH    27
## 5  pfR    23
## 6  pfH    25

temp7.text <- c("Home Team", "Road Team")
p7 <- ggplot(temp7, aes(x = team, y = fouls, fill = team)) + 
  geom_boxplot() +
  labs(title = "Personal Foul Calls: Home vs. Road Teams",
       subtitle = "2019-20 Regular Season (post-COVID)", 
       x = "", 
       y = "Personal Fouls per Game") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(legend.position = "none") +
  scale_x_discrete(labels = temp1.text) +
  theme(plot.title = element_text(face = "bold")) +
  stat_compare_means(method = "t.test", label.x = 1.4, label.y = 38)

temp8 <- select(fouls1920b, c(6,11)) 
temp8 %>%
  pivot_longer(cols = c(ftaR, ftaH),
               names_to = "team",
               values_to = "ftattempts") -> temp8
head(temp8)
##   team ftattempts
## 1 ftaR         28
## 2 ftaH         18
## 3 ftaR         28
## 4 ftaH         37
## 5 ftaR         28
## 6 ftaH         23

temp8.text <- c("Home Team", "Road Team")
p8 <- ggplot(temp8, aes(x = team, y = ftattempts, fill = team)) + 
  geom_boxplot() +
  labs(title = "Free Throw Attempts: Home vs. Road Teams",
       subtitle = "2019-20 Regular Season (post-COVID)", 
       x = "", 
       y = "Free Throw Attempts per Game") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(legend.position = "none") +
  scale_x_discrete(labels = temp1.text) +
  theme(plot.title = element_text(face = "bold")) +
  stat_compare_means(method = "t.test", label.x = 1.4, label.y = 43)

p7 + p8 + plot_layout(ncol = 2)

图 7.4 这两组配对箱线图显示了我们所见到的最不显著的统计结果。

我们 2019-20 赛季的发现与 2018-19 赛季的发现相似，如下所示：

• 无论从哪个角度来看，COVID 前后结果的方向性都一致，有利于主队。

• 在 COVID 之前，方差在统计学上是显著的，而在 COVID 之后则不是，这并不是因为方差发生了变化，更多的是因为记录计数的不一致。

我们将通过进行一系列 Cohen’s d 测试来结束 2019-20 赛季的常规赛季分析。

7.5.3 更多的效应量测试

由于 2018-19 赛季的常规赛季和 2019 赛季季后赛的效应量测试结果，以及 2019-20 赛季常规赛前后个人犯规和罚球尝试的计算，我们对 2019-20 赛季的数据进行的 Cohen’s d 测试可能是可预测的。我们将从我们的前 COVID 数据集开始：

cohen.d(fouls1920a$pfR, fouls1920a$pfH)
## 
## Cohen's d
## 
## d estimate: 0.08934564 (negligible)
## 95 percent confidence interval:
##        lower        upper 
## 0.0002941679 0.1783971024

cohen.d(fouls1920a$ftaR, fouls1920a$ftaH)
## 
## Cohen's d
## 
## d estimate: -0.08934564 (negligible)
## 95 percent confidence interval:
##        lower       upper 
## -0.170753099 0.007335309

毫不奇怪，根据我们的 Cohen’s d 测试，在 COVID 大流行之前进行的所有 2019-20 赛季常规赛中，客队和主队在个人犯规和罚球尝试方面的差异被评为可忽略不计。再次强调，这是因为标准差几乎相同。

让我们用我们的后 COVID 数据集进行相同的测试：

cohen.d(fouls1920b$pfR, fouls1920b$pfH)
## 
## Cohen's d
## 
## d estimate: 0.1404753 (negligible)
## 95 percent confidence interval:
##      lower      upper 
## -0.1557346  0.4366853

cohen.d(fouls1920b$ftaR, fouls1920b$ftaH)
## 
## Cohen's d
## 
## d estimate: -0.03126236 (negligible)
## 95 percent confidence interval:
##       lower     upper 
## -0.3271257  0.2646010

定量结果——即 d 估计值——高于我们的前 COVID 结果，但不足以将定性排名从可忽略不计提升。

在下一章中，我们将检查由球员控制的比赛方面，而不是由官员控制：何时投篮。

摘要

• 准确比较两组的平均值可能具有重大影响。测试一对竞争性药物的制药公司可能会推广一种更昂贵的替代品，而实际上它并没有优于一种更便宜但其他方面相似的药物；一所大学可能会要求每个商业分析 101 课程的学生亲自上课，从而限制招生，尽管与其他仅在线上课的学生相比，考试分数的方差实际上并不具有统计学意义；一家银行的分行经理可能会被降职甚至被解雇，尽管该分行的客户服务评分较低，而参与度平平。

• 我们 R 代码可以完全转移到这些和其他 t 检验用例中。

• 我们进行了 t 检验来确定方差是否具有统计学意义，然后进行了 Cohen’s d 检验来测量这些相同方差的规模。再次强调，选择运行多个测试以获得完整和彻底的阅读。

• 所有结果——2018-19 赛季和季后赛以及 2019-20 赛季前和 COVID 后的个人犯规和尝试罚球——都显示有利于主队的方向性结果。

• 在我们记录数相对较大的地方——即 2018-19 赛季和 COVID 之前的 2019-20 赛季——根据我们的 t 检验，个人犯规和尝试罚球在客场和主队之间的方差在统计上是显著的。

• 相反，在我们记录数较低的地方——2019 年季后赛和 2019-20 赛季在奥兰多举行的比赛——根据 5%的阈值，客场和主队在个人犯规和尝试罚球方面的方差在统计上并不显著。

• 我们的 Cohen’s d 检验，它忽略了记录数，而是使用平均值和标准差，每次都返回相同的结果：客场和主队之间的个人犯规和罚球尝试的差异始终被评定为微不足道。

• 因此，我们可以得出结论，在 2018-19 赛季和 2019-20 赛季期间存在一些裁判偏见，但我们只能推测可能是什么原因导致了这种偏见（观众和其他大气影响？）。

• 此外，我们只能推测这种偏见如何影响了结果。我们的目的不是解释为什么或如何主队有时不公平地赢得比赛；相反，它仅仅解释了，结果证明，主队往往在裁判方面获得轻微但统计上显著的边缘优势。

8 优化停止

本章涵盖

• 最优停止（又称 37%规则）

• 均值回归

• 创建频率表

• 为ggplot2可视化添加主题

• 将图像导入和插入到ggplot2可视化中

• 向数据系列添加多个趋势线

• 从子字符串创建派生变量

有一个流行的算法称为最优停止规则——通常被称为 37%规则，有时也称为观察后跳跃规则——它解决了在何时采取特定行动与继续深思熟虑之间的问题。以下是一个常见的用例：假设你是组织中的一个开放职位的招聘经理，正在面试候选人，你必须在面试每个候选人后立即做出是或否的决定，因为没有第二次机会。根据最优停止规则，你应该自动跳过申请池中前 37%的候选人，然后向第一个评分高于所有之前候选人的面试候选人发出录用通知。

我们在这里的目的就是要探索最优停止规则可能或不可能适用于 NBA 的情况。球队是否应该在分配的控球时间的 37%之前不投篮？然后，一旦他们获得与之前任何机会相等或更好的得分机会，他们是否应该立即尝试投篮？根据规则，球队有 24 秒的时间尝试投篮，没有重置；未能投篮将导致失误，对方球队获得控球权。球队使用所有或部分分配的时间进行传球和运球——相当于面试候选人——期望或希望在他们 24 秒用完之前创造一个高概率的投篮机会。是否存在一个最优的停止点，以秒为单位，来衡量传球和运球与投篮之间的平衡？如果是的话，它是否与 37%的规则一致？这正是我们想要弄清楚的事情。

我们将使用 2019-20 赛季的数据，依次对三支球队进行最优停止规则的测试，然后我们将对整个联赛进行相同的测试。在这个过程中，我们将展示一系列新的可视化和数据处理技术。

8.1 加载包

我们将使用基本的 R 功能以及熟悉和不那么熟悉的包的组合；这里介绍了一些之前未使用的包，包括stringr、janitor和png：

• stringr包实际上是tidyverse包宇宙的一部分，因此当我们加载tidyverse时，它会默认加载；stringr使得操作字符字符串变得容易。

• janitor包包含用于检查和清理脏数据的几个函数。

• png包包含用于读取、写入和显示便携式网络图形（PNG）图像的函数。

我们首先通过调用四次基本的 R library() 函数来依次加载所需的包：

library(tidyverse)
library(janitor)
library(patchwork)
library(png)

我们首先将对这些包中的最后一个进行操作。

8.2 导入图像

以.png 扩展名保存并存储在我们默认工作目录中的图像，导入方式与导入.csv 文件类似——我们只需从png包中调用readPNG()函数，并在一对单引号或双引号之间添加文件路径。当插入到任何图表或图中时，图像不仅增强了其美学，还提供了关于范围或内容的即时清晰度。例如，在图表中出现密尔沃基雄鹿队的标志，可以立即清楚地表明我们正在可视化密尔沃基雄鹿队的结果。

在下面的代码块中，我们四次调用readPNG()函数，依次导入从互联网下载的四个 NBA 标志，保存为.png 文件，然后拖放到我们的默认工作目录中。（可能有数十个，甚至数百个网站可以下载这些和其他 NBA 图像。）因为这些是光栅（或位图）图像，所以原生的参数设置为TRUE：

bucks <- readPNG("bucks.png", native = TRUE)

hawks <- readPNG("hawks.png", native = TRUE)

hornets <- readPNG("hornets.png", native = TRUE)

nba <- readPNG("nba.png", native = TRUE)

一旦我们着手创建一系列ggplot2折线图，我们将插入这些图像作为增强我们视觉内容的一种方式。在此期间，我们将继续导入和查看我们的数据集。

8.3 导入和查看数据

我们通过调用readr的read_csv()函数导入数据，并在过程中创建了一个名为 pbp（意为比赛过程）的对象。我们的数据是从网站www.bigdataball.com下载的，随后保存在我们的默认工作目录中，文件名为 pbp.csv。

我们的数据集包含了 2019-20 NBA 赛季每场常规赛和季后赛的几乎所有比赛。我们数据中包含和不包含的比赛类型将在稍后探讨。现在，我们只想从宏观层面了解我们数据的大小和范围；dplyr包中的glimpse()函数返回 pbp 的维度和内容的转置快照——它有 543,149 行长和 44 列宽。如果你在个人电脑上工作而不是服务器上，加载数据可能需要几秒钟：

pbp <- read_csv("pbp.csv")

glimpse(pbp) 
## Rows: 543,149
## Columns: 44
## $ game_id        <chr> "0021900001", "0021900001", "0021900001", ...
## $ data_set       <chr> "2019-2020 Regular Season", "2019-2020 Reg...
## $ date           <date> 2019-10-22, 2019-10-22, 2019-10-22, 2019-...
## $ a1             <chr> "Jrue Holiday", "Jrue Holiday", "Jrue Holi...
## $ a2             <chr> "Brandon Ingram", "Brandon Ingram", "Brand...
## $ a3             <chr> "Derrick Favors", "Derrick Favors", "Derri...
## $ a4             <chr> "JJ Redick", "JJ Redick", "JJ Redick", "JJ...
## $ a5             <chr> "Lonzo Ball", "Lonzo Ball", "Lonzo Ball", ...
## $ h1             <chr> "OG Anunoby", "OG Anunoby", "OG Anunoby", ...
## $ h2             <chr> "Pascal Siakam", "Pascal Siakam", "Pascal ...
## $ h3             <chr> "Marc Gasol", "Marc Gasol", "Marc Gasol", ...
## $ h4             <chr> "Kyle Lowry", "Kyle Lowry", "Kyle Lowry", ...
## $ h5             <chr> "Fred VanVleet", "Fred VanVleet", "Fred Va...
## $ period         <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ...
## $ away_score     <dbl> 0, 0, 0, 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, ...
## $ home_score     <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...
## $ remaining_time <time> 00:12:00, 00:12:00, 00:11:48, 00:11:47, 0...
## $ elapsed        <time> 00:00:00, 00:00:00, 00:00:12, 00:00:13, 0...
## $ play_length    <chr> "0:00:00", "0:00:00", "0:00:12", "0:00:01"...
## $ play_id        <dbl> 2, 4, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,...
## $ team           <chr> NA, "NOP", "NOP", "NOP", "NOP", "TOR", "NO...
## $ event_type     <chr> "start of period", "jump ball", "miss", "r...
## $ assist         <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ away           <chr> NA, "Derrick Favors", NA, NA, NA, NA, NA, ...
## $ home           <chr> NA, "Marc Gasol", NA, NA, NA, NA, NA, NA, ...
## $ block          <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ entered        <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ left           <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ num            <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ opponent       <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ outof          <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ player         <chr> NA, "Marc Gasol", "Lonzo Ball", "Derrick F...
## $ points         <dbl> NA, NA, 0, NA, 2, 0, NA, 0, NA, 0, NA, 0, ...
## $ possession     <chr> NA, "Lonzo Ball", NA, NA, NA, NA, NA, NA, ...
## $ reason         <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ result         <chr> NA, NA, "missed", NA, "made", "missed", NA...
## $ steal          <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA...
## $ type           <chr> "start of period", "jump ball", "unknown",...
## $ shot_distance  <dbl> NA, NA, 11, NA, 1, 3, NA, 8, NA, 25, NA, 1...
## $ original_x     <dbl> NA, NA, 2, NA, 0, 15, NA, 81, NA, 178, NA,...
## $ original_y     <dbl> NA, NA, 114, NA, -6, 28, NA, -1, NA, 176, ...
## $ converted_x    <dbl> NA, NA, 24.8, NA, 25.0, 26.5, NA, 16.9, NA...
## $ converted_y    <dbl> NA, NA, 16.4, NA, 4.4, 86.2, NA, 4.9, NA, ...
## $ description    <chr> NA, "Jump Ball Gasol vs. Favors: Tip to Ba...

在我们能够正确分析刚刚加载的数据之前，我们首先需要进一步探索和整理它。

8.4 探索和整理数据

我们首先通过调用内置的as.factor()函数将变量data_set从字符字符串转换为因子：

pbp$data_set <- as.factor(pbp$data_set)

通过这样做，我们就可以调用基础 R 的levels()函数，该函数返回与变量data_set相关的三个因子水平。如果我们没有将data_set保持为字符字符串，而是将其转换为因子，然后调用levels()函数，R 将返回NULL：

levels(pbp$data_set)
## [1] "2019-20 Playoffs"         "2019-20 Regular Season"  
## [3] "2019-2020 Regular Season"

看起来，那些与常规赛比赛相关的观测值，由于某种原因，被分成了两个因子水平，即 2019-20 常规赛和 2019-2020 常规赛，而季后赛比赛则由 2019-20 季后赛因子水平指定。

我们的意图是将我们的分析限制在常规赛比赛上，而不是混合常规赛和季后赛结果；每个 NBA 球队都有一份固定的常规赛赛程，但只有一些球队有资格参加季后赛。因此，我们将 pbp 数据集通过dplyr filter()函数进行管道处理，以子集 pbp，其中变量data_set不等于2019-20 Playoffs（!=运算符表示不等于）。

我们随后从基础 R 中调用dim()函数来检查 pbp 数据集的新维度：

pbp %>% 
  filter(data_set != "2019-20 Playoffs") -> pbp
dim(pbp) 
## [1] 504445     44

通过过滤掉季后赛比赛并保留 2019-20 常规赛的每一场比赛，pbp 因此减少到 504,445 行。

变量play_length有点更具挑战性。它现在是一个以小时:分钟:秒格式表示的字符串（这对我们不起作用），我们需要一个只以秒为单位的数值变量。因此，我们调用dplyr包中的mutate()函数和stringr包中的str_sub()函数来创建一个新变量play_length2，它将只以秒为单位。str_sub()函数需要以下三个输入：

• 需要操作的字符串，即原始变量play_length。

• 应从变量play_length中提取并移植到派生变量play_length2的第一个字符。因为play_length2将只以秒为单位，所以我们感兴趣的是提取并移植play_length的最后两个字符，它再次是以小时:分钟:秒的格式。因此，第二个输入是-2，它是play_length中的倒数第二个字符。

• 应从play_length中提取并移植到最后一个字符到play_length2，即字符串中的最后一个字符。因此，第三个输入是-1。

我们的新变量随后通过调用基础 R 的as.numeric()函数转换为数值类型：

pbp %>%
  mutate(play_length2 = str_sub(play_length, -2, -1)) -> pbp
pbp$play_length2 <- as.numeric(pbp$play_length2)

要比较和对比变量play_length和play_length2，我们两次调用基础 R 的head()函数，以返回每个变量在 pbp 数据集中的前六个值。通常，当我们调用head()函数，甚至tail()函数时，我们指示 R 返回我们需要查看的顶部或底部观察值中的每个变量；这里，通过插入$运算符，我们告诉 R 只返回play_length和play_length2，忽略其他 pbp 变量：

head(pbp$play_length)
## [1] "00:00:00" "00:00:00" "00:00:12" "00:00:01" "00:00:00" "00:00:18"
head(pbp$play_length2)
## [1]  0  0 12  1  0 18

因此，通过调用str_sub()函数，我们成功创建了一个新变量，例如，00:00:12 被转换为 12 秒，00:00:18 被转换为 18 秒。

现在我们来探索变量event_type，它也是一个字符串。我们将其转换为因子变量，然后调用levels()函数以返回因子水平：

pbp$event_type <- as.factor(pbp$event_type)
levels(pbp$event_type)
##  [1] "ejection"        "end of period"   "foul"            "free throw"     
##  [5] "jump ball"       "miss"            "rebound"         "shot"           
##  [9] "start of period" "sub"             "timeout"         "turnover"       
## [13] "unknown"         "violation"

结果表明，pbp 数据集包含 14 种事件类型，包括未知类型。我们最终将只处理以下 13 种事件类型的小子集：

• ejection——一名球员被一名裁判永久驱逐出场比赛，通常是在被判定第二次技术犯规后。技术犯规是在特别暴力或球员与裁判争论之后对个人犯规的追加。

• end of period——时间已到，因此结束了一个时段或一个季度。

• foul——被判个人犯规。

• free throw——尝试罚球，可能命中（成功投篮）或未命中。罚球不同于投篮或投篮。当球员尝试罚球时，比赛计时器和投篮计时器都不会运行。

• jump ball——在两名对方球员拥有相等球权后发生。裁判吹哨，从而停止比赛。然后两名球员跳起争夺球权。

• miss——投篮未命中，或未成功。

• rebound——在投篮不中后立即进行的进攻或防守篮板。

• shot——投篮尝试成功。

• start of period——一个新的时段或一个季度开始，包括任何加时赛，这些加时赛在比赛平局后进行。

• sub——一方或双方球队正在替换一名或多名球员。替换只能在比赛计时器停止时进行。

• timeout——比赛暂停，通常由一方球队请求。当叫暂停时，比赛计时器停止，直到比赛恢复时才继续。

• turnover——持球方犯了一些粗心大意的失误，导致对方球队获得球权。

• violation——一方球队，通常是持球方，犯了一些违规行为，如越位、两次运球或关键区三秒违例，这导致球权改变。

在下面的 dplyr 代码块中，我们调用 group_by() 和 tally() 函数，以 tibble 形式返回 pbp 数据集中每种事件类型的计数，称为 tbl1：

pbp %>%
  group_by(event_type) %>%
  tally() -> tbl1
print(tbl1)
## # A tibble: 15 × 2
##    event_type             n
##    <fct>              <int>
##  1 ejection            39
##  2 end of period     4315
##  3 foul             45295
##  4 free throw       49006
##  5 jump ball         1856
##  6 miss            101684
##  7 rebound         112803
##  8 shot             86633
##  9 start of period   4315
## 10 sub              51838
## 11 timeout          11911
## 12 turnover         30707
## 13 unknown           1306
## 14 violation         1947
## 15 <NA>               790

以下是一些观察和解释：

• 投篮犯规很少见。一旦球员犯了第六次个人犯规，就会被永久罚下场，但这是一种取消资格，而不是被驱逐出场。

• 结束时段和开始时段的事件数量相等，这是完全合理的。

• 个人犯规通常立即导致一次或两次罚球尝试，但有时根本不会导致罚球尝试。无法从另一个计数中轻松推导出一个计数的数量。

• 大约有 15,000 次事件是球员投篮未命中，而不是投篮命中，这意味着未命中的投篮比命中的投篮多。

• 反弹通常发生在大多数投篮不中和罚球不中之后，但并非所有。

• 同队球员之间的传球可能是最明显的一——当然是最频繁的一——事件类型，但我们的数据集中没有记录。

• 注意，我们的数据集中有 790 个观测值，其中没有定义事件类型；我们对levels()函数的调用未能检测到这些。否则，这些数字完全合理——只是少数投篮，比投篮次数多，例如，这当然表明我们正在处理一个整体上可靠的数据集。

我们接下来的操作是将变量team转换为因子。然后我们可以再次调用levels()函数来返回因子水平，但我们将调用基本的 R summary()函数，它返回因子水平和每个的记录计数。因此，summary()函数返回了变量team的因子水平和计数，而之前我们调用levels()函数，然后编写一小段dplyr代码来返回与变量event_type相同的相同结果：

pbp$team <- as.factor(pbp$team)
summ ary(pbp$team) 
##   ATL   BKN   BOS   CHA   CHI   CLE   DAL   DEN   DET   GSW   HOU   IND 
## 15643 16578 16302 14012 14263 13986 16943 15999 14150 14337 16290 15477 
##   LAC   LAL   MEM   MIA   MIL   MIN   NOP   NYK   OKC   ORL   PHI   PHX 
## 16701 15996 17066 16013 17691 14847 16368 14940 15890 15877 16346 16333 
##   POR   SAC   SAS   TOR   UTA   WAS  NA's 
## 16601 15761 15812 15845 15931 16101 30346

NBA 是一个 30 支球队的联赛，但变量team包含 31 个水平，这是由于 R 返回的 30,346 个空白值作为 NAs。

最后，我们再次调用summary()函数来返回变量points的一系列基本统计数据：

summary(pbp$points)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##       0       0       1       1       2       3  267122

尽管我们的数据集可能并不完美，但结果仍然与我们的预期一致：

• 大多数事件类型中不可能得分，所以我们有 267,122 个 NAs。

• 失误和罚球失误得零分。

• 成功的罚球得一分。

• 成功的投篮得两分或三分，具体取决于投篮距离篮筐的远近。

现在我们已经探索并整理了我们的数据，是时候开始分析它了。

8.5 分析

再次强调，我们在这里的目的是确定最优停止算法在 NBA 中的应用效果。换句话说，我们想确定 NBA 球队是否应该自动放弃射击一些有限秒数，然后抓住第一个等于或优于任何先前射击机会的射击；如果是的话，我们还想进一步确定 37%规则是否适用。一如既往，我们必须小心不要得出任何过于宽泛的结论。因为接下来的分析只使用了我们已导入并随后整理的数据，因此我们的结论仅适用于 2019-20 赛季常规赛。

我们的分析分为两部分。我们将首先隔离三支在 2019-20 赛季每场比赛得分平均值差异很大的球队，按 1 秒的增量总结和可视化他们的得分和投篮百分比，然后基于 R 返回的结果得出一些更广泛的结论。之后，我们将对整个 NBA 进行同样的分析，将联盟的 30 支球队打包成一个单一的数据系列。让我们从密尔沃基雄鹿队开始，他们在 2019-20 赛季常规赛中平均每场得分 118.7 分，领跑 NBA。

8.5.1 密尔沃基雄鹿队

我们的首要任务是创建一个从 pbp 数据集中提取的密尔沃基雄鹿队数据集。我们将首先调用 dplyr filter() 函数来通过仅保留满足一系列特定标准的观测值来减少 pbp 的长度：

1. 当变量 team 等于 MIL，即密尔沃基雄鹿队

2. 当我们派生的变量 play_length2 等于或大于 5 且小于或等于 24

3. 当变量 event_type 等于 shot 或 miss

这里需要一些解释。我们的兴趣在于半场控球，球队可以选择通过运球和传球来犹豫，或者可以选择通过投篮来采取行动。控球时间少于 5 秒的投篮通常是对站位不当的防守的快速反击机会，是进攻篮板后靠近篮筐的轻松得分，或者是在比赛时间即将用尽时的绝望努力。在这三种情况下，投篮是唯一合理的行动。因此，持续时间少于 5 秒的控球时间将被忽略，全部删除。因此，设定一个截止点绝对是必要的；5 秒虽然有些武断，但确实代表了大多数快速反击的大致持续时间。不幸的是，我们的数据集没有包含一个事件类型来指示控球球队何时穿过中场并建立半场阵容。

此外，NBA 采用 24 秒的投篮计时器，这意味着球队必须在获得球权后的 24 秒内尝试投篮，否则将球权转给对方球队。投篮计时器通过加快比赛节奏来增加得分，并防止球队使用拖延战术来保护领先（以及避免让观众感到无聊）。由于某些原因——可能是由于缺少事件类型——pbp 数据集中包含一些变量 play_length2 大于 24 秒的观测值。因此，只删除这些少数记录是有意义的。

最后，我们只对投篮或未投篮的回合感兴趣。因为我们不感兴趣于驱逐、篮板、犯规和其他事件类型，所以也删除这些记录是有意义的。

创建数据源

最终结果是称为 MIL 的新对象。关于我们的 dplyr 代码和特别是我们传递给 filter() 函数的逻辑的一个注意事项：像其他编程语言一样，R 要求在设置唯一选择标准时明确调用变量名。例如，如果我们告诉 R play_length2 必须等于或大于 5 秒且小于或等于 24 秒，而不是告诉 R play_length2 必须等于或大于 5 秒，并且 play_length2 也应该等于或小于 24 秒，R 就会不知道哪个 pbp 变量应该等于或小于 24；然后它会抛出一个错误。

然后我们调用 dim() 函数来返回 MIL 行和列的数量：

pbp %>% 
  filter(team == "MIL",
         play_length2 >= 5 & play_length2 <= 24,
         event_type == "shot" | event_type == "miss") -> MIL
dim(MIL)
## [1] 5436   45

MIL 包含 5,436 行和 45 列。我们的分析只需要 event_type、points 和 play_length2 这三个变量；因此，我们通过调用 dplyr select() 函数来裁剪 MIL 的宽度，该函数仅保留这三个变量。

然后，我们再次调用 dim() 函数，只是为了确认 MIL 现在具有 5,436 行和仅三个列的维度。何时以及如何频繁地验证操作和显示相同的结果完全取决于你。我们倾向于安全而不是后悔：

MIL %>%
  select(event_type, points, play_length2) -> MIL
dim(MIL)
## [1] 5436    3

然后，我们将 MIL 数据集通过管道传递到 dplyr group_by() 和 summarize() 函数，以计算雄鹿队在每个 play_length2 值上得分的平均值。我们的结果是名为 MILx 的 20 × 2 tibble，其中 play_length2 是一列（最小值为 5，最大值为 24 秒），而 avg 是另一列，它代表平均或平均得分数：

MIL %>%
  group_by(play_length2) %>%
  summarize(avg = mean(points)) -> MILx
print(MILx)
## # A tibble: 20 × 2
##    play_length2   avg
##           <dbl> <dbl>
##  1            5 1.13 
##  2            6 1.09 
##  3            7 1.15 
##  4            8 1.19 
##  5            9 1.14 
##  6           10 1.04 
##  7           11 1.06 
##  8           12 1.03 
##  9           13 1.08 
## 10           14 1.14 
## 11           15 1.16 
## 12           16 1.04 
## 13           17 1.12 
## 14           18 1.05 
## 15           19 0.948
## 16           20 1.18 
## 17           21 0.925
## 18           22 0.930
## 19           23 1.03 
## 20           24 1.02

我们将暂时将这些结果放在我们的口袋里。

同时，让我们创建第二个数据对象，以获取 play_length2 中每个值的投篮百分比。然后我们将 MIL 传递给 janitor 包中的 tabyl() 函数来创建一个频率表，其中第一个参数是 play_length2，第二个参数是 event_type。R 返回一个频率表，或数据框——称为 MILy，它统计了每个 play_length2 值的每个 event_type 因子的频率。因为我们只对投篮和未命中事件类型感兴趣，所以我们调用 select() 函数将 MILy 简化，仅包括这两个变量，当然还有 play_length2。

最后，我们调用来自 dplyr 包的 mutate() 函数来创建另一个变量，fg_pct，然后将其附加到 MILy 上。我们的新变量通过将变量 shot 除以变量 shot 和 miss 的总和来计算投篮（或射门）百分比；然后将商数乘以 100 以返回一个百分比。我们的导出变量然后四舍五入到小数点后两位：

MIL %>%
  tabyl(play_length2, event_type) -> MILy
MILy %>%
  select(play_length2, shot, miss) %>%
  mutate(fg_pct = shot / (shot + miss)*100) -> MILy
MILy$fg_pct <- round(MILy$fg_pct, digits = 2)
print(MILy)
##  play_length2 shot miss fg_pct
##             5  206  219  48.47
##             6  193  218  46.96
##             7  173  187  48.06
##             8  176  183  49.03
##             9  161  169  48.79
##            10  155  200  43.66
##            11  171  205  45.48
##            12  165  210  44.00
##            13  167  191  46.65
##            14  178  188  48.63
##            15  164  167  49.55
##            16  125  158  44.17
##            17  126  133  48.65
##            18  113  130  46.50
##            19   62   91  40.52
##            20   73   77  48.67
##            21   43   63  40.57
##            22   34   52  39.53
##            23   30   37  44.78
##            24   19   24  44.19

显示结果

现在，我们有两个数据源，MILx 和 MILy，用于两个独立但互补的 ggplot2 线形图。我们两个线形图中的第一个，MILp1，从 tibble MILx 中提取数据，显示了密尔沃基雄鹿队在 2019-20 赛季的每个整秒拥有时间中得分平均数，在 5 到 24 秒之间，其中投篮命中或未命中是结果：

• 因此，play_length2 是我们的 x 轴变量，而 avg，我们使用 dplyr group_by() 和 summarize() 函数的组合创建，是我们的 y 轴变量。

• geom_line() 函数绘制线条，而 geom_point() 函数向线条添加点层。

• 被调用三次的 geom_smooth() 函数在数据上绘制了三条回归线，使我们能够轻松地看到平均得分趋势是如何随着比赛时间的增加而变化的。回归线被绘制出来以最小化它与适用数据点之间的距离。蓝色线表示覆盖整个数据系列的趋势，而金色和紫色线分别显示了 12 秒前后的趋势，或 37% 的标记（12 秒等于 5 秒加 7 秒；7 除以 19 秒等于 37%）。通过传递 se = FALSE 参数，我们指示 R 不要在回归线之上和之下绘制阴影置信区间。

• theme_classic() 函数将 ggplot2 默认的背景替换为纯白色。必须在使用 theme() 函数之前调用 theme_classic() 函数，以保留标题的粗体字体；否则，theme_classic() 函数，它以普通字体渲染标题，将覆盖 theme() 函数的偏好设置。

• inset_element() 函数，实际上是 patchwork 包的一部分，将名为 bucks 的 .png 文件嵌入。左、底、右和顶参数共同决定图像应该放置的位置以及它的大小。因为这些参数等于接近 1 的数字，所以我们的图像将被放置在图表的右上角。你可能想要尝试这些设置。

所有这些都在以下代码块中一起使用：

MILp1 <- ggplot(MILx, aes(x = play_length2, y = avg, group = 1)) +
  geom_line(aes(y = avg), color = "darkgreen", size = 2) +
  geom_point(color = "wheat2", size = 3) +
  labs(title = "Points Scored per Second Increment",
       subtitle = "2019-20 Milwaukee Bucks",
       caption = "regular season only",
       x = "Number of Seconds into Possession",
       y = "Average Number of Points Scored") +
  geom_smooth(method = lm, color = "blue", se = FALSE) +
  geom_smooth(method = lm, color = "gold", 
              data = MILx[MILx$play_length2 < 13,], se = FALSE) +
  geom_smooth(method = lm, color = "purple", 
              data = MILx[MILx$play_length2 > 11,], se = FALSE) +
  theme_classic() +
  theme(plot.title = element_text(face = "bold")) +
  inset_element(bucks, left = 0.80, bottom = 0.80, 
                right = 0.95, top = 0.95) 

我们的第二个折线图 MILp2 从 MILy 中获取，这是通过调用 janitor 包中的 tabyl() 函数之前创建的频率表。play_length2 是我们的 x 轴变量，fg_pct 是我们的 y 轴变量。否则，我们的第二个折线图的语法就像第一个一样，因此返回一个具有与 MILp1 相同的形式、特征和功能的图形对象：

MILp2 <- ggplot(MILy, aes(x = play_length2, y = fg_pct, group = 1)) +
  geom_line(aes(y = fg_pct), color = "darkgreen", size = 2) +
  geom_point(color = "wheat2", size = 3) +
  labs(title = "Field Goal Percentage per Second Increment", 
       subtitle = "2019-20 Milwaukee Bucks",
       caption = "regular season only",
       x = "Number of Seconds into Possession",
       y = "Field Goal Percentage") +
  geom_smooth(method = lm, color = "blue", se = FALSE) +
  geom_smooth(method = lm, color = "gold", 
              data = MILy[MILy$play_length2 < 13,], se = FALSE) +
  geom_smooth(method = lm, color = "purple", 
              data = MILy[MILy$play_length2 > 11,], se = FALSE) +
  theme_classic() +
  theme(plot.title = element_text(face = "bold")) +
  inset_element(bucks, left = 0.80, bottom = 0.80, 
                right = 0.95, top = 0.95) 

然后，我们调用 plot_layout() 函数，该函数来自 patchwork 包，将我们的两个折线图捆绑成一个单一的对象，其中图表并排放置（见图 8.1）。我们的注意力立即被吸引到这样一个事实，即得分和投篮命中率都会随着控球时间的增加而急剧下降，尽管这种关系并不完全是线性的：

MILp1 + MILp2 + plot_layout(ncol = 2)

图 8.1 在 2019-20 赛季每半场控球每秒计算出的密尔沃基雄鹿队平均得分（左侧）和投篮命中率（右侧），并带有趋势线

结论

在总结我们的第一组结果之前，让我们再讨论一下最佳停止策略：首先，最佳停止规则的目的在于规定在采取行动之前应该进行的具体思考量，也就是说，招聘经理在发出录用通知之前应该面试多少个候选人，或者 NBA 球队在尝试投篮之前应该运球和传球多长时间。

第二，当正确应用时，最佳停止策略会带来最大收益并防止无效努力。最大收益可能不等于任何绝对意义上的“巨大”回报，但它确实提供了在几种替代方案中实现最佳回报的最高机会。违反最佳停止规则不会增加最佳结果的机会：招聘经理不会通过违反最佳停止点来增加找到最佳申请人的机会；NBA 球队至少在理论上，不会通过忽视最佳停止点并追求更好的得分机会的虚假希望而射出更多的球。

第三，无论情况如何，招聘经理或 NBA 球队——或任何人——应该跳过而不是继续寻找的点是 37%。计算这个标记的方法有两种。例如，如果n等于 20——申请池中有 20 个候选人或投篮时钟剩余 20 秒——最佳停止点就是 20 乘以 37%，等于 7（四舍五入到最接近的整数）。或者，当n除以数学常数e（约等于 2.72）时，我们也会得到相同的结果。

因此，如果招聘经理有 20 个候选人的申请池，经理应该自动跳过前七个候选人，继续面试，然后在面试第一个与前面七个候选人相比表现良好的候选人后立即停止。同样，NBA 球队应该等到 24 秒的投篮时钟过半，即 12 秒，或 5 加 7 秒，然后才有得分机会，这个机会与任何之前的得分机会一样好或更好时再尝试投篮。

话虽如此，从这两个图表中，我们可以得出一些明显和可能不那么明显的结论，因为这里有很多东西需要解释：

• 趋势线是方向的视觉表示，其中斜率进一步说明了变化的速率。尽管下降趋势几乎不是线性的，但我们的两个 y 轴变量，平均得分和投篮命中率，仍然正强相关——这意味着它们同时向同一方向移动。

• 关于每秒占有时间平均得分的数量，雄鹿队在 x 轴变量等于 8 秒或 20 秒时最成功；当 x 等于 8 时，雄鹿队平均得到 1.19 分，当 x 等于 20 时，平均得到 1.18 分。

• 这是有意义的，因为它意味着雄鹿队在 37%的标记之后从未像之前那样成功得分。换句话说，密尔沃基的最佳停止点实际上是在 37%的标记之前，而不是之后。

• 然而，这些结果并不能转化为投篮命中率。当 x 等于 8 时，雄鹿队的投篮命中率为 49.03%，当 x 等于 15 时为 49.55%。当然，这意味着根据这一衡量标准，至少密尔沃基在 37%的标记之前不投篮是更好的选择。

• 无论如何，当投篮计时器剩余时间更多时，雄鹿队通常在得分和投篮方面表现得更好。我们说“通常”，因为，又一次，这些趋势并不完全是线性的；大多数数据点实际上都远远低于或高于我们的回归线。这表明我们真正看到的是回归到平均值的现象，其中相反的结果相互抵消，而不是最优停止规则的字面意思。

• 为了进一步阐述这一点，让我们更仔细地看看 x 等于 19 到 21 秒的图表——这三个连续的数据点显著且交替地低于或高于回归线。当投篮计时器仅剩 4 秒时（因此 x 等于 20），密尔沃基在得分和投篮方面的成功在很大程度上是对其当 x 等于 19 时的相对不成功的一种抵消，而当 x 等于 21 时，其进一步的不成功则是另一种相反方向的抵消。

• 回归到平均值，有时也称为回归到平均值，是一种现象，其中极端的结果被更温和的结果或同等极端但方向相反的结果所继起，从而相互抵消。我们所看到的是由于偶然性引起的变化，或者至少是只有少数数据点的自然结果。毕竟，当投篮计时器剩余时间不超过 5 秒时，我们的数据包含的记录明显少于其他情况。当我们评估两个更多球队的结果时，我们将看到相同的现象；然而，当我们分析整个 NBA 的单个数据系列时，我们将观察到平滑过的结果。

接下来，我们将看看这些结果能保持多久，或者不能保持多久，我们将使用一对得分较低的球队。

8.5.2 亚特兰大老鹰队

我们首先将用亚特兰大老鹰队代替雄鹿队重复这项练习。老鹰队在 2019-20 赛季常规赛中每场比赛得到 111.8 分，这是联盟的平均水平。

创建数据源

我们对 pbp 数据集进行子集化，其中变量team等于ATL（代表亚特兰大老鹰队），派生变量play_length2等于或大于5且小于或等于24，变量event_type等于shot或miss。然后我们调用dim()函数来返回我们新数据集的维度：

pbp %>% 
  filter(team == "ATL",
         play_length2 >= 5 & play_length2 <= 24,
         event_type == "shot" | event_type == "miss") -> ATL
dim(ATL) 
## [1] 4945   45

ATL 数据集有 4,945 行，这比 MIL 数据集短得多。以下dplyr代码块返回老鹰队和雄鹿队的失误和投篮次数，用于比较目的。

ATL %>%
  group_by(event_type) %>%
  tally()
## # A tibble: 2 × 2
##   event_type     n
##   <fct>      <int>
## 1 miss        2807
## 2 shot        2138

MIL %>%
  group_by(event_type) %>%
  tally()
## # A tibble: 2 × 2
##   event_type     n
##   <fct>      <int>
## 1 miss        2902
## 2 shot        2534

老鹰队的投篮次数比雄鹿队少 441 次，投篮次数少 396 次。这就是为什么 ATL 行数少于 MIL 行数，以及为什么老鹰队平均每场比赛比密尔沃基雄鹿队少得 7 分。

然后，我们调用select()函数，仅保留event_type、points和play_length2变量来减少 ATL 的宽度：

ATL %>%
  select(event_type, points, play_length2) -> ATL
dim(ATL)
## [1] 4945    3

再次运行dim()函数确认，我们的 ATL 数据集现在仅包含这三个变量。

接下来，我们通过调用dplyr group_by()和summarize()函数创建一个名为 ATLx 的 tibble，这是亚特兰大的 MILx 的对应物，以计算老鹰队在play_length2变量中每秒的平均得分：

ATL %>%
  group_by(play_length2) %>%
  summarize(avg = mean(points)) -> ATLx
print(ATLx)
## # A tibble: 20 × 2
##    play_length2   avg
##           <dbl> <dbl>
##  1            5 1.04 
##  2            6 1.03 
##  3            7 1.17 
##  4            8 0.897
##  5            9 1.02 
##  6           10 1.11 
##  7           11 1.04 
##  8           12 0.912
##  9           13 1.08 
## 10           14 0.976
## 11           15 0.984
## 12           16 0.938
## 13           17 0.878
## 14           18 1.06 
## 15           19 0.994
## 16           20 0.831
## 17           21 1.04 
## 18           22 1.04 
## 19           23 0.678
## 20           24 1.06

然后，我们创建一个名为 ATLy 的频率表，这是亚特兰大的 MILy 的对应物，通过将 ATL 传递给tabyl()函数，并添加play_length2和event_type作为额外的参数。因为我们只需要event_type变量中的play_length2变量以及shot和miss因子，这些现在也是变量，所以我们调用select()函数将 ATLy 减少到仅包含play_length2、shot和miss。

接下来，我们调用mutate()函数创建一个名为fg_pct的变量；我们的新变量通过将shot变量除以shot和miss变量之和，然后乘以 100 来计算投篮命中率。我们的导出变量随后被四舍五入到小数点后两位：

ATL %>%
  tabyl(play_length2, event_type) -> ATLy
ATLy <- select(ATLy, play_length2, shot, miss)
ATLy %>%
  mutate(fg_pct = shot / (shot + miss)*100) -> ATLy
ATLy$fg_pct <- round(ATLy$fg_pct, digits = 2)
print(ATLy)
##  play_length2 shot miss fg_pct
##             5  147  180  44.95
##             6  139  170  44.98
##             7  150  155  49.18
##             8  124  195  38.87
##             9  131  170  43.52
##            10  155  171  47.55
##            11  163  206  44.17
##            12  136  204  40.00
##            13  164  188  46.59
##            14  141  191  42.47
##            15  128  181  41.42
##            16  116  160  42.03
##            17   92  153  37.55
##            18   93  113  45.15
##            19   75  102  42.37
##            20   53   89  37.32
##            21   53   62  46.09
##            22   39   44  46.99
##            23   16   43  27.12
##            24   23   30  43.40

展示结果

我们将 tibble ATLx 提取为一段ggplot2代码，以生成一个折线图，并将频率表 ATLy 提取为另一段ggplot2代码，以生成第二个折线图。这些折线图（见图 8.2）与第一个对完全相同，只是我们更换了数据源和图像：

ATLp1 <- ggplot(ATLx, aes(x = play_length2, y = avg, group = 1)) +
  geom_line(aes(y = avg), color = "red", size = 2) +
  geom_point(color = "black", size = 3) +
  labs(title = "Points Scored per Second Increment",
       subtitle = "2019-20 Atlanta Hawks",
       caption = "regular season only",
       x = "Number of Seconds into Possession", 
       y = "Average Number of Points Scored") +
  geom_smooth(method = lm, color = "blue", se = FALSE) +
  geom_smooth(method = lm, color = "gold", 
              data = ATLx[ATLx$play_length2 < 13,], se = FALSE) +
  geom_smooth(method = lm, color = "purple", 
              data = ATLx[ATLx$play_length2 > 11,], se = FALSE) +
  theme_classic() +
  theme(plot.title = element_text(face = "bold")) +
  inset_element(hawks, left = 0.78, bottom = 0.78, 
                right = 0.95, top = 0.95)

ATLp2 <- ggplot(ATLy, aes(x = play_length2, y = fg_pct, group = 1)) +
  geom_line(aes(y = fg_pct), color = "red", size = 2) +
  geom_point(color = "black", size = 3) +
  labs(title = "Field Goal Percentage per Second Increment",
       subtitle = "2019-20 Atlanta Hawks",
       caption = "regular season only",
       x = "Number of Seconds into Possession", 
       y = "Field Goal Percentage") +
  geom_smooth(method = lm, color = "blue", se = FALSE) +
  geom_smooth(method = lm, color = "gold", 
              data = ATLy[ATLy$play_length2 < 13,], se = FALSE) +
  geom_smooth(method = lm, color = "purple", 
              data = ATLy[ATLy$play_length2 > 11,], se = FALSE) +
  theme_classic() +
  theme(plot.title = element_text(face = "bold")) +
  inset_element(hawks, left = 0.62, bottom = 0.78, 
                right = 0.79, top = 0.95) 

图 8.2 展示了亚特兰大老鹰队在 2019-20 赛季常规赛中，在每个半场控球秒数所获得的平均得分（左侧）和投篮命中率（右侧），并附有趋势线

在临时保留 ATLp1 和 ATLp2 在内存中后，我们再次通过调用plot_layout()函数从patchwork包中捆绑它们，并将两个对象打印为一个单一对象：

ATLp1 + ATLp2 + plot_layout(ncol = 2)

结论

我们的结果既相同又略有不同：

• 在得分和投篮命中率方面，2019-20 赛季的老鹰队在控球时间仅 7 秒时最成功，平均每秒得到 1.17 分，投篮命中率达到了 49.18%。

• 这意味着在 37%标记之后，老鹰队平均得分没有达到或超过他们在控球时间等于 7 秒时的得分，也没有达到或超过他们的投篮命中率。因此，我们再次没有看到最佳停止，或 37%，规则生效。

• 就像雄鹿队一样，亚特兰大老鹰队在剩余投篮时间较多时，无论从哪个角度来看，在进攻上都普遍更成功。

• 同样，就像雄鹿队一样，我们看到随着 x 轴变量的增加和观察次数的减少，存在回归到平均水平的趋势。

让我们再看看另一支球队。

8.5.3 夏洛特黄蜂队

我们将再次重复这项练习，这次是将夏洛特黄蜂队插入到雄鹿队或老鹰队的位置。2019-20 赛季常规赛中，黄蜂队平均每场得分仅为 102.9 分，这是联盟中最低的。

创建数据源

我们将 pbp 数据集传递给filter()函数，以便对它进行子集化，其中变量team等于CHA，变量play_length2再次等于或大于5且小于或等于24，变量event_type等于shot或miss。然后我们将结果转换为名为 CHA 的 tibble。接下来，我们将 CHA 传递给select()函数，通过仅保留变量event_type、points和play_length2来减少其宽度。最后，我们调用dim()函数以返回 CHA 数据集的最终维度：

pbp %>% 
  filter(team == "CHA",
         play_length2 >= 5 & play_length2 <= 24,
         event_type == "shot" | event_type == "miss") -> CHA

CHA %>%
  select(event_type, points, play_length2) -> CHA
dim(CHA) 
## [1] 4539    3

CHA 数据集包含在miss和made事件类型之间的 4,539 个观测值。然后我们将 CHA 传递给group_by()和tally()函数，以返回失误和命中次数，这样我们就可以比较和对比黄蜂队与雄鹿队和老鹰队：

CHA %>%
  group_by(event_type) %>%
  tally()
## # A tibble: 2 × 2
##   event_type     n
##   <fct>      <int>
## 1 miss        2624
## 2 shot        1915

2019-20 赛季的夏洛特黄蜂队比雄鹿队少尝试了 897 次投篮，比老鹰队少 406 次；他们比雄鹿队少投中 619 次，比老鹰队少投中 223 次。

然后，我们创建一个名为 CHAx 的 tibble 和一个名为 CHAy 的频率表，就像我们之前做过两次一样：

CHA %>%
  group_by(play_length2) %>%
  summarise(avg = mean(points)) -> CHAx
print(CHAx)
## # A tibble: 20 × 2
##    play_length2   avg
##           <dbl> <dbl>
##  1            5 1.05 
##  2            6 1.14 
##  3            7 1.03 
##  4            8 0.986
##  5            9 0.981
##  6           10 0.913
##  7           11 0.992
##  8           12 1.04 
##  9           13 0.907
## 10           14 0.956
## 11           15 0.900
## 12           16 1.06 
## 13           17 0.950
## 14           18 1.19 
## 15           19 1.10 
## 16           20 0.839
## 17           21 1.02 
## 18           22 0.843
## 19           23 0.906
## 20           24 0.931

CHA %>%
  tabyl(play_length2, event_type) -> CHAy
CHAy %>%
  select(play_length2, shot, miss) -> CHAy
CHAy %>%
  mutate(fg_pct = shot / (shot + miss)*100) -> CHAy
CHAy$fg_pct <- round(CHAy$fg_pct, digits = 2)
print(CHAy)
##  play_length2 shot miss fg_pct
##             5  124  152  44.93
##             6  124  132  48.44
##             7  109  139  43.95
##             8   88  127  40.93
##             9   87  121  41.83
##            10   97  145  40.08
##            11  108  144  42.86
##            12  123  159  43.62
##            13  118  183  39.20
##            14  129  187  40.82
##            15  111  178  38.41
##            16  125  158  44.17
##            17  101  141  41.74
##            18  114  115  49.78
##            19   89  103  46.35
##            20   71  122  36.79
##            21   70   89  44.03
##            22   43   84  33.86
##            23   47   80  37.01
##            24   37   65  36.27

显示结果

然后，我们创建第三组折线图来可视化夏洛特黄蜂队每场比赛的平均得分和每秒控球时间的投篮命中率（见图 8.3）：

CHAp1 <- ggplot(CHAx, aes(x = play_length2, y = avg, group = 1)) +
  geom_line(aes(y = avg), color = "cyan3", size = 2) +
  geom_point(color = "black", size = 3) +
  labs(title = "Points Scored per Second Increment",
       subtitle = "2019-20 Charlotte Hornets",
       caption = "regular season only",
       x = "Number of Seconds into Possession", 
       y = "Average Number of Points Scored") +
  geom_smooth(method = lm, color = "blue", se = FALSE) +
  geom_smooth(method = lm, color = "gold", 
              data = CHAx[CHAx$play_length2 < 13,], se = FALSE) +
  geom_smooth(method = lm, color = "purple", 
              data = CHAx[CHAx$play_length2 > 11,], se = FALSE) +
  theme_classic() +
  theme(plot.title = element_text(face = "bold")) +
  inset_element(hornets, left = 0.73, bottom = 0.73, 
                right = 0.95, top = 0.95)

CHAp2 <- ggplot(CHAy, aes(x = play_length2, y = fg_pct, group = 1)) +
  geom_line(aes(y = fg_pct), color = "cyan3", size = 2) +
  geom_point(color = "black", size = 3) +
  labs(title = "Field Goal Percentage per Second Increment",
       subtitle = "2019-20 Charlotte Hornets",
       caption = "regular season only",
       x = "Number of Seconds into Possession", 
       y = "Field Goal Percentage") +
  geom_smooth(method = lm, color = "blue", se = FALSE) +
  geom_smooth(method = lm, color = "gold", 
              data = CHAy[CHAy$play_length2 < 13,], se = FALSE) +
  geom_smooth(method = lm, color = "purple", 
              data = CHAy[CHAy$play_length2 > 11,], se = FALSE) +
  theme_classic() +
  theme(plot.title = element_text(face = "bold")) +
  inset_element(hornets, left = 0.73, bottom = 0.73, 
                right = 0.95, top = 0.95) 
CHAp1 + CHAp2 + plot_layout(ncol = 2)

图 8.3 在 2019-20 赛季常规赛中，夏洛特黄蜂队在半场控球每秒的平均得分（左侧）和投篮命中率（右侧），并带有趋势线

结论

与之前的球队相比，夏洛特黄蜂队的结果既有相似之处也有不同之处：

• 有趣的是，无论是平均得分还是投篮命中率，夏洛特黄蜂队最擅长应用最佳停止规则。

• 当控球时间等于 6 秒时，黄蜂队平均每场得到 1.14 分，投篮命中率达到了 48.44%，这是黄蜂队在 37%命中率之前进攻最成功的时候。

• 但当控球时间等于 18 秒时，黄蜂队平均得到 1.19 分，并且在其尝试的投篮中成功率为 49.78%，这实际上与密尔沃基队最佳数据相当。

• 否则，我们也会看到类似趋势以及回归到平均值——就像我们在雄鹿和老鹰队中看到的那样。

最后，让我们通过最后的一对ggplot2线形图来审视整个 NBA——包括雄鹿、老鹰和黄蜂队。

8.5.4 NBA

毫无疑问，你现在已经熟悉了代码，但请注意，传递给filter()函数的第一个参数是可选的；实际上，在 pbp 数据集中没有变量team为空且变量event_type等于shot或miss的观测值。最终结果，正如你现在可能预料的那样，又是另一对互补的ggplot2线形图（见图 8.4）：

pbp %>% 
  filter(team != "",
         play_length2 >= 5 & play_length2 <= 24,
         event_type == "shot" | event_type == "miss") -> NBA

NBA %>%
  select(event_type, points, play_length2) -> NBA
dim(NBA)
## [1] 155130    3

NBA %>%
  group_by(play_length2) %>%
  summarise(avg = mean(points)) -> NBAx
print(NBAx)
## # A tibble: 20 × 2
##    play_length2   avg
##           <dbl> <dbl>
##  1            5 1.13 
##  2            6 1.10 
##  3            7 1.07 
##  4            8 1.08 
##  5            9 1.06 
##  6           10 1.06 
##  7           11 1.06 
##  8           12 1.05 
##  9           13 1.01 
## 10           14 1.04 
## 11           15 1.04 
## 12           16 1.04 
## 13           17 1.01 
## 14           18 1.04 
## 15           19 1.00 
## 16           20 0.992
## 17           21 0.942
## 18           22 0.937
## 19           23 0.928
## 20           24 0.927

NBA %>%
  tabyl(play_length2, event_type) -> NBAy
NBAy %>%
  select(play_length2, shot, miss) -> NBAy
NBAy %>%
  mutate(fg_pct = shot / (shot + miss)*100) -> NBAy
NBAy$fg_pct <- round(NBAy$fg_pct, digits = 2)
print(NBAy)
##  play_length2 shot miss fg_pct
##             5 4522 4774  48.64
##             6 4421 4919  47.33
##             7 4169 4891  46.02
##             8 4182 4902  46.04
##             9 4280 5088  45.69
##            10 4439 5308  45.54
##            11 4693 5599  45.60
##            12 4772 5768  45.28
##            13 4710 5976  44.08
##            14 4649 5673  45.04
##            15 4345 5336  44.88
##            16 3951 4768  45.31
##            17 3399 4356  43.83
##            18 3152 3851  45.01
##            19 2649 3434  43.55
##            20 2224 2972  42.80
##            21 1809 2591  41.11
##            22 1451 2132  40.50
##            23 1099 1683  39.50
##            24  867 1326  39.53

NBAp1 <- ggplot(NBAx, aes(x = play_length2, y = avg, group = 1)) +
  geom_line(aes(y = avg), color = "red", size = 2) +
  geom_point(color = "blue", size = 3) +
  labs(title = "Points Scored per Second Increment",
       subtitle = "2019-20 NBA Regular Season (all teams)",
       x = "Number of Seconds into Possession", 
       y = "Average Number of Points Scored") +
  geom_smooth(method = lm, color = "blue", se = FALSE) +
  geom_smooth(method = lm, color = "gold", 
              data = NBAx[NBAx$play_length2 < 13,], se = FALSE) +
  geom_smooth(method = lm, color = "purple", 
              data = NBAx[NBAx$play_length2 > 11,], se = FALSE) +
  theme_classic() +
  theme(plot.title = element_text(face = "bold")) +
  inset_element(nba, left = 0.65, bottom = 0.65, right = 0.95, top = 0.95)

NBAp2 <- ggplot(NBAy, aes(x = play_length2, y = fg_pct, group = 1)) +
  geom_line(aes(y = fg_pct), color = "red", size = 2) +
  geom_point(color = "blue", size = 3) +
  labs(title = "Field Goal Percentage per Second Increment",
       subtitle = "2019-20 NBA Regular Season (all teams)",
       x = "Number of Seconds into Possession", 
       y = "Field Goal Percentage") +
  geom_smooth(method = lm, color = "blue", se = FALSE) +
  geom_smooth(method = lm, color = "gold", 
              data = NBAy[NBAy$play_length2 < 13,], se = FALSE) +
  geom_smooth(method = lm, color = "purple",
              data = NBAy[NBAy$play_length2 > 11,], se = FALSE) +
  theme_classic() +
  theme(plot.title = element_text(face = "bold")) +
  inset_element(nba, left = 0.65, bottom = 0.65, right = 0.95, top = 0.95)

NBAp1 + NBAp2 + plot_layout(ncol = 2)

图 8.4 在 2019-20 赛季的常规赛中，每半场控球时间每秒所有 30 支 NBA 球队的平均得分（左侧）和投篮命中率（右侧），并带有趋势线

我们在这里看到了一些非常有趣的结果，但这些结果并不一定是由于数据量大小而产生的意外结果：

• 首先，我们没有看到在仅可视化一个球队的结果时出现的第二次超过第二次的变化。这是因为结果在将整个 NBA 绘制在一个数据系列中而不是仅 30 支球队中的 1 支时，已经被或多或少地平滑化了。

• 相反，我们看到三条大致相等但斜率陡峭的回归线，当然，它们之间的相对距离相对较小。

• 这些回归线表明，既没有最优停止规则，也没有回归到平均值的效果。

• 最重要的是，球队在早于晚投篮时表现得更好。

就最优停止规则而言，我们的结果，至少从规则的字面意义上讲，是混合的；事实上，在一些地方可能看到最优停止，而我们却看到了回归到平均值。但最优停止规则的精神确实适用于 NBA。记住，最优停止部分目的是为了防止浪费精力——对合格的候选人开枪并停止面试；好好投篮并停止传球和运球。我们的团队层面和联赛层面的分析强烈表明，当剩余的投篮时钟时间更长时，球队在得分和投篮命中率方面最成功，至少基于 2019-20 赛季的数据。

在本章和前一章中，我们探讨了由裁判、球员和教练控制的 NBA 比赛的各个方面，但在下一章中，我们将探讨联赛赛程如何显著影响一支球队在休息时间比对手更多时胜负。

摘要

• 在我们的个人和职业生活中，我们都拥有应用最佳停止规则的机会。例如，如果你在市场上寻找新家，并且绝对需要在 60 天内提交出价，你应该在前 22 天（60 天的 37%）非承诺性地参加公开房屋参观；然后你应该提交出价给第一套与你之前检查过的最佳房屋有利的房屋。同样，如果你在快速约会，你应该在晚上的前 37%的时间里进行更多的热身，然后与第一个与你已经遇到的所有人一样吸引人的第一人配对。最后，如果你是一名律师，正在研究 25 个符合条件的案例中的最佳法律先例，你应该自动排除前九个案例，然后继续处理与最初一批最相似的第一个案例。

• 然而，请注意：最佳停止策略旨在提供最高概率的最佳结果，没有任何保证，同时积极消除浪费的努力。而且它仅在你没有第二次机会时才有效。

• 最佳停止策略不一定适合 NBA，至少根据我们对 2019-20 赛季常规赛季数据的分析是这样的。可能被视为最佳停止策略的更有可能是回归到平均值，其中正面和负面的结果不断地相互抵消。然而，在 2019-20 赛季的常规赛季中，NBA 球队通常表现得更好——实际上要好得多——在半场设置中尽早投篮，而不是晚些时候。

• 对于一支球队来说，放弃好的或甚至还可以的投篮机会，并使用剩下的或大部分剩下的 24 秒投篮时钟上的时间，通常是不值得的。那种认为球队在大多数情况下通过传球和运球直到最佳投篮机会出现而更有利的老式想法是完全错误的。换句话说，虽然最佳停止规则的字面意义可能并不普遍适用，但最佳停止的精神绝对适用。

• 同时，我们展示了如何创建频率表以及如何从一个字符串创建另一个字符串的字符串。

• 我们还展示了如何通过添加主题来覆盖默认的ggplot2设置，如何嵌入提高你视觉内容质量的图片，以及如何向同一张线图添加多个趋势线。

卡方检验和更多效应量检验

本章涵盖

• 在分类数据上运行和解释显著性检验

• 在分类数据上运行和解释效应量检验

• 计算排列以及区分排列和组合

• 创建分面图、气球图和 mosaic 图

休息曾经被认为是工作和活动的对立面。今天，它被认为是实现最高生产力和表现的关键推动因素。我们的目的是通过可视化和统计检验来探索——首先通过可视化和然后通过统计检验——休息（在本文中定义为常规赛比赛前的休息日数）对 NBA 胜负的影响。

在第七章中，我们运行了 t 检验，因为我们正在处理数值依赖变量。在本章中，我们将处理一个分类依赖变量，因此我们将运行独立性卡方检验。但就像 t 检验一样，我们的进入假设，或零假设，是变量之间没有有意义的关系。同样，就像 t 检验一样，如果我们的卡方检验返回的 p 值小于 0.05，我们将拒绝我们的零假设；如果我们得到的 p 值大于 0.05，我们将无法拒绝我们的零假设。之后，我们将展示两种方法，你可以通过这些方法运行 Cramer’s V 效应量检验，这是一种补充卡方检验的效应量检验，就像 Cohen’s d 效应量检验补充 t 检验一样。再次强调，应该根据你的数据来决定运行哪些测试。

NBA 常规赛赛程本质上是一个约束优化问题。每个球队都要打 82 场比赛，主场和客场各占一半。每个球队必须与同分区的其他球队打 16 场比赛，与同一联盟的其他球队打 36 场比赛，与对立联盟的球队打 30 场比赛。最好的球队在圣诞节和其他日子里展示，以最大化电视观众；某些日子有场地可用，而其他日子则没有；还有黑名单日期。同时，联盟的目标是尽量减少空中旅行和与旅行相关的费用。

因此，球队会打不同的和不规则的赛程——一对对手球队在他们的比赛前可能会有相同或不同数量的休息日。我们的零假设是休息对胜负没有影响；因此，我们的备择假设是休息实际上确实影响谁赢谁输。

在我们完成加载我们的包、导入我们的数据集和整理数据之后，我们的后续步骤如下：

• 我们将首先简要检查组合和排列，并讨论如何区分它们；此外，我们还将演示如何使用 R 代码计算排列。

• 我们将基线我们的数据，并使用分面图可视化。

• 我们接下来将运行我们的统计检验，从独立性卡方检验开始，以一对 Cramer’s V 效应量检验结束。

• 卡方检验比其他统计显著性测试，如相关检验或 t 检验，更全面。我们首先必须创建一个列联表——一个表格或矩阵，有时也称为交叉表，它显示了涉及两个或更多变量的频率分布——然后我们将列联表传递给我们的卡方检验。有许多方法可以可视化列联表，但我们将演示其中的两种。

让我们开始吧。

9.1 加载包

运行我们的显著性统计测试并返回结果的函数是现成的；然而，处理数据、查询数据和创建我们的可视化需要一些基础 R 中不可用的函数。因此，我们通过一系列调用library()函数来加载允许我们超越基础安装的包。

到现在为止，你对tidyverse和sqldf包已经很熟悉了。我们将加载这两个包以及五个之前未加载或使用的其他包：

library(tidyverse)
library(sqldf)
library(gtools)
library(gplots)
library(vcd)
library(questionr)
library(rcompanion)

其中第一个是gtools，它包含几个实用函数，包括一些用于计算和打印排列和组合的函数。排列实际上是组合，其中我们关心顺序。例如，数字 24、16 和 31 如果顺序无关紧要，则等同于 16、31 和 24；如果是这样，这些数字可以被视为组合。但如果 24、16 和 31 是打开健身房储物柜的“组合”，那么它实际上是一个排列，因为 16、31、24 将不起作用。我们将在稍后详细介绍排列和组合。现在，了解计算可能排列的最大数量与计算可能组合的最大数量并不相同；在绘图和分析数据之前，我们需要首先区分这两者。

这两个包中的第二个和第三个是gplots和vcd。虽然我们的分面图将使用ggplot2函数创建，但我们还将使用gplots包中的balloonplot()函数创建气球图，以及vcd包中的mosaic()函数创建镶嵌图。气球图和镶嵌图只是可视化列联表的两种方式。

第四个和第五个包是questionr和rcompanion，我们将演示这两种包中的一种方法，分别运行 Cramer 的 V 效应量测试。接下来我们将导入我们的数据集。

9.2 导入数据

我们现在通过调用readr的read_csv()函数（记住readr是tidyverse的一部分）导入我们的数据，一个从 Kaggle 下载的.csv 文件。我们的文件之前以文件名 2012_18_officialBoxScore 保存，并存储在我们的默认工作目录中；我们的数据集名为 NBAboxscores，它包含了 2012-13 赛季至 2017-18 赛季之间每场常规赛 NBA 比赛的表格化结果。

然后我们调用基础 R 的dim()函数来返回 NBAboxscores 数据集的维度：

NBAboxscores <- read_csv("2012_18_officialBoxScore.csv")

dim(NBAboxscores) 
## [1] 44284   119

我们的数据有 44,284 行和 119 列。在接下来的部分，我们将运行一系列操作来将 NBAboxscores 数据集在长度和宽度上减少，以便我们更好地处理。

9.3 数据整理

首先，我们绝对不需要每个游戏分配的官员或裁判的姓氏 (offLNm) 和名字 (offFNm)。因此，我们调用 dplyr select() 函数从 NBAboxscores 中移除这两个变量。在这里，我们展示了 select() 函数的另一个应用；而不是指出变量名称或变量位置来取消选择，我们反而告诉 R 移除 NBAboxscores 数据集中以 off 开头的所有变量。然后我们再次调用 dim() 函数，只是为了确认我们的数据集确实已经从 119 列减少到 117 列：

NBAboxscores %>%
  select(-starts_with("off")) -> NBAboxscores
dim(NBAboxscores)
## [1] 44284   117

然而，仅仅通过从我们的数据集中移除这两个变量，我们现在有了重复的行。官员的姓氏和名字是区分一条记录与下一条记录的唯一变量，因为我们有一个垂直而不是水平的数据集，其中单场比赛的记录分布在多个观测值之间。因此，我们接下来调用基本的 R unique() 函数来从我们的数据集中移除每个重复的记录。

然后，我们第三次调用 dim() 函数来检查 NBAboxscores 数据集的减少维度。如果这个操作需要超过几秒钟才能完成，请不要惊慌：

NBAboxscores <- unique(NBAboxscores)
dim(NBAboxscores) 
## [1] 14758   117

由于大多数 NBA 比赛都是由三位官员判罚，我们应该预计 NBAboxscores 中的行数将减少大约三分之二，从而使我们的数据集从 44,284 行减少到 14,758 行。

虽然一切似乎都很顺利，但我们仍然会暂时暂停，对我们的数据集进行完整性检查。dplyr 包中的 count() 函数使得快速轻松地提取唯一值或条件的计数成为可能。变量 teamPTS（代表一支参赛队伍在比赛中得分的总和）大于变量 opptPTS（代表对方队伍得分的数量）的频率应该等于相反条件成立的频率：

NBAboxscores %>% 
  count(teamPTS > opptPTS) 
##   teamPTS > opptPTS    n
## 1             FALSE 7379
## 2              TRUE 7379

这看起来没问题，但为了确保，我们将通过反转条件进行第二次完整性检查：

NBAboxscores %>% 
  count(teamPTS < opptPTS) 
##   teamPTS < opptPTS    n
## 1             FALSE 7379
## 2              TRUE 7379

由于 R 返回了我们希望和预期的结果，我们现在可以自信地继续进一步整理 NBAboxscores 数据集。接下来，我们调用 dplyr filter() 函数来对 NBAboxscores 进行子集化，其中 teamPTS 变量大于 opptPTS 变量。

再次调用 dim() 函数确认我们已经有效地将 NBAboxscores 的行数减少了正好 50%——我们的数据集现在包含 7,379 条记录，至少到目前为止，有 117 列：

NBAboxscores %>%
  filter(teamPTS > opptPTS) -> NBAboxscores
dim(NBAboxscores) 
## [1] 7379  117

让我们保存 NBAboxscores 并创建一个名为 mydata 的副本。再次调用dim()函数确认 mydata 与 NBAboxscores 具有相同的维度：

mydata <- NBAboxscores
dim(mydata)
## [1] 7379  117

然后，我们再次调用select()函数，对 mydata 进行子集化，只保留六个变量。基础 R 的head()和tail()函数分别打印 mydata 数据集中的前六个和最后六个观察值：

mydata %>%
  select(teamLoc, teamRslt, teamDayOff, opptLoc, opptRslt, 
         opptDayOff) -> mydata
head(mydata) 
##   teamLoc teamRslt teamDayOff opptLoc opptRslt opptDayOff
##   <chr>   <chr>         <dbl> <chr>   <chr>         <dbl>
## 1    Home      Win          0    Away     Loss          0
## 2    Home      Win          0    Away     Loss          0
## 3    Away      Win          0    Home     Loss          0
## 4    Home      Win          0    Away     Loss          0
## 5    Away      Win          0    Home     Loss          0
## 6    Away      Win          0    Home     Loss          0
tail(mydata)
##      teamLoc teamRslt teamDayOff opptLoc opptRslt opptDayOff
##      <chr>   <chr>         <dbl> <chr>   <chr>         <dbl>
## 7374    Home      Win          2    Away     Loss          2
## 7375    Home      Win          2    Away     Loss          1
## 7376    Home      Win          1    Away     Loss          2
## 7377    Away      Win          1    Home     Loss          2
## 7378    Home      Win          2    Away     Loss          1
## 7379    Home      Win          2    Away     Loss          1

这里是我们“幸存”变量的分解：

• teamLoc—等于Home或Away，但始终等于变量opptLoc的相反值

• teamRslt—等于所有观察值中的Win

• teamDayOff—等于比赛前赢得球队的休息日天数，最小值为 0，最大值为 11

• opptLoc—等于Home或Away，但始终等于teamLoc的相反值

• opptRslt—等于所有观察值中的Loss

• opptDayOff—等于比赛前输掉球队的休息日天数，最小值为 0，最大值为 11

通过调用基础 R 的min()和max()函数，提取了变量teamDayOff和opptDayOff的最小值和最大值：

min(mydata$teamDayOff)
## [1] 0
max(mydata$teamDayOff)
## [1] 11
min(mydata$opptDayOff)
## [1] 0
max(mydata$opptDayOff)
## [1] 11

为了使这个练习易于管理并避免在主队和客队之间有太多不合理的休息日排列，其中大多数观察值非常少，我们两次调用filter()函数，以保留变量teamDayOff小于或等于 4 的观察值，然后再次保留变量opptDayOff小于或等于 4 的观察值。

然后，我们再次调用dim()函数，发现现在我们的工作数据集有 7,191 行和六列。因此，我们仅仅从 mydata 中移除了 188 行，或者说不到总记录数的 3%：

mydata %>%
  filter(teamDayOff <= 4,
         opptDayOff <= 4) -> mydata
dim(mydata) 
## [1] 7191    6

接下来，我们调用purrr包中的map_df()函数，它是tidyverse包宇宙的一部分，以返回我们六个变量的类别。（我们在加载tidyverse时自动加载了purrr包。）它们都是字符字符串或整数，但都应该被转换为因子，因此我们通过调用基础 R 的as.factor()函数相应地转换它们：

map_df(mydata, class)
## # A tibble: 1 × 6
##   teamLoc   teamRslt  teamDayOff opptLoc   opptRslt  opptDayOff
##   <chr>     <chr>     <chr>      <chr>     <chr>     <chr>     
## 1 character character integer    character character integer

mydata$teamLoc <- as.factor(mydata$teamLoc)
mydata$teamRslt <- as.factor(mydata$teamRslt)
mydata$teamDayOff <- as.factor(mydata$teamDayOff)
mydata$opptLoc <- as.factor(mydata$opptLoc)
mydata$opptRslt <- as.factor(mydata$opptRslt)
mydata$opptDayOff <- as.factor(mydata$opptDayOff)

然后，我们将 mydata 数据集管道传输到dplyr group_by()和tally()函数，以计算主队和客队的胜利次数：

mydata %>%
  group_by(teamLoc, teamRslt) %>%
tally()
## # A tibble: 2 × 3
## # Groups:   teamLoc [2]
##   teamLoc teamRslt     n
##   <fct>   <fct>    <int>
## 1 Away    Win       2967
## 2 Home    Win       4224

结果表明，主队赢得了 4,224 场比赛，客队赢得了 2,967 场比赛。因此，在 2012-13 赛季至 2017-18 赛季的常规赛中，主队赢得了 58.7%的比赛——这就是我们的基准。

在我们开始分析之前，让我们谈谈我们最初承诺的排列和组合问题。

9.4 计算排列

关于排列，首先需要理解的是，它们与组合不是同义的。金州勇士队的首发阵容可能由奥托·波特小、安德鲁·威金斯、德拉蒙德·格林、克莱·汤普森和斯蒂芬·库里组成。这是一个组合而不是排列，因为宣布这些球员的顺序并不重要；无论哪种方式，金州勇士队的首发阵容都不会改变。

另一方面，如果我们关心 2021-22 赛季结束时的分区排名，那么这是一个排列而不是组合，因为顺序至关重要——每个队伍最终的位置绝对重要。

因此，首先需要理解的是，如果顺序不重要，那么它是组合；但如果顺序重要，那么它是排列。关于排列的第二个理解是带替换与不带替换的概念。主教练为球队接下来的两次进攻叫出的两个战术是带替换的排列，因为同一个球员可能是零次、一次或两次进攻的主要选择。NBA 抽签是不带替换的排列，因为同一个队伍不能被选中超过一次。

所有这些有什么意义？在下一刻，我们将计算并可视化主队和客队之间基于前一天休息日的排列数量的胜负。事实上，这些是带替换的排列，原因如下：

• 顺序很重要。对于任何一场比赛，主队可能有两个前一天休息日，而客队只有一个前一天休息日；当然，这与主队只有一个休息日而客队有两个休息日的情况非常不同。因此，这些都是排列而不是组合。

• 主队和客队的前一天休息日数量可能完全相同；事实上，这种情况很常见。例如，一对主客场球队可能都有两个前一天休息日。这意味着我们可以在排列中使用相同的数字（在这个例子中是 2）两次，而不仅仅是一次。因此，这些是带替换的排列。

就我们的目的而言，我们有五个前一天休息日可供选择（0-4），并且每个排列将包含其中两个。计算我们需要考虑的排列数量很容易；公式是 n^r，其中 n 代表潜在选择数量（5）和 r 代表每个排列的选择数量（2）。

我们可以在 R 中执行此操作或任何其他数学运算。我们将 5 平方并将输出设置为等于一个名为 permutationsCount 的对象。来自基础 R 的 paste0() 函数是 print() 函数的一种增强版本；在这里，它将一个字符串与 permutationsCount 连接并打印完整的字符字符串结果。^ 运算符将第一个数字提升为第二个数字的指数：

n = 5
r = 2
permutationsCount = n^r
paste0("The permuation count equals: ", permutationsCount)
## [1] "The permuation count equals: 25"

我们还可以调用 gtools 包中的 permutations() 函数来计算排列计数，其中 n 等于可供选择的先前休息日数，r 等于每个排列的休息日数，而 repeats.allowed 设置为 TRUE 因为允许重复。我们在 permutations() 函数前面使用基本的 R nrow() 函数来返回排列计数：

nrow(permutations(n = 5, r = 2, repeats.allowed = TRUE))
## [1] 25

然后，我们再次调用 permutations() 函数，这次没有使用 nrow() 函数，以打印出我们的 25 种排列。我们方便地减去我们的结果，这样 R 就返回了 0 到 4 之间的先前休息日，而不是 1 到 5 之间：

permutations(n = 5, r = 2, repeats.allowed = TRUE) - 1
##       [,1] [,2]
##  [1,]    0    0
##  [2,]    0    1
##  [3,]    0    2
##  [4,]    0    3
##  [5,]    0    4
##  [6,]    1    0
##  [7,]    1    1
##  [8,]    1    2
##  [9,]    1    3
## [10,]    1    4
## [11,]    2    0
## [12,]    2    1
## [13,]    2    2
## [14,]    2    3
## [15,]    2    4
## [16,]    3    0
## [17,]    3    1
## [18,]    3    2
## [19,]    3    3
## [20,]    3    4
## [21,]    4    0
## [22,]    4    1
## [23,]    4    2
## [24,]    4    3
## [25,]    4    4

由于 n 和 r 都是较小的数字，我们当然可以手动执行此操作，但这并不是统计学家、数据科学家和数据分析师应该采取的方式。此外，我们并不总是可以依赖 n 和 r 是较小的数字；因此，了解排列与组合的区别以及进一步了解有放回和无放回之间的差异——公式根据问题类型的不同而有很大差异——是至关重要的。

我们现在可以继续计算和可视化我们的结果。

9.5 可视化结果

我们的计划是在单张分面图中显示主队和客队胜利的计数，按每个可能的排列进行。我们将创建一个数据源，绘制我们的结果，并总结关键要点。

9.5.1 创建数据源

我们首先通过再次调用 group_by() 和 tally() 函数来恢复并完成我们的数据处理操作；然而，这一次，我们的目标是计算我们 25 种排列中的主队和客队胜利总数。由于每个排列都有主队胜利和客队胜利，我们的结果被转换成一个名为 finaldf 的 tibble，长度为 50 行而不是 25 行。因为 R 默认只打印 tibble 的前 10 行，所以我们向 print() 函数添加了参数 n = 50，这样 R 就会完整地打印出 finaldf：

mydata %>%
  group_by(teamLoc, teamDayOff, opptLoc, opptDayOff) %>%
tally() -> finaldf
print(finaldf, n = 50) 
## # A tibble: 50 × 5
## # Groups:   teamLoc, teamDayOff, opptLoc [10]
##    teamLoc teamDayOff opptLoc opptDayOff     n
##    <fct>   <fct>      <fct>   <fct>      <int>
##  1 Away    0          Home    0             35
##  2 Away    0          Home    1             31
##  3 Away    0          Home    2             33
##  4 Away    0          Home    3              8
##  5 Away    0          Home    4              1
##  6 Away    1          Home    0             26
##  7 Away    1          Home    1            334
##  8 Away    1          Home    2            477
##  9 Away    1          Home    3            148
## 10 Away    1          Home    4             33
## 11 Away    2          Home    0             12
## 12 Away    2          Home    1            201
## 13 Away    2          Home    2            969
## 14 Away    2          Home    3            195
## 15 Away    2          Home    4             47
## 16 Away    3          Home    0              4
## 17 Away    3          Home    1             46
## 18 Away    3          Home    2            191
## 19 Away    3          Home    3             82
## 20 Away    3          Home    4             17
## 21 Away    4          Home    0              2
## 22 Away    4          Home    1             11
## 23 Away    4          Home    2             35
## 24 Away    4          Home    3             17
## 25 Away    4          Home    4             12
## 26 Home    0          Away    0             66
## 27 Home    0          Away    1             35
## 28 Home    0          Away    2             20
## 29 Home    0          Away    3              8
## 30 Home    0          Away    4              1
## 31 Home    1          Away    0             47
## 32 Home    1          Away    1            431
## 33 Home    1          Away    2            242
## 34 Home    1          Away    3             70
## 35 Home    1          Away    4              4
## 36 Home    2          Away    0             54
## 37 Home    2          Away    1            795
## 38 Home    2          Away    2           1335
## 39 Home    2          Away    3            275
## 40 Home    2          Away    4             49
## 41 Home    3          Away    0             10
## 42 Home    3          Away    1            216
## 43 Home    3          Away    2            280
## 44 Home    3          Away    3            110
## 45 Home    3          Away    4             13
## 46 Home    4          Away    0              4
## 47 Home    4          Away    1             56
## 48 Home    4          Away    2             69
## 49 Home    4          Away    3             21
## 50 Home    4          Away    4             13

胜利总数在右侧的列 n 中表示。例如，看看第一行。当客队和主队都没有先前休息日时，客队赢了 35 次。现在看看第 26 行；同样，当客队和主队都没有先前休息日时，主队赢了 66 次。

然后，我们对 finaldf 调用基本的 R sum() 函数来返回 n 的总和——它等于 7,191，当然，一旦我们将 mydata 子集化，使得变量 teamDayOff 和 opptDayOff 都等于或小于 4，这个数字就与 mydata 的行数相同：

sum(finaldf$n) 
## [1] 7191

我们现在有了分面图的数据源。

9.5.2 可视化结果

我们的ggplot2面图可视化在 finaldf 中每个可能的休息日排列组合的主队和客队胜负次数。（再次强调，面图是由多个子图组成的可视化类型，每个子图具有相同的坐标轴，每个子图代表数据的一个互斥子集。）由于有五种休息日可能性（0-4）和两支球队（主队和客队），休息日排列组合的数量等于 5²，即 25。因此，我们的面图有 25 个面板。每个面板顶部都附有前一天休息日的排列组合，其中顶部数字适用于主队，底部数字适用于客队。创建我们的面图的具体说明如下：

• 我们将n设置为 x 轴变量，将teamLoc设置为 y 轴变量；因此，我们的结果将以水平而不是垂直的方式可视化。

• 调用geom_bar()函数在每个面板中以条形图的形式可视化结果；stat = identify参数告诉 R 将条形的长度与变量n匹配。

• facet_wrap()函数指示 R 将teamDayOff/opptDayOff排列组合与 25 个面板匹配。R 将自动将 25 个面板排列成 5×5 的网格，但可以通过向facet_wrap()函数添加ncol参数并指定列数来自定义布局，这样就会相应地增加或减少行数以保持 25 个面板不变。此外，x 轴刻度默认固定，以在整个面板中保持一致。但这也可以通过使用scales包与facet_wrap()函数一起使用并设置为free来自定义；R 将根据每个排列的结果独立缩放每个面板或 x 轴。我们尝试了这两种选项，但可以肯定的是，默认设置有其原因。

• 添加了xlim()函数来延长 x 轴的长度。我们这样做是为了确保我们附加在水平条形图“顶部”的标签能够适应所有面板，尤其是在记录计数最高的地方。

• 这些标签是通过添加geom_text()函数实现的；vjust和hjust参数调整标签的垂直和水平位置。

我们通过首先调用ggplot()函数来创建我们的面图（实际上任何ggplot2对象）——然后通过交替调用加号（+）运算符和其他ggplot2函数来逐步添加功能。请注意，R 可能不会仅仅跳过没有加号（+）运算符的前置的ggplot()函数；相反，R 可能会抛出一个错误或返回NULL。这完全取决于没有加号（+）运算符的前置函数。以下是对象的调用：

ggplot(data = finaldf, aes(x = n, y = teamLoc, fill = teamLoc)) +
  geom_bar(stat = "identity") +
  facet_wrap(teamDayOff~opptDayOff) +
  labs(title = 
         "Home and Away Win Totals Broken Down by Days Off Permutations", 
       subtitle = "2012-13 to 2017-18 Regular Seasons", 
       caption = "Top Numbers: Home team prior days off
       Bottom Numbers: Away team prior days off",
       x = "Win Totals",
       y = "") +
  xlim(0,1500) +
  geom_text(aes(label = n, vjust = 0.1, hjust = -0.1)) +
  theme(plot.title = element_text(face = "bold")) +
  theme(legend.position = "none")

图 9.1 将面图分为 25 个面板，通过一系列条形图展示了通过前一天休息日的排列组合来分解主队和客队胜负情况。

9.5.3 结论

看到这些结果非常令人着迷，因为休息似乎对胜负有巨大的影响。仅举一个例子，当主队休息两天而客队只休息一天时，主队赢得了 996 场比赛中的 795 场，或者说接近 80%。但当客队休息两天而主队只休息一天时，客队赢得了大约三分之二的比赛。记住，我们的参考点是 58.7%——这是无论主队和客队之间前一天休息日多少，主队胜率。

在下面展示的 dplyr 代码块中，我们计算了当两支球队都有相同数量的前一天休息日时，主队和客队的胜利次数。随后是一对 SELECT 语句，我们在这里调用 sqldf() 函数，仅用于比较目的；sqldf 代码在其他方面与上面的 dplyr 代码相同：

finaldf %>%
  filter(teamDayOff == opptDayOff) %>%
  group_by(teamLoc) %>%
  summarize(wins = sum(n))
## # A tibble: 2 × 2
##   teamLoc  wins
##   <fct>   <int>
## 1 Away     1432
## 2 Home     1955

sqldf("select SUM(n) FROM finaldf WHERE teamLoc ='Home' and 
      teamDayOff = opptDayOff")
##   SUM(n)
## 1   1955

sqldf("select SUM(n) FROM finaldf WHERE teamLoc ='Away' 
      and teamDayOff = opptDayOff")
##   SUM(n)
## 1   1432

当主队和客队在前一天休息日数量相等时，主队赢得了 57.7% 的比赛，这非常接近他们在 2012-13 赛季和 2017-18 赛季常规赛中的整体胜率。

在下一个 dplyr 代码块中，我们计算了当主队比客队有更多前一天休息日时，主队胜利次数和客队胜利次数。注意，我们临时将变量 teamDayOff 和 opptDayOff 从因子转换为数值变量，因为大多数数学运算符不适用于因子。同样，我们再次调用 sqldf() 函数两次，并编写另一对 SELECT 语句，提供与我们的 dplyr 代码相同的输出：

finaldf %>%
  filter(as.numeric(teamDayOff) > as.numeric(opptDayOff)) %>%
  group_by(teamLoc) %>%
  summarize(wins = sum(n))
## # A tibble: 2 × 2
##   teamLoc  wins
##   <fct>   <int>
## 1 Away      545
## 2 Home     1552

sqldf("select SUM(n) FROM finaldf WHERE teamLoc ='Home' 
      and teamDayOff > opptDayOff")
##   SUM(n)
## 1   1552

sqldf("select SUM(n) FROM finaldf WHERE teamLoc ='Away' 
      and teamDayOff > opptDayOff")
##   SUM(n)
## 1    545

当主队比客队多休息一天或以上时，主队赢得了 74% 的比赛。

在下一个也是最后的 dplyr 代码块中，我们计算了当客队比主队有更多前一天休息日时，主队胜利次数和客队胜利次数。随后，我们再次调用 sqldf() 函数以返回相同的输出：

finaldf %>%
  filter(as.numeric(teamDayOff) < as.numeric(opptDayOff)) %>%
  group_by(teamLoc) %>%
  summarize(wins = sum(n))
## # A tibble: 2 × 2
##   teamLoc  wins
##   <fct>   <int>
## 1 Away      990
## 2 Home      717

sqldf("select SUM(n) FROM finaldf WHERE teamLoc ='Home' 
      and teamDayOff < opptDayOff")
##   SUM(n)
## 1    717

sqldf("select SUM(n) FROM finaldf WHERE teamLoc ='Away' 
      and teamDayOff < opptDayOff")
##   SUM(n)
## 1    990

客队在它比主队多休息一天或以上的比赛中赢得了 58% 的比赛。这些结果似乎很显著，但让我们进行统计检验来确认（或发现其他情况）。

9.6 显著性统计检验

现在我们将进行所谓的卡方检验，以确定这些差异是否具有统计学意义。当因变量是数值时，t 检验用于计算统计显著性或缺乏显著性，而当因变量是分类变量时，使用卡方检验。与 t 检验一样，我们的零假设是两个变量之间没有有意义的关系，并且一个变量的值不能帮助预测另一个变量的值。因此，我们需要一个等于或小于我们预定义的 0.05 显著性阈值的 p 值，以拒绝零假设，并得出结论，休息对胜负有影响。

这里是三个假设但却是现实世界的卡方检验例子：

• 我们想确定选民对增加公立学校资金法案的情感与婚姻状况之间是否存在关系。零假设，或H[0]，是情感和婚姻状况彼此独立；备择假设，或H[1]，是情感和婚姻状况并不独立。这类数据通常通过调查收集。研究人员在研究调查回答时经常使用卡方检验来检验独立性。

• 我们对测试性别与政治信仰之间潜在关系感兴趣。零假设是性别与一个人是否将自己视为自由派或保守派之间不存在关系；备择假设是性别与政治相关。

• 我们希望通过星期几来衡量餐厅的顾客数量。零假设是，无论星期几，餐厅提供的顾客数量相同或大致相同；备择假设是，顾客数量按星期几变化，可能变化很大。

考虑到所有因素，我们正在比较卡方检验的 p 值与预先定义的 5%统计显著性阈值——就像我们之前在 t 检验中所做的那样。如果 p 值小于 5%，我们将拒绝零假设，即任何差异更多或更少是由于偶然性造成的；如果大于 5%，我们将无法拒绝那个相同的零假设——再次，就像我们在 t 检验中所做的那样。我们现在运行的是卡方检验的独立性，而不是 t 检验，因为我们现在处理的是分类数据，而回想起第六章，我们当时处理的是数值数据。这就是为什么我们将在之后运行 Cramer’s V 效应量测试而不是 Cohen’s d 效应量测试的原因。

9.6.1 创建列联表和气球图

在上一节中我们计算出的输出被放入了一个 3 × 2 的列联表，称为 chisq_table。列联表是一种通过水平（或按行）显示一个分布，而垂直（或按列）显示另一个分布的方式来总结分类数据的方法；简而言之，我们将我们的列联表传递给卡方检验。我们通过调用基础 R 的matrix()函数来初始化列联表；因此，至少在目前，我们的列联表实际上是一个矩阵而不是一个表格。三行分别标记为“更多休息”、“相同休息”和“较少休息”（毕竟，每个队伍的休息时间都比对方队伍多、少或相同）而两列分别标记为“主场胜利”和“主场失利”（所有比赛都以这两种结果之一结束，但显然在标签上还有其他选择）：

chisq_table <- matrix(c(1552, 545, 1955, 1432, 717, 990), 
                      ncol = 2, byrow = TRUE)
rownames(chisq_table) <- c("More Rest", "Same Rest", "Less Rest")
colnames(chisq_table) <- c("Home Wins", "Home Losses")
print(chisq_table)
##           Home Wins Home Losses
## More Rest      1552         545
## Same Rest      1955        1432
## Less Rest       717         990

可视化列联表的一种方法是通过气球图（见图 9.2），在 R 中创建气球图的一种方法是通过调用gplots包中的balloonplot()函数，并结合基础 R 中的t()函数。t()函数通过交换行和列来转置矩阵或数据框。这不是绝对必要的，但balloonplot()函数本身会自动转置我们的列联表。因此，t()函数仅仅是将列联表恢复到其原始维度。

图 9.2 气球图是可视化 R 中列联表的一种方法。

balloonplot()函数需要一个表格作为数据源，因此我们首先通过将chisq_table作为矩阵传递给基础 R 的as.table()函数，将chisq_table从矩阵转换为表格，然后创建我们的可视化：

chisq_table <- as.table(as.matrix(chisq_table))
balloonplot(t(chisq_table), main = "Home Wins and Home Losses", 
            xlab = "", ylab = "",
            label = TRUE, show.margins = TRUE)

我们的气球图可能不是我们迄今为止创建的最优雅的视觉化图表，但它确实完成了任务。它基本上是一个图形化的列联表或矩阵，其中点的大小反映了记录数。我们可以清楚地看到，当主队比客队有更多休息时间时，主队的表现更加成功；而当对手反而有更多休息时间时，主队的表现则不那么成功。

当label等于TRUE时，R 会在点内添加记录数；当show.margins等于TRUE时，R 会汇总每一行和每一列，并将总数打印在表格的外面。

9.6.2 运行卡方检验

我们通过调用基础 R 的chisq.test()函数并传递我们的列联表（现在实际上是一个表格）作为唯一参数来运行我们的独立性卡方检验。这和运行 t 检验一样简单直接：

options(scipen = 999)

test <- chisq.test(chisq_table)
test
## 
##  Pearson's Chi-squared test
## 
## data:  chisq_table
## X-squared = 400.5, df = 2, p-value < 0.00000000000000022

我们的结果以完整的数字形式返回，因为我们通过禁用基础 R 中的options()函数的指数表示法并通过传递scipen = 999参数来提前处理我们的代码。因为 p 值小于显著性阈值 0.05（实际上要小得多），因此我们可以拒绝零假设，并得出结论，休息时间和胜负之间存在显著的统计关系。我们的零假设——在这里以及总是——是变量之间相互独立，因此一个变量的值不能也不应该预测另一个变量的值。只有当证据表明我们的结果几乎完全不可能随机时，我们才能并且应该拒绝零假设，并接受备择假设。这就是为什么我们通常要求 p 值在 5%或以下才能拒绝任何零假设。

9.6.3 创建 mosaic 图

空间拼图是列联表的另一种图形表示方法（见图 9.3）。然而，vcd包中的mosaic()函数更进一步——除了绘制表示分类变量之间关系的图片外，mosaic()函数还通过独立计算 p 值并将结果返回到右下角，添加了我们关于独立性的卡方检验结果。

图 9.3 空间拼图是另一种在 R 中可视化列联表的方法。完全没有必要创建气球图和空间拼图——推荐选择其中一个——你应该选择最适合你的图表。

我们调用mosaic()函数并将我们的列联表作为第一个参数。当shade等于TRUE时，R 会在实际结果与预期结果不一致的地方添加颜色到图中；当legend也等于TRUE时，R 会在图的右侧添加一个图例，以皮尔逊残差的形式。皮尔逊残差表示实际结果与预期结果之间的标准化距离：

mosaic(chisq_table, shade = TRUE, legend = TRUE,
       main = "Home Wins and Home Losses")

矩形的尺寸或长度代表比例值。与休息时间相等的情况相比，当主队至少有额外一天的休息时间时，主队获胜的频率更高，而当情况相反时，获胜的频率更低。

9.7 效应量测试

Cramer’s V 测试对于分类数据就像 Cohen’s d 测试对于连续数据；因此，Cohen’s d 测试补充了 t 检验，而 Cramer’s V 测试补充了独立性卡方检验。我们在这里的目的是要展示两种计算 Cramer’s V 效应量测试的方法，我们将我们的列联表 chisq_table 传递给一对类似的功能，它们返回相似的结果。

从我们的卡方检验中，我们了解到休息时间和胜负之间存在统计显著的关联；然而，卡方检验并没有提供关于这种关联可能“如何”显著的任何见解。无论从哪个包中调用哪个函数，Cramer’s V 测试都会返回一个介于 0 到 1 之间的数字，其中 0 表示两个变量之间完全没有关联，而 1 表示两个变量之间有强烈的关联。

我们首先调用questionr包中的cramer.v()函数：

cramer.v(chisq_table)
## [1] 0.2359978

然后，我们调用rcompanion包中的cramerV()函数：

cramerV(chisq_table)
## Cramer V 
##    0.236

因此，我们得到了两个操作相同的结果；基于结果等于 0.24，我们可以得出结论，效应量较小。在第六章中，我们强调了像 Cohen’s d 这样的效应量测试是补充而不是取代统计显著性测试，如 t 检验，并且我们不应该将两个结果相关联。在这里，我们的卡方检验和随后的 Cramer’s V 效应量测试也是如此。

在下一章中，我们将探讨球队工资、常规赛胜利、季后赛出场和联赛冠军之间可能存在的关系。

摘要

• 休息显然是胜负的重要因素。我们的卡方检验独立性证实了我们之前计算和可视化的结果——主客场之间的胜负会随着之前的休息日而翻转。在 R 中，你可以用一行或两行内置代码编写和运行显著性检验。

• 对于分类数据的效应量测试也是如此；在 R 中运行 Cramer 的 V 测试只需要一行代码，无论你选择哪个包的哪个函数。

• 理解排列组合以及有放回和无放回之间的区别至关重要。根据问题类型，公式可能会有根本性的不同；恰好排列组合有放回的情况可能是最简单的。

• 虽然脑力必须来自你，但 R 可以完成繁琐的工作和重活。计算排列几乎不是日常任务，但 R 包含多个包和多个函数来完成这项任务。此外，计算排列计数只需一行代码，打印所有排列只需额外一行代码。

• 将条形图转换为ggplot2分面图只需额外一行代码。我们的气球图和马赛克图可能不是我们迄今为止创建的最复杂的图表，但它们仍然像以前一样引人入胜，而且制作起来也很容易。

• 由于休息的重要性及其带来的益处，NBA 在生成常规赛日程时，如果可能的话，应考虑安排休息日。此外，如果拉斯维加斯的体育博彩公司还没有这样做，它们应该将之前的休息日纳入其算法中。

10 使用 ggplot2 做更多操作

本章涵盖

• 创建相关图、点图和棒棒糖图

• 通过转换和连接修改ggplot2标签

• 通过图例、注释和形状增强ggplot2可视化

• 根据组别更改ggplot2颜色

• 揭示辛普森悖论

本章的目的是量化并可视化 NBA 中球队工资和球队成就之间的关系。在这个过程中，我们将展示如何通过ggplot2图形包进行超越——通过实验非传统类型的图表；通过转换和增强轴标签；通过添加图例、注释和形状；以及通过颜色分段分组。当我们可视化数据而不是将其限制在表格的行和列中时，我们加快了从数据中学习的能力和采取行动的能力。我们能够轻松地看到变量之间的相关性、时间趋势、异常模式、频率、分布和异常值，这些在电子表格或其他类似输出中几乎无法发现。有时，一些小的改动可以对您的视觉内容产生重大影响。

话虽如此，在继续之前，我们需要考虑几个注意事项。首先，球队工资总额等于球员工资的总和，因此不包括通常补充球员工资的代言费和其他收入来源。我们只计算球队支付给员工的资金。其次，从现在开始，球队成就将以三种方式衡量：常规赛胜利、季后赛出场和联赛冠军。我们的旅程将涵盖几条路径：

• 量化并可视化球队工资和常规赛胜利之间的年度相关性（见第 10.4.1 节）

• 按赛季对球队工资进行排名排序，并将赛季末的结果分类到三个级别的因子变量中（见第 10.4.2 节）

• 通过一系列棒棒糖图比较平均球队工资和不同的赛季结束结果（见第 10.4.3 节）

但首先，让我们处理一些清理任务。

10.1 加载包

为了实现这些目标，我们需要超越基本的 R 语言；因此，我们三次调用library()函数来加载之前使用过的三个包。作为提醒，我们之前在第四章中介绍的scales包包括用于转换ggplot2标签格式的函数：

library(tidyverse)
library(scales)
library(patchwork)

接下来，我们将导入我们的数据集。

10.2 导入和查看数据

本章我们将使用两个数据集。第一个数据集，称为 cap，只有 18 行，3 列宽。它包含了 2000 年至 2017 年每个赛季的真实 NBA 工资帽，以及 2021 年的工资帽，使用www.usinflationcalculator.com的工具进行了通货膨胀调整，数据来源于www.basketball-reference.com。

我们的第二个数据集，称为薪资，包含了 2000 年至 2017 年间每个 NBA 球队的实付和通胀调整后的工资总额；实付工资是从一个名为 Celtics Hub 的波士顿凯尔特人球迷网站获得的（www.celticshub.com；打印时网站处于维护状态），调整后的工资是通过www.usinflationcalculator.com计算得出的。此外，薪资数据集还包含了每个球队和赛季组合的常规赛胜利总数和季后赛结果，这些数据是从www.basketball-reference.com抓取的。

这两个数据集都是存储在我们默认工作目录中的.csv 文件。因此，我们调用readr的read_csv()函数两次来导入它们：

cap <- read_csv("salary_cap.csv")

salaries <- read_csv("salaries.csv")

以下是一些关于薪资数据集的简短说明：

• NBA 在 1999-2000 赛季至 2003-2004 赛季之间有 29 支球队，此后每年有 30 支球队；因此，我们的薪资数据集中包含几个“不可用”（NA）值。我们将展示如何处理 NA 值，以确保缺失值不会妨碍我们的分析。

• 我们在整个文档中使用了当前的球队名称，尽管一些球队之前曾在另一个城市甚至另一个州进行主场比赛。例如，篮网队只被称为布鲁克林篮网，尽管他们之前在泽西州比赛时被称为新泽西篮网；雷霆队，当他们在西雅图比赛时被称为超音速，现在只被称为俄克拉荷马城雷霆。球队有时会搬迁并因此更改名称，但它们仍然是同一个特许经营，通常由同一个所有权集团拥有。

调用dplyr的glimpse()函数会返回薪资行的数量和列的数量，以及数据的转置视图。然而，我们首先调用options()函数，以确保glimpse()函数以及当然，几乎之后的每一个操作，都以原始或原始格式返回结果，而不是以科学记数法。你应该预期，除非事先禁用，否则在处理包含大量数字的数字时，科学记数法会自动生效。即使是 NBA 中最边缘的球员也是百万富翁多次；因此，我们所有的薪资或工资数据都包含很多零。我们更喜欢以全数字形式返回工资数据，然后，如有必要，用智能和可读的转换覆盖结果：

options(scipen = 999)

科学记数法和 tibbles

我们在前面一章提到，tibbles 并不总是与基础 R 函数一起工作。事实证明，在某些时候禁用科学记数法对 tibbles 有效，但有时则无效。然而，我们将在第 10.3 节中展示一个非常简单的解决方案。

考虑到空间，我们将薪资传递给dplyr select()函数以减少我们的数据，这样glimpse()函数就只返回变量Team和 2017 数据的子集：

salaries %>%
  select(Team, s2017, sa2017, w2017, pc2017) %>%
  glimpse()
## Rows: 30
## Columns: 5
## $ Team   <chr> "Atlanta Hawks", "Boston Celtics", "Brooklyn Nets", ...
## $ s2017  <dbl> 95471579, 87272327, 72926799, 99780303, 94291373, 13...
## $ sa2017 <dbl> 102154590, 93381390, 78031675, 106764924, 100891769,...
## $ w2017  <dbl> 43, 53, 20, 36, 41, 51, 33, 40, 37, 67, 55, 42, 51, ...
## $ pc2017 <dbl> 10, 10, 0, 0, 10, 10, 0, 0, 0, 11, 10, 10, 10, 0, 10...

对dim()函数的后续调用为我们提供了薪资数据集的完整维度：

dim(salaries)
## [1] 30 73

薪资数据集的宽度几乎是长度的两倍半。以下是您需要立即了解的数据信息：

• s2017 至 s2000 列代表年度球队实际薪资，例如，s2017 等于 2016-17 赛季。

• sa2017 至 sa2000 列代表按通货膨胀调整后的年度球队薪资。

• w2017 至 w2000 列代表年度常规赛胜利总数（所有 NBA 球队都参加 82 场比赛的赛程，减去因罢工和流行病等意外事件造成的破坏）。

• pc2017 至 pc2000 列代表年度赛季结束时的结果，其中 0 表示球队未能进入季后赛，10 表示球队有资格参加季后赛但途中输掉了比赛，11 表示赢得了联赛冠军。

现在来分析一下球员薪资和薪资上限的时间序列。薪资上限是球队在球员薪资上允许花费的最高限额；联盟几乎每年都会调整薪资上限，至少是为了应对通货膨胀。

10.3 薪资和薪资上限分析

本章中的第一个可视化是一个ggplot2折线图，显示了 2000 年至 2017 年 NBA 薪资上限的实值美元（USD）和通货膨胀调整后的美元（2021 USD）。我们导入的第一个数据集，cap，是我们的数据源（见图 10.1）：

• 因此，我们两次调用geom_line()函数来绘制两条线，一条实线，一条虚线。R 默认所有线都是实线，除非另有说明；除了虚线之外，还有其他几种选择。

• 为了将我们的 y 轴标签从，比如说，90000000 转换为更易读的$90,000,000，我们两次调用scale_y_continuous()函数——首先，为这些大（有些人可能会说是过分的）薪资数字添加逗号，其次，在这些数字前加上美元符号。这两个操作都是通过scales包一起完成的。虽然scales包是tidyverse的一部分，通过ggplot2包实现，但 R 在调用未单独和独立于tidyverse或ggplot2加载的scales函数时抛出错误并不罕见。

• 由于我们没有添加图例，我们还两次调用annotate()函数，在指定的 x 和 y 坐标相遇的位置添加一对标签；我们的标签通过指定哪些线代表哪些数据系列来代替图例。

图 10.1 2000 年至 2017 年 NBA 薪资上限（美元）和 2021 年美元。例如，2010 年的薪资上限略低于 6000 万美元。将这个数字转换为 2021 年美元，上限变为大约 7000 万美元，这就是为什么两条线最终会汇合。无论我们是以实际美元还是调整通货膨胀后的美元来查看上限，球员薪资自 2000 年以来或多或少都急剧上升。

再次，我们通过首先调用ggplot()函数来初始化一个ggplot2对象。然后我们指定 R 要绘制的图表类型，并通过随后调用其他ggplot2函数来装饰它：

p1 <- ggplot(cap, aes(x = year, y = real, group = 1)) + 
  geom_line(aes(y = real), color = "steelblue", size = 1.5, 
            linetype = "dashed") +
  geom_line(aes(y = adjusted), color = "black", size = 1.5) +
  labs(title = "NBA Salary Cap in USD and 2021 USD", 
       subtitle = "2000-2017", 
       x = "Season", 
       y = "Dollars") +
  theme(plot.title = element_text(face = "bold")) +
  scale_y_continuous(labels = comma) +
  scale_y_continuous(labels = dollar) +
  annotate("text", x = 2005, y = 68000000, label = "2021 USD", 
           fontface = "bold", color = c("black")) +
  annotate("text", x = 2008, y = 50000000, label = "USD", 
           fontface = "bold", color = c("steelblue")) 
print(p1)

根据我们的第一个图表，NBA 薪资上限在 2017 年接近了 1 亿美元。薪资上限代表了一年中球队在球员薪资上允许花费的最高金额（尽管有一些允许的例外）。大多数球队在任何时候都会在其活跃名单上拥有大约 15 名球员，这表明平均球员每年可以赚取高达 700 万美元的薪资。

使用ggplot2线型和线宽

默认情况下，ggplot2折线图以实线绘制；换句话说，如果你想要实线，ggplot2会自动为你处理。但ggplot2也支持其他线型：虚线、点线、点划线、长划线和双划线。你只需将linetype参数传递给geom_line()函数，并在单引号或双引号内指定你想要或需要ggplot2绘制的线型即可，而不是默认的线型。

此外，你可以调整任何线的宽度，无论其类型如何。例如，当传递给geom_line()的大小参数等于1.5时，你是在告诉ggplot2绘制比默认值宽 50%的线。当大小参数设置为，比如说，0.8时，你是在告诉ggplot2绘制默认值的 80%宽度的线。

我们的第二个可视化是另一个需要一些数据整理的ggplot2折线图。我们首先从薪资数据创建一个新的数据集，称为mean_salaries_real。summarize()函数计算实际美元的平均团队薪资，而dplyr across()函数将计算应用于薪资变量的连续子集。na.rm参数设置为TRUE，以便平均计算实际上忽略了薪资数据集中的 NA 值；否则 R 会出错。

此外，请注意，我们在打印时通过调用基础 R 的as.data.frame()函数，将mean_salaries_real从tibble转换为经典数据框。这是因为 R 否则会以科学记数法返回结果；解决方案是将对象从tibble转换为数据框：

salaries %>%
  summarize(across(s2017:s2000, mean, na.rm = TRUE)) -> mean_salaries_real
print(as.data.frame(mean_salaries_real))
##      s2017    s2016    s2015    s2014    s2013    s2012
## 1 95461491 79261793 73862841 71669986 70503755 67299568
##      s2011    s2010    s2009    s2008    s2007    s2006
## 1 67529008 70437138 71950425 68796241 64645788 63248999
##      s2005    s2004    s2003    s2002    s2001    s2000
## 1 59122201 57676465 57580407 53744919 51853886 45314984

我们的新数据集有一个行和一个 18 列的维度。接下来，我们调用 tidyr 包中的 pivot_longer() 函数将 mean_salaries_real 转换为一个包含 18 行和两列（year 和 real）的长而精简的数据集。之前的列 s2017 到 s2000 转换为 year 列的值，薪资转换为 real 列的值。我们得到一个新的对象，称为 new_mean_salaries_real：

mean_salaries_real %>%
  pivot_longer(col = c(s2017:s2000),
               names_to = "year",
               values_to = "real") -> new_mean_salaries_real
print(new_mean_salaries_real)
## # A tibble: 18 × 2
##    year       real
##    <chr>     <dbl>
##  1 s2017 95461491.
##  2 s2016 79261793.
##  3 s2015 73862841.
##  4 s2014 71669986.
##  5 s2013 70503755.
##  6 s2012 67299568.
##  7 s2011 67529008.
##  8 s2010 70437138.
##  9 s2009 71950425.
## 10 s2008 68796241.
## 11 s2007 64645788.
## 12 s2006 63248999.
## 13 s2005 59122201.
## 14 s2004 57676465.
## 15 s2003 57580407.
## 16 s2002 53744919.
## 17 s2001 51853886.
## 18 s2000 45314984

这两个步骤随后被重复执行：

• 首先，调整薪资变量替代了实际薪资，并计算了 2000 年至 2017 年间平均调整后的球队工资。

• 然后，调用 pivot_longer() 函数将数据从宽格式转换为长格式。这产生了一个 18 × 2 的数据集，称为 new_mean_salaries_adjusted，其中 year_temp 中的单元格填充了之前的列 sa2017 到 sa2000，而这些列中的值现在变为调整列中的值。

我们的代码块和结果如下：

salaries %>%
  summarize(across(sa2017:sa2000, mean, 
                   na.rm = TRUE)) -> mean_salaries_adjusted

mean_salaries_adjusted %>%
  pivot_longer(col = c(sa2017:sa2000),
               names_to = "year_temp",
               values_to = "adjusted") -> new_mean_salaries_adjusted
print(new_mean_salaries_adjusted)
## # A tibble: 18 × 2
##    year_temp   adjusted
##    <chr>          <dbl>
##  1 sa2017    102143796.
##  2 sa2016     87187972.
##  3 sa2015     81987754.
##  4 sa2014     79553685.
##  5 sa2013     79669243.
##  6 sa2012     77394503.
##  7 sa2011     79008939.
##  8 sa2010     85228938.
##  9 sa2009     88499022.
## 10 sa2008     83931414.
## 11 sa2007     82100151 
## 12 sa2006     82223699.
## 13 sa2005     79814972.
## 14 sa2004     80170286.
## 15 sa2003     82339982.
## 16 sa2002     78467582.
## 17 sa2001     77262290.
## 18 sa2000     69331926.

我们通过调用基础 R 的 cbind() 函数，或列绑定函数，将 new_mean_salaries_real 和 new_mean_salaries_adjusted 结合起来创建一个新的对象或数据集，称为 salaries_temp：

salaries_temp <- cbind(new_mean_salaries_real, new_mean_salaries_adjusted)
print(salaries_temp)
##     year     real year_temp  adjusted
## 1  s2017 95461491    sa2017 102143796
## 2  s2016 79261793    sa2016  87187972
## 3  s2015 73862841    sa2015  81987754
## 4  s2014 71669986    sa2014  79553685
## 5  s2013 70503755    sa2013  79669243
## 6  s2012 67299568    sa2012  77394503
## 7  s2011 67529008    sa2011  79008939
## 8  s2010 70437138    sa2010  85228938
## 9  s2009 71950425    sa2009  88499022
## 10 s2008 68796241    sa2008  83931414
## 11 s2007 64645788    sa2007  82100151
## 12 s2006 63248999    sa2006  82223699
## 13 s2005 59122201    sa2005  79814972
## 14 s2004 57676465    sa2004  80170286
## 15 s2003 57580407    sa2003  82339982
## 16 s2002 53744919    sa2002  78467582
## 17 s2001 51853886    sa2001  77262290
## 18 s2000 45314984    sa2000  69331926

由于我们不需要变量 year 和 year_temp，我们通过将 salaries_temp 数据集传递给 dplyr select() 函数并实质上取消选择它来移除 year_temp：

salaries_temp %>% 
  select(-c(year_temp)) -> salaries_temp

然后，我们通过调用基础 R 的 as.factor() 函数将变量 year 转换为因子。同时，我们将值 2017 通过 2000 传递给 as.factor()，作为 s2017 通过 s2000 的完全替换：

salaries_temp$year <- as.factor(2017:2000)
print(salaries_temp)
##    year     real  adjusted
## 1  2017 95461491 102143796
## 2  2016 79261793  87187972
## 3  2015 73862841  81987754
## 4  2014 71669986  79553685
## 5  2013 70503755  79669243
## 6  2012 67299568  77394503
## 7  2011 67529008  79008939
## 8  2010 70437138  85228938
## 9  2009 71950425  88499022
## 10 2008 68796241  83931414
## 11 2007 64645788  82100151
## 12 2006 63248999  82223699
## 13 2005 59122201  79814972
## 14 2004 57676465  80170286
## 15 2003 57580407  82339982
## 16 2002 53744919  78467582
## 17 2001 51853886  77262290
## 18 2000 45314984  69331926

最后，我们现在可以创建第二个 ggplot2 线形图（见图 10.2）。在这里，我们展示了从 2000 年至 2017 年平均每支球队工资（实际和调整后）的变化趋势；否则，我们的第二个线形图与第一个可视化（p1）的拟合、形式和功能完全相同，只是我们通过第二次调用 theme() 函数将 x 轴标签旋转了 45 度：

p2 <- ggplot(salaries_temp, aes(x = year, y = real, group = 1)) + 
  geom_line(aes(y = real), color = "steelblue", 
            size = 1.5, linetype = "dashed") +
  geom_line(aes(y = adjusted), color = "black", size = 1.5) +
  labs(title = "Average Payroll per NBA Team in USD and 2021 USD", 
       subtitle = "2000-2017", 
       x = "Season", 
       y = "Dollars") +
  theme(plot.title = element_text(face = "bold")) + 
  scale_y_continuous(labels = comma) +
  scale_y_continuous(labels = dollar) +
  annotate("text", x = "2003", y = 85000000, 
           label = "2021 USD", fontface = "bold", color = c("black")) +
  annotate("text", x = "2007", y = 61000000, 
           label = "USD", fontface = "bold", color = c("steelblue")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) 
print(p2)

图 10.2 2000 年至 2017 年间实际和调整后的平均球队工资

考虑到通货膨胀的调整，平均球队工资实际上在 2001 年至 2014 年间非常稳定。从那时起，它以递增的速度增长。现在我们已经提供了一些背景信息，接下来我们将进行深入分析。

10.4 分析

在 NBA 中，更成功的球队——即赢得更多常规赛比赛、晋级季后赛并赢得冠军的球队——在球员薪资上的支出比赢得较少常规赛比赛且未能进入季后赛的球队要多。为了提供一些额外的背景信息，特别是对于那些不熟悉典型 NBA 赛季的各位，请考虑以下内容：

• NBA 的 30 支球队分为两个 15 支球队的联盟；常规赛结束时每个联盟的前八名球队有资格进入季后赛。

• NBA 常规赛通常在十月中旬开始，并在下一年四月中旬结束。引用一个从 10 月 2021 年开始并在 4 月 2022 年结束的 NBA 赛季，无论是作为 2021-22 赛季、2022 赛季还是 2022 年，都是同样正确的。所有这些意思相同，都是正确的，因此我们将交替使用这些术语。

• 季后赛紧随常规赛结束之后开始，通常在六月初结束。季后赛和赛季后赛是同义的，因此我们将交替使用这些额外术语。

尽管几乎每条规则都有例外，但我们将看看是否可以证明，至少在 2000 年至 2017 年之间，高薪 NBA 球队比低薪球队更成功。我们将主要通过总结和可视化我们的数据来完成这项工作：显示球队工资与常规赛胜利之间正的、显著年度关系的相关图；显示球队工资排名顺序并将赛季结束情况分类为三个离散的类别或箱子的点图；以及显示按这些相同类别分解的年度平均球队工资的棒棒图。

10.4.1 绘制球队工资与常规赛胜利之间的相关图和计算相关系数

我们的旅程从计算和绘制球队工资与常规赛胜利之间的年度相关系数，并在我们的数据中执行相关测试开始。

计算相关系数和执行相关测试

在 R 中，你可以以多种方式计算数值变量之间的相关系数。计算两个数值变量之间相关系数的最常见和直接方法是通过调用基础 R 的cor()函数。在下面的代码中，我们调用cor()函数来计算 2000 赛季的工资和胜利之间的相关系数。通过添加use = "complete.obs"参数，我们告诉 R 忽略工资数据集中的 NA 值并返回相关系数；否则，R 会返回 NA 而不是相关系数。

cor(salaries$s2000, salaries$w2000, use = "complete.obs")
## [1] 0.5721255

默认情况下，R 返回皮尔逊相关系数，它评估两个数值或连续变量之间的线性关系。如果你希望或需要 R 返回斯皮尔曼相关系数，它基于每个变量的排名值而不是原始数据，只需将method = "spearman"参数添加到cor()函数中：

cor(salaries$s2000, salaries$w2000, method = 'spearman',
    use = "complete.obs")
## [1] 0.4988909

由于我们处理的是区间数据（即，沿数值尺度测量的数据，其中相邻值之间的距离始终相同）而不是有序数据（即，在其类别之间具有自然顺序或层级的分类数据），我们将始终计算皮尔逊相关系数。如果你认为计算斯皮尔曼相关系数是合适的，请注意，与皮尔逊相关系数一样，它们总是等于介于-1 和+1 之间的某个数字，因此应该以相同的方式进行解释。

当然，我们对数据集中所有 18 个赛季的球队工资和胜利之间的相关性感兴趣，而不仅仅是 2000 年的赛季。因此，虽然这种方法简单直接，但它并不是最可扩展的解决方案。另一种方法是只对 salaries 数据集的相关变量进行子集化，然后通过一行代码计算每对变量的相关系数。

首先，我们调用dplyr select()函数，对 salaries 数据集进行子集化，只保留 s2017 到 s2000 之间的 18 个变量和 w2017 到 w2000 之间的 18 个附加变量。然后我们调用基础 R 的dim()函数来返回维度：

salaries %>%
  select(s2017:s2000, w2017:w2000) -> salaries_cor
dim(salaries_cor)
## [1] 30 36

我们的新数据集 salaries_cor 与 salaries 的行数相同，但在宽度上已经有效减少到 36 列。

我们现在可以通过再次调用cor()函数来计算 salaries_cor 中每对变量的相关系数；然而，这次不是传递两个变量作为参数，而是将整个数据集传递。

为了限制结果集，我们首先调用options()函数，其中"max.print"参数等于100；我们不希望给 R 返回每对 36 个变量的相关系数的选项。此外，我们使用基础 R 的round()函数限制了cor()函数，使得 R 只返回小数点后两位的相关系数，而不是默认的七位。尽管如此，我们只打印了完整结果集的一部分：

options("max.print" = 100)

round(cor(salaries_cor, use = "complete.obs"), digits = 2)
##       s2017 s2016 s2015 s2014 s2013 s2012 s2011 s2010 s2009 s2008
## s2017  1.00  0.42  0.41  0.09 -0.09  0.20  0.01  0.20  0.34  0.11
## s2016  0.42  1.00  0.49  0.16 -0.14 -0.20 -0.48 -0.07 -0.04 -0.07
##       s2007 s2006 s2005 s2004 s2003 s2002 s2001 s2000 w2017 w2016
## s2017  0.08  0.04  0.16  0.00  0.10 -0.16 -0.06 -0.02  0.40  0.59
## s2016 -0.21 -0.32 -0.35 -0.38 -0.46 -0.44 -0.22 -0.34  0.48  0.56
##       w2015 w2014 w2013 w2012 w2011 w2010 w2009 w2008 w2007 w2006
## s2017  0.48  0.23 -0.10 -0.10 -0.05  0.21  0.06 -0.07  0.11  0.11
## s2016  0.53  0.43  0.30 -0.03 -0.15 -0.13 -0.16 -0.17  0.16  0.33
##       w2005 w2004 w2003 w2002 w2001 w2000
## s2017 -0.09 -0.11 -0.21 -0.10 -0.21 -0.25
## s2016  0.29 -0.05 -0.38 -0.33 -0.54 -0.57

当每个变量都是数值类型时，这种方法才有效，这也是我们首先对 salaries 数据集进行子集化的原因；如果不是这样，R 会抛出一个错误。但是数据量太大。例如，我们并不关心 2017 年和 2016 年工资之间的相关性；同样，我们也不关心 2017 年工资和 2014 年胜利之间的关系。这使得找到有意义的关联（例如，s2017 和 w2017 之间的相关系数，例如，等于 0.40）变得困难。

让我们尝试另一种方法。在我们的下一个代码块中，以下情况发生：

• 我们首先调用dplyr select()函数，对 salaries_cor 数据集进行子集化，只保留 s2017 和 s2000 之间的变量。

• 接下来，我们调用tidyr包中的pivot_longer()函数，将 salaries_cor 从宽布局转换为薄布局，其中剩下的两列假设变量名为year1和salary。结果被转换为名为 salaries_sals 的 tibble。

最后，我们对 salaries_sals 运行一系列熟悉的 base R 命令来检查结果：

salaries_cor %>%
  select(s2017:s2000) %>%
  pivot_longer(col = c(s2017:s2000),
               names_to = "year1",
               values_to = "salary") -> salaries_sals
dim(salaries_sals)
## [1] 540   2

head(salaries_sals, n = 3)
## # A tibble: 3 × 2
##   year1   salary
##   <chr>    <dbl>
## 1 s2017 95471579
## 2 s2016 72902950
## 3 s2015 58470278

tail(salaries_sals, n = 3)
## # A tibble: 3 × 2
##   year1    salary
##   <chr>     <int>
##   year1   salary
##   <chr>    <dbl>
## 1 s2002 54776087
## 2 s2001 59085969
## 3 s2000 53194441

接下来，我们重复这个练习，以下条件成立：

• salaries_cor 数据集在变量w2017到w2000上进行了子集化，而不是在s2017到s2000上。

• 然后将数据集从宽布局转换为长布局，变量名为year2和wins。

结果被转换为一个名为 salaries_wins 的 tibble，然后我们调用基础 R 的 dim()、head() 和 tail() 函数来检查我们工作的结果：

salaries_cor %>%
  select(w2017:w2000) %>%
  pivot_longer(col = c(w2017:w2000),
               names_to = "year2",
               values_to = "wins") -> salaries_wins
dim(salaries_wins)
## [1] 540   2

head(salaries_wins, n = 3)
## # A tibble: 3 × 2
##   year2  wins
##   <chr> <dbl>
## 1 w2017    43
## 2 w2016    48
## 3 w2015    60

tail(salaries_wins, n = 3)
## # A tibble: 3 × 2
##   year2  wins
##   <chr> <dbl>
## 1 w2002    37
## 2 w2001    19
## 3 w2000    29

然后，我们调用基础 R 的 cbind() 函数将 salaries_sals 和 salaries_wins 合并到一个新的数据集中，称为 salaries_cor2：

salaries_cor2 <- cbind(salaries_sals, salaries_wins)
dim(salaries_cor2)
## [1] 540   4

head(salaries_cor2, n = 3)
##   year1   salary year2 wins
## 1 s2017 95471579 w2017   43
## 2 s2016 72902950 w2016   48
## 3 s2015 58470278 w2015   60

tail(salaries_cor2, n = 3)
##     year1   salary year2 wins
## 538 s2002 54776087 w2002   37
## 539 s2001 59085969 w2001   19
## 540 s2000 53194441 w2000   29

salaries_cor2 数据集共有 540 行，4 列，具有以下特征：

• 每个球队的每份薪资现在都合并到一个列中。

• 每个球队的常规赛胜利总数合并到一个列中。

• 变量 year1 或 year2 可以用作分组标识符。

这意味着我们可以编写一段 dplyr 代码，在其中调用 group_by() 和 summarize() 函数来计算变量 salary 和 wins 之间的相关系数，对于变量 year1（或如果我们希望，year2）中的每个因子或唯一标识符。结果被转换为一个名为 tbl1 的 tibble：

salaries_cor2 %>%
  group_by(year1) %>%
  summarize(cor = round(cor(salary, wins, use = "complete.obs"), 
    digits = 2)) -> tbl1
print(tbl1)
## # A tibble: 18 × 2
##    year1   cor
##    <chr> <dbl>
##  1 s2000  0.57
##  2 s2001  0.37
##  3 s2002  0.13
##  4 s2003  0.31
##  5 s2004  0.21
##  6 s2005  0.15
##  7 s2006  0.02
##  8 s2007  0.1 
##  9 s2008  0.16
## 10 s2009  0.43
## 11 s2010  0.48
## 12 s2011  0.54
## 13 s2012  0.39
## 14 s2013  0.25
## 15 s2014  0.26
## 16 s2015  0.3 
## 17 s2016  0.54
## 18 s2017  0.39

在所有这些之后，我们现在有了 18 个相关系数打包在一个单一的数据对象中，我们将从中提取以进行绘图和分析。

同时，让我们运行一次薪资和胜利之间的相关性测试。我们调用基础 R 的 cor.test() 函数来确定变量 payrolls 和 wins 之间是否存在任何有意义或统计上显著的关系。我们的零假设是没有，但如果我们的测试返回的 p 值或显著性水平等于或低于我们预定义的阈值 0.05，我们将得出结论，实际上这两个变量之间确实存在有意义的关系：

cor.test(salaries_cor2$salary, salaries_cor2$wins)
## 
##  Pearson's product-moment correlation
## 
## data:  salaries_cor2$salary and salaries_cor2$wins
## t = 4.9844, df = 533, p-value = 0.0000008417
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.1285648 0.2906084
## sample estimates:
##       cor 
## 0.2110361

p 值远低于 0.05 的显著性阈值；因此，我们可以拒绝零假设，并接受备择假设，即 2000 年至 2017 年 NBA 赛季之间球队薪资和常规赛胜利之间的关联在统计上是显著的。区分关联和因果关系也很重要；我们的相关性测试结果，特别是在孤立于其他结果和推论的情况下，是前者的证据，而不一定是后者的证据。

可视化年度相关性

现在，让我们可视化变量 s2000 和 w2000 之间的相关性，或者从 2000 赛季开始的真实薪资和常规赛胜利之间的相关性。我们首先调用 select() 函数来对 Team、s2000、w2000 和 pc2000 变量进行子集化，从而创建一个名为 salaries2000 的新数据集。然后我们调用基础 R 的 na.omit() 函数来忽略 salaries2000 中等于 NA 的任何和所有值。

这里是额外的参数：

• 我们的 x 轴是球队薪资（s2000）。我们两次将 scale_x_continuous() 函数与 scales 包结合使用，重新格式化 x 轴标签，以便它们包含逗号和美元符号。

• 我们的 y 轴是胜利（w2000）。

• 通过在 geom_point() 函数中添加 size = 3 参数，数据点的大小增加到默认大小的三倍。

• 所有 NBA 球队根据各自 2000 赛季的结束情况被分为三个组。换句话说，变量pc2000中的三个级别——0、10和11——大致转换为无季后赛、进入季后赛和赢得冠军。

• 我们两次调用geom_smooth()函数来绘制三条趋势线，不包含置信区间。我们第一次调用geom_smooth()为三个因素中的两个绘制趋势线；第二次调用geom_smooth()在整个数据系列上绘制第三条趋势线，不考虑因素。

• 在图上添加了一个图例并固定在底部。

• 我们将 x 轴标签旋转了 45 度以适应。

这是我们的第一个图的代码：

salaries2000 <- select(salaries, Team, s2000, w2000, pc2000)
salaries2000 <- na.omit(salaries2000)

cor1 <- ggplot(salaries2000, aes(x = s2000, y = w2000, 
                                 color = factor(pc2000))) + 
  geom_point(size = 3) +
  labs(title = " Team Payrolls vs. Wins (1999-2000)",
       subtitle = "correlation coefficient = 0.57",
       x = "Team Payrolls", 
       y = "Wins") + 
  scale_x_continuous(labels = comma) +
  scale_x_continuous(labels = dollar) +
  geom_smooth(method = lm, se = FALSE) +
  geom_smooth(method = lm, color = "green4",
              data = salaries2000[salaries2000$s2000 > 20000000,], 
              se = FALSE) +
  theme(plot.title = element_text(face = "bold")) +
  scale_color_manual(name = "", 
                     labels = c("No playoffs", 
                                "Made playoffs", 
                                "Won title"), 
                     values = c("0" = "navy", 
                                "10" = "gold3", 
                                "11" = "red")) +
  theme(legend.position = "bottom") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

现在让我们通过将 2000 年的变量替换为 2001 年，但保持之前的语法，为 2001 年创建一个类似的图：

salaries2001 <- select(salaries, Team, s2001, w2001, pc2001)
salaries2001 <- na.omit(salaries2001)

cor2 <- ggplot(salaries2001, aes(x = s2001, y = w2001, 
                                 color = factor(pc2001))) + 
  geom_point(size = 3) +
  labs(title = " Team Payrolls vs. Wins (2000-01)",
       subtitle = "correlation coefficient = 0.37",
       x = "Team Payrolls", y = "Wins") + 
  scale_x_continuous(labels = comma) +
  scale_x_continuous(labels = dollar) +
  geom_smooth(method = lm, se = FALSE) +
  geom_smooth(method = lm, color = "green4",
              data = salaries2001[salaries2001$s2001 > 20000000,], 
              se = FALSE) +
  theme(plot.title = element_text(face = "bold")) +
  scale_color_manual(name = "", 
                     labels = c("No playoffs", 
                                "Made playoffs", 
                                "Won title"), 
                     values = c("0" = "navy", 
                                "10" = "gold3", 
                                "11" = "red")) +
  theme(legend.position = "bottom") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

我们随后从patchwork package包中调用plot_layout()函数，将我们的两个相关图合并为一个单一的图形对象（见图 10.3）：

cor1 + cor2 + plot_layout(ncol = 2)

图 10.3 两个相关图，一个针对 2000 年，另一个针对 2001 年，可视化球队工资和常规赛胜利之间的关系。

剩余的相关图，涵盖 2002 年至 2017 赛季，显示在本书的附录中。总的来说，除了工资和胜利之间的统计显著性外，考虑到相关系数始终等于-1 和+1 之间的某个数字，并且接近这些极端的结果表明存在强烈的负相关或正相关关系，我们可以得出以下结论：

• 年复一年，或者说赛季复赛季，球队工资和常规赛胜利之间存在正相关关系。换句话说，随着工资的增加，常规赛胜利也会增加。

• 相关系数在年度间似乎没有一致性，实际上，我们的结果中存在大量的变异性。例如，2006 年球队工资和常规赛胜利之间的相关系数低至 0.02，而 2000 年高达 0.57。

• 此外，我们甚至看到连续赛季之间的相关系数缺乏连续性。以 2008 年和 2009 年为例，球队工资和常规赛胜利之间的相关系数从 0.16 跃升至 0.43。

• 几乎每年都有最高工资的球队进入季后赛，而工资最低的球队几乎无法进入季后赛。

• 赢得冠军的球队通常在常规赛胜利和工资总额方面都接近顶端。

此外，让我们简要介绍并讨论一下被称为辛普森悖论（Simpson’s Paradox）的统计现象。当两个变量之间的关联，在分割成多个子群体时，与在考察整个数据系列时相同对变量的关联相矛盾时，辛普森悖论就出现了。2012-13 赛季的结果可能是最好的例子（见附录）。总体而言，工资与常规赛胜利之间存在正相关。然而，当数据按赛季结束因素子集时，这些相同变量之间的关系是平的。我们通过分割数据并为不同的因素分配不同的颜色来获得这种见解；如果我们保持数据完整并未应用颜色方案，我们绝对看不到这种情况。

绘制随时间变化的关联性

我们接下来的可视化显示了使用我们之前创建的 tibble 作为数据源，团队工资与常规赛胜利之间逐年相关系数。但首先，我们调用 dplyr mutate() 函数和内置的 replace() 和 sprintf() 函数，有效地覆盖 tbl1 变量 year1 中的所有值，例如，将 s2014 替换为 14：

• 我们之前调用 mutate() 函数来创建新的或派生变量；这里，它是被调用以帮助更改现有变量的值。

• replace() 函数接受三个参数：我们正在修改的向量名称（year1）、我们要替换的元素（所有 18 个），以及替换值（从 00 到 17）。

• sprintf() 函数格式化字符字符串；这里，我们指示 R 以两位小数点左边的数字和零位小数点右边的数字格式化替换值。否则，R 会将 00 到 09 返回为 0, 1, 2, 3 等等。

然后，我们调用 as.factor() 函数将 year1 从字符字符串转换为因子变量：

tbl1 %>%
  mutate(year1 = replace(year1, 1:18, sprintf("%02.0f", 00:17))) -> tbl1
tbl1$year1 <- as.factor(tbl1$year1)
print(tbl1)
## # A tibble: 18 × 2
##    year1   cor
##    <fct> <dbl>
##  1 00     0.57
##  2 01     0.37
##  3 02     0.13
##  4 03     0.31
##  5 04     0.21
##  6 05     0.15
##  7 06     0.02
##  8 07     0.1 
##  9 08     0.16
## 10 09     0.43
## 11 10     0.48
## 12 11     0.54
## 13 12     0.39
## 14 13     0.25
## 15 14     0.26
## 16 15     0.3 
## 17 16     0.54
## 18 17     0.39

现在，我们可以继续创建我们的可视化，一个包含多个趋势线的 ggplot2 线形图，如下所示：

• tibble tbl1 是我们的数据源，其中变量 year1 占据 x 轴，变量 cor 占据 y 轴。

• 我们对 geom_smooth() 函数的第一次调用在完整的数据系列上绘制了一条趋势线。参数 se = FALSE 告诉 R 不要在趋势线周围绘制置信区间。

• 我们对 geom_smooth() 函数的下一个也是最后的两次调用，绘制了覆盖数据中互斥子集的其他趋势线，以强调从 2006 年开始趋势的急剧变化。

• 最后，我们连续四次调用geom_segment()和annotate()函数来绘制两条垂直箭头和两条水平箭头，然后添加补充文本。箭头是从提供的 x 和 y 坐标到提供的 xend 和 yend 坐标绘制的。请注意，箭头的尖端是终点。箭头可以是垂直的、水平的、对角线的，也可以是向上的或向下的。x 和 xend 坐标等于 x 轴刻度的位置，而 y 和 yend 坐标等于相关系数。可以通过使用unit()函数来调整箭头尖的大小。

• 通过调用annotate()函数，我们在给定的 x 和 y 坐标处添加文本，这些坐标是集合中心点。当向ggplot2对象添加形状和文本层时，请准备好在锁定代码之前进行大量的实验。

我们在这里展示了ggplot代码块：

p3 <- ggplot(tbl1, aes(x = year1, y = cor, group = 1)) + 
  geom_line(aes(y = cor), color = "orange2", size = 2.5) +
  labs(title ="YoY Correlation between Payrolls and Wins",
       subtitle = "2000-17", 
       x = "Season", 
       y = "Correlation Coefficient") +
  geom_smooth(method = lm, color = "blue", se = FALSE) +
  geom_smooth(method = lm, color = "purple", se = FALSE,
            data = tbl1[as.numeric(tbl1$year1) < 08,]) +
  geom_smooth(method = lm, color = "red", se = FALSE,
            data = tbl1[as.numeric(tbl1$year1) > 06,]) +
  theme(plot.title = element_text(face = "bold")) +
  geom_segment(aes(x = 10,
                   y = 0.5,
                   xend = 11,
                   yend = 0.5),
               arrow = arrow(length = unit(0.3, "cm"))) +
  annotate("text", x = 8.7, y = 0.5, 
           label = "YoY Correlations", size = 3) +
  geom_segment(aes(x = 4,
                   y = 0.34,
                   xend = 3,
                   yend = 0.34),
               arrow = arrow(length = unit(0.3, "cm"))) +
  annotate("text", x = 6.3, y = 0.34, 
           label = "Trend between\n2000 and 2006", size = 3) +
  geom_segment(aes(x = 11.5,
                   y = 0.24,
                   xend = 11.5,
                   yend = 0.29),
               arrow = arrow(length = unit(0.3, "cm"))) +
  annotate("text", x = 11.5, y = 0.22, 
           label = "Trend between\n2006 and 2017", size = 3) +
  geom_segment(aes(x = 17.5,
                   y = 0.31,
                   xend = 17.5,
                   yend = 0.36),
               arrow = arrow(length = unit(0.3, "cm"))) +
  annotate("text", x = 17.5, y = 0.27, 
           label = "Trend\nbetween\n2000 and\n2017", size = 3)
print(p3)

下一个输出结果（见图 10.4）。在 2000 年至 2017 年之间，相关系数略有上升趋势。然而，更重要的是，存在两种趋势：首先，在 2000 年至 2006 年之间，我们看到一个急剧的下降趋势；其次，从 2006 年至 2017 年，我们看到一个同样急剧的上升趋势。因此，尽管相关系数每年都有波动，有时幅度很大，但我们的最重要的启示是，2006 年之后的薪资与胜利之间的关系比 2006 年之前更强。

图 10.4 团队薪资与常规赛胜利之间的年度相关系数，数据上方叠加了三条趋势线。相关系数在 2006 赛季之前呈下降趋势，然后从 2006 年开始急剧上升。

让我们通过探索团队薪资与球队完成赛季的方式或地点之间的可能联系来进行数据透视，无论他们在常规赛中赢得多少场比赛。

10.4.2 薪资与赛季末结果对比

我们继续通过检查每个球队的三个赛季结束分类之一来绘制团队薪资：

• 有资格参加季后赛但未能赢得冠军

• 有资格参加季后赛并赢得联赛冠军

• 赢得的常规赛比赛不够多，因此没有进入季后赛

我们将使用一系列点图来可视化我们的结果，每个 NBA 赛季一个点图，每个点图的数据来源是薪资数据集的临时子集。以下是关于我们的点图的几点额外说明：

• 我们绘制的是实际团队薪资或薪水，而不是调整后的薪资；因此，在我们的第一个点图中，x 轴变量是s2000而不是sa2000，前者包含 2000 年的实际薪资，后者包含调整后的 2000 年薪资。

• 如前所述，我们为了保持一致性和简单性，在整个文档中使用当前球队名称。例如，在 2000 年，布鲁克林篮网队曾是新泽西篮网队——同一支球队，不同的名称，但工资数据集只提到了布鲁克林篮网队。

• 球队根据各自的工资按降序排名，因此 aesthetic 中添加了 reorder() 函数。

• 就像我们的相关图一样，每个球队都被归入三个类别之一，或称为分类，这些分类与三个级别的变量pc2000到pc2017相对应，其中因素0、10和11基本上被转换为No playoffs（无季后赛）、Made playoffs（进入季后赛）和Won title（赢得冠军）。

• 我们点的尺寸与相关图中的数据点尺寸相同：默认尺寸的三倍。

• 我们已经格式化了 x 轴标签（再次旋转 45 度以适应），例如，我们显示的是更易读的$20 M 而不是 20000000. 我们通过调用ggplot2 scale_x_continuous()函数以及来自scales包的label_dollar``()和cut_short_scale()函数来实现这一点，其中前者在 x 轴标签前添加美元符号，后者将相同的标签转换为百万并添加 M 作为后缀。

• 每个点图的底部都附有图例。

• 最后，在调用ggplot()函数并创建我们的点图之前，我们通过子集工资数据集仅包含后续图所需的变量，并在必要时调用基础 R 的na.omit()函数来删除任何包含 NAs 的行。我们不希望永久删除可能包含一些 NAs 的工资数据集中的所有行，所以我们创建了一个临时子集，然后应用na.omit()函数。这是由于 2000 年至 2004 年间的球队增加、搬迁和变更所必需的。

话虽如此，我们的第一个点图是用以下代码块创建的：

salaries2000 <- select(salaries, Team, s2000, pc2000)
salaries2000 <- na.omit(salaries2000)

dot1 <- ggplot(salaries2000) +
  geom_point(aes(x = s2000, y = reorder(Team, s2000), 
                 color = factor(pc2000)), size = 3) +
  labs(title= "NBA Team Payrolls (USD)", 
       subtitle = "1999-2000", 
       x = "Team Payroll", 
       y = "") +
  scale_x_continuous(labels = label_dollar(scale_cut = cut_short_scale())) +
  theme(plot.title = element_text(face = "bold")) + 
  scale_color_manual(name = "", 
                     labels = c("No playoffs", 
                                "Made playoffs", 
                                "Won title"), 
                     values = c("0" = "navy", 
                                "10" = "gold3", 
                                "11" = "red")) +
  theme(legend.position = "bottom") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

我们通过更改变量并创建一个新的、临时的工资数据集子集salaries2001来创建我们的第二个点图——这是 2000-01 赛季的点图。其他所有内容都与我们的第一个点图保持一致：

salaries2001 <- select(salaries, Team, s2001, pc2001)
salaries2001 <- na.omit(salaries2001)

dot2 <- ggplot(salaries2001) +
  geom_point(aes(x = s2001, y = reorder(Team, s2001), 
                 color = factor(pc2001)), size = 3) +
  labs(title= "NBA Team Payrolls (USD)", 
       subtitle = "2000-01", 
       x = "Team Payroll", 
       y = "") +
  scale_x_continuous(labels = label_dollar(scale_cut = cut_short_scale())) +
  theme(plot.title = element_text(face = "bold")) + 
  scale_color_manual(name = "", 
                     labels = c("No playoffs", 
                                "Made playoffs", 
                                "Won title"), 
                     values = c("0" = "navy", 
                                "10" = "gold3", 
                                "11" = "red")) +
  theme(legend.position = "bottom") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

我们通过再次调用plot_layout()函数从patchwork包中，并将两个点图作为单个图形对象打印出来，将我们的两个点图放在一起（见图 10.5）：

dot1 + dot2 + plot_layout(ncol = 2)

图 10.5 1999-2000 和 2000-01 赛季的 NBA 球队工资排名，点图的阴影与赛季结束结果相对应

我们数据集中剩余的 NBA 赛季的点图在附录中。以下是这些图从我们的数据中显著揭示的内容：

• 联赛冠军很少拥有 NBA 最高的工资。事实上，在我们的数据集中 18 个赛季中，只有两次——2010 年和 2016 年——联赛冠军拥有最高的工资。

• 然而，这些球队通常的薪资高于剩余 50%以上的球队，并且经常拥有 NBA 中最高的薪资之一。

• 薪资最高的球队通常能进入季后赛；实际上，这些球队的薪资通常显著高于所有其他球队。

• 薪资最低的球队——其薪资明显低于其他所有球队的薪资——通常无法进入季后赛。

• 与成功球队相关的高薪资和与不太成功球队相关的低薪资在近年来比在 21 世纪初更为明显和普遍。

接下来，我们将计算年度平均薪资，比较和对比有资格进入季后赛的球队与其他没有进入季后赛的球队以及联赛冠军。我们将通过一系列棒棒糖图来可视化这些结果。

10.4.3 薪资比较

让我们再次转换视角，从年度对比的角度来审视平均球队薪资，就像之前那样，分为三个部分，每个球队都执行以下其中一项：

• 有资格进入季后赛但最终未能赢得冠军

• 赢得联赛冠军

• 连季后赛资格都没有获得

我们将使用棒棒糖图来可视化 2000 年至 2017 年每个 NBA 赛季的结果，棒棒糖图是条形图的现代替代品。在第二章中提出的条形图用例同样适用于棒棒糖图。

首先，我们创建一个 tibble，通过执行以下命令来为每个棒棒糖图提供数据源：

• 告诉 R 忽略薪资数据集中任何赛季子集中的 NA 值。

• 通过调用dplyr group_by()和summarize()函数，并将结果转换为名为mean的变量，计算每个赛季结束分类的平均薪资。

• 调用mutate()函数创建一个名为mean2的新变量，其中值本质上是对变量mean中其他内容的转换版本。使用基础 R 中的paste()函数将三个术语——一个美元符号、变量mean中相应的值四舍五入到最近的百万分之一，以及一个大写 M——连接起来，每个术语之间没有空格。因此，mean中的41611202这样的值在mean2中转换为$42M。

• 将变量pc2000、pc2001等中的因素0、10和11转换为No playoffs（无季后赛）、Made playoffs（进入季后赛）和Won title（赢得冠军）。

我们的棒棒糖图具有以下特点：

• 我们三个赛季结束的分类沿着 x 轴展开。

• 平均球队薪资位于 y 轴上。

• geom_segment()函数为 x 轴变量中的每个因素绘制三个棒棒糖，茎从 y 等于 0 开始，到 y 等于平均薪资结束。

• geom_point()函数根据我们的大小、颜色和填充规格在每根茎上绘制圆圈。

• 我们 y 轴的标签——它们是从变量 mean 而不是 mean2 中提取的——通过调用 ggplot2 scale_y_continuous() 函数和 scales label_dollar() 以及 cut_short_scale() 函数进行转换。

• geom_text() 函数在棒棒糖图的顶部添加了与变量 mean2 相关的文本。

我们第一个棒棒糖图的数据处理和可视化代码如下：

salaries2000 <- na.omit(salaries2000)

salaries2000 %>%
  group_by(pc2000) %>%
  summarize(mean = mean(s2000)) %>%
  mutate(mean2 = paste("$", round(mean/1000000),
                       "M", sep = "")) -> tbl2
  tbl2$pc2000 <- c("No playoffs", "Made playoffs", "Won title")

lol1 <- ggplot(tbl2, aes(x = pc2000, y = mean)) +
  geom_segment(aes(x = pc2000, xend = pc2000, 
                   y = 0, yend = mean)) +
  geom_point(size = 15, color = c("navy", "gold3", "red"), 
             fill = c("navy", "gold3", "red")) +
    labs(title = "Team Payroll Comparisons (USD)", 
         subtitle = "1999-2000",
         x = "", 
         y = "Averqge Team Payroll") +
  scale_y_continuous(labels = 
                       label_dollar(scale_cut = cut_short_scale())) +
  scale_x_discrete(limits = c("No playoffs", "Made playoffs", 
                              "Won title")) +
  geom_text(aes(label = mean2), color = "white", 
            fontface = "bold", size = 3) +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

下面的代码块是第二个棒棒糖图的数据处理和可视化代码，我们只是将 2000 年的变量替换为它们的 2001 年等价物：

salaries2001 <- na.omit(salaries2001)

salaries2001 %>%
  group_by(pc2001) %>%
  summarize(mean = mean(s2001)) %>%
  mutate(mean2 = paste("$", round(mean/1000000),
                       "M", sep = "")) -> tbl2
  tbl2$pc2001 <- c("No playoffs", "Made playoffs", "Won title")

lol2 <- ggplot(tbl2, aes(x = pc2001, y = mean)) +
  geom_segment(aes(x = pc2001, xend = pc2001, y = 0, yend = mean)) +
  geom_point(size = 15, color = c("navy", "gold3", "red"), 
             fill = c("navy", "gold3", "red")) +
    labs(title = "Team Payroll Comparisons (USD)",
         subtitle = "2000-01",
         x = "", 
         y = "Averqge Team Payroll") +
  scale_y_continuous(labels = 
                       label_dollar(scale_cut = cut_short_scale())) +
  scale_x_discrete(limits = c("No playoffs", "Made playoffs", 
                              "Won title")) +
  geom_text(aes(label = mean2), color = "white", 
            fontface = "bold", size = 3) +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

再次，我们通过调用 plot_layout() 函数从 patchwork 包中合并我们的两个图表，并将两个可视化作为单个对象打印出来（见图 10.6）：

lol1 + lol2 + plot_layout(ncol = 2)

图 10.6 NBA 1999-2000 和 2000-01 赛季的球队薪资比较，按三个赛季结束分类细分。无季后赛和进入季后赛的数字代表达到相应分类的所有球队的平均薪资总额，当然，夺冠的数字是赢得联赛冠军的那一支球队的薪资总额。

我们的一系列棒棒糖图告诉我们关于数据的信息（这些信息，如我们的相关图和点图，都在附录中）：

• 比较常见的是，夺冠球队的薪资总额等于或大于所有其他进入季后赛的球队的平均薪资总额。同样常见的是，进入季后赛但未夺冠的球队的薪资总额等于或大于未能进入季后赛的球队的平均薪资总额。

• 在我们的数据集中，有 18 个赛季中的 11 个赛季，包括最后 11 个赛季中的 9 个赛季，两个条件都是成立的。

• 在 2000 年到 2017 年之间的 每一 年，进入季后赛但未能夺冠的球队的平均薪资总额等于或（通常是）大于未能进入季后赛的球队的平均薪资总额。

现在，我们将之前运行的一些数据处理操作重新定向到调整后的薪资上，以便通过一个快照来总结和可视化我们三个赛季结束分类之间的平均薪资支出以及薪资数据集的全面情况。首先，我们调用 dplyr select() 函数来对 sa2017 和 sa2000 之间的变量进行子集化薪资数据集。然后，我们调用 tidyr pivot_longer() 函数将我们的结果从宽格式转换为长格式。结果被转换为一个名为 salaries_mean 的 tibble，我们可以通过检查 dim()、head() 和 tail() 函数的返回值来查看：

salaries %>%
  select(sa2017:sa2000) %>%
  pivot_longer(col = c(sa2017:sa2000),
               names_to = "year1",
               values_to = "salary") -> salaries_mean
dim(salaries_mean)
## [1] 540   2

head(salaries_mean, n = 3)
## # A tibble: 3 × 2
##   year1     salary
##   <chr>      <dbl>
## 1 sa2017 102154590
## 2 sa2016  80193245
## 3 sa2015  64902009

tail(salaries_mean, n = 3)
## # A tibble: 3 × 2
##   year1    salary
##   <chr>     <dbl>
## 1 sa2002 79973087
## 2 sa2001 88038094
## 3 sa2000 81387495

我们重复执行这些完全相同的操作，只是这次我们用变量 pc2017 到 pc2000 替换了调整后的薪资变量，从而创建了另一个 tibble，名为 salaries_flag：

salaries %>%
  select(pc2017:pc2000) %>%
  pivot_longer(col = c(pc2017:pc2000),
               names_to = "year2",
               values_to = "flag") -> salaries_flag
dim(salaries_flag)
## [1] 540   2

head(salaries_flag, n = 3)
## # A tibble: 3 × 2
##   year2   flag
##   <chr>  <dbl>
## 1 pc2017    10
## 2 pc2016    10
## 3 pc2015    10

tail(salaries_flag, n = 3)
## # A tibble: 3 × 2
##   year2   flag
##   <chr>  <dbl>
## 1 pc2002     0
## 2 pc2001     0
## 3 pc2000     0

然后，我们调用基础 R 的cbind()函数将salaries_mean和salaries_flag合并成一个名为salaries2的单个数据集：

salaries2 <- cbind(salaries_mean, salaries_flag)
dim(salaries2)
## [1] 540   4

head(salaries2, n = 3)
##    year1    salary  year2 flag
## 1 sa2017 102154590 pc2017   10
## 2 sa2016  80193245 pc2016   10
## 3 sa2015  64902009 pc2015   10

tail(salaries2, n = 3)
##      year1   salary  year2 flag
## 538 sa2002 79973087 pc2002    0
## 539 sa2001 88038094 pc2001    0
## 540 sa2000 81387495 pc2000    0

最后，我们通过调用基础 R 的na.omit()函数来告诉 R 忽略salaries2中的 NAs，然后编写一段dplyr代码。我们调用group_by()和summarize()函数来计算 2000 年至 2017 年间每个salaries2变量中的flag因素的平均调整薪资，该因素与我们的三个赛季结束分类相匹配。然后，我们调用mutate()函数创建一个名为mean2的变量，它是变量mean的转换且更简洁的版本。我们的结果被转换为一个名为tbl3的 tibble：

salaries2 <- na.omit(salaries2)

salaries2 %>%
  group_by(flag) %>%
  summarize(mean = mean(salary, na.rm = TRUE)) %>%
  mutate(mean2 = paste("$", round(mean/1000000),"M", sep = "")) -> tbl3
print(tbl3)
## # A tibble: 3 × 3
##    flag      mean mean2
##   <int>     <dbl> <chr>
## 1     0 78363267\. $78M 
## 2    10 85059950\. $85M 
## 3    11 88149764\. $88M

接下来，我们创建了一个额外的棒棒糖图，这次显示了 2000 年至 2017 赛季之间按我们的三个赛季结束分类调整后的平均球队薪资。这个棒棒糖图与之前创建的其他棒棒糖图之间的美学差异在于，我们通过第二次调用theme()函数在图表周围添加了一个浅蓝色边框：

tbl3$flag <- c("No playoffs", "Made playoffs", "Won title")
p4 <- ggplot(tbl3, aes(x = flag, y = mean)) +
  geom_segment(aes(x = flag, xend = flag, 
                   y = 0, yend = mean)) +
  geom_point(size = 15, color = c("navy", "gold3", "red"), 
             fill = c("navy", "gold3", "red")) +
  labs(title = "Adjusted Team Payroll Comparisons (2021 USD)", 
       subtitle = "2000-2017 Seasons",
       x = "", 
       y = "Averqge Team Payroll\nAdjusted for Inflation") +
  scale_y_continuous(labels = 
                       label_dollar(scale_cut = cut_short_scale())) +
  scale_x_discrete(limits = c("No playoffs", "Made playoffs", 
                              "Won title")) +
  geom_text(aes(label = mean2), color = "white", 
            fontface = "bold", size = 3) +
  theme(plot.title = element_text(face = "bold")) + 
  theme(panel.border = element_rect(fill = "transparent", 
                                    color = "lightskyblue", size = 2))
print(p4)

图 10.7 调整通货膨胀后的薪资比较

平均而言，赢得冠军的球队在球员薪资上的支出比那些进入季后赛但未赢得冠军的球队要多；而进入季后赛的球队在球员薪资上的平均支出也比未能进入季后赛的球队要多。此外，赢得冠军的球队与其他进入季后赛的球队之间的平均薪资差异很小（只有 300 万美元），而季后赛球队与未能进入季后赛的球队之间的后续差异则更为显著（800 万美元）。

在第十一章中，我们将使用相同的数据集，首先通过量化并可视化每个常规赛胜利的球队薪资，其次通过构建一个无监督学习算法，根据薪资支出和常规赛胜利总数将 NBA 的 30 支球队分成类似集群。

摘要

• 在本章中，我们展示了 R 的强大功能。例如，我们调用了基础 R 函数如cor()和cor.test()来提供我们一些最显著和巧妙的成果。

• 我们随后超越了基础 R，创建了引人入胜但并不常见的可视化，例如点图和棒棒糖图。我们甚至调用其他包装函数来转换我们的ggplot2标签，使我们的可视化更加美观。敢于超越传统可视化，并且不要犹豫在为读者增加价值时添加或修改美学元素，例如将 x 轴和 y 轴标签转换为更易读的格式。

• 当你的数据中出现缺失值（NAs）时，了解你的选项。在这里，我们通过忽略 NAs 执行了几个操作。在第二章和第三章中，我们移除了包含多个 NAs 的记录，但在其他情况下，你可能想要进行数据插补。

• 当有两个或更多测试可以讲述一个更有说服力的故事时，不要只依赖一个测试。

• 基于我们团队薪资与常规赛胜利之间的相关性测试，两者之间存在统计学上的显著关系。当然，相关性并不一定意味着因果关系，但当与其他证据相冲突时，很难避免得出薪资影响胜利的结论。

• 薪资与常规赛胜利之间的年度相关性系数在 2006 年之前和之后趋势截然不同。虽然相关性系数每年并不完全一致，但趋势是先下降后上升，这表明薪资在最近几年对胜负的影响比以前更大。努力在你的时间序列图中插入多条趋势线，以讲述一个完整的故事。

• 我们的点图和棒棒糖图也表明，薪资与是否进入季后赛之间的关联性更加明确，尤其是在 2006 年之后。

• 薪资绝对最高的球队，几乎没有例外，都能进入季后赛。

• 薪资绝对最低的球队，几乎没有例外，未能进入季后赛。

• 获得冠军的球队几乎总是拥有联盟中最高的薪资之一，尤其是最近几年。

• 在此过程中，我们展示了几个可以提高你的ggplot2可视化效果的技巧——无需更改数据源即可转换轴标签，添加图例，插入注释和形状，以及按因子水平对数据点进行着色。这些细节可以避免人们对数据的疑问，并让人们专注于分析。

• 最后，我们介绍了辛普森悖论，并展示了如何揭示它。虽然辛普森悖论可能有些过度，并不十分普遍，但它仍然是一个需要熟悉的临界统计现象。对整个数据系列得出的结论实际上可能正好与每个相同子群体的真相相反。

11 K-means 聚类

本章涵盖

• 开发 K-means 聚类算法

• 计算和可视化最佳聚类数量

• 理解标准差和计算 z 分数

• 创建克利夫兰点图

本章的主要目的是演示如何开发 K-means 聚类算法。K-means 聚类是一种流行的无监督学习方法，也是多变量分析技术，它允许围绕从数据中切割出的智能聚类或群体制定有目的的定制策略。无监督学习是一种学习方法，其目标是仅使用输入变量（因此没有目标或输出数据）在数据中找到模式、结构或关系。相比之下，监督学习方法使用输入和输出变量，通常用于做出预测。在前者中，你不知道你可能会寻找什么；在后者中，你已经弄清楚了。多变量分析是指用于同时分析和理解两个或更多变量之间关系的统计技术和方法。

K-means 聚类的最明显应用——也许是最被证实的应用——是客户细分。K-means 用于根据例如以前的购买、人口统计变量（如年龄、性别和家庭地址）和其他属性来细分客户。具有这种洞察力的公司可以为不同的客户群体开发不同的营销策略，这反过来可以推动销售并提高客户满意度评分。

K-means 聚类与层次聚类的最显著区别在于，K-means 需要预先确定聚类数量，用 K 表示，才能运行。尝试不同的聚类数量，甚至在一个固定的聚类数量上运行算法都是完全可以接受的。然而，有一些方法可以根据数据中的差异来确定最佳聚类数量。我们将演示其中两种方法，然后运行 K-means 算法并分析结果。我们甚至将尝试不同的 K 值，并评估结果的变化。

在此之前，我们将通过介绍标准差和 z 分数（K-means 聚类在二维平面上可视化，其中原始数据已被标准化）以及绘制一对不同数值变量（已转换为相同尺度）来为您打下基础。

在第十章中，我们考察了球队工资与常规赛胜利、季后赛出场和联赛冠军之间的关系，是在一个综合水平上的。而在本章中，我们将专注于球队层面的工资和胜利。首先，我们将加载与上一章开头相同的一组包，再加上一个用于 K-means 聚类的包。

11.1 加载包

我们的一个新包是factoextra，这是一个流行的包，用于提取和绘制多变量数据分析的结果，包括 K-means 聚类。我们将调用factoextra中的一个函数来计算和可视化最佳聚类数量，然后调用第二个函数来绘制我们的聚类。否则，我们的首要任务是连续调用四次library()函数来加载factoextra以及您已经熟悉的三个其他包：

library(tidyverse)
library(scales)
library(patchwork)
library(factoextra)

接下来，我们将导入并浏览我们的数据。

11.2 导入数据

在上一章中，我们简要地处理了一个名为 cap 的数据集，然后相当深入地处理了另一个名为 salaries 的数据集。在本章中，我们将仅使用 salaries 数据集。因此，我们的第二项任务是调用readr read_csv()函数（再次）导入薪资数据集：

salaries <- read_csv("salaries.csv")

关于薪资数据集，这里有一些提醒：

• 数据集包含 30 行——每行代表一个 NBA 球队。一些球队在 2000 年至 2017 年赛季之间（这是我们的数据的时间范围）搬迁并因此更改了名称。超音速队从西雅图搬到俄克拉荷马城，现在是俄克拉荷马城雷霆队；篮网队从新泽西搬到布鲁克林，现在被称为布鲁克林篮网而不是新泽西篮网。但数据仍然只对应每个球队的一个观测值；薪资数据集只包含当前球队名称。

• 数据集包含 73 列。除了变量Team外，薪资数据大致分为四个 18 列的部分，每个部分代表 2000 年至 2017 年间的 NBA 赛季：实际薪资（数值）、通货膨胀调整后的薪资（数值）、常规赛胜利（数值）和赛季结束状态（分类）。在本章中，我们将只关注调整后的薪资（这些是当按Team变量中的每个因素求和并按赛季分组时，等于一支球队的工资总额的球员薪资）和常规赛胜利。

• 由于夏洛特黄蜂队和新奥尔良鹈鹕队与 NBA 的其他球队不同，在 2000 年至 2017 年之间分别只打了 16 个和 15 个赛季，因此我们被迫整理薪资数据集并进行其他调整，否则这些调整是不必要的。您将很快看到这些调整。

在以下代码中，我们将薪资数据集通过两个dplyr函数进行管道处理——首先是通过select()函数来选择变量Team、sa2017（等于 2017 年的调整后薪资）和w2017（等于 2017 年的常规赛胜利）；其次是通过glimpse()函数，它返回薪资子集的转置视图：

salaries %>%
  select(Team, sa2017, w2017) %>%
  glimpse 
## Rows: 30
## Columns: 3
## $ Team   <chr> "Atlanta Hawks", "Boston Celtics", "Brooklyn Nets", "Ch...
## $ sa2017 <dbl> 102154590, 93381390, 78031675, 106764924, 100891769, 13...
## $ w2017  <dbl> 43, 53, 20, 36, 41, 51, 33, 40, 37, 67, 55, 42, 51, 26,...

在我们开始整理和分析数据之前，首先了解标准差和 z 分数是很重要的。

11.3 标准差和 z 分数的基础知识

理解标准差和 z 分数的基本知识将在这个章节以及更远的地方对我们大有裨益。在第二章中，我们提到，当数据呈正态分布时，大约 68% 的数据将位于均值的一个标准差范围内，正负；95% 将位于均值的两个标准差范围内；除了少数异常值外，所有数据都将位于均值的三个标准差范围内。在第七章中，我们进行了 Cohen 的 d 效应大小测试，它通过合并标准差来衡量两个均值之间的差异。因此，我们至少对标准差有一些先前的了解，但让我们更深入地探讨一下。

标准差是一种统计量，它量化了数值向量中的变异量或分散度。低标准差表明数据紧密围绕均值聚集；另一方面，高标准差表明数据，或大部分数据，分布较广。z 分数是一种统计量，它表示单个数据点与其分布均值的距离标准差数。

让我们创建一个小型数据框来演示。我们首先调用基础 R 的 c() 函数两次，创建包含五个值的两个数值向量 var1 和 var2。然后，我们将 var1 和 var2 传递给基础 R 的 data.frame() 函数，创建一个名为 df 的数据框——简单直接：

var1 <- c(2, 4, 6, 8, 10)
var2 <- c(1, 2, 3, 10, 14)
df <- data.frame(var1, var2)
print(df)
##   var1 var2
## 1    2    1
## 2    4    2
## 3    6    3
## 4    8   10
## 5   10   14

但通过手工计算或使用 Microsoft Excel 或 Google Sheets 等电子表格应用程序来计算标准差实际上需要六个步骤。让我们以 var1 为例：

1. 通过将 var1 中的值相加并除以观测值的数量来找到均值。这等于 6。

2. 通过从每个值中减去均值来找到每个值与均值的偏差。对于 var1 中的第一个值，偏差等于 2 - 6，或 -4。

3. 将每个偏差从均值平方，例如，-4 变为 16。

4. 通过将平方偏差相加来找到平方和。这等于 40。

5. 计算方差，它等于平方和除以 n - 1，其中 n 等于观测值的数量。这等于 40 ÷ 4，或 10。

6. 计算方差，取平方根得到标准差。这等于 3.16。

幸运的是，我们只需将 var1 和 var2 传递给基础 R 的 sd() 函数，即可得到标准差：

sd(df$var1)
## [1] 3.162278
sd(df$var2)
## [1] 5.700877

两个向量具有相同的均值，但 var2 的标准差几乎是 var1 的两倍。换句话说，当标准差较低时，均值可以指示样本或总体，但当标准差较高时，均值实际上可能是误导性的。

现在我们来计算var1和var2中每个值的 z 分数。要得到任何数据点的 z 分数，我们从值中减去平均值，然后将差值除以标准差。在 R 中，我们只需将df传递给dplyr mutate()函数，以创建一对新的变量zvar1和zvar2，并将它们附加到我们的数据框中：

df %>%
  mutate(zvar1 = (var1 - mean(var1)) / sd(var1),
         zvar2 = (var2 - mean(var2)) / sd(var2)) -> df
print(df) 
##   var1 var2      zvar1      zvar2
## 1    2    1 -1.2649111 -0.8770580
## 2    4    2 -0.6324555 -0.7016464
## 3    6    3  0.0000000 -0.5262348
## 4    8   10  0.6324555  0.7016464
## 5   10   14  1.2649111  1.4032928

例如，var1中的中间值等于var1的平均值，因此它的 z 分数等于 0；var2中的中间值 z 分数等于-0.53，这意味着它大约低于var2平均值的半个标准差。

标准差和 z 分数提供了我们从原始数据中无法总是获得的信息。波士顿凯尔特人在 2000 年至 2017 年赛季期间仅花费了超过 15 亿美元（B）的球员工资。这是一笔巨大的金额——或者不是吗？当我们计算 z 分数时，我们得到 0.21；换句话说，波士顿在 2000 年至 2017 年期间在球员工资上的总支出仅比联盟平均水平高出 0.21 个标准差——也就是说，几乎就是平均水平。

标准差对于进行无偏的多变量分析也非常关键。当评估一对数值变量之间的关联，而这些变量处于非常不同的尺度上——例如球队工资和常规赛胜利——在完成分析之前将两个变量放在同一尺度上绝对至关重要，以避免得到偏向于一个变量而牺牲另一个变量的结果。我们通过标准化数据和计算 z 分数来实现这一点。这正是我们分析的前半部分将要做的，再次计算我们的 K-means 聚类时也是如此。

11.4 分析

我们在第十章中已经确定，球队工资和常规赛胜利之间存在正相关关系，至少在 2000 年至 2017 年的 NBA 赛季之间是这样的；事实上，这种相关性是逐渐增加的——不是线性的，但总体上还是在增加——从 2006 年到 2017 年。此外，我们还进行了一次相关性测试，其 p 值低于 5%的阈值，因此表明球队工资和常规赛胜利之间的关联实际上在统计学上是显著的。

我们在这里的目的是进一步调查工资数据集，并两次可视化，直到球队层面，工资和胜利之间的关系。我们首先将展示如何创建所谓的ggplot2克利夫兰点图，其中工资和胜利通过点在同一标准化尺度上显示。然后，我们将向您展示如何创建ggplot2水平条形图，按常规赛每场胜利的工资金额排序，其中数据以原始格式呈现。

如您现在可能猜到的，我们的数据必须首先进行一些整理，以支持我们正在进行的分析。我们将在下一部分处理这些需求。

11.4.1 数据整理

如前所述，NBA 在 2000 年至 2004 年之间是一个 29 支球队的联赛，此后每个赛季都是 30 支球队；因此，需要对数据进行一些小的调整，以抵消缺失或不可用（NA）值，并确保我们返回公平和准确的结果。此外，原始数据本身不足以进行我们心中的分析，所以我们别无选择，只能以先前章节中不需要的方式转换和增强薪资。

夏洛特黄蜂队和新奥尔良鹈鹕队是薪资数据集中有两个缺失数据的球队，因为这两个球队在 2000 年至 2004 年之间并不是每年都存在。因此，我们即将创建三个主要相似的数据集子集从薪资：一个固定用于黄蜂队，另一个固定用于鹈鹕队，第三个固定用于剩余的 28 支球队。最后，我们将这些合并成一个数据集用于绘图和分析。

我们将从黄蜂队开始，它在我们的数据集中活跃在 18 个 NBA 赛季中的 16 个赛季。因此，我们调用 dplyr filter() 函数来对薪资数据集进行子集化，其中变量 Team 等于夏洛特黄蜂队，从而创建一个名为 cha 的新对象。

然而，在继续进行这些和其他数据处理操作之前，让我们通过将 scipen = 999 参数传递给基础 R 的 options() 函数来禁用科学记数法：

options(scipen = 999)

之后，我们将实际上重新启用科学记数法：

salaries %>%
  filter(Team == "Charlotte Hornets") -> cha

然后，我们调用 dplyr select() 函数来减少 cha 数据集，使其仅包括我们绝对需要的 33 列或变量——这些是 Team、16 个 调整后 薪资变量和 16 个常规赛胜利变量。我们故意排除了 2003 年和 2004 个赛季以及数据中的 NA 值：

cha %>%
  select(Team, sa2017:sa2005, sa2002:sa2000, w2017:w2005, 
         w2002:w2000) -> cha

接下来，我们调用 mutate() 函数来创建四个派生变量：

• 第一个变量 sumSalaries 等于第 2 至 17 个位置调整后薪资变量的总和。

• 第二个变量 sumWins 等于第 18 至 33 个位置常规赛胜利变量的总和。

• 第三个变量 efficiency 等于变量 2 至 17 的总和除以变量 18 至 33 的总和。因此，我们正在对 16 个赛季的调整后薪资进行求和，然后除以黄蜂队在相同 16 个赛季中的常规赛胜利次数。

• 第四个也是最后一个变量 meanWins 等于变量 18 至 33 的总和除以 16 个赛季，四舍五入到最接近的整数。因此，它正在计算并返回每个常规赛黄蜂队胜利的平均数。

以下是对以下代码块的一些说明：

• rowSums() 函数是 R 的一个内置函数，它按行在数据集中对数值变量进行求和（cha 数据集只包含一行数据）。还有一个基础 R 的 colSums() 函数，它对列执行相同的操作。

• 方括号用于索引向量、矩阵、数组、列表或数据框；当它们专门用于从同一数据集中提取元素子集时，有时被称为提取运算符。

• 点 (.) 用作 cha 的替代，因此它们代表 cha 数据集的指针：

cha %>%
  mutate(sumSalaries = rowSums(.[2:17]),
         sumWins = rowSums(.[18:33]),
         efficiency = rowSums(.[2:17]) / rowSums(.[18:33]),
         meanWins = round(rowSums(.[18:33]) / 16)) -> cha

最后，我们将 cha 数据集通过管道传递给 dplyr select() 函数，创建一个新的对象 cha_final，它只包含变量 Team 以及我们刚刚创建的四个派生变量：

cha %>%
  select(Team, sumSalaries, sumWins, efficiency, meanWins) -> cha_final
print(cha_final)
##                Team sumSalaries sumWins efficiency meanWins
## 1 Charlotte Hornets  1124300389     549    2047906       34

然后，我们重复这个练习两次，一次用于新奥尔良鹈鹕队，再次用于 NBA 的其余部分，在这个过程中创建了两个新的数据集，nop_final 和 league_final。

league_final 数据集应包括每个 NBA 球队的记录，除了夏洛特黄蜂队和新奥尔良鹈鹕队。因此，我们调用逻辑运算符不等于 (!=) 来提取薪资数据集中变量 Team 不等于夏洛特黄蜂队或新奥尔良鹈鹕队的每个记录：

salaries %>%
  filter(Team == "New Orleans Pelicans") -> nop

nop %>%
  select(Team, sa2017:sa2003, w2017:w2003) -> nop

nop %>%
  mutate(sumSalaries = rowSums(.[2:16]),
         sumWins = rowSums(.[17:31]),
         efficiency = rowSums(.[2:16]) / rowSums(.[17:31]),
         meanWins = round(rowSums(.[17:31]) / 15)) -> nop

nop %>%
  select(Team, sumSalaries, sumWins, efficiency, meanWins) -> nop_final
print(nop_final)
##                   Team sumSalaries sumWins efficiency meanWins
## 1 New Orleans Pelicans  1150489652     562    2047135       37

salaries %>%
  filter(Team != "Charlotte Hornets" & 
           Team != "New Orleans Pelicans") -> league

league %>%
  select(Team, sa2017:sa2000, w2017:w2000) -> league

league %>%
  mutate(sumSalaries = rowSums(.[2:19]),
         sumWins = rowSums(.[20:37]),
         efficiency = rowSums(.[2:19]) / rowSums(.[20:37]),
         meanWins = round(rowSums(.[20:37]) / 18)) -> league

league %>%
  select(Team, sumSalaries, sumWins, efficiency, meanWins) -> league_final
print(league_final)
##                      Team sumSalaries sumWins efficiency meanWins
## 1           Atlanta Hawks  1331370577     672    1981206       37
## 2          Boston Celtics  1502338683     782    1921149       43
## 3           Brooklyn Nets  1572394745     635    2476212       35
## 4           Chicago Bulls  1350128086     696    1939839       39
## 5     Cleveland Cavaliers  1513579016     715    2116894       40
## 6        Dallas Mavericks  1793863099     911    1969114       51
## 7          Denver Nuggets  1359921484     741    1835252       41
## 8         Detroit Pistons  1374565213     750    1832754       42
## 9   Golden State Warriors  1401640477     709    1976926       39
## 10        Houston Rockets  1464712564     810    1808287       45
## 11         Indiana Pacers  1464126069     781    1874681       43
## 12   Los Angeles Clippers  1307071048     681    1919341       38
## 13     Los Angeles Lakers  1682631996     821    2049491       46
## 14      Memphis Grizzlies  1436199380     681    2108957       38
## 15             Miami Heat  1575463391     815    1933084       45
## 16        Milwaukee Bucks  1423272015     657    2166320       36
## 17 Minnesota Timberwolves  1424852176     616    2313072       34
## 18        New York Knicks  2034231301     626    3249571       35
## 19  Oklahoma City Thunder  1360935249     790    1722703       44
## 20          Orlando Magic  1494331249     694    2153215       39
## 21     Philadelphia 76ers  1471662937     638    2306682       35
## 22           Phoenix Suns  1420327702     777    1827964       43
## 23  Portland Trailblazers  1815095481     773    2348118       43
## 24       Sacramento Kings  1398565630     677    2065828       38
## 25      San Antonio Spurs  1458067975    1040    1401988       58
## 26        Toronto Raptors  1418504110     695    2041013       39
## 27              Utah Jazz  1333886430     786    1697057       44
## 28     Washington Wizards  1443384399     615    2346967       34

然后，我们调用内置的 rbind() 函数，通过行将 cha_final、nop_final 和 league_final 数据集组合成一个名为 final 的单一对象。head() 函数返回前六个观测值：

final <- rbind(cha_final, nop_final, league_final)
head(final)
##                   Team sumSalaries sumWins efficiency meanWins
## 1    Charlotte Hornets  1124300389     549    2047906       34
## 2 New Orleans Pelicans  1150489652     562    2047135       37
## 3        Atlanta Hawks  1331370577     672    1981206       37
## 4       Boston Celtics  1502338683     782    1921149       43
## 5        Brooklyn Nets  1572394745     635    2476212       35
## 6        Chicago Bulls  1350128086     696    1939839       39

现在我们已经将数据合并到一个单一的对象中，我们将调用 mutate() 函数两次来创建一对额外的派生变量，这两个变量都需要在数值向量中进行计算。变量 zSalaries 等于变量 sumSalaries 的 z 分数，有时也称为标准分数。z 分数表示数据点高于或低于分布平均值的多少个标准差；它是通过从原始数据中减去分布平均值并除以标准差来计算的。如果变量 sumSalaries 是正态分布的，我们可以预计大约 20 支 NBA 球队，即三分之二的联赛，将位于平均值的一个标准差内，也许除了一个或两个球队外，所有球队都位于两个标准差内。变量 zWins 等于变量 sumWins 的 z 分数。

后续对 head() 和 tail() 函数的调用返回前三个和最后三个观测值：

final %>%
  mutate(zSalaries = (sumSalaries - mean(sumSalaries)) / sd(sumSalaries),
         zWins = (sumWins - mean(sumWins)) / sd(sumWins)) -> final

head(final, n = 3)
## # A tibble: 3 × 7
##   Team                 sumSalaries sumWins efficiency meanWins 
##   <chr>                      <dbl>   <dbl>      <dbl>    <dbl>     
## 1 Charlotte Hornets     1124300389     549   2047906\.       34    
## 2 New Orleans Pelicans  1150489652     562   2047135\.       37    
## 3 Atlanta Hawks         1331370577     672   1981206\.       37    
##   zSalaries  zWins
##       <dbl>  <dbl>
## 1     -1.86  -1.71 
## 2     -1.71  -1.58 
## 3    -0.723 -0.501

tail(final, n = 3)
## # A tibble: 3 × 7
##   Team               sumSalaries sumWins efficiency meanWins 
##   <chr>                    <dbl>   <dbl>      <dbl>    <dbl>     
## 1 Toronto Raptors     1418504110     695   2041013\.       39    
## 2 Utah Jazz           1333886430     786   1697057\.       44    
## 3 Washington Wizards  1443384399     615   2346967\.       34    
##   zSalaries  zWins
##       <dbl>  <dbl>
## 1    -0.246 -0.276
## 2    -0.710  0.616
## 3     -0.110 -1.06

以犹他爵士队为例。顺便说一下，犹他爵士队曾经在新奥尔良进行主场比赛；当他们搬到盐湖城时，他们决定保留他们的名字“爵士”，这是大多数 NBA 球队在搬迁时所做的。犹他爵士队在 2000 年至 2017 年间在球员薪资上花费了超过 13 亿美元。在这 18 个赛季中，他们赢得了 786 场常规赛，平均每个赛季 44 场胜利。因此，他们为每场常规赛胜利花费了大约 170 万美元的球员薪资。他们在薪资上的总支出比联赛平均值低 0.71 个标准差，他们的常规赛胜利比平均值高 0.62 个标准差。

11.4.2 评估薪资和胜利

我们计划通过创建克利夫兰点图和水平条形图来评估 2000 年至 2017 年 NBA 赛季之间的球队工资和常规赛胜利。我们的分析将为我们下一步做好准备：K-means 聚类。

克利夫兰点图

我们的第一幅可视化，一个ggplot2克利夫兰点图，显示了所有 30 支 NBA 球队标准化变量之间的差异；换句话说，它显示了投资与回报之间的接近程度或距离（见图 11.1）。本书的一个目标是通过ggplot2图形包介绍一些可能不在主流之外的可视化，讨论它们何时最好展示，并演示如何创建它们。由著名统计学家和数据可视化专家威廉·S·克利夫兰设计的克利夫兰点图是下一个可视化，如下所述：

• NBA 的 30 支球队按字母顺序排列在 x 轴上。标签以 45 度角倾斜，并水平对齐在图表下方。

• 我们的 y 轴度量是标准差，或 z 分数。

• geom_segment()函数绘制了 30 条垂直于 x 轴的线，每条线连接由两个geom_point()函数调用创建的一对点或点，从 y 等于zSalaries开始，到 y 等于zWins结束。

• 代表变量zSalaries的点以深色调绘制，而代表变量zWins的点以浅色调绘制。所有点的大小都增加了ggplot2默认值的 3 倍。

• 标题中的 \n 作为一个换行符。默认情况下，标题放置在右下角，并且是右对齐的。

图 11.1 在标准化两个变量后，比较通货膨胀调整后的工资和常规赛胜利

下面是我们克利夫兰点图的代码块：

p1 <- ggplot(final) +
  geom_segment(aes(x = Team, xend = Team, 
                   y = zSalaries, yend = zWins), color = "grey50") +
  geom_point(aes(x = Team, y = zSalaries), color = "springgreen3", 
             size = 3) +
  geom_point(aes(x = Team, y = zWins), color = "darkred", size = 3) +
  labs(title = "Inflation-Adjusted Payrolls vs. Regular Season Wins",
       subtitle = "2000-17", 
       x = "", 
       y = "Standard Deviations", 
       caption = "green/light = salaries\nred/dark = wins") + 
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))
print(p1)

显然，如果没有首先对非常不同的度量进行标准化，我们就无法绘制克利夫兰点图。茎的长度表示球员薪资与胜利之间的匹配程度如何；这是正确解读我们图表的第一个线索。

第二个线索是理解每个茎的绘制方向；提醒一下，茎是从zSalaries绘制到zWins的。因此，当茎是上升的，这意味着常规赛胜利的回报超过了球队在球员薪资上的投资。当茎相反地下降时，当然意味着正好相反。

结果表明，17 支球队从各自的投资中获得了回报，但 13 支球队没有。这些总数很容易通过将最终数据集两次传递到dplyr tally()函数来计算，一次是返回zWins大于zSalaries的 NBA 球队数量，再次是zWins小于zSalaries。

final %>%
  tally(zWins > zSalaries)
##    n
## 1 17
final %>%
  tally(zWins < zSalaries)  
##    n
## 1 13

当调用dplyr filter()函数对最终数据集进行子集化，以 17 个观察值中zWins大于zSalaries的情况，以及调用dplyr summarize()函数来计算zWins和zSalaries之间的均值和中位数差异时，我们看到平均差异等于 0.68 个标准差，而中位数差异等于 0.44 个标准差：

final %>%
  filter(zWins > zSalaries) %>%
  summarize(mean = mean(zWins - zSalaries),
            median = median(zWins - zSalaries))
##        mean    median
## 1 0.6776743 0.4434517

平均值大于中位数，这是因为像休斯顿火箭队、犹他爵士队以及尤其是圣安东尼奥马刺队这样的队伍；在 2000 年至 2017 年期间，圣安东尼奥在球员薪资上的投资大致等于联盟平均水平，但他们的常规赛总胜场数比平均水平高出三个标准差以上。

当我们翻转变量zWins和zSalaries时，我们看到均值和中位数几乎相差半个标准差，均值大于中位数：

final %>%
  filter(zSalaries > zWins) %>%
  summarize(mean = mean(zSalaries - zWins),
            median = median(zSalaries - zWins))
##        mean    median
## 1 0.8861895 0.4552426

这在一定程度上也适用于布鲁克林篮网队，而在很大程度上适用于纽约尼克斯队。尼克斯队与马刺队正好相反——他们的年度工资总额比 NBA 平均水平高出三个标准差以上，而他们的常规赛总胜场数比平均值低大约一个标准差。

否则，仅通过查看我们的图表，我们可以看到投资和回报非常一致——变量zWins和zSalaries之间的绝对差异小于 0.5 个标准差，对于大约一半的 NBA 球队来说。除去明显的异常值（马刺队和尼克斯队），我们第十章的结论无疑会更加明确。

水平条形图

在我们的第二次审视中，总薪资除以胜场数在ggplot2水平条形图中可视化，效率，即 2000 年至 2017 年每场常规赛投入球员薪资的效率，从上到下递减（见图 11.2）：

• reorder()和coord_flip()函数在这里几乎是协同工作的。如果我们原本的意图是创建一个垂直条形图，我们的结果将按照效率变量从左到右递减的顺序排序，但通过将我们的图表翻转成水平布局，我们得到顶部（较低且较好）的效率数值和底部（较高且较差）的效率数值。注意，x 轴和 y 轴是图表的一部分；因此，它们也会翻转。

• scale_y_continuous()函数加上scales包中的label_dollar()和cut_short_scale()函数将我们的 y 轴标签从七位数转换为$1M、$2M 和$3M。

• geom_text()函数将变量meanWins的值附加到条形旁作为标签；这些标签可以通过vjust和hjust参数分别垂直或水平调整。此外，我们还在labs()函数中添加了一个标题作为另一个参数，以指出这些数字代表每个球队常规赛平均胜场数的计数。

图 11.2：2000 年至 2017 年间，每场常规赛胜利的球员薪资支出，从最高效到最低效进行排序

现在，这是代码：

p2 <- ggplot(final, aes(x = reorder(Team, -efficiency), y = efficiency)) + 
  geom_bar(stat = "identity", width = .5, fill = "darkorange1") + 
  coord_flip() +
  labs(title = "NBA Team Efficiency: Salary Spend per Win (2000-17)", 
       subtitle = "2021 USD", 
       x = "", 
       y = "Salary Spend per Regular Season Win", 
       caption = "Average number of regular season wins 
       affixed atop bars") + 
  scale_y_continuous(labels = 
                       label_dollar(scale_cut = cut_short_scale())) +
  geom_text(aes(label = meanWins, fontface = "bold", 
                vjust = 0.3, hjust = -0.4)) +
  theme(plot.title = element_text(face = "bold"))
print(p2)

从我们的排序条形图中，我们可以得出以下结论：

• 圣安东尼奥马刺平均每赛季的常规赛胜利数显著高于其他任何球队，并且每场胜利的球员薪资支出不到 150 万美元。顺便说一句，马刺在 2003 年至 2014 年期间赢得了四次联赛冠军。

• 另一方面，纽约尼克斯为每场常规赛胜利支付的球员薪资是圣安东尼奥马刺的两倍多，但平均每赛季只赢得 35 场比赛。尼克斯自 1973 年以来就没有赢得过 NBA 冠军。

• 再次强调，除去我们数据中的这两个相当明显的异常值，我们关于薪资和胜利的第十章结论将更加令人信服。

• 在圣安东尼奥马刺和纽约尼克斯之间，我们在效率和平均每赛季胜利数上并没有看到太大的差异。

• 然而，在我们的图表上半部分的球队，大部分情况下，平均每赛季的常规赛胜利数比下半部分的球队多。上半部分的 15 支球队中只有 4 支每赛季平均胜场数少于 40 场，下半部分的球队中只有 3 支每赛季平均胜场数至少为 40 场。

毫无疑问，薪资会影响胜利，但当你看到这样的结果时，你也必须考虑到其他因素，例如合格的管理（或不合格的管理）以及可能的好运（或坏运），这些也是相关的。

接下来，我们将根据球队的薪资和常规赛胜利数将 NBA 的 30 支球队划分为类似和不同的聚类。

11.5 K 均值聚类

K 均值聚类是一种流行的无监督学习算法，用于数据分段。以下是基本原理：

• 目标是将整个数据集划分为不同的且因此非重叠的聚类，其中每个数据点都被分配到具有最近平均值的聚类中，即质心。聚类的数量等于K。因此，它的目标是使簇内方差最小化，使簇间方差最大化。

• K 均值算法通过迭代方式运行，随机初始化K个质心，然后交替进行两个步骤——(1)将每个数据点分配或重新分配到最近的质心，以及(2)重新计算质心，作为所有分配和重新分配给它们的点的平均值——直到收敛。收敛发生在质心变得固定或达到预定义的最大迭代次数时。虽然不是强制要求设置最大迭代次数，但这是一个良好的实践。

• 与层次聚类类似，数据点和质心之间的距离通常是通过应用欧几里得距离度量来计算的，它衡量的是二维空间中一对数据点之间的直线距离（详细信息请参阅第三章）。

• 与层次聚类不同，簇的数量，或 K，必须提前确定。选择 K 并非总是直截了当。例如，如果你是一家百货公司的营销团队负责人，而且你只有足够的资源来开发和维护两个广告活动，那么对于 K 来说只有一个选择。同样，如果你在一家债务收集机构工作，并且一开始就决定超过三个策略来处理三个违约客户细分是不可行的，那么 K 不能超过三个。但如果 K 可以是几乎任何合理和逻辑的数字，那么有几种方法可以用来计算可能最优的簇数量。我们将演示其中两种方法。总的来说，簇太少可能会过度简化数据，不会增加太多价值，但簇太多可能会导致过度拟合。

• K-means 算法快速、简单且可扩展，并且有大量的应用场景。警察局可以将犯罪行为类别（暴力犯罪、财产犯罪、白领犯罪、有组织犯罪和同意或无受害者犯罪）与地理空间点关联起来，识别任何模式，并据此部署警力；百货公司可以利用人口统计属性和购买历史来分析其客户，以制定定制化的营销策略；债务收集机构可以根据客户的未偿还余额和信用历史来细分客户，以实施定制化的收集策略；或者国家档案馆的职员可以使用 K-means 算法，通过标签、主题和内容对文档进行分类。

• 但是，通常认为 K-means 在变量呈正态分布时返回最佳结果。然而，NBA 的薪资和常规赛胜利并不呈正态分布，所以我们将测试这一点，并在稍后展示。

我们的结果将被绘制在一个单一的可视化中，以球队薪资作为 x 轴变量，常规赛胜利作为 y 轴变量。K-means 算法自动将原始数字转换为 z 分数。你会看到结果与我们的克利夫兰点图非常吻合，除了所有 30 支 NBA 球队都被分配到一个或另一个簇中。但首先，我们还有一些进一步的数据处理要处理。

11.5.1 更多数据处理

回到夏洛特黄蜂队。我们首先将之前创建的 cha 数据集通过 dplyr mutate() 函数处理两次，以创建一对派生变量。第一个派生变量被称为 salarytotal，它仅仅是夏洛特队 2000 年至 2002 年和 2005 年至 2017 年间调整后的工资总和，从第 2 列到第 17 列。第二个派生变量被称为 wintotal，它是夏洛特队常规赛胜利总数的总和，从第 18 列到第 33 列。结果被转换到一个新的对象 cha_kmeans 中：

cha %>%
  mutate(salarytotal = rowSums(.[2:17]),
         wintotal = rowSums(.[18:33])) -> cha_kmeans

为了使夏洛特黄蜂队与在 2000 年至 2017 年之间每个赛季都参加的 NBA 球队保持一致，我们将派生的变量salarytotal和wintotal增加 11%（黄蜂队“错过了”两个赛季，即大约 11%的包含在薪资数据集中的 18 个 NBA 赛季）。这绝对不是一门精确的科学，但它将比什么都不做产生更合理、更准确的结果；再次看看我们的克利夫兰点图，我们在那里保留了黄蜂队和鹈鹕队。由于wintotal不应包含任何分数或小数部分，我们调用基础 R 的round()函数将wintotal结果四舍五入到最接近的整数：

cha_kmeans$salarytotal <- cha_kmeans$salarytotal * 1.11 
cha_kmeans$wintotal <- round(cha_kmeans$wintotal * 1.11)

然后，我们通过调用select()函数来降低cha_kmeans的维度，只包括我们绝对需要的三个变量，以启用我们即将到来的 K-means 聚类算法——Team、salarytotal和wintotal：

cha_kmeans %>%
  select(Team, salarytotal, wintotal) -> cha_kmeans

然后，我们重复这个完全相同的练习两次，首先针对新奥尔良鹈鹕队，然后针对剩余的 NBA 球队。由于鹈鹕队“错过了”三个赛季，我们将它们的salarytotal和wintotal总和增加了 17%。因此，我们有了两个新的数据对象，nop_kmeans和league_kmeans：

nop %>%
  mutate(salarytotal = rowSums(.[2:16]),
         wintotal = rowSums(.[17:31])) -> nop_kmeans

nop_kmeans$salarytotal <- nop_kmeans$salarytotal * 1.17
nop_kmeans$wintotal <- round(nop_kmeans$wintotal) * 1.17

nop_kmeans %>%
  select(Team, salarytotal, wintotal) -> nop_kmeans

league %>%
  mutate(salarytotal = rowSums(.[2:19]),
         wintotal = rowSums(.[20:37])) -> league_kmeans

league_kmeans %>%
  select(Team, salarytotal, wintotal) -> league_kmeans

在接下来的代码块中，我们首先调用基础 R 的rbind()函数，将cha_kmeans、nop_kmeans和league_kmeans数据集合并成一个名为final_kmeans的单个对象。然后，我们调用select()函数对final_kmeans进行子集化，基于变量salarytotal和wintotal，从而删除Team变量。紧接着，我们调用基础 R 的trunc()函数，将变量wintotal从浮点数转换为整数。最后，我们调用print()函数来返回整个final_kmeans数据集：

final_kmeans <- rbind(cha_kmeans, nop_kmeans, league_kmeans)

final_kmeans %>%
  select(salarytotal, wintotal) %>%
  trunc(final_kmeans$wintotal) -> final_kmeans
print(final_kmeans)
##    salarytotal wintotal
## 1   1247973431      609
## 2   1346072892      657
## 3   1331370577      672
## 4   1502338683      782
## 5   1572394745      635
## 6   1350128086      696
## 7   1513579016      715
## 8   1793863099      911
## 9   1359921484      741
## 10  1374565213      750
## 11  1401640477      709
## 12  1464712564      810
## 13  1464126069      781
## 14  1307071048      681
## 15  1682631996      821
## 16  1436199380      681
## 17  1575463391      815
## 18  1423272015      657
## 19  1424852176      616
## 20  2034231301      626
## 21  1360935249      790
## 22  1494331249      694
## 23  1471662937      638
## 24  1420327702      777
## 25  1815095481      773
## 26  1398565630      677
## 27  1458067975     1040
## 28  1418504110      695
## 29  1333886430      786
## 30  1443384399      615

我们最终的数据处理操作是调用基础 R 的rownames()函数，将final_kmeans数据集中的数字行名替换为表示所有 30 支 NBA 球队的三个字母缩写。我们的数据按夏洛特（CHA）和纽奥尔良（NOP）排在最前面，然后按剩余的 28 支球队进行字母排序。当然，如果结果包含球队缩写而不是数字，那么它们将更容易解释：

rownames(final_kmeans) <- c("CHA", "NOP", "ATL", "BOS", "BKN", "CHI",
                            "CLE", "DAL", "DEN", "DET", "GSW", "HOU",
                            "IND", "LAC", "LAL", "MEM", "MIA", "MIL",
                            "MIN", "NYK", "OKC", "ORL", "PHI", "PHO",
                            "POR", "SAC", "SAS", "TOR", "UTA", "WAS")

现在，让我们继续进行我们的分析。

11.5.2 K-means 聚类

与我们在第三章中创建的层次聚类算法不同，K-means 算法首先要求我们指定要生成的聚类数量。随机指定一个聚类数量，称为K，或者尝试不同的聚类数量并不罕见；然而，我们将演示两种生成最佳聚类数量的方法，并在完成这两种方法之后决定K：

计算最佳聚类数量

第一种方法通常被称为肘部方法，或者更技术性地，称为簇内平方和法。我们绘制一种称为碎石图的线形图，它在 x 轴上显示簇数，在 y 轴上显示簇内平方和（也称为簇内方差）。它计算并重新计算每个数据点与其分配的簇之间的距离平方和，通过增加簇数来最小化每次迭代的和。方差通常以递减的速度下降，直到出现递减回报，这时增加 K 的额外增加无法进一步降低簇内方差。通常，这就是图表弯曲的地方——肘部点——我们应该接受这个作为最优簇数。

然而，肘部方法比客观方法更为主观；不幸的是，碎石图并不总是显示一个明确的肘部点。事实上，肘部点和我们观察到对于 K 的递减回报可能并不相同。这就是第二种方法，被称为平均轮廓方法，发挥作用的地方。它首先计算每个数据点的轮廓系数，这是一个介于 -1 和 +1 之间的数字，基于数据点与其所在簇内其他数据点的相似度，以及数据点与最近簇中每个数据点的平均相似度。轮廓系数是通过取这些相似度的差值，并将其除以这两个数中的最大值来计算的。当大多数数据点具有高，或者至少是正的轮廓系数时，聚类配置停止；相反，低轮廓系数表明簇计数过低或过高，从而触发额外的迭代。我们得到一个显示 x 轴上的簇数和 y 轴上的轮廓系数的图。它还揭示了 K 的一个 精确 的最优值。

在下一个代码块中，我们两次调用 factoextra 包中的 fviz_nbclust() 函数来计算和可视化最优簇计数，首先使用簇内平方和法，然后使用轮廓法。fviz_nbclust() 函数接受以下三个参数：数据源、聚类算法（它不一定是 K-means）和方法，这些都是相当简单的。事实上，fviz_nbclust() 函数自动为两个图插入标签，并将第二个图的 y 轴刻度默认设置为基于我们偏好全数字数值而不是科学记数法。由于平方和值是很大的数字，我们首先通过将 scipen 参数设置为 000 重新启用科学记数法，然后连续调用 fviz_nbclust()：

options(scipen = 000)
p3 <- fviz_nbclust(final_kmeans, kmeans, method = "wss") 
p4 <- fviz_nbclust(final_kmeans, kmeans, method = "silhouette") 

patchwork包与这些图表的配合效果与ggplot2可视化一样好。因此，我们调用plot_layout()函数将这两个图表组合成一个单一的图形对象，将图表p3显示在p4之上（见图 11.3）：

p3 + p4 + plot_layout(ncol = 1)

图 11.3 展示了两种关于最优聚类数量的解决方案，其中顶部的图表是碎石图，代表簇内平方和法，底部的图表代表轮廓法

当轮廓法（图 11.3 底部）返回一个明确的、或无歧义的、最优聚类数量时，簇内平方和法（图 11.3 顶部的碎石图）返回的聚类数量则开放于解释。一方面，平方和的最陡下降出现在一和两个聚类之间，因此表明两个聚类将是最佳选择；另一方面，图表弯曲，五和六个聚类之间的斜率接近 0，这更有说服力地表明六个聚类可能才是最佳选择。

运行算法

我们将折中处理，并继续使用四个聚类，同时考虑到小聚类数量有时会存在过度简化的风险。然后我们调用kmeans()函数，这是 R 基础包的一部分，来构建我们的四个聚类，并根据最终kmeans变量salarytotal和wintotal将 NBA 的 30 支球队分组。kmeans()函数需要两个参数：数据集（final_kmeans）和期望的聚类数量（4），也称为K。

我们还将向kmeans()函数传递两个可选参数：iter.max和nstart。iter.max参数表示算法在返回任何结果之前应该运行的次数。请记住，如果允许，kmeans()函数会经历几个迭代步骤，并返回一个配置，其中数据与各自质心的总平方和最小化——即聚类的中心位置。最佳配置可能在仅运行一次后就能获得，也可能不会——仅运行一次算法可能会留下更多最佳配置。因此，最好启用多次迭代，这是默认设置；在这里，我们告诉 R 迭代算法 25 次。

nstart参数表示用于初始化算法的随机数据集的数量。我们指定了四个聚类，并将nstart参数设置为25。因此，每次算法运行时，R 将提取四组数据，每组一个聚类，总共 25 次。print()函数返回结果：

k <- kmeans(final_kmeans, 4, iter.max = 25, nstart = 25) 
print(k)
## K-means clustering with 4 clusters of sizes 15, 1, 3, 11
##
## Cluster means:
##   salarytotal wintotal
## 1  1366605768 700.8667
## 2  2034231301 626.0000
## 3  1763863525 835.0000
## 4  1490569128 746.0000
##
## Clustering vector:
## CHA NOP ATL BOS BKN CHI CLE DAL DEN DET GSW HOU IND LAC LAL MEM MIA MIL 
##   1   1   1   4   4   1   4   3   1   1   1   4   4   1   3   4   4   1 
## MIN NYK OKC ORL PHI PHO POR SAC SAS TOR UTA WAS 
##   1   2   1   4   4   1   3   1   4   1   1   4 
##
## Within cluster sum of squares by cluster:
## [1] 3.519544e+16 0.000000e+00 1.012325e+16 2.254863e+16
## (between_SS / total_SS =  91.6 %)
##
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"    
## [5] "tot.withinss" "betweenss"    "size"         "iter"        
## [9] "ifault"   

这给我们以下信息：

• 分配给每个聚类的球队数量（1，15，11，3）。

• 每个聚类的salarytotal和wintotal均值，这些也代表了每个聚类的中心点。返回的数据按wintotal变量升序排序。

• 每个球队的聚类分配，其中每个聚类由 1 到 4 之间的数字标识。每个 NBA 球队都被分配到一个聚类中。

我们通过调用factoextra包中的fviz_cluster()函数，以ggplot2的外观和感觉可视化这些结果（见图 11.4）。除非另有说明，否则图例会自动添加到图的右侧（我们决定不包含图例）。我们还可以选择添加自己的标题和副标题、x 轴和 y 轴标签，以及将字体改为粗体：

p5 <- fviz_cluster(k, data = final_kmeans,
             main = "K-means Cluster of Payrolls and Wins (2000-17)",
             subtitle = "k = 4",
             xlab = "Team Payrolls",
             ylab = "Regular Season Wins",
             font.main = "bold") + 
      theme(legend.position = "none")
print(p5)

图 11.4 我们 K-means 聚类的可视化，其中 K 等于 4。聚类基于球队工资和常规赛胜利次数的组合，其中每个变量都已标准化。

x 轴和 y 轴上的标签表示分布均值的标准差数（你可以通过我们的克利夫兰点图进行交叉验证）。以下是我们从 K-means 算法及其可视化中可以得出的结论：

• 圣安东尼奥马刺队（SAS），据我们估计，在 2000 年至 2017 年期间是 NBA 最有效的球队，其常规赛胜利次数比联赛平均水平高出三个标准差以上，而其实际总工资却低于平均水平。然而，他们与篮网队而不是湖人队或小牛队聚集在一起。

• 纽约尼克斯队（NYK）独自在一个“聚类”中，因为他们的常规赛胜利次数比联赛平均水平低一个标准差以上，而他们的工资却比平均水平高三个标准差以上。你可能认为篮网队应该与尼克斯队对齐，而不是与圣安东尼奥队。

• 波士顿凯尔特人队（BOS）、迈阿密热火队（MIA）、洛杉矶湖人队（LAL）和达拉斯小牛队（DAL）在胜利次数和工资方面与联赛平均水平大致相等。这四支球队在 2000 年至 2013 年之间共赢得了 10 个 NBA 总冠军。

• 在 2000 年至 2017 赛季期间常规赛胜利次数最少的球队——夏洛特黄蜂队（CHA）、明尼苏达森林狼队（MIN）、华盛顿奇才队（WAS）、费城 76 人队（PHI）、布鲁克林篮网队（BKN）和密尔沃基雄鹿队（MIL）——总的来说，他们的工资与联赛平均水平非常接近，当然，他们的常规赛胜利次数在联赛平均水平或以下一个标准差。

• 我们的数据聚类在垂直方向上比在水平方向上更密集；也就是说，可以说在变量“球队工资”等于均值以上一个标准差的地方画了一条线。

请记住，salarytotal 和 wintotal 都不是正态分布的。当绘制的变量均匀地分布在它们的平均数周围时，K-means 算法工作得最好——它仍然可以正常工作。Shapiro-Wilk 测试返回一个 p 值，告诉我们一个数值变量是否服从正态分布。我们的零假设是正态分布；因此，如果 Shapiro-Wilk 返回的 p 值低于 5%，我们会拒绝该假设。话虽如此，我们将变量 salarytotal 和 wintotal 传递给基础 R 的 shapiro.test() 函数：

shapiro.test(final_kmeans$salarytotal) 
##  Shapiro-Wilk normality test
##
## data:  final_kmeans$salarytotal
## W = 0.82724, p-value = 0.0002144

shapiro.test(final_kmeans$wintotal)
##  Shapiro-Wilk normality test
##
## data:  final_kmeans$wintotal
## W = 0.89706, p-value = 0.007124

两次测试的 p 值都低于 5% 的显著性阈值；因此我们会两次拒绝零假设，并得出结论，这两个变量都不服从正态分布。这或许可以解释结果中的异常。

尝试其他 K 值的实验

而不是仅仅以一个 K 等于 4 的 K-means 算法结束，接下来让我们迭代我们的代码并测试 K 从 2 到 7 的情况。我们的结果——仅仅是结果，没有代码——将在接下来的几页中展示（见图 11.5a 至 11.5c）。

图 11.5a 当聚类数量，即 K，从 2 开始到 7 结束时的 K-means 聚类

图 11.5b 当聚类数量，即 K，从 2 开始到 7 结束时的 K-means 聚类

图 11.5c 当聚类数量，即 K，从 2 开始到 7 结束时的 K-means 聚类

在结果中，请注意以下几点：

• 当 K 等于 2 时，K-means 将工资总额低于 NBA 平均数一个标准差以下的所有数据点投入一个聚类，而工资总额高于联盟平均数一个标准差以上的所有数据点投入另一个聚类。

• 当 K 等于 3 时，之前两个较大的聚类中的最大一个被分为两组。在新聚类中，每个数据点的 salarytotal z 分数都低于平均数，而 wintotal z 分数低于联盟平均数一个标准差。

• 当 K 等于 4 时，算法仅仅将纽约尼克斯队放入了自己的一个组中。

• 当 K 等于 5 时，之前绘制的工资总额低于平均数一个标准差以下的两个聚类被划分为三个聚类。这三个聚类中的每一个数据点的 wintotal z 分数都低于平均数一个标准差。

• 当 K 等于 6 时，洛杉矶湖人队（LAL）与达拉斯小牛队（DAL）和波特兰开拓者队（POR）分开，并被放入一个包含两支工资总额低于平均数一个标准差以下的球队的聚类中。

• 当 K 等于 7 时，夏洛特黄蜂队，其工资水平低于联赛平均值的超过一个标准差，常规赛胜利次数也低于平均值超过一个标准差，被放入他们自己的组中。总的来说，K-means 算法在指令迭代添加一个新簇时，主要通过工资而不是胜利次数来分割数据。

K-means 算法绝对可以包括不止两个属性；然而，你一次只能可视化两个变量。

在下一章中，我们将进一步通过衡量团队层面的不平等程度来探索球员工资，并将这些结果与胜利和失败相关联。

摘要

• 无论你的用例是什么，无论你处理的是什么类型的数据——客户、犯罪行为、文件，无论什么——你都可以通过遵循这些确切步骤来创建一个 K-means 算法。

• 我们通过引入一对称为簇内平方和与平均轮廓的方法，展示了如何首先根据数据中的差异生成最佳簇数量。前者是这两种方法中最受欢迎的，但后者没有留下任何解释的空间。两者都是可以接受的。

• K-means 的优点是它速度快、容易使用，并且可以扩展到大型数据集；缺点是它最好在变量围绕其各自均值呈正态分布时工作——而我们处理的这对变量并不符合这种情况。

• 我们对标准差和 z 分数的分析旨在为你准备随后的分析。再次强调，标准差是数值向量的变异性的定量度量，或称为分散度；z 分数是一个度量，等于任何数值向量中的数据点相对于其分布均值的上方或下方标准差的数目。

• 我们之前已经指出，R 是数据可视化（以及其他方面）中的最佳编程语言。其中一个原因是它可以创建的图表范围广泛，尤其是在 ggplot2 图形包的帮助下。我们在前面的章节中展示了如何开发主流之外的图表，例如桑基图和棒棒糖图。在这里，我们展示了如何创建克利夫兰点图，它不仅外观和感觉都很流畅，而且包含大量易于理解的信息。

• 至于我们的结果，工资和胜利在联赛中几乎一半的球队中相当好地或非常好地一致。

• 我们发现了进一步的支持我们第十章结论的证据，即工资对常规赛胜利有显著影响。

• 我们 K-means 算法产生的簇既有趣又令人惊讶。“最佳”球队，拥有最聪明的球团——湖人队、小牛队、马刺队、火箭队、凯尔特人队、热火队和爵士队——散布在我们四个簇中的三个中。你也可以考虑将马刺队和篮网队放在同一个簇中，或者犹他队与黄蜂队混合。

• 然而，纽约尼克斯队处于他们自己的集群（至少当 K 等于 4 时是这样），这完全说得通。

12 计算和绘制不平等

本章涵盖

• 计算和理解基尼系数

• 创建和解读洛伦兹曲线

• 进行显著性检验

• 进行效应量检验

社会学家、经济学家、哲学家和其他人多年来一直声称，收入不平等加剧了犯罪和其他社会问题。这就是为什么他们说，税收、收入再分配和其他国家层面的纠正措施不是零和游戏，而是对公共利益的至关重要。一个平等的社会是一个繁荣的社会，一个不平等的社会是一个衰落的社会。

这种想法如何转化为 NBA 呢？NBA 是一个极其不平等的社会，“社会”中大部分的薪资支出都分配给了少数球员。事实上，你很快就会发现，整个联盟的薪资不平等程度最近比以前要高得多。但与此同时，薪资不平等在不同球队或“社区”之间差异显著。

是否可能相对平等薪资分配的球队比其他球队更繁荣？也就是说，这样的球队是否赢得更多常规赛和更多联赛冠军，而相对不平等薪资分配的球队则不然？无论如何，这是我们进入时的假设。

你可以从本章中获得以下内容：

• 你将了解有关基尼系数的所有必要知识，基尼系数是不平等的统计指标。我们将讨论基尼系数的确切含义，如何手动计算它，如何在 R 中执行相同的操作，以及如何解读结果。

• 你将学习如何创建洛伦兹曲线，这是一种不平等的图形表示，以及如何从同一数据中估算基尼系数。

• 你将对 t 检验和 Cohen 的 d 效应量检验进行复习。

• 你将学习一些我们尚未有机会介绍的数据处理操作——直到现在。

由于本章的大部分内容都依赖于基尼系数和洛伦兹曲线，在我们加载包、导入数据并进行分析之前，让我们先对这两个主题进行简要介绍。

12.1 基尼系数和洛伦兹曲线

基尼系数是衡量一个群体收入不平等的统计指标，通常应用于国家层面，其中 0 代表完全平等（即，每个人都获得相同的收入或拥有相同数量的财富），而 1 代表完全不平等（只有一个人拥有所有收入或财富，其他人则一无所获）。一般来说，以下情况是正确的：

• 低不平等对应于小于 0.3 的基尼系数。

• 中等不平等程度对应于 0.3 到 0.4 之间的基尼系数。

• 显著不平等对应于 0.4 到 0.6 之间的基尼系数。

• 高不平等对应于大于 0.6 的基尼系数。

基尼系数是由意大利统计学家科拉多·基尼在 1912 年开发的，尽管基尼的世界观早已不再受到青睐（基尼是一位优生学家），但他的衡量收入不平等系数的方法至今仍由世界银行、联合国和其他许多组织定期计算和发布。这就是为什么我们在一系列替代方案中选择了基尼系数作为我们的不平等度量标准，例如标准差（参见上一章）。

关于基尼系数，以下几点至关重要：

• 基尼系数是一个相对度量，而不是绝对度量，它掩盖了分布和其他细节；例如，两个国家可能具有相同的基尼系数，但生活水平却截然不同。从统计学的角度来看，这意味着一个国家可能有一个负偏斜的收入分布，左尾较长，而另一个国家可能有一个正偏斜的收入分布，右尾较长。

• 基尼系数可能在产品和服务部分或全部由政府补贴的地方失去一些准确性；毕竟，将社会主义或混合经济的好处，如医疗、住房和教育，转化为个人收入或财富并不容易。

洛伦兹曲线是 1905 年由一位名叫马克斯·洛伦兹的美国博士生开发的，它是一种图形表示人口内累积收入或财富分布的方法，有趣的是，这比基尼系数的提出早了七年。绘制洛伦兹曲线涉及绘制一对数值变量：沿任一轴的累积收入或财富份额以及沿相对轴的累积人口份额。（我们将累积薪酬分布作为我们的 x 轴变量，累积 NBA 球员份额作为我们的 y 轴变量。）绘制一条对角线来表示完全平等的状态，例如，一半的收入由一半的人口赚取，然后在对角线下绘制洛伦兹曲线，以显示，比如说，一半的收入或财富实际上只由 25%的人口拥有。当存在完全不平等时，洛伦兹曲线将呈现出类似倒 C 的形状。

我们可以从洛伦兹曲线中估计或计算基尼系数；基尼系数是洛伦兹曲线与完全平等线之间的面积与完全平等线下总面积的比率。因此，洛伦兹曲线与完全平等线之间的面积越大，不平等程度就越大。

现在我们已经处理好了基尼系数和洛伦兹曲线，至少暂时如此，我们将加载我们的包，导入我们的数据，然后开始我们的分析。

12.2 加载包

我们将超越内置的 R 函数，进行数据整理、提取、测试，以及其他计算和可视化结果。这次，我们将调用library()函数六次来加载扩展 R 功能范围的包：

library(tidyverse)
library(sqldf)
library(ineq)
library(gglorenz)
library(scales)
library(effsize)

这四个包——tidyverse、sqldf、scales和effsize——我们之前已经加载过；另外两个包，ineq和gglorenz，这次是首次使用。ineq包包含ineq()函数，该函数接受一个数字向量并计算基尼系数；gglorenz包是ggplot2的扩展，用于绘制洛伦兹曲线。

作为友好的提醒，在导入之前必须安装包，并且在调用它们的函数之前必须导入包。例如，如果ineq包尚未安装，我们首先会调用install.packages()函数，并将ineq包作为参数传递，用一对单引号或双引号括起来：

install.packages("ineq")

我们将导入我们的第一个数据集。

12.3 导入和查看数据

我们的第一份数据集是以.csv 文件的形式，之前从data.world下载的。因此，我们调用read_csv()函数从readr包中导入存储在我们默认工作目录中的数据。在这个过程中，我们创建了一个名为 gini 的对象：

gini <- read_csv("salaries_1985to2018.csv")

我们的数据集包含了 1985 年至 2018 年间每位 NBA 球员的年薪。

然后，我们调用dplyr包中的glimpse()函数来对我们的数据进行快速评估：

glimpse(gini) 
## Rows: 14,163
## Columns: 7
## $ league       <chr> "NBA", "NBA", "NBA", "NBA", "NBA", "NBA", "NB...
## $ player_id    <chr> "abdelal01", "abdelal01", "abdelal01", "abdel...
## $ salary       <dbl> 395000, 494000, 500000, 805000, 650000, 15300...
## $ season       <chr> "1990-91", "1991-92", "1992-93", "1993-94", "...
## $ season_end   <dbl> 1991, 1992, 1993, 1994, 1995, 1985, 1986, 198...
## $ season_start <dbl> 1990, 1991, 1992, 1993, 1994, 1984, 1985, 198...
## $ team         <chr> "Portland Trail Blazers", "Portland Trail Bla...

基尼数据集有 14,163 行，七列宽；它包含数字变量（int）和字符字符串（chr）的组合。一些粗略的计算——考虑到我们数据集中包含的 NBA 赛季数量、球队数量以及球队通常在其活跃阵容中携带的球员数量——表明 14,163 条记录相当高。这可能是由于许多球员在短期或临时合同中进出联盟，或者可能是其他完全不同的事情的结果。

由于球员在赛季中经常转会——他们可以被交易到另一支球队，或者在被放弃后被另一支球队签下，这相当于被解雇或裁员——因此，检查和标记player_id（一个唯一标识符）和season_end（NBA 常规赛结束的日历年份）之间的重复记录是合适的。这是一个理解数据所在生态系统中重要性的好例子；缺乏关于变量潜在移动或交互的上下文的无视分析可能会破坏分析的整体性。

如果有一种快速简单的方法来检测或确认重复记录的存在，那将很理想，但不幸的是，伴随我们的数据的数据字典没有提及赛季内球员的移动或在这种情况下工资是否被重复计算，这意味着我们不得不自己应对。但在现实世界中，这通常是这种情况。

在下面的dplyr代码块中，我们首先将 gini 数据集传递给group_by()函数，其中player_id和season_end是额外的参数，然后我们调用mutate()函数创建一个名为duplicate的逻辑变量。如果 gini 包含一个或多个player_id和season_end相同的记录，则duplicate变量将等于TRUE；否则，duplicate将等于FALSE。我们的结果被转换为一个名为 gini2 的 tibble，我们只临时使用它：

gini %>%
  group_by(player_id, season_end) %>%
  mutate(duplicate = n() > 1) -> gini2

然后，我们将gini2传递给group_by()和tally()函数，以返回变量duplicate等于TRUE或FALSE时的行计数，以获取数据中（可能）重复记录的数量：

gini2 %>%
  group_by(duplicate) %>%
  tally()
## # A tibble: 2 × 2
##   duplicate     n
##   <lgl>     <int>
## 1 FALSE     13367
## 2 TRUE        796

我们的数据集中确实包含重复项——很多，如果我们在这里停下来，这似乎就是如此。

接下来，我们从sqldf包中调用sqldf()函数，从基础 R 中调用head()函数，以返回gini2中变量duplicate等于TRUE的前六个观测值。这让我们对一些重复记录有了了解，并为我们进行一些额外研究提供了一个起点：

head(sqldf("SELECT * FROM gini2 WHERE duplicate = TRUE"))
##   league player_id  salary  season season_end season_start                 
## 1    NBA   acyqu01 1914544 2016-17       2017         2016        
## 2    NBA   acyqu01 1050961 2016-17       2017         2016     
## 3    NBA afflaar01 1500000 2017-18       2018         2017     
## 4    NBA afflaar01 1471382 2017-18       2018         2017        
## 5    NBA aguirma01 1471000 1993-94       1994         1993      
## 6    NBA aguirma01  150000 1993-94       1994         1993 
##                     team  duplicate
## 1    Brooklyn Nets             TRUE
## 2    Dallas Mavericks          TRUE
## 3    Sacramento Kings          TRUE
## 4    Orlando Magic             TRUE
## 5    Detroit Pistons           TRUE
## 6    Los Angeles Clippers      TRUE

经过进一步调查，我们发现我们的重复项根本不是重复项。Quincy Acy 是一个典型的例子（参见我们的sqldf输出中的player_id acyqu01）。Acy 是一个边缘化和被遗忘的球员，但他在一个七年的职业生涯中赚了超过 800 万美元的薪水。根据他的www.basketball-reference.com个人资料，Acy 在 2016-17 赛季开始时是达拉斯小牛队的一员。在赛季开始大约一个月后，他只参加了六场比赛，Acy 被放弃，两个月后被布鲁克林篮网队签下。对我们来说最重要的是，小牛队支付给 Acy 超过 100 万美元，并且篮网队额外支付给他 190 万美元；因此，Acy 在 2016-17 赛季赚了超过 290 万美元。对其他“重复项”的其他检查揭示了相同的模式；在变量player_id和season_end上确实存在重复，但薪水是唯一的。对我们来说，最后这部分是关键：对于每个player_id、season和team组合，薪水是唯一的或互斥的。现在我们已经解决了这个问题，我们就知道从数据处理的角度需要做什么，以及不需要做什么。

12.4 数据处理

从现在开始，我们只需要 gini 中的八个变量中的三个——这些是 salary、season_end 和 team。没有必要保留不必要的数据，因此我们将通过调用 dplyr 包中的 select() 函数来减少 gini 数据集，只包括这三个变量：

gini %>%
  select(salary, season_end, team) -> gini

接下来，我们通过两次调用基础 R 的 as.factor() 函数将变量 season_end 和 team 转换为因子：

gini$season_end <- as.factor(gini$season_end)
gini$team <- as.factor(gini$team)

然后，我们运行基础 R 的 summary() 函数，以返回 gini 中剩余三个变量的描述性统计信息；maxsum 参数告诉 R 返回最多但不超过 40 个级别的因子。变量 season_end 包含 34 个级别，每个赛季或年份一个，而变量 team 因为我们的数据识别了队名迭代，包含 39 个级别。

对于数值变量，例如 salary，summary() 函数返回平均值、中位数、最小值和最大值，以及第一和第三四分位数；对于因子变量，例如 season_end 和 team，summary() 则返回每个组的观测计数：

summary(gini, maxsum = 40)
##      salary         season_end                                team    
##  Min.   :    2706   1985:210                                    :  4  
##  1st Qu.:  630000   1986:296   Atlanta Hawks                    :494  
##  Median : 1500000   1987: 40   Boston Celtics                   :502  
##  Mean   : 3164870   1988:303   Brooklyn Nets                    :103  
##  3rd Qu.: 3884239   1989:321   Charlotte Bobcats                :156  
##  Max.   :34682550   1990: 64   Charlotte Hornets                :253  
##                     1991:353   Chicago Bulls                    :496  
##                     1992:387   Cleveland Cavaliers              :491  
##                     1993:404   Dallas Mavericks                 :519  
##                     1994:394   Denver Nuggets                   :490  
##                     1995:418   Detroit Pistons                  :481  
##                     1996:388   Golden State Warriors            :491  
##                     1997:413   Houston Rockets                  :509  
##                     1998:444   Indiana Pacers                   :484  
##                     1999:432   Kansas City Kings                : 11  
##                     2000:526   Los Angeles Clippers             :503  
##                     2001:464   Los Angeles Lakers               :475  
##                     2002:459   Memphis Grizzlies                :298  
##                     2003:459   Miami Heat                       :453  
##                     2004:458   Milwaukee Bucks                  :491  
##                     2005:478   Minnesota Timberwolves           :436  
##                     2006:494   New Jersey Nets                  :413  
##                     2007:511   New Orleans Hornets              :143  
##                     2008:486   New Orleans Pelicans             : 95  
##                     2009:471   New Orleans/Oklahoma City Hornets: 31  
##                     2010:472   New York Knicks                  :499  
##                     2011:467   Oklahoma City Thunder            :163  
##                     2012:468   Orlando Magic                    :463  
##                     2013:496   Philadelphia 76ers               :519  
##                     2014:410   Phoenix Suns                     :509  
##                     2015:543   Portland Trail Blazers           :487  
##                     2016:527   Sacramento Kings                 :482  
##                     2017:556   San Antonio Spurs                :488  
##                     2018:551   Seattle SuperSonics              :308  
##                                Toronto Raptors                  :375  
##                                Utah Jazz                        :456  
##                                Vancouver Grizzlies              : 93  
##                                Washington Bullets               :153  
##                                Washington Wizards               :346

summary() 函数的输出揭示了一些问题——一个相对较小，另一个则不然。首先，我们在 gini 中有四个观测值，其中变量 team 为空。这可能是在创建数据集时的疏忽，也许这些是签订了保证合同但因为没有受伤而未为任何球队出场的球员，或者完全是其他原因。以下 SELECT 语句从 gini 数据集中返回了这四个记录：

sqldf("SELECT * FROM gini WHERE team == ''")
##   salary season_end team
## 1  65000       1985     
## 2 600000       1985     
## 3 450000       1985     
## 4 120000       1985

很有趣的是，所有这些数据都来自 1984-85 赛季。

第二个问题是记录计数较低——在某些情况下非常低——当变量 season_end 小于或早于 1991 年时。这很可能是由于当时薪水并不总是那么公开。以下两个 SELECT 语句返回了两个随机队伍的每条记录，一个来自 1987 年，另一个来自 1990 年，结果发现记录计数特别低：

sqldf("SELECT * FROM gini WHERE team == 'Boston Celtics' AND 
      season_end == 1987")
##    salary season_end           team
## 1 1800000       1987 Boston Celtics
## 2  200000       1987 Boston Celtics
## 3  425000       1987 Boston Celtics

sqldf("SELECT * FROM gini WHERE team == 'Los Angeles Lakers' AND 
      season_end == 1990")
##    salary season_end               team
## 1 1500000       1990 Los Angeles Lakers
## 2 3100000       1990 Los Angeles Lakers
## 3 1100000       1990 Los Angeles Lakers
## 4 1500000       1990 Los Angeles Lakers

有可能用相同的数据，当然，通过用 dplyr 代码替换 WHERE 子句来返回相同的结果，以使用 filter() 函数。这取决于你。只是要注意，dplyr 和 sqldf 通常不使用相同的语法；例如，sqldf 使用 AND，而 dplyr 使用 &：

gini %>%
  filter(team == "Boston Celtics" & season_end == 1987)
##    salary season_end           team
## 1 1800000       1987 Boston Celtics
## 2  200000       1987 Boston Celtics
## 3  425000       1987 Boston Celtics

gini %>%
  filter(team == "Los Angeles Lakers" & season_end == 1990)
##    salary season_end               team
## 1 1500000       1990 Los Angeles Lakers
## 2 3100000       1990 Los Angeles Lakers
## 3 1100000       1990 Los Angeles Lakers
## 4 1500000       1990 Los Angeles Lakers

gini 数据集只包含 1987 年波士顿凯尔特人队的三个记录和 1990 年洛杉矶湖人队的四个记录。

由于这些发现，我们随后通过删除所有 factor 变量 season_end 等于 1985、1986、1987、1988、1989 或 1990 的行来对 gini 数据集进行子集化，以删除数据不完整的 NBA 赛季。然后我们有一个新的工作数据集，称为 gini3。

为了实现这一点，我们调用基础 R 的c()函数来创建一个包含 1985 年至 1990 年season_end级别的向量的向量。接下来，因为我们通过向量进行过滤，所以我们使用%in%运算符，该运算符指示 R 通过变量season_end筛选并移除（而不是保留，因为我们的代码前面有表示逻辑否定运算符的!运算符）那些级别等于我们向量中值的记录：

gini[!(gini$season_end %in% c(1985, 1986, 1987, 1988, 
                              1989, 1990)),] -> gini3

然后，我们调用dim()函数来返回 gini3 数据集的维度：

dim(gini3)
## [1] 12929     3

因此，我们的工作数据集已从原始的 14,163 行减少到 12,929 行，相差 1,234 行。

以下是我们数据中的两个快速要点：

• NBA 常规赛通常在十月中旬开始，在四月中旬结束，因此开始于一个日历年份，结束于另一个日历年份。所以，例如，因为 2018 赛季实际上是在 2017 年 10 月开始，有时被称为 2017-18 赛季。我们之前从 gini 数据集中删除了变量season和season_start，因为它们（甚至两个一起）比单独的变量season_end本身增加的价值不多。

• 与我们在前两章中使用的薪资数据集不同，gini 数据集识别了 1985 年至 2018 赛季之间的特许经营变动和随后的球队名称变更。这就是为什么变量team包含的级别比 30 多个级别显著更多。

在以下代码块中，我们进一步通过仅保留每个team和season_end组合中排名前 14 位的球员薪资来减少 gini3 数据集。否则，包括联赛最低薪资球员的结果可能会不公平或不准确，这些球员通常在短期或临时合同上打球。我们通过以下步骤实现这一点：

1. 我们首先通过管道运算符将 gini3 数据集传递给dplyr arrange()函数，该函数按 gini 的每个三个变量进行排序。

2. 然后，我们调用dplyr group_by()和mutate()函数以及基础 R 的rank()函数来创建一个名为rank的新变量，其中变量薪资按每个team和season_end组合的降序排列，1 到n。rank()函数中的负号或负号对变量薪资进行排序或排名。ties.method参数指定如何处理平局；当等于first时，R 将平局元素分配为连续的、因此不同的排名。

3. 最后，我们调用dplyr filter()函数，仅包括变量排名小于或等于 14 的记录。结果被放入一个名为 gini4 的 tibble 中：

gini3 %>%
  arrange(season_end, team, salary) %>%
  group_by(season_end, team) %>%
  mutate(rank = rank(-salary, ties.method = "first")) %>%
  filter(rank <= 14) -> gini4

这使得我们拥有一个工作数据集，其中每个season_end和team组合的记录数最多为 14。但让我们进行一系列完整性检查以验证这一点。

在下一个代码块中，我们两次调用sqldf()函数，该函数来自sqldf包，编写SELECT语句从 gini3 数据集和 gini4 tibble 中提取数据，其中变量season_end等于2012且变量team等于丹佛掘金队。注意我们在外面使用双引号，在内部使用单引号；这种风格使 R 更容易阅读和解释代码：

sqldf("SELECT * FROM gini3 WHERE season_end = 2012 AND 
      team = 'Denver Nuggets'")
##      salary season_end           team
## 1   7562500       2012 Denver Nuggets
## 2   4234000       2012 Denver Nuggets
## 3   3059000       2012 Denver Nuggets
## 4    289382       2012 Denver Nuggets
## 5   1254720       2012 Denver Nuggets
## 6   2180443       2012 Denver Nuggets
## 7   4190182       2012 Denver Nuggets
## 8   1073286       2012 Denver Nuggets
## 9   6226200       2012 Denver Nuggets
## 10 13000000       2012 Denver Nuggets
## 11  2203792       2012 Denver Nuggets
## 12  1654440       2012 Denver Nuggets
## 13  7807728       2012 Denver Nuggets
## 14  3343896       2012 Denver Nuggets
## 15   473604       2012 Denver Nuggets

sqldf("SELECT * FROM gini4 WHERE season_end = 2012 AND 
      team = 'Denver Nuggets'")
##      salary season_end           team rank
## 1    473604       2012 Denver Nuggets   14
## 2   1073286       2012 Denver Nuggets   13
## 3   1254720       2012 Denver Nuggets   12
## 4   1654440       2012 Denver Nuggets   11
## 5   2180443       2012 Denver Nuggets   10
## 6   2203792       2012 Denver Nuggets    9
## 7   3059000       2012 Denver Nuggets    8
## 8   3343896       2012 Denver Nuggets    7
## 9   4190182       2012 Denver Nuggets    6
## 10  4234000       2012 Denver Nuggets    5
## 11  6226200       2012 Denver Nuggets    4
## 12  7562500       2012 Denver Nuggets    3
## 13  7807728       2012 Denver Nuggets    2
## 14 13000000       2012 Denver Nuggets    1

第一个SELECT语句返回 gini3 中season_end等于2012且team等于Denver Nuggets的每条记录和每个变量；返回了 15 条记录，每条记录代表那个赛季在丹佛掘金队工资名单上的每位球员。

第二个SELECT语句返回 gini4 中season_end也等于2012且team也等于Denver Nuggets的每条记录和每个变量；然后返回了 14 条记录，其中工资变量按升序排序，排名变量按降序排序。这正是我们预期的。

让我们再次尝试，这次用 2012 年的丹佛掘金队替换为 2018 年的芝加哥公牛队：

sqldf("SELECT * FROM gini3 WHERE season_end = 2018 AND 
      team = 'Chicago Bulls'")
##      salary season_end          team
## 1   1471382       2018 Chicago Bulls
## 2  10595505       2018 Chicago Bulls
## 3    200000       2018 Chicago Bulls
## 4   4046760       2018 Chicago Bulls
## 5    100353       2018 Chicago Bulls
## 6   7843500       2018 Chicago Bulls
## 7   1713840       2018 Chicago Bulls
## 8   4615385       2018 Chicago Bulls
## 9   2163006       2018 Chicago Bulls
## 10  3202217       2018 Chicago Bulls
## 11 13788500       2018 Chicago Bulls
## 12  3821640       2018 Chicago Bulls
## 13  1312611       2018 Chicago Bulls
## 14  2203440       2018 Chicago Bulls
## 15  3853931       2018 Chicago Bulls
## 16  1516320       2018 Chicago Bulls
## 17  1471382       2018 Chicago Bulls
## 18  3000000       2018 Chicago Bulls
## 19    50000       2018 Chicago Bulls
## 20  2186400       2018 Chicago Bulls
## 21  3505233       2018 Chicago Bulls
## 22 15550000       2018 Chicago Bulls
## 23  1312611       2018 Chicago Bulls

sqldf("SELECT * FROM gini4 WHERE season_end = 2018 AND 
      team = 'Chicago Bulls'")
##      salary season_end          team rank
## 1   2163006       2018 Chicago Bulls   14
## 2   2186400       2018 Chicago Bulls   13
## 3   2203440       2018 Chicago Bulls   12
## 4   3000000       2018 Chicago Bulls   11
## 5   3202217       2018 Chicago Bulls   10
## 6   3505233       2018 Chicago Bulls    9
## 7   3821640       2018 Chicago Bulls    8
## 8   3853931       2018 Chicago Bulls    7
## 9   4046760       2018 Chicago Bulls    6
## 10  4615385       2018 Chicago Bulls    5
## 11  7843500       2018 Chicago Bulls    4
## 12 10595505       2018 Chicago Bulls    3
## 13 13788500       2018 Chicago Bulls    2
## 14 15550000       2018 Chicago Bulls    1

第一个SELECT语句返回 23 条记录，第二个返回从最低到最高排序的前 14 位球员工资。这很完美。

最后，让我们运行两个额外的SELECT语句，计算gini4行数，其中变量team等于Denver Nuggets，然后当变量team等于Chicago Bulls时。行数应该等于最大值 392，这是 28 个赛季乘以每个赛季最多 14 位球员工资的结果（有些队伍在某些赛季的工资名单上球员人数少于 14 人）：

sqldf("SELECT COUNT (*) FROM gini4 WHERE team = 'Denver Nuggets'") 
##   COUNT(*)
## 1      388

sqldf("SELECT COUNT (*) FROM gini4 WHERE team = 'Chicago Bulls'")
##   COUNT(*)
## 1      387

因为掘金队的行数是 388，公牛队的行数是 387，这两个检查进一步验证了我们的数据完整性。

验证那些并非每天都必须执行的操作，始终是时间和精力的值得投资。现在，让我们通过计算基尼系数来开始我们的分析。

12.5 基尼系数

再次强调，基尼系数是衡量不平等的指标，因此系数越高意味着差异越大。让我们通过一系列非常简单的例子来演示基尼系数。

首先，假设我们有一组 10 个人，每人每月收入 50 美元。我们通过调用rep()和c()函数并告诉 R 重复 50 十次来创建一个包含 10 个相同元素的向量。然后，我们将我们的向量传递给ineq()函数，该函数来自ineq包，以计算基尼系数：

a <- rep(c(50), each = 10)
print(a)
##  [1] 50 50 50 50 50 50 50 50 50 50

ineq(a)
## [1] 0

因为每个人的收入都完全相同，所以存在完美的平等，因此基尼系数等于 0。

在我们的第二个例子中，有五个人每月赚 50 美元，另外五个人赚两倍于此；因此，三分之二的收入仅由一半的人赚取：

b <- rep(c(50, 100), each = 5)
print(b)
##  [1]  50  50  50  50  50 100 100 100 100 100

ineq(b)
## [1] 0.1666667

因此，我们得到的基尼系数等于 0.17。

在我们的第三个例子中，一半的人每月赚取 150 美元，另一半的人每月赚取 300 美元：

c <- rep(c(150, 300), each = 5)
print(c)
##  [1] 150 150 150 150 150 300 300 300 300 300

ineq(c)
## [1] 0.1666667

与先前的例子相比，月收入普遍较高；然而，基尼系数也等于 0.17，因为总收入的三分之二再次仅由一半的人赚取。正如之前提到的，我们可以有右偏和左偏的分布，但基尼系数相等。

在我们的第四个例子中，我们有一个完美的月收入分布，平均值和中位数都是 80，标准差最小：

d <- rep(c(60, 70, 80, 90, 100), each = 2)
print(d)
##  [1]  60  60  70  70  80  80  90  90 100 100

ineq(d)
## [1] 0.1

几乎一半的月收入是由仅四个人赚取的；因此，我们有一个基尼系数等于 0.10。

在我们的第五个例子中，我们再次有一个完美的正常收入分布；这次，平均值和中位数都是 100，标准差是之前的两倍：

e <- rep(c(50, 75, 100, 125, 150), each = 2)
print(e)
##  [1]  50  50  75  75 100 100 125 125 150 150

ineq(e)
## [1] 0.2

因此，10 个人中有 4 个人的月收入占 55%，我们的基尼系数翻倍至 0.20。

在我们的第六个和最后一个例子中，九个人每月仅赚取 10 美元，而第十个人每月赚取 100 美元：

f <- rep(c(10, 100), times = c(9, 1))
print(f)
##  [1]  10  10  10  10  10  10  10  10  10 100

ineq(f)
## [1] 0.4263158

因此，最后这个人的收入是其他所有人收入的两倍多，因此基尼系数因此大幅上升至 0.43。

现在，在下面的代码块中，我们将我们工作数据集的最新版本 gini4 传递给dplyr::group_by()和summarize()函数以及ineq()函数，以根据变量season_end中的每个剩余因素计算基尼系数。结果被转换成一个名为 gini_summary 的 tibble。通过调用基础 R 的round()函数，我们限制结果只包含小数点后两位数字：

gini4 %>%
  group_by(season_end) %>%
  summarize(gc = round(ineq(salary), digits = 2)) -> gini_summary
print(gini_summary)
## # A tibble: 28 × 2
##    season_end    gc
##    <fct>      <dbl>
##  1 1991        0.41
##  2 1992        0.41
##  3 1993        0.41
##  4 1994        0.39
##  5 1995        0.42
##  6 1996        0.45
##  7 1997        0.52
##  8 1998        0.51
##  9 1999        0.49
## 10 2000        0.5 
## # ... with 18 more rows

这些结果随后在ggplot2线图或时间序列图中进行可视化（见图 12.1）。以下是关于被调用的关键ggplot2函数的一些提示：

• geom_line()函数绘制了一条宽度为默认ggplot2宽度的 1.5 倍的线条。

• geom_point()函数在沿线添加了大小为默认大小的三倍的点。

• geom_smooth()函数在整个数据系列上绘制了一条细的回归线，没有置信区间，因为我们向geom_smooth()添加了se = FALSE参数来覆盖默认功能。

• 第二次调用theme()函数将 x 轴标签旋转至 45 度，并将它们水平对齐在图表下方。

• 通过连续调用annotate()函数，在图表的右下角标注描述性统计信息。

图 12.1 NBA 年薪分布的年度或季节性基尼系数

话虽如此，以下是我们的代码块：

ggplot(gini_summary, aes(x = season_end, y = gc, group = 1)) + 
  geom_line(aes(y = gc), color = "coral3", size = 1.5) + 
  geom_point(size = 3, color = "coral3") +
  geom_smooth(method = lm, se = FALSE) +
  labs(title = "Gini Coefficient of NBA Player Salaries by Season", 
       subtitle = "1991-2018",
       x = "Season", 
       y = "Gini Coeffiicient",
       caption = "includes a maximum top 14 salaries for each team") +
  annotate("text", x = "2014", y = .38, label = "min = 0.39", 
           fontface = "bold") +
  annotate("text", x = "2014", y = .40, label = "max = 0.52", 
           fontface = 'bold') +
  annotate("text", x = "2014", y = .39, label = "mean = 0.47", 
           fontface = 'bold') +
  annotate("text", x = "2014", y = .37, 
           label = "standard deviation = 0.03", fontface = 'bold') +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

这些结果真的很令人着迷：

• 在 1991 年至 1995 年之间，基尼系数每年都是 0.41 或 0.42，除了 1994 年，当时它达到了 gini_summary 的最小值 0.39。

• 基尼系数在 1995 年激增，在 1996 年再次激增，特别是在 1997 年，尽管人口保持静态，基尼系数达到了 0.52，这是基尼系数的最大值。

• 系数在 1998 年适度下降，并在 1999 年再次下降。

• 1999 年建立了一个新的标准，并在 2018 年维持了这个标准，其中基尼系数在 0.47（1991-2018 年的平均值）和 0.50 之间“弹跳”。

• 所有这些都表明，尽管 NBA 薪资分布在过去是适度不平等的，但毫无疑问现在是显著不平等的。

不平等性通过洛伦兹曲线进行可视化，正如我们在本章前面讨论的那样。接下来，我们将演示如何使用ggplot2扩展构建洛伦兹曲线，展示如何估计或甚至计算基尼系数，然后讨论如何正确解释结果。

12.6 洛伦兹曲线

再次，洛伦兹曲线是收入或财富分布的图形表示，其中收入或薪资分布的百分比通常是 x 轴变量，而获得该收入或领取该薪资的个人百分比则是 y 轴变量（尽管翻转变量也是完全可以接受的）。

使用内置的 R 函数可以创建洛伦兹曲线；然而，我们将使用ggplot2包以及一个名为gglorenz的ggplot2扩展。我们的第一条洛伦兹曲线可视化了 1993-94 赛季的薪资分布，基尼系数为 0.39，这是我们的数据集中的最小值（见图 12.2）：

• 我们首先调用dplyr filter()函数，对 gini4 数据集进行子集化，其中变量season_end等于1994。在这个过程中，我们创建了一个名为 gini1994 的新数据集。

• 由于我们的洛伦兹曲线在本质上与其他任何ggplot2对象没有区别，因此我们通过调用ggplot()函数并传递 gini1994 数据集作为参数以及变量salary作为唯一的美学映射来初始化我们的绘图。

• 来自gglorenz包的stat_lorenz()函数绘制洛伦兹曲线。当设置为TRUE时，人口按降序排列；当设置为FALSE时，人口则按升序排列。由于大多数洛伦兹曲线都是按人口升序排列创建的，而不是相反，因此我们将desc参数（表示降序）设置为FALSE。此外，我们指示 R 用实线红色绘制线条，并将其宽度增加到默认宽度的两倍。

• ggplot2 coord_fixed()函数固定了 x 轴和 y 轴的比率，使它们的刻度相等。这并不是绝对必要的，但对于洛伦兹曲线来说，这是高度推荐的，因为保持 x 轴和 y 轴对齐以及相同的纵横比非常重要。否则，解释结果将很困难。

• geom_abline()函数绘制了一条虚线对角线，它代表了一种完美的平等状态，我们可以将其与我们的不平等曲线进行比较。

• scale_x_continuous() 和 scale_y_continuous() 函数，结合 scales 包——它是 ggplot2 包的一部分，而 ggplot2 包当然又是 tidyverse 的一部分——将我们的 x 轴和 y 轴标签从小数转换为百分比。

图 12.2 1993-94 赛季的洛伦兹曲线，当吉尼系数等于 0.39 时

我们的数据整理和数据处理代码如下：

gini1994 <- filter(gini4, season_end == 1994)

ggplot(gini1994, aes(salary)) +
  stat_lorenz(desc = FALSE, color = "red", lwd = 2) +
  coord_fixed() +
  geom_abline(linetype = "dashed", lwd = 1.5) +
  labs(title = "Lorenz Curve\n1993-94 Season", 
       subtitle = "Gini coefficient = 0.39",
       x = "Salary Distribution",
       y = "Percentage of NBA Players",
       caption = "includes a maximum top 14 salaries for each team") +
  scale_x_continuous(labels = percent) +
  scale_y_continuous(labels = percent) +
  theme(plot.title = element_text(face = "bold")) 

这是我们如何解释我们的洛伦兹曲线：

• x 轴代表球员薪水的美元支付百分比。

• y 轴代表 NBA 球员的百分比。

• 虚线线代表完全平等的状态，例如，50%的所有薪水都分给了联赛中 50%的球员。

• 洛伦兹曲线代表薪资不平等的程度；它与虚线之间的面积越大，不平等越严重，反之亦然。在 1994 年，75%的所有薪水都由 50%的球员获得。

• 吉尼系数可以通过计算洛伦兹曲线与完全平等线之间的面积，并将其除以完全平等线下方的总面积来得出（你将在第十三章中了解更多关于这一点）。

让我们再画一条洛伦兹曲线，仅为了比较目的（见图 12.3）。这最好通过子集化 gini4 数据集来完成，其中变量 season_end 等于 1997，此时吉尼系数达到了最大值 0.52。你会看到洛伦兹曲线与完全平等线之间的额外面积与之前的图表相比有多大。洛伦兹曲线与完全平等线之间的差距越大，意味着不平等越严重：

gini1997 <- filter(gini4, season_end == 1997)

ggplot(gini1997, aes(salary)) +
  stat_lorenz(desc = FALSE, color = "red", lwd = 2) +
  coord_fixed() +
  geom_abline(linetype = "dashed", lwd = 1.5) +
  labs(title = "Lorenz Curve\n1996-97 Season", 
       subtitle = "Gini coefficient = 0.52",
       x = "Salary Distribution", 
       y = "Percentage of NBA Players",
       caption = "includes a maximum top 14 salaries for each team") +
  scale_x_continuous(labels = percent) +
  scale_y_continuous(labels = percent) +
  theme(plot.title = element_text(face = "bold")) 

图 12.3 1996-97 赛季的洛伦兹曲线，当吉尼系数等于 0.53 时

而 1994 年，75%的薪水发放给了 50%的球员，而到了 1997 年，75%的薪水只发放给了 38%的球员；这就是吉尼系数从 0.39 变为 0.52 的差异。

现在你已经很好地理解了吉尼系数和洛伦兹曲线，让我们通过探索薪资不平等可能与胜负的关系来应用我们刚刚学到的知识。

12.7 薪资不平等与冠军

我们将从比较和对比冠军球队与其他所有球队开始。回想一下，我们的假设是，薪资分配更平等的球队通常比薪资分配不平等的球队更成功。

然而，我们首先需要整理我们的数据。

12.7.1 数据整理

以下代码块将 gini4 数据集重塑，使得每个 team 和 season_end 组合的球员薪水都是其自己的列：

1. 然而，首先，我们调用 dplyr select() 函数从 gini4 中移除变量 rank。

2. 然后，我们将 gini4 数据集传递给 dplyr 的 group_by()、mutate() 和 row_number() 函数，以创建一个名为 id 的新变量，它仅是一个连续数字的列，每个 team 和 season_end 组合都有独立的序列。

3. 最后，我们调用 tidyr 的 pivot_wider() 函数，该函数将 gini4 从长格式转换为宽格式，其中变量 id 被拆分为列，变量 salary 的值用于填充这些新列中的单元格。

结果是一个名为 gini5 的新 tibble。调用基础 R 的 head() 函数返回前六个观测值（注意 R 自动将一些值以科学记数法返回）：

gini4 <- select(gini4, -c(rank))

gini4 %>%
  group_by(team, season_end) %>%
  mutate(id = row_number(salary)) %>%
  pivot_wider(names_from = id, values_from = salary) -> gini5
head(gini5)
## # A tibble: 6 × 16
## # Groups:   team, season_end [6]
##   season_end team       `1`    `2`    `3`    `4`    `5`    `6`    
##   <fct>      <fct>    <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  
## 1 1991       Atlant... 125000 200000 510000 510000 590000 650000 
## 2 1991       Boston...  80000 222000 315000 375000 400000 525000 
## 3 1991       Charlo...  75000 200000 322000 355000 485000 675000 
## 4 1991       Chicag... 150000 385000 425000 450000 600000 750000 
## 5 1991       Clevel... 100000 120000 200000 350000 525000 525000 
## 6 1991       Dallas...  30000 115000 150000 250000 600000 730000 
##   `7`    `8`    `9`   `10`   `11`
##    <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
## 1 685000 775000 8   e5 8.95e5 1.55e6
## 2 547000 550000 7.5 e5 8.5 e5 1.21e6
## 3 805000 900000 1   e6 1.2 e6 1.25e6
## 4 765000 915000 1   e6 1   e6 1.1 e6
## 5 548000 630000 9.25e5 1.26e6 1.32e6
## 6 765000 880000 9.85e5 1   e6 1.5 e6

注意，第 1 至 14 列现在只是列名，而不是排名；实际上，薪资现在是按从左到右的顺序水平排序。这是可以接受的——我们之前对薪资进行排名只是为了对每个 team 和 season_end 组合的前 14 个薪资进行子集化。薪资如何排列不再重要。

然后，我们调用基础 R 的 names() 函数来重命名 gini5 的大多数列名；season_end 和 team 将保持不变，但来自先前变量 rank 的其余列将被重命名，例如，1 被转换为 s1（s 是 salaries 的缩写），2 被转换为 s2，依此类推。

再次注意，当我们再次调用 head() 函数以获取前六个观测值时，R 会以科学记数法返回较大的值，这对于我们的目的来说完全没问题：

names(gini5) = c("season_end", "team", "s1", "s2", "s3", "s4", "s5", 
                 "s6", "s7", "s8", "s9", "s10", "s11", "s12", "s13", "s14")

head(gini5)
## # A tibble: 6 × 16
## # Groups:   team, season_end [6]
##   <fct>      <fct>           <dbl>  <dbl>  <dbl>  <dbl>  
## 1 1991       Atlanta Hawks  125000 200000 510000 510000 
## 2 1991       Boston Celtics  80000 222000 315000 375000 
## 3 1991       Charlotte Hor...  75000 200000 322000 355000 
## 4 1991       Chicago Bulls  150000 385000 425000 450000 
## 5 1991       Cleveland Cav... 100000 120000 200000 350000
## 6 1991       Dallas Maveri...  30000 115000 150000 250000 
##    <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  
## 1 90000  650000 685000 775000 8   e5 
## 2 400000 525000 547000 550000 7.5 e5 
## 3 485000 675000 805000 900000 1   e6 
## 4 600000 750000 765000 915000 1   e6 
## 5 525000 525000 548000 630000 9.25e5 
## 6 600000 730000 765000 880000 9.85e5 
##    <dbl>  <dbl>  <dbl>   <dbl>   <dbl>
## 1 8.95e5 1.55e6 2.06e6 2406000      NA
## 2 8.5 e5 1.21e6 1.4 e6 1500000 2500000
## 3 1.2 e6 1.25e6 1.5 e6 1650000      NA
## 4 1   e6 1   e6 1.1 e6 2.5 e6       NA  
## 5 1.26e6 1.32e6 1.4 e6 2640000 3785000
## 6 1   e6 1.5 e6 1.52e6 1519000 1650000

然后，我们调用 dplyr 包中的 mutate() 函数来创建一个名为 gini_index 的新变量，该变量等于 gini5 数据集中每个 team 和 season_end 组合的 Gini 系数，四舍五入到小数点后两位。Gini 系数再次通过调用 ineq 包中的 ineq() 函数来计算，该函数将变量 s1 到 s14 作为参数。通过将 na.rm 参数设置为 TRUE，我们指示 ineq() 函数跳过数据中的不可用（NA）值；如果我们将其设置为 FALSE，则 ineq() 函数将为每个 team 和 season_end 组合中少于 14 个薪资的情况返回 NA。 （记住，我们将 14 名球员/薪资设定为每个团队每个赛季的最大值，而不是最小值。）

结果是一个名为 gini6 的新数据集。head() 函数打印出前六个观测值：

gini5 %>%
  mutate(gini_index = round(ineq(c(s1, s2, s3, s4, s5, s6, s7, s8, 
                                   s9, s10, s11, s12, s13, s14, 
                                   na.rm = TRUE)), digits = 2)) -> gini6
head(gini6)
## # A tibble: 6 × 17
## # Groups:   team, season_end [6]
##   season_end team                    s1     s2     s3     s4     
##   <fct>      <fct>                <dbl>  <dbl>  <dbl>  <dbl>  
## 1 1991       Atlanta Hawks       125000 200000 510000 510000 
## 2 1991       Boston Celtics       80000 222000 315000 375000 
## 3 1991       Charlotte Hornets    75000 200000 322000 355000 
## 4 1991       Chicago Bulls       150000 385000 425000 450000 
## 5 1991       Cleveland Cavaliers 100000 120000 200000 350000 
## 6 1991       Dallas Mavericks     30000 115000 150000 250000 
##       s5     s6     s7     s8      s9     s10    
##    <dbl>  <dbl>  <dbl>  <dbl>   <dbl>   <dbl>
## 1 590000 650000 685000 775000  800000  895000 
## 2 400000 525000 547000 550000  750000  850000 
## 3 485000 675000 805000 900000 1000000 1200000 
## 4 600000 750000 765000 915000 1000000 1000000 
## 5 525000 525000 548000 630000  925000 1260000 
## 6 600000 730000 765000 880000  985000 1000000 
##       s11    s12     s13     s14 gini_index
##     <dbl>  <dbl>   <dbl>   <dbl>      <dbl>
## 1 1550000 2.06e6 2406000      NA       0.42
## 2 1212000 1.4 e6 1500000 2500000       0.45
## 3 1250000 1.5 e6 1650000      NA       0.39
## 4 1100000 2.5 e6      NA      NA       0.38
## 5 1320000 1.4 e6 2640000 3785000       0.52
## 6 1500000 1.52e6 1519000 1650000       0.41

接下来，我们再次调用 read_csv() 函数来导入第二个数据集，称为 records：

records <- read_csv("records.csv")

调用 dplyr 的 glimpse() 函数的后续操作会返回记录的行数和列数，以及数据的一个小样本：

glimpse(records)
## Rows: 816
## Columns: 6
## $ season_end <dbl> 1991, 1991, 1991, 1991, 1991, 1991, 1991, 199...
## $ team       <chr> "Atlanta Hawks", "Boston Celtics", "Charlotte...
## $ wins       <dbl> 43, 56, 26, 61, 33, 28, 20, 50, 44, 52, 41, 3...
## $ losses     <dbl> 39, 26, 56, 21, 49, 54, 62, 32, 38, 30, 41, 5...
## $ pct        <dbl> 0.52, 0.68, 0.32, 0.74, 0.40, 0.34, 0.24, 0.6...
## $ champ      <dbl> 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ...

records 数据集包括名为 season_end 和 team 的变量，它们与 gini6 中的相同变量完全匹配。它还包含以下变量：

• wins——等于常规赛的胜利次数。作为提醒，球队参加 82 场比赛的常规赛。但在 1999 年和 2012 年，由于所有者和球员之间关于金钱的分歧而发生的停摆，赛季都被缩短了。因此，1999 赛季缩短到只有 50 场比赛，2012 赛季减少到 66 场比赛。

• losses——等于常规赛的失败次数。

• pct——代表胜率，是一个派生变量，等于胜利次数除以胜利次数和失败次数的总和。

• champ——一个等于0或1的二元变量，其中0表示一支球队没有赢得冠军，而1表示否则。

然后我们将变量season_end、team和champ转换为因子变量：

records$season_end <- as.factor(records$season_end)
records$team <- as.factor(records$team)
records$champ <- as.factor(records$champ)

接下来，我们通过调用dplyr包中的left_join()函数在 gini6 和 records 数据集上执行左连接。两个数据集在变量season_end和team上连接；否则，left_join()返回一个新数据集，gini_records，它包含 gini6 和 records 中的每一行和每一列：

gini_records <- left_join(gini6, records, by = c("season_end", "team"))

我们的新数据集有 816 行和 21 列——816 行是因为来自 gini6 和 records 的行数，21 列是因为 gini6 和 records 之间相互排斥的变量数量，加上两个共享变量season_end和team：

dim(gini_records)
## [1] 816  21

head()函数返回 gini_records 的前三个观测值：

head(gini_records, n = 3)
## # A tibble: 3 × 21
## # Groups:   team, season_end [3]
##   season_end team                  s1     s2     s3     s4     s5     
##   <fct>      <fct>              <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  
## 1 1991       Atlanta Hawks     125000 200000 510000 510000 590000 
## 2 1991       Boston Celtics     80000 222000 315000 375000 400000 
## 3 1991       Charlotte Hornets  75000 200000 322000 355000 485000 
##       s6     s7      s8      s9     s10     s11     s12     
##    <dbl>  <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   <dbl>   
## 1 650000 685000  775000   800000 895000 1550000 2065000
## 2 525000 547000  550000  750000  850000 1212000 1400000
## 3 675000 805000  900000 1000000 1200000 1250000 1500000
##       s13     s14 gini_index  wins losses   pct champ
##     <dbl>   <dbl>      <dbl> <dbl>  <dbl> <dbl> <fct>
## 1 2406000      NA       0.42    43     39  0.52 0  
## 2 1500000 2500000       0.45    56     26  0.68 0  
## 3 1650000      NA       0.39    26     56  0.32 0

现在，由于 gini6 和 records 数据集已经合并成一个单一的对象，我们可以执行那些在其他情况下不可能的操作，然后执行我们的分析目标。

12.7.2 t-test

因为我们是首先评估赢得冠军的球队与所有其他球队，我们将计算按 gini_records 二元变量champ分组的平均基尼系数，然后执行 t-test 以确定任何方差是否在统计上显著。变量champ对于未能赢得联赛冠军的球队等于0，对于每个赛季赢得冠军的那支球队等于1。以下是两个注意事项：

• 我们的预期是，薪酬分配更平均的团队比薪酬分配不平均的团队更成功。换句话说，我们应该预期赢得冠军的团队的平均基尼系数低于没有赢得冠军的平均团队。

• 从纯粹统计的角度来看，我们的零假设是任何方差，无论是一方还是另一方，都是由于偶然性造成的。因此，我们需要我们的 t-test 返回一个低于 5%显著性阈值的 p-value，以拒绝零假设并接受备择假设，即薪酬分配的差异是有意义的。

我们从一段dplyr代码开始，通过这段代码将gini_records数据集传递给group_by()和summarize()函数；再次，我们通过二元变量champ计算变量gini_index的平均值。我们的结果被转换成一个名为gini_summary2的 tibble：

gini_records %>%
  group_by(champ) %>%
  summarize(mean = round(mean(gini_index), digits = 2)) -> gini_summary2
print(gini_summary2)
## # A tibble: 2 × 2
##   champ  mean
##   <fct> <dbl>
## 1 0      0.48
## 2 1      0.53

因此，在我们的数据集中有 28 支冠军球队——从 1991 年到 2018 年每赛季一支——平均基尼系数等于 0.53，而未赢得联赛冠军的球队的平均基尼系数等于 0.48。换句话说，1991 年到 2018 年间，冠军球队比其他球队的工资分布更加不平等。

这种方差在统计学上是否显著？让我们进行 t 检验来找出答案。t 检验是一种统计检验，它比较两个（且仅两个）数据系列的均值。它考虑均值差异、组方差和记录数，以确定方差是否本质上等于零或不同于零。如果前者，我们将无法拒绝我们的零假设或进入假设，即均值相等；如果后者，我们将拒绝零假设，并接受备择假设，即均值不同。

在这个前提下，我们建立了两个新的数据集，giniX，它是通过变量 champ 等于 0 过滤的 gini_records，而 giniY，它是通过变量 champ 而不是等于 1 过滤的 gini_records。t 检验是通过从基础 R 调用 t.test() 函数对 gini_records 变量 gini_index 进行的：

gini_records %>%
  filter(champ == 0) -> giniX
gini_records %>%
  filter(champ == 1) -> giniY

t.test(giniX$gini_index, giniY$gini_index)
## 
##  Welch Two Sample t-test
## 
## data:  giniX$gini_index and giniY$gini_index
## t = -2.9526, df = 28.54, p-value = 0.006245
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.08297073 -0.01503507
## sample estimates:
## mean of x mean of y 
## 0.4795685 0.5285714

t 检验的 p 值，定义为统计量大于或等于观察结果的概率，基本上等于 0。因为它低于预定义的通常接受的 5% 显著性阈值，所以我们拒绝均值在统计学上相等的零假设。这意味着方差在统计学上是显著的：冠军球队比所有其他球队有更多 不平等 的工资分布是一个具有统计学意义的差异。这可能是由于冠军球队在其阵容中有超级明星和高价人才，由于工资帽的限制，这为其他球员留下了更少的资金。

我们将使用配对的 ggplot2 箱线图来可视化这些结果。首先，关于我们的代码有一些注意事项：

• 我们首先从基础 R 调用 rbind() 函数将 giniX 和 giniY 数据集按行连接，从而在过程中创建了一个名为 giniXY 的新对象。

• 因此，我们的数据源是 giniXY 数据集。

• 我们的自变量是二元变量 champ，而我们的因变量是 gini_index。

• ggplot() 函数自动绘制水平线来表示中位数。stat_summary() 函数添加了轻点来表示均值。

• scale_x_discrete() 函数将二元变量 champ 的标签 1 和 0 分别替换为 League Champions 和 All Other Teams。

ggplot2 的形状选项

在前一章中，我们简要提到了可以使用 ggplot2 图形包绘制不同类型的线条，因此现在是时候对形状进行同样的介绍了。因为有很多选项，形状通过数字进行引用：

圆形：1，10，13，16，19，20，21

三角形：2，6，17，24，25

方形：5，9，18，23

正方形：0，7，12，14，15，22

其他：3，4，8，11

所有这些都可以通过添加或更改颜色、填充和大小来调整。一如既往，您会想尝试不同的形状、颜色、填充和大小的组合。

下面是我们的数据处理和可视化代码；其成果，即我们的配对箱线图，如下所示（见图 12.4）：

giniXY <- rbind(giniX, giniY)
ggplot(giniXY, aes(x = champ, y = gini_index)) +
  geom_boxplot() +
  labs(title = "Comparison of Gini Coefficients based on 
       Season-End Disposition ",
       subtitle = "1991-2018",
       x = "", 
       y = "Gini Coefficients") +
  geom_boxplot(color = "skyblue4", fill = "skyblue1") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(plot.title = element_text(face = "bold")) +
  scale_x_discrete(breaks = c("1", "0"),
                   labels = c("League Champions", "All Other Teams")) 

图 12.4 配对箱线图，可视化冠军队伍与其他所有队伍之间的均值、中位数和基尼系数分布。方差具有统计学意义。

当然，我们已经知道冠军队伍的基尼系数平均值大于其他所有队伍。箱线图显示，中位数也相当不同，联赛冠军的分布比其他队伍的分布更分散。回想一下，箱线图将数据系列的分布分解为四分位数范围（IQR），代表数据的中间 50%；分别代表数据的下 25%和上 25%的 IQR 延伸到四分位数范围以下和以上的触须；以及代表超出触须的异常值，由实心点表示。

接下来，我们将用 Cohen’s d 效应量测试来补充我们的 t 检验。

12.7.3 效应量测试

现在我们进行 Cohen’s d 测试，这是一种基于总体均值和标准差的效果量测试。与 t 检验不同，Cohen’s d 测试不受记录计数的影响。语法类似于 t 检验，甚至可以说类似于相关测试；我们只是用effsize包中的cohen.d()函数替换了t.test()函数或cor.test()函数，如下所示：

cohen.d(giniX$gini_index, giniY$gini_index)
## 
## Cohen's d
## 
## d estimate: -0.6331437 (medium)
## 95 percent confidence interval:
##      lower      upper 
## -1.0118781 -0.2544094

与 t 检验返回一个 p 值，从而我们拒绝或未能拒绝零假设相比，Cohen’s d 检验则返回一个表示效应量或方差大小的分类指标，范围从可忽略到很大，这与 d 估计值相关联，d 估计值定义为两个均值之间分离的标准差数。d 估计值将根据我们传递给cohen.d()函数的参数顺序是正数还是负数。由于gini_index在 giniX 中的平均值低于在 giniY 中的平均值，我们的 Cohen’s d 检验返回了一个负的 d 估计值。结果在 0.40 到 0.70 标准差之间，正负波动，将转化为中等效应量，这正是我们所看到的。

12.8 薪酬不平等与胜负

因此，我们确定，在赢得或未赢得 NBA 总冠军时，薪资分布很重要，但可能并非我们开始这段旅程时所想象的那样。不需要进行太多额外的数据处理，所以我们将直接进行第二次 t 检验和第二次 Cohen’s d 效应量测试；这次，我们将比较和对比常规赛中的获胜和失败队伍。

12.8.1 t 检验

在本节和以下章节中，我们将关注派生变量pct，它等于常规赛胜率。我们首先将 gini_records 数据集传递给dplyr group_by()和summarize()函数；summarize()函数计算基尼系数，四舍五入到小数点后两位，而group_by()函数将结果分为胜率等于或大于 0.50 的队伍与胜率小于 0.50 的队伍。因为我们已经在group_by()函数的参数中包含了一个逻辑运算符，所以我们的结果将在TRUE和FALSE之间分割：

gini_records %>%
  group_by(pct >= 0.50) %>%
  summarize(mean = round(mean(gini_index), digits = 2)) -> gini_summary3
print(gini_summary3)
## # A tibble: 2 × 2
##   `pct >= 0.5`  mean
##   <lgl>        <dbl>
## 1 FALSE         0.46
## 2 TRUE          0.5

获胜队伍的平均基尼系数高于战绩不佳的队伍，至少在 1991 年至 2018 年赛季之间是这样的。这些结果可能具有统计学意义，但让我们确保这一点。

因此，我们创建了另外两个数据集，giniA，它是 gini_records 的子集，其中变量pct等于或大于0.50，以及 giniB，它是 gini_records 的子集，其中变量pct小于0.50。我们的 t 检验比较了 giniA 和 giniB 数据集中的 gini_index 均值：

gini_records %>%
  filter(pct >= 0.50) -> giniA
gini_records %>%
  filter(pct < 0.50) -> giniB

t.test(giniA$gini_index, giniB$gini_index)
## 
##  Welch Two Sample t-test
## 
## data:  giniA$gini_index and giniB$gini_index
## t = 8.8145, df = 767.61, p-value < 0.00000000000000022
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.03594185 0.05653782
## sample estimates:
## mean of x mean of y 
## 0.5013666 0.4551268

p 值不出所料，再次几乎为 0；因此，我们再次拒绝零假设，并接受备择假设，即均值方差在统计上具有显著性。

在以下代码块中，我们调用基础 R 的rbind()函数将 giniA 和 giniB 合并到一个新的数据集 giniAB 中。然后，我们调用dplyr mutate()函数创建一个名为win_pct的新变量，根据球队的常规赛胜率将球队分为两个群体。接下来的ggplot2代码的语法与我们的第一组箱线图类似（见图 12.5）：

giniAB <- rbind(giniA, giniB)
mutate(giniAB, win_pct = ifelse(pct >= 0.50, "y", "n")) -> giniAB
ggplot(giniAB, aes(x = win_pct, y = gini_index)) + 
  geom_boxplot() +
  labs(title = "Comparison of Gini Coefficients based on 
       Regular Season Winning Percentage",
       subtitle = "1991-2018",
       x = "", 
       y = "Gini Coefficients") +
  geom_boxplot(color = "skyblue4", fill = "skyblue1") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(plot.title = element_text(face = "bold")) +
  scale_x_discrete(breaks = c("y", "n"),
                   labels = c("Winning Teams", "Losing Teams")) 

图 12.5 展示了获胜和失败队伍之间均值、中位数和基尼系数分布的配对箱线图。再次强调，方差在统计上具有显著性。

虽然我们的测试结果相当直接，但它们在可视化后变得更加引人注目。我们几乎可以（如果不是因为记录计数的相关性）将 t 检验放在一边，而是完全信任这些配对箱线图，它们清楚地显示了均值、中位数和分布之间的显著差异。让我们运行第二次 Cohen’s d 测试来了解效应量。

12.8.2 效应量测试

我们调用 cohen.d() 函数，并传递与最初为我们的 t-test 传递的相同的一对参数：

cohen.d(giniA$gini_index, giniB$gini_index)
## 
## Cohen's d
## 
## d estimate: 0.6210674 (medium)
## 95 percent confidence interval:
##     lower     upper 
## 0.4792167 0.7629181

因为 d 估计值为 0.62，我们的 Cohen’s d 测试返回了一个中等效应大小。这次我们的 d 估计值是正的，因为传递给 cohen.d() 函数的第一个参数的平均值大于第二个参数的平均值；也就是说，赢得至少一半常规赛比赛的球队的薪酬分布的平均基尼系数高于赢得少于一半比赛的球队。因此，到目前为止，我们的分析得到了一些我们并不一定预期的结果，如下所述：

• 1991 年至 2018 年 NBA 赛季的冠军球队，根据基尼系数至少，比没有赢得冠军的球队具有更不平等的薪酬分布。

• 这些差异在统计学上是显著的，根据我们的 Cohen’s d 效应大小测试，它衡量的是实际意义而不是统计意义，平均值的差异被评定为中等（这小于大型，但大于可忽略或小型）。

• 在 1991 年至 2018 年间，至少赢得一半常规赛比赛的球队，平均而言，比那些常规赛以失利结束的球队具有更不平等的薪酬分布。

• 这些差异同样在统计学上是显著的，我们随后的 Cohen’s d 测试返回的结果与我们的第一次效应大小测试大致相同。

我们将把这些最后的结果进一步深入，通过将数据集中的每个 NBA 球队分类到五个区间之一，或称为档位，并计算每个档位的平均基尼系数。

12.9 基尼系数档位与胜率对比

最后，我们将创建一个 ggplot2 条形图，该图将基尼系数与常规赛胜率进行对比。我们将看到不平等的薪酬分布和较高的常规赛胜率之间是如何相互关联的。然而，这首先需要一些额外的数据处理。

我们首先将 gini_records 数据集传递给 dplyr mutate() 和 case_when() 函数，以创建一个名为 gini_band 的分类变量，该变量是从数值变量 gini_index 派生出来的。当变量 gini_index，例如，等于或大于 0.60 时，gini_band 将等于 >0.60；当 gini_index 大于或等于 0.50 且小于 0.60 时，gini_band 将等于 >0.50；依此类推。我们想看看基尼系数是如何随着常规赛胜率从一档增加到下一档而变化的。

然后，我们的新变量被转换为因子变量。head() 函数返回前三个观测值：

gini_records %>%
  mutate(gini_band = 
           case_when(gini_index >= .60 ~ ">0.60",
                     gini_index >= .50 & gini_index < .60 ~ ">0.50",
                     gini_index >= .40 & gini_index < .50 ~ ">0.40",
                     gini_index >= .30 & gini_index < .40 ~ ">0.30",
                     gini_index < .30 ~ ">0.20")) -> gini_records

gini_records$gini_band <- as.factor(gini_records$gini_band)

head(gini_records, n = 3)
## # A tibble: 3 × 22
## # Groups:   team, season_end [3]
##   season_end team                  s1     s2     s3     s4     s5     
##   <fct>      <fct>              <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  
## 1 1991       Atlanta Hawks     125000 200000 510000 510000 590000 
## 2 1991       Boston Celtics     80000 222000 315000 375000 400000 
## 3 1991       Charlotte Hornets  75000 200000 322000 355000 485000 
##       s6     s7     s8     s9    s10    s11    s12
##    <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl> 
## 1 650000 685000 775000  8  e5 8.95e5 1.55e6 2.06e6
## 2 525000 547000 550000  7.5e5 8.5 e5 1.21e6 1.4 e6
## 3 675000 805000 900000  1  e6 1.2 e6 1.25e6 1.5 e6 
##      s13    s14 gini_index  wins losses   pct champ gini_band
##    <dbl>  <dbl>      <dbl> <dbl>  <dbl> <dbl> <fct> <fct> 
## 1 2.41e6  NA          0.42    43     39  0.52 0     >0.40  
## 2 1.5 e6  2.5e6       0.45    56     26  0.68 0     >0.40  
## 3 1.65e6  NA          0.39    26     56  0.32 0     >0.30

然后，我们将 gini_records 传递给dplyr group_by``()和summarize()函数，通过summarize()函数计算变量pct的平均值，保留两位小数，而group_by()函数将变量gini_band中的每个因素的结果分开。结果被转换为名为 gini_summary3 的 tibble：

gini_records %>%
  group_by(gini_band) %>%
  summarize(mean_pct = round(mean(pct), digits = 2)) -> gini_summary3
print(gini_summary3)
## # A tibble: 5 × 2
##   gini_band mean_pct
##   <fct>        <dbl>
## 1 >0.20         0.37
## 2 >0.30         0.43
## 3 >0.40         0.58
## 4 >0.50         0.54
## 5 >0.60         0.57

这是我们使用ggplot2绘制的条形图，以 gini_summary3 作为数据源，并将变量gini_band沿 x 轴绘制，变量mean_pct沿 y 轴绘制（见图 12.6）：

ggplot(gini_summary3, aes(x = gini_band, y = mean_pct)) + 
  geom_bar(stat = "identity", width = .6, fill = "sienna1") + 
  labs(title = "Gini Coefficients and Winning Percentages",
       subtitle = "1991-2018", 
       x = "Gini Coefficient Bands", 
       y = "Average Regular Season Winning Percentage") + 
  ylim(0, 0.65) +
  geom_text(aes(x = gini_band, y = mean_pct, label = mean_pct,
                vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold"))

图 12.6 一个条形图显示了更高的基尼系数——即更不平等的工资分布——与更高的常规赛胜率非常一致

随着工资分布变得更加不平等，常规赛胜率显著增加。基尼系数等于或大于 0.40 的球队平均至少赢得常规赛比赛的 54%。相比之下，基尼系数小于 0.40 的球队平均只赢得常规赛比赛的 43%或更少。这是赢得联赛冠军的可能性和连季后赛资格都拿不到之间的区别。

因此，至少在 1991 年至 2018 年间的 NBA 中，工资不平等实际上创造了繁荣。这是因为超级巨星——他们的收入（基于表现）每年比其他球员多出数百万美元——是推动 NBA 的动力。我们在第三章中了解到，球队甚至不能考虑赢得冠军的想法，除非他们的阵容中有一名或可能两名真正的超级巨星。

在下一章中，我们将探讨围绕胜利份额分布的不平等，以及这可能与胜负有何关联。

摘要

• 关于 t 检验，可能最值得理解的重要观点是，其结果取决于均值差异和记录数。在小数据集上，小的方差不会显示出统计显著性，但在大数据集上，小的方差可能会得到不同的结果。同样，在大数据集上，大的方差绝对会显示出统计显著的结果，而在小数据集上可能或可能不会得到相同的结果。

• 与此相反，效应量测试并不考虑记录数。因此，当方差相等但记录数不相等时，你可能会得到一对效应量测试的类似回报。因此，效应量测试应该补充 t 检验或其他“类似”的统计测试，而不应该作为替代。你根据 t 检验或卡方检验等统计测试的结果拒绝或未能拒绝零假设；你永远不会根据效应量测试的结果做同样的事情。此外，当记录数差异很大时，你永远不应该从类似方差中得出类似结论。

• 在探索你的数据上投资。不仅彻底的数据探索练习能带来宝贵的见解，而且它通常会帮助你指导后续的数据整理和分析操作。如果我们不假思索地移除数据集中所谓的重复记录，我们的结果会有所不同吗？

• 在你的数据整理活动中进行额外的投资，定期检查和验证操作的完整性，尤其是在这些操作不典型且相对复杂时。如果可以称之为“重复”，那么它应该始终让位于定期甚至频繁的完整性检查。

• 关于我们的结果，冠军球队的平均薪资分布不平等程度比其他球队更高，获胜球队的平均薪资分布不平等程度比输球球队更高。我们的 t 检验证明，这些差异实际上在统计学上是显著的。我们的 Cohen's d 检验进一步证实，这些相同的差异在幅度上实际上是微不足道的。

• 从前面的章节中我们知道，获胜的球队，尤其是冠军球队，通常在其阵容中有一到多个超级巨星，他们当然拥有最高的薪资。这留给其他球员的薪资就少了，这无疑有助于解释我们的结果。

• 自从 1997 年以来，球员薪资的联赛范围内基尼系数已经显著上升——比 1997 年之前高出大约八个百分点。其中一部分原因无疑是由于多年来联赛的扩张和阵容规模的增加。但剩余的部分可能非常可能是由于对超级巨星人才更大投资的效益的认识增加。

13 使用基尼系数和洛伦兹曲线的更多内容

本章涵盖

• （再次）使用基尼系数

• 创建替代洛伦兹曲线

• 运行显著性检验（t 检验和 F 检验）

• 运行其他效应量检验（除了 Cohen’s d）

• 编写for循环

• 编写用户自定义函数

的确，我们将再次计算基尼系数，通过绘制洛伦兹曲线来描绘不平等，进行更多的显著性检验，以及进行额外的效应量检验以补充我们的 t 检验——但本章也包含了大量新的内容：

• 我们将演示如何用最少的代码智能地绘制多个洛伦兹曲线。你将学习如何在同一张图上绘制两条洛伦兹曲线，以比较一个对象中的两个基尼系数，而不是两个。

• 此外，我们将演示如何创建一个简单的for循环，作为编写可重复代码行的替代方案，然后通过用一段简短的代码绘制四条洛伦兹曲线来展示我们所学的内容。

• 因为我们将演示如何创建for循环，所以我们将展示如果你需要的 R 还没有相应的函数，你可以如何创建自己的函数。我们将首先演示如何创建一对简单的函数，然后提供创建可以估计基尼系数的函数的进一步指导。

• 在前面的章节中，包括第十二章，我们已经进行了 Cohen’s d 效应量测试，以定量和定性测量两个变量在数值尺度上的统计关系。实际上，还有其他效应量测试，除了 Cohen’s d 之外，也能做同样的事情。我们将演示如何运行这些测试，然后讨论在什么情况下哪种测试最好。

• 最后，我们将演示如何运行 F 检验，这是一种用于比较两个或更多组方差的另一种统计检验。F 检验实际上评估的是两个方差比率的统计显著性，或者仅仅是偶然的结果。我们将简要讨论 F 检验何时以及如何最适合你的分析。

在此过程中，我们将计算胜利份额分布的基尼系数，这是我们在第二章和第三章分析的核心球员级高级统计指标。虽然基尼系数主要用于衡量收入或财富的不平等，但实际上可以用来衡量任何类型的不平等，正如我们在上一章所展示的。在本章中，我们的目的是确定胜利份额分布的基尼系数是否与胜负有关，以及是否有任何方差具有统计学意义。我们的零假设是，无论基尼系数是低、高还是介于两者之间，都不会对胜负产生影响。然而，如果球员的薪水确实与生产力相匹配，我们不应该对看到与第十二章类似的结果感到惊讶，但让我们找出一种或另一种方式。我们将首先加载我们所需的包。

13.1 加载包

我们在上一章中加载并使用的相同包集——tidyverse、sqldf、ineq、gglorenz、scales和effsize——再次是必需的，另外还需要两个包，effectsize和car：

• 在前面的章节中，包括第十二章，我们通过effsize包执行了一种类型的效果量测试，即 Cohen's d。在本章中，我们再次将通过effsize包计算 Cohen's d 估计值，然后我们将通过effectsize包执行其他效果量测试。

• 在第五章中，我们从car包中调用了vif()函数来检查我们的多元线性回归中的多重共线性；在这里，我们将加载car包，然后调用它的recode()函数来重新编码或重命名字符向量中的元素。

我们通过依次调用基础 R 的library()函数来加载八个包：

library(tidyverse)
library(sqldf)
library(ineq)
library(gglorenz)
library(scales)
library(effsize)
library(effectsize)
library(car)

接下来，我们将导入我们的数据集，并快速浏览我们将要处理的内容。

13.2 导入和查看数据

我们的数据集是一个从 Kaggle 下载的.csv 文件，然后存储在我们的默认工作目录中；它包含了从 1950 年到 2017 年每个 NBA 赛季的球员统计数据，包括胜利份额。因此，我们调用readr read_csv()函数来导入我们的数据，并在过程中创建一个名为 ws_gini 的对象：

ws_gini <- read_csv("seasons_stats.csv")

基础 R 的dim()函数返回 ws_gini 数据集的维度，即行和列的数量：

dim(ws_gini)
## [1] 24624    53

我们的数据集有 24,624 个观测值和 53 列宽，其中每个球员/年份/球队组合在 ws_gini 数据集中都占据一个唯一的记录。始终是一个最佳实践，通过消除不必要的或不受欢迎的变量和记录来降低数据的维度，即使没有其他原因，也能让查询和其他代码行运行得更快，并让你在最需要的地方保持专注。因此，我们将从减少数据的宽度开始，然后是长度，来开始我们的数据整理操作。

13.3 数据整理

我们首先调用dplyr select()函数来筛选 ws_gini 中的三个变量：Year（例如，2012 年，代表 2011-12 赛季），Tm（例如，CLE 代表克利夫兰骑士队或 DAL 代表达拉斯小牛队），以及WS（代表赢球份额）：

ws_gini %>%
  select(Year, Tm, WS) -> ws_gini 

然后，我们调用dplyr filter()函数来筛选 ws_gini 中变量Year等于或大于1991的部分。从现在起，我们的数据集将包含 1991 年到 2017 年的 NBA 赛季，这与第十二章中的数据紧密相关：

ws_gini %>%
  filter(Year >= 1991) -> ws_gini 

接下来，我们再次调用filter()函数，通过只包括变量Tm不等于TOT的记录来进一步减少 ws_gini 数据集。因此，我们添加了逻辑运算符不等于(!=)来排除未来的这些记录。结果发现，在一个 NBA 赛季中为不止一支球队效力的球员在从 Kaggle 下载的数据中多次出现。例如，现在已经退役的斯宾塞·霍华德（Spencer Hawes）在 2017 年为夏洛特黄蜂队和密尔沃基雄鹿队效力；因此，ws_gini 中 2017 年有斯宾塞·霍华德的三条记录，一条是变量Tm等于CHO（代表夏洛特），一条是变量Tm等于MIL（代表密尔沃基），还有一条是变量Tm等于TOT，这是CHO和MIL的汇总：

ws_gini %>%
  filter(Tm != "TOT") -> ws_gini 

再次调用dim()函数可以得到 ws_gini 数据集的降维维度：

dim(ws_gini)
## [1] 13356     3

现在数据集只有 13,356 行长，当然，三列宽。

我们通过两次调用基础 R 的as.factor()函数，将变量Year和Tm转换为因子变量：

ws_gini$Year <- as.factor(ws_gini$Year)
ws_gini$Tm <- as.factor(ws_gini$Tm)

连续调用基础 R 的head()和tail()函数分别返回 ws_gini 中的前六个和最后六个观测值——这样你可以看到一些记录的实际样子：

head(ws_gini)
##   Year  Tm    WS
##   <fct> <fct> <dbl>
## 1 1991  POR  0.5
## 2 1991  DEN -1.0
## 3 1991  ORL  2.5
## 4 1991  DEN  6.3
## 5 1991  DET  5.5
## 6 1991  POR  6.2

tail(ws_gini)
##       Year  Tm    WS
##       <fct> <fct> <dbl>
## 13351 2017  IND   4.6
## 13352 2017  CHO   5.6
## 13353 2017  BOS   1.0
## 13354 2017  ORL   0.0
## 13355 2017  CHI   0.5
## 13356 2017  LAL   1.1

然后，我们调用基础 R 的summary()函数，它返回 ws_gini 中剩余三个变量的描述性统计。通过添加maxsum参数，我们指示 R 返回最多 40 个水平（因子）但不超过 40 个。变量Year包含 26 个水平，变量Tm包含 38 个水平（我们的数据包括多个水平或因子，即使特许经营保持不变，球队名称的多个迭代也有不同的水平）。

提醒一下，对于像WS这样的数值变量，summary()函数返回均值、中位数、最小值、最大值以及第一和第三四分位数。对于像Year和Tm这样的因子变量，summary()函数则返回每个组的观测计数：

summary(ws_gini, maxsum = 40)
##    Year       Tm            WS        
##  1991:415   ATL:464   Min.   :-2.100  
##  1992:425   BOS:465   1st Qu.: 0.200  
##  1993:421   BRK: 93   Median : 1.300  
##  1994:444   CHA:183   Mean   : 2.422  
##  1995:430   CHH:207   3rd Qu.: 3.700  
##  1996:489   CHI:445   Max.   :20.400  
##  1997:511   CHO: 53                   
##  1998:494   CLE:473                   
##  1999:474   DAL:477                   
##  2000:468   DEN:474                   
##  2001:490   DET:428                   
##  2002:470   GSW:480                   
##  2003:456   HOU:471                   
##  2004:517   IND:422                   
##  2005:526   LAC:457                   
##  2006:512   LAL:425                   
##  2007:487   MEM:288                   
##  2008:527   MIA:458                   
##  2009:515   MIL:452                   
##  2010:512   MIN:440                   
##  2011:542   NJN:394                   
##  2012:515   NOH:161                   
##  2013:523   NOK: 34                   
##  2014:548   NOP: 89                   
##  2015:575   NYK:452                   
##  2016:528   OKC:163                   
##  2017:542   ORL:455                   
##             PHI:481                   
##             PHO:459                   
##             POR:439                   
##             SAC:449                   
##             SAS:456                   
##             SEA:280                   
##             TOR:402                   
##             UTA:416                   
##             VAN: 98                   
##             WAS:351                   
##             WSB:122

如果你已经阅读了第十二章，接下来的代码块应该很熟悉。我们的目的是通过在Year和Tm组合中筛选出每个组合的前 14 个最高赢球份额来进一步缩短数据集的长度。NBA 中有许多球员因为短期合同而来来去去；通过筛选 ws_gini 数据集，我们可以公平准确地排除 NBA 的临时合同球员，并专注于全职和永久员工：

• 我们首先将数据传递给dplyr arrange()函数，该函数按 ws_gini 中的每个 ws_gini 变量对 ws_gini 进行排序。

• 然后，我们调用dplyr group_by()和mutate()函数以及基本的 R rank()函数来创建一个名为rank的新变量，其中变量WS按降序排序，从 1 到n，按我们数据中的每个Year和Tm组合排序。rank()函数内部的负号或负号指示 R 按降序排序或排名变量WS。ties.method参数指定如何处理平局；当等于first时，R 将平局元素分配给连续的、因此不同的排名。

• 最后，我们调用dplyr filter()函数，只包括变量rank小于或等于14的记录。

结果被放入一个名为 ws_gini2 的 tibble 中：

ws_gini %>%
  arrange(Year, Tm, WS) %>%
  group_by(Year, Tm) %>%
  mutate(rank = rank(-WS, ties.method = "first")) %>%
  filter(rank <= 14) -> ws_gini2

然后，我们调用基本的 R head()函数，这次是为了返回 ws_gini2 数据集中的前 14 条记录，以显示这些最后几个操作的输出：

head(ws_gini2, n = 14)
## # A tibble: 14 × 4
## # Groups:   Year, Tm [1]
##    Year  Tm       WS  rank
##    <fct> <fct> <dbl> <int>
##  1 1991  ATL    -0.5    14
##  2 1991  ATL    -0.1    13
##  3 1991  ATL     0      11
##  4 1991  ATL     0      12
##  5 1991  ATL     1.1    10
##  6 1991  ATL     1.8     9
##  7 1991  ATL     1.9     8
##  8 1991  ATL     2.5     7
##  9 1991  ATL     4       6
## 10 1991  ATL     4.4     5
## 11 1991  ATL     5.4     4
## 12 1991  ATL     5.6     3
## 13 1991  ATL     6.3     2
## 14 1991  ATL    11.4     1

这里有一些观察结果（顺便说一下，ATL 是亚特兰大老鹰队的缩写）：

• 变量WS显然是按升序排序的，同样明显的是，我们看到变量rank是按降序排序的。这使得我们可以对每个Year和Tm组合进行子集化，不超过前 14 个胜利贡献值。

• 亚特兰大老鹰队有两名球员在 1991 赛季“获得”了 0.0 胜利贡献值。按照设计，他们被分配了不同但连续的排名；否则，我们就有可能将我们的Year和Tm组合的子集扩展到超过 14 条记录的风险。

虽然看起来很完美，但我们仍然要执行一系列与上一章中执行的那些类似的完整性检查。我们首先两次调用sqldf()函数，来自sqldf包，以（1）返回变量Year等于2012且变量Tm等于GSW（即金州勇士队）的 ws_gini 中的每条记录；（2）返回变量Year也等于2012且变量Tm也等于GSW的 ws_gini2 中的每条记录：

sqldf("SELECT * FROM ws_gini WHERE Year = 2012 AND Tm = 'GSW'")
##    Year  Tm   WS
## 1  2012 GSW  0.0
## 2  2012 GSW  0.0
## 3  2012 GSW  1.3
## 4  2012 GSW  0.1
## 5  2012 GSW  2.2
## 6  2012 GSW  1.5
## 7  2012 GSW  0.2
## 8  2012 GSW  0.7
## 9  2012 GSW  0.5
## 10 2012 GSW  5.0
## 11 2012 GSW  1.5
## 12 2012 GSW  0.1
## 13 2012 GSW  2.8
## 14 2012 GSW  3.5
## 15 2012 GSW  0.1
## 16 2012 GSW  1.7
## 17 2012 GSW -0.2
## 18 2012 GSW  0.9
## 19 2012 GSW  0.6
## 20 2012 GSW  3.4

sqldf("select * FROM ws_gini2 WHERE Year = 2012 AND Tm = 'GSW'")
##    Year  Tm  WS rank
## 1  2012 GSW 0.2   14
## 2  2012 GSW 0.5   13
## 3  2012 GSW 0.6   12
## 4  2012 GSW 0.7   11
## 5  2012 GSW 0.9   10
## 6  2012 GSW 1.3    9
## 7  2012 GSW 1.5    7
## 8  2012 GSW 1.5    8
## 9  2012 GSW 1.7    6
## 10 2012 GSW 2.2    5
## 11 2012 GSW 2.8    4
## 12 2012 GSW 3.4    3
## 13 2012 GSW 3.5    2
## 14 2012 GSW 5.0    1

我们的第一条SELECT语句返回了 20 条记录，没有特定的排序顺序，而我们的第二条SELECT语句返回了 14 条记录，其中变量WS按升序排序，变量rank按降序排序。这是正确的。

接下来，我们通过用波士顿凯尔特人队（BOS）替换金州勇士队，并编写两个简短的dplyr代码块而不是sqldf代码来执行相同的操作。我们将 ws_gini 和 ws_gini2 数据集传递给filter()函数，以子集化变量Year等于2017且变量Tm等于BOS的结果：

ws_gini %>%
  filter(Year == 2017 & Tm == "BOS")
##    Year  Tm   WS
## 1  2017 BOS  3.1
## 2  2017 BOS  1.5
## 3  2017 BOS  6.7
## 4  2017 BOS  0.6
## 5  2017 BOS  6.3
## 6  2017 BOS  0.1
## 7  2017 BOS  2.1
## 8  2017 BOS  5.0
## 9  2017 BOS  0.1
## 10 2017 BOS  4.1
## 11 2017 BOS  1.4
## 12 2017 BOS  3.2
## 13 2017 BOS 12.6
## 14 2017 BOS  0.3
## 15 2017 BOS  1.0

ws_gini2 %>%
  filter(Year == 2017 & Tm == "BOS")
## # A tibble: 14 × 4
## # Groups:   Year, Tm [1]
##    Year  Tm       WS  rank
##    <fct> <fct> <dbl> <int>
##  1 2017  BOS     0.1    14
##  2 2017  BOS     0.3    13
##  3 2017  BOS     0.6    12
##  4 2017  BOS     1      11
##  5 2017  BOS     1.4    10
##  6 2017  BOS     1.5     9
##  7 2017  BOS     2.1     8
##  8 2017  BOS     3.1     7
##  9 2017  BOS     3.2     6
## 10 2017  BOS     4.1     5
## 11 2017  BOS     5       4
## 12 2017  BOS     6.3     3
## 13 2017  BOS     6.7     2
## 14 2017  BOS    12.6     1

我们的第一段dplyr代码返回了 15 条未排序的记录，而我们的第二段代码通过过滤掉 2017 赛季获得 0.1 胜利贡献值的两名球员中的一名，只返回了 14 条记录。这是正确的。

最后，让我们运行两个额外的SELECT语句，计算变量Tm等于GSW和Tm等于BOS时的 ws_gini2 行数。行数应等于最多 378，这是 27 个赛季乘以每个赛季最多 14 名球员/赢分份额的乘积（有些赛季的某些球队在其阵容中少于 14 名球员）：

sqldf("select COUNT(*) FROM ws_gini2 WHERE Tm = 'GSW'") 
##   COUNT(*)
## 1      377

sqldf("select COUNT(*) FROM ws_gini2 WHERE Tm = 'BOS'")
##   COUNT(*)
## 1      378

行数分别等于 377 和 378。这也检查无误。

现在我们知道数据处于良好状态，我们可以通过计算基尼系数来开始我们的分析。

13.4 基尼系数

再次强调，基尼系数是经常报道的不平等度量，通常是在某些人口中的收入不平等，其中系数等于 0 表示完全平等的状态，系数等于 1 表示完全不平等的状态。在第十二章中，我们计算基尼系数来衡量薪酬不平等；在这里，我们将计算基尼系数来衡量赢分不平等。

在下一块代码中，我们将 ws_gini2 传递给dplyr group_by()和summarize()函数，以计算变量Year中每个级别的联赛基尼系数。ineq包中的ineq函数否则正在做我们的重活，通过一个名为gc的新变量返回年度基尼系数，四舍五入到小数点后两位。我们的结果被转换为一个名为 ws_gini_summary 的 tibble。

ws_gini2 %>%
  group_by(Year) %>%
  summarize(gc = round(ineq(WS), digits = 2)) -> ws_gini_summary
print(ws_gini_summary)
## # A tibble: 27 × 2
##    Year     gc
##    <fct> <dbl>
##  1 1991   0.56
##  2 1992   0.56
##  3 1993   0.54
##  4 1994   0.54
##  5 1995   0.53
##  6 1996   0.54
##  7 1997   0.55
##  8 1998   0.53
##  9 1999   0.55
## 10 2000   0.53
## # ... with 17 more rows

然后我们将结果绘制在gpplot2折线图中（见图 13.1）。我们改变了一些之前折线图的美学设置：

• geom_line()函数绘制一条宽度为ggplot2默认宽度一半的黑色线。

• geom_point()函数在沿线添加五倍于默认大小的点。因此，我们的图表假定看起来像一个连接的散点图。

• geom_text()函数在连接到 ws_gini_summary 变量gc的点上方添加标签。nudge_x和nudge_y参数用于将标签定位到点相对的位置——数字越小，标签越靠近。如果为负数，R 将数字放置在点下方而不是上方。check_overlap参数是 R 避免尽可能重叠标签的指令。

• theme()函数的第一和第二次调用将标题和副标题居中，从而覆盖了ggplot2的默认设置，即左对齐两者。通过将hjust参数（代表水平调整）设置为0.5，我们将标题和副标题移至图表宽度的中点。或者，我们可以通过将hjust参数设置为1来右对齐标题和副标题。

• theme()函数的第三次调用将 x 轴标签旋转 45 度，并将它们水平对齐在图表下方。

• annotate()函数被调用了两次，以添加一对透明的矩形形状，其中xmin、xmax、ymin和ymax参数确定了水平和垂直边界。这是一个很好的细节，立即暗示了图表有两个不同的故事要讲述。

图 13.1 NBA 赢分分布的年度或赛季基尼系数

最后，这是我们的第一个图表的代码块：

ggplot(ws_gini_summary, aes(x = Year, y = gc, group = 1)) + 
  geom_line(aes(y = gc), color = "black", size = .5) + 
  geom_point(size = 5, color = "seagreen3") +
  geom_text(aes(label = gc),
            nudge_x = 0.01, nudge_y = 0.01,
            check_overlap = TRUE, size = 2.5) +
  labs(title = "Gini Coefficient for Win Shares", 
       subtitle = "1991-2017",
       x = "Season", 
       y = "Gini Coeffiicient",
       caption = "includes a maximum top 14 win shares for each team") +
  ylim(0.42, 0.60) +
  theme(plot.title = element_text(hjust = 0.5, face = "bold")) +
  theme(plot.subtitle = element_text(hjust = 0.5)) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  annotate("rect", xmin = "1991", xmax = "2009", 
           ymin = 0.42, ymax = 0.60, alpha = 0.1, fill = "orange") +
  annotate("rect", xmin = "2010", xmax = "2017", 
           ymin = 0.42, ymax = 0.60, alpha = 0.1, fill = "blue") 

我们立即得出的结论如下：

• 这些是高基尼系数：在 1991 年至 2017 年之间，基尼系数两次达到峰值 0.56，并且从未低于 0.47。再次强调，基尼系数等于或大于 0.40 表明存在显著的不平等，无论测量的是什么。

• 我们在图表中添加了一对阴影矩形来突出结果之间的对比。在 1991 年至 2009 年之间，基尼系数从未低于 0.52，但在 2010 年至 2017 年之间，基尼系数达到峰值 0.51 一次，并且在此之后从未高于 0.50。再次强调，这是一个相当简单的技术，可以清楚地表明我们有两个不同的结果集。

• 因此，从 1991 年到 2017 年，联赛的基尼系数在赢分方面呈下降趋势；相比之下，我们在第十二章中探讨的工资基尼系数在 1990 年代中期急剧上升，并从那时起稳定到 2018 年。因此，在 1990 年代，工资和赢分之间的基尼系数不匹配，而在 2010 年至 2017 年之间，它们每年都是相同的，或者几乎是相同的；换句话说，它们随着时间的推移逐渐趋同。

在接下来的几节中，我们将展示不同的方法来可视化球员生产力的不平等，使用洛伦兹曲线。

13.5 洛伦兹曲线

首先，如果我们尝试从一个包含负元素的向量创建洛伦兹曲线，R 将抛出一个错误，因此我们需要查询我们的数据并采取纠正措施。我们在第二章和第三章中学到，球员在职业生涯中可能会“累积”负的赢分。在以下代码中，我们调用sqldf()函数来返回 ws_gini2 中变量WS小于 0 的记录数：

sqldf("SELECT COUNT(*) FROM ws_gini2 WHERE WS < 0") 
##   COUNT(*)
## 1      227

果然，我们有 227 条记录，其中变量WS等于某个小于 0 的数字。至少有两个明显的解决方案。一个是调用filter()函数并从我们的数据集中删除这 227 条记录；另一个是将负的赢分调整为等于 0。我们将采取后一种方法。

在以下代码行中，我们应用了方括号，也称为提取运算符，来索引 ws_gini2 数据集中值小于 0 的WS向量，然后修改这些元素，使它们等于 0。然后，我们调用基本的 R min()函数来返回变量WS中的最小值；正如预期的那样，它现在等于 0：

ws_gini2$WS[ws_gini2$WS < 0] = 0.0
min(ws_gini2$WS)
## [1] 0

我们使用下一代码块创建了第一个洛伦兹曲线（见图 13.2）：

• 我们首先从 dplyr 包中调用 filter() 函数，对 ws_gini2 数据集进行子集化，其中变量 Year 等于 1991。最终结果是名为 gini91 的新数据集。

• 尽管我们的洛伦兹曲线本质上是对 ggplot2 的扩展，不仅需要 ggplot() 函数，还需要 gglorenz 的 stat_lorenz() 函数，但其语法与其他任何 ggplot2 对象完全一致。因此，我们的图表是通过调用 ggplot() 函数初始化的，将 gini91 作为我们的数据源，然后将变量 WS 作为唯一的美学映射传递。

• gglorenz 包中的 stat_lorenz() 函数绘制洛伦兹曲线。当设置为 TRUE 时，人口按降序排列；当设置为 FALSE 时，人口则按升序排列。由于大多数洛伦兹曲线都是按人口升序排列创建的，而不是相反，我们将 desc 参数（表示降序）设置为 FALSE。此外，我们指示 R 用实线绘制线条，并将其宽度设置为默认宽度的两倍。

• ggplot2 coord_fixed() 函数固定 x 轴和 y 轴的比率，使它们的刻度相等。

• geom_abline() 函数绘制一条虚线对角线，代表完全相等的状态。

• scale_x_continuous() 和 scale_y_continuous() 函数，结合 scales 包，分别将 x 轴和 y 轴的标签从小数转换为百分比。

图 13.2 1990-91 赛季 NBA 赛季的联赛范围内胜利份额分布的洛伦兹曲线，基尼系数等于 0.56

下面是我们的 dplyr 和 ggplot2 代码：

ws_gini2 %>%
  filter(Year == 1991) -> gini91

ggplot(gini91, aes(WS)) +
  stat_lorenz(desc = FALSE, color = "red", lwd = 2) +
  coord_fixed() +
  geom_abline(linetype = "dashed", lwd = 1.5) +
  labs(title = "Lorenz Curve\n1990-91 Season", 
       subtitle = "Gini coefficient = 0.56",
       x = "Win Share Distribution",
       y = "Percentage of NBA Players",
       caption = "includes a maximum top 14 salaries for each team") +
  scale_x_continuous(labels = percent) +
  scale_y_continuous(labels = percent) +
  theme(plot.title = element_text(face = "bold")) 

在 1990-91 赛季的 NBA 赛季中，大约 25% 的胜利份额是由大约 1% 的球员产生的；大约 50% 的所有胜利份额是由大约 12% 的球员产生的；大约 75% 的胜利份额是由大约 37% 的球员产生的。这正是我们创建第十二章洛伦兹曲线的方式。但假设我们想要在单个图形表示中比较和可视化两个赛季之间的基尼系数，并且同时创建一个比我们之前的洛伦兹曲线更美观的图表。

我们的第一步是调用 dplyr filter() 函数，对 ws_gini2 数据集进行子集化，其中变量 Year 等于 1991 或 2017，基尼系数分别为 0.56 和 0.49。管道 (|) 是一个逻辑运算符，表示“或”。我们将结果转换到一个名为 gini9117 的新对象中：

ws_gini2 %>%
  filter(Year == 1991 | Year == 2017) -> gini9117 

然后我们调用基础 R 的 head() 和 tail() 函数，以返回 gini9117 中的前三个和最后三个记录：

head(gini9117, n = 3)
## # A tibble: 3 × 4
## # Groups:   Year, Tm [1]
##   Year  Tm       WS  rank
##   <fct> <fct> <dbl> <int>
## 1 1991  ATL       0    14
## 2 1991  ATL       0    13
## 3 1991  ATL       0    11

tail(gini9117, n = 3)
## # A tibble: 3 × 4
## # Groups:   Year, Tm [1]
##   Year  Tm       WS  rank
##   <fct> <fct> <dbl> <int>
## 1 2017  WAS     8.5     3
## 2 2017  WAS     8.8     2
## 3 2017  WAS     9.4     1

变量 Tm 中的因素按字母顺序排列。也就是说，我们的数据集从 1991 年的亚特兰大老鹰队开始，以 2017 年的华盛顿奇才队结束。所以这是正确的。

我们接下来的代码块绘制了一个新的、改进的洛伦兹曲线（见图 13.3）。语法与之前相同，但有两大例外——（1）我们添加了一个美学参数fill，其值等于变量Year，（2）我们用额外的geom等于polygon替换了stat_lorenz()函数内的单个洛伦兹曲线或线条，这绘制了一对填充区域曲线：

ggplot(gini9117, aes(WS, fill = Year)) +
  stat_lorenz(geom = "polygon", desc = FALSE) +
  coord_fixed() +
  geom_abline(linetype = "dashed") +
  labs(title = "Lorenz Curve\n1990-91 versus 2016-17 Seasons", 
       subtitle = "Gini coefficients = 0.56 and 0.49",
       x = "Win Share Distribution", 
       y = "Percentage of NBA Players",
       caption = "includes a maximum top 14 salaries for each team") +
  scale_x_continuous(labels = percent) +
  scale_y_continuous(labels = percent) +
  theme(plot.title = element_text(face = "bold")) 

图 13.3 1991 年和 2017 年联赛范围内的赢分分布洛伦兹曲线合并为一个单一图形对象

较小的曲线代表 2017 年赢分分布的基尼系数，而较大的曲线代表 1991 年的基尼系数。不要被阴影所迷惑——我们仍在测量每条洛伦兹曲线与虚线对角线之间的距离。这是一种比创建成对的并排图表更有效、更高效的方式来直观比较两个基尼系数。

我们将在下一节中展示创建洛伦兹曲线的另一种方法——实际上，是一系列洛伦兹曲线。

13.6 循环

到目前为止，我们已经展示了两种创建ggplot2洛伦兹曲线的方法。但假设我们想要或需要为数据集中的 27 个 NBA 赛季中的每一个创建一个单独的洛伦兹曲线。一种方法是创建一个洛伦兹曲线，复制粘贴代码 26 次，然后在每次迭代中可能更改几个参数。是的，这很繁琐，但并不困难。另一种方法是编写一个for循环。

13.6.1 简单演示

当同一个任务必须重复有限次数时，for循环是一种高效且常见的选择。代码量更少，这最小化了开发阶段中人为错误的可能性，并在之后最大化了可维护性，因为修复和其他更改只需要应用一次，而不是，比如说，27 次。

下面是最简单的for循环：

for (i in 1:5)  {
  print(i * 2)
}
## [1] 2
## [1] 4
## [1] 6
## [1] 8
## [1] 10

下面是刚刚发生的事情：索引i被迭代地替换为向量 1:5 中的每个值。因为我们的向量中的第一个值等于1，所以我们的for循环首先将i替换为数字1，然后执行花括号之间的代码。通常，for循环以i作为计数器初始化，这是迭代的简称，但for循环也可以用任何字母或字符字符串初始化。然后for循环遍历向量，直到达到最终值，此时它停止并退出。

我们用一小段代码返回了五个值，而如果用其他方法，我们需要依次将五个数字乘以二。如果我们应该将这五个相同的数字乘以三而不是二，那么我们就需要五次而不是一次地实施更改。

13.6.2 应用所学知识

现在，对于我们的洛伦兹曲线，我们首先整理数据，以最好地展示使用for循环创建多个图的使用方法。我们首先调用dplyr ungroup()函数来解耦，或取消组合，之前通过调用group_by()函数组合的两个变量，Year和Tm。我们只想对变量Year和WS进行子集操作，但由于Year和Tm目前是组合的，否则 R 将强制我们保留变量Tm：

ws_gini2 %>%
  ungroup(Tm, Year) -> ws_gini2

接下来，我们调用dplyr filter()函数来缩短 ws_gini2 的长度，只包括变量Year等于1991、1992、1993或1994的记录。我们可以用 4 年的数据同样有效地展示for循环的价值，就像我们用 27 年的数据一样。然后，我们将结果转换成一个新的 tibble，称为 ws9194。head()和tail()函数返回前六个和后六个观测值：

ws_gini2 %>%
  filter(Year == 1991 | Year == 1992 | Year == 1993 | 
           Year == 1994) -> ws9194

head(ws9194)
## # A tibble: 6 × 4
##   Year  Tm       WS  rank
##   <fct> <fct> <dbl> <int>
## 1 1991  ATL     0      14
## 2 1991  ATL     0      13
## 3 1991  ATL     0      11
## 4 1991  ATL     0      12
## 5 1991  ATL     1.1    10
## 6 1991  ATL     1.8     9

tail(ws9194)
## # A tibble: 6 × 4
##   Year  Tm       WS  rank
##   <fct> <fct> <dbl> <int>
## 1 1994  WSB     1.3     6
## 2 1994  WSB     1.9     5
## 3 1994  WSB     3.1     4
## 4 1994  WSB     3.8     3
## 5 1994  WSB     3.9     2
## 6 1994  WSB     5.6     1

然后，我们通过调用tidyr包中的pivot_wider()函数将 ws9194 从长格式转换为宽格式。这样做后，变量Year被拆分为四个列，从1991到1994，用变量WS的元素填充。然后head()函数返回前六个记录：

ws9194 %>%
  pivot_wider(names_from = Year, values_from = WS) -> ws9194
head(ws9194)
## # A tibble: 6 × 6
##   Tm     rank `1991` `1992` `1993` `1994`
##   <fct> <int>  <dbl>  <dbl>  <dbl>  <dbl>
## 1 ATL      14    0      0      0      0  
## 2 ATL      13    0      0.1    0.1    0  
## 3 ATL      11    0      1.1    0.2    1.3
## 4 ATL      12    0      0.2    0.2    0.2
## 5 ATL      10    1.1    1.1    0.3    1.4
## 6 ATL       9    1.8    2.1    1.1    2.2

我们不需要变量Tm和rank来创建我们的洛伦兹曲线，所以我们接下来调用dplyr select()函数来对 ws9194 进行子集操作，除了Tm和rank之外的所有变量（注意c()函数调用之前的前导减号）：

ws9194 %>%
  select(-c(Tm, rank)) -> ws9194 

然后，我们通过调用基础 R 的as.data.frame()函数将 ws9194 从 tibble 转换为数据框。当我们第一次创建 tibble 时，我们提到 tibbles 与数据框有许多相同的属性，但至少有三个重要的区别。第一个是，当调用print()函数时，tibbles 只返回前 10 行和屏幕上能容纳的任意数量的列（我们之前已经看到过）。当处理大型数据集时这通常很方便，但有时也会令人沮丧。第二个是，当对数据进行子集操作时，tibbles 有时需要“解决方案”（我们之前也看到过）。

第三个区别更为重要——tibbles 并不总是与旧代码兼容。结果是，我们即将创建的洛伦兹曲线，部分使用基础 R 代码创建，不能将 ws9194 作为 tibble 读取，但当 ws9194 是数据框时可以。因此，我们调用as.data.frame()函数将 ws9194 从 tibble 转换为数据框。然后，我们调用基础 R 的class()函数，它返回 ws9194 的类，并确认它现在是一个数据框：

ws9194 <- as.data.frame(ws9194)
class(ws9194)
## [1] "data.frame"

最后，我们从基础 R 中调用names()函数来重命名 ws9194 中剩余的四列，分别为a、b、c和d：

names(ws9194) <- c("a", "b", "c", "d")
head(ws9194)
##     a   b   c   d
## 1 0.0 0.0 0.0 0.0
## 2 0.0 0.1 0.1 0.0
## 3 0.0 1.1 0.2 1.3
## 4 0.0 0.2 0.2 0.2
## 5 1.1 1.1 0.3 1.4
## 6 1.8 2.1 1.1 2.2

现在，我们可以开始编写一个 for 循环，并使用它来创建四个洛伦兹曲线，每个曲线对应于 ws9194 数据集中的四个年份。首先，我们调用基础 R 的 par() 函数来将我们的四个洛伦兹曲线排列在一个 2 × 2 矩阵中。mfrow 参数告诉 R 将图表排列为 1991 年和 1992 年在上部，1993 年和 1994 年在底部；如果我们调用 mfcol 参数，R 将将 1991 年和 1992 年排列在左侧，1993 年和 1994 年排列在右侧。

在剩余的代码块中，发生以下情况：

• 我们首先创建一个循环向量，称为 loop.vector，它最终将迭代四次，或者在其他情况下循环遍历 ws9194 数据集中的每一列或向量。

• 循环对象随后被初始化为 i。

• 开括号和闭括号内的代码将被执行四次，每次对应于一列或向量，从而生成四个相应的图表。

• 数据被存储为 x，然后用于生成我们的洛伦兹曲线，这些曲线是通过基础 R 的 plot() 函数和 ineq 包中的 Lc() 函数的组合来创建的（见图 13.4）。

• paste0() 函数是一个内置的 R 函数，它可以将元素连接起来，而不需要分隔符。我们每个洛伦兹曲线的标题实际上是一个顶部标题和底部副标题，其中洛伦兹曲线打印在顶部，适用的年份打印在底部；在 R 中，\n 在字符字符串中使用时类似于回车符。年份是通过附加或连接 199 和 i（或 1、2、3、4，每个循环依次进行）来返回的。

图 13.4 从 for 循环和基础 R 创建的 1991 年至 1994 年联赛洛伦兹曲线

结果是四个洛伦兹曲线合并成一个单一的图形对象：

par(mfrow = c(2, 2)) 

loop.vector <- 1:4

for (i in loop.vector) {
x <- ws9194[,i]

plot(Lc(x), col = "red", lwd = 2,
      main = paste0("Lorenz Curve\n", "199", i),
      xlab = "Win Share Distribution",
      ylab = "Percentage of NBA Players")
}

如果我们不知道其他情况，我们可能会估计基尼系数大约等于 0.50。 (根据我们显示的年度联赛 Gini 系数的时间序列图，实际的系数在 1991 年和 1992 年为 0.56，在 1993 年和 1994 年为 0.54。) 但更重要的是，我们已经展示了如何编写一个 for 循环，在这种情况下，用不到四分之一的代码就能创建四个图表。

在下一节中，我们将假设 R 中不包含任何内置或包装的函数来计算基尼系数，因此我们将创建一个自己的函数。

13.7 用户自定义函数

R 实质上是一种 函数式 编程语言，这意味着 R 中的几乎所有内容都源自内置或包装的函数。仅在这一章中，我们就已经调用了近 40 个独特的函数。每个函数都包含以下组件：

• 函数名称—函数的实际名称。函数名称通常是唯一的，但考虑到新包和函数的激增，这并不一定。非常简单，pivot_wider() 函数的函数名称是 pivot_wider。

• 参数—函数运行所需的一个或多个参数或输入。例如，当我们调用 pivot_wider() 函数时，我们随后在括号内传递两个参数，这些参数通过逗号分隔，告诉 R 从哪个数据集的哪个变量中提取新列，以及从哪个其他变量中填充这些新列。

• 函数体—大致包含一组定义函数应该做什么的语句。与函数名称和函数参数不同，函数体对我们来说是不可见的；我们通过经验或阅读了解函数应该做什么。

• 返回值—函数运行时预期的输出。例如，当我们对连续变量调用 mean() 函数时，我们期望 R 返回一个表示平均数或均值的数值。

当我们说 R 是一种函数式编程语言时，这也是因为我们能够编写自己的函数，这些函数通常被称为用户定义函数。它们包含与内置或打包函数相同的组件，并且采用相同的语法。

让我们编写一个函数，将 r，即一对连续变量之间的相关系数，转换为 r²，如果我们对其中一个连续变量进行回归，它代表可以由预测变量解释的目标变量的方差比例。

我们函数的名称，位于赋值运算符的左侧，被称为 r_to_ rsquared()。函数名称应该比创意性更强，更直观。我们的函数只需要一个参数，或者输入，那就是 r。函数体和返回值位于一对开括号和闭括号内。我们的 r_to_ rsquared() 函数通过平方 r 并返回结果，将 r 转换为 r²。我们的第一个用户定义函数如下：

r_to_rsquared <- function(r) {
   rsquared <- r²
   return(rsquared)
 }

然后，我们调用该函数，并将 .42 作为 r 的值传递。我们的函数返回 r²，即 0.1764。

r_to_rsquared(.42)
## [1] 0.1764

现在让我们编写第二个用户定义函数，它将 r² 转换为 r：

• 我们的新函数被称为 rsquared_to_r()。

• 它需要一个参数，即 r² 的值，才能运行。

• 然后，它通过计算平方根并将结果返回，将 r² 转换为 r。

我们的第二个用户定义函数“看起来”和第一个完全一样：

rsquared_to_r <- function(rsquared) {
   r <- sqrt(rsquared)
   return(r)
 }

我们随后调用该函数，并将 0.1764 作为参数传递，以获得 0.42 的返回值：

rsquared_to_r(.1764)
## [1] 0.42

接下来，我们将创建一个函数来估计洛伦兹曲线的基尼系数：

• 我们的函数采用 gini.est() 的名称。

• 它需要恰好传递三个参数：

  • a 代表当累积赢分分布等于 40% 时估计的累积人口百分比。

  • b 代表当累积赢分分布等于 60% 时估计的累积人口百分比。

  • c 代表当累积赢分分布等于 80% 时估计的累积人口百分比。换句话说，给定三个 x 轴坐标——40%、60% 和 80%——我们通过洛伦兹曲线估计相应的 y 轴坐标。当 x 等于 0% 或 100% 时，我们已知 y 的值。

• 函数体计算估计的基尼系数，简称为 gini，并返回结果。估计的基尼系数首先通过将洛伦兹曲线下方的面积分成互斥的三角形，估计每个三角形的面积，并将估计值相加；然后将这个总和乘以 2，然后将这个乘积减去 1。关于 1991 年至 1994 年 NBA 赛季，我们应该得到等于或略大于 0.50 的基尼系数。

每个洛伦兹曲线下方的面积被分成四个三角形，其中估计的面积等于宽度（x 轴上两点之间的距离）乘以高度（y 轴上两点之间的距离，其中必须提供 a、b 和 c 的估计）乘以 0.5：

gini.est <- function(a, b, c) {
  gini <- 1 - 2 * ((0.4 - 0.0) * (a + 0) * 0.5 +
                   (0.6 - 0.4) * (b + a) * 0.5 +
                   (0.8 - 0.6) * (c + b) * 0.5 +
                   (1.0 - 0.8) * (1 + c) * 0.5)
  return(gini)
}

现在我们来运行 gini.est() 函数，但只传递所需的三个参数中的两个：

gini.est(.05, .18)
## Error in gini.est(0.05, 0.18): argument "c" is missing, with no default

R 抛出错误，因为我们提供了 a 和 b，但没有提供 c。

让我们这次做对。根据我们为 1991 年 NBA 赛季创建的洛伦兹曲线，我们估计 40% 的赢分由我们数据集中那一年 5% 的球员获得，60% 的赢分由 18% 的球员获得，80% 的赢分由 44% 的球员获得：

gini.est(.05, .18, .44)
## [1] 0.522

我们的功能返回一个估计的基尼系数等于 0.522；1991 年的实际基尼系数为 0.56。所以虽然我们的函数并不完美，但它仍然返回了一个足够合理的估计。

现在我们为 1992 年、1993 年和 1994 年 NBA 赛季运行 gini.est() 函数：

gini.est(.05, .19, .44)
## [1] 0.518
gini.est(.06, .20, .44)
## [1] 0.508
gini.est(.06, .20, .44)
## [1] 0.508

我们一直在低估我们的估计——基尼系数当然在 1992 年等于 0.56，在 1993 年和 1994 年等于 0.54。如果我们进一步分解曲线下方的面积并进行额外的几何计算，我们的函数可能会证明更准确。但更重要的是，我们已经展示了如何在 R 中创建用户定义的函数。现在让我们看看实际的基尼系数如何与胜负相关。

13.8 赢分不平等和冠军

我们在这里的目的是通过按冠军球队与其他所有球队分组来衡量赢分不平等，进行 t 检验以确定两组之间平均基尼系数的方差在统计上是否显著，然后围绕同一组进行成对效应量测试。换句话说，我们将在过程中进行“旧”和“新”测试的混合。然而，必须首先执行一系列数据处理操作。

13.8.1 数据整理

我们接下来的代码块重新排列了ws_gini2，这是我们演示for循环和用户定义函数之前的工作数据集，以便每个年份（Year）和团队（Tm）组合的单独胜利份额（WS）成为它们自己的列：

• 变量rank并不在我们的分析中起作用；它仅被创建来帮助我们子集最初导入的数据。因此，我们调用dplyr select()函数来子集ws_gini2中的所有变量，除了rank。

• 然后，我们将ws_gini2数据集传递给dplyr group_by()、mutate()和row_number()函数，以创建一个名为id的新变量，它仅是一个连续数字的列，每个Year和Tm组合都有独立的序列。

• 然后，我们调用tidyr pivot_wider()函数将ws_gini2数据集从长格式转换为宽格式，其中变量id被拆分为列，然后变量WS的值用于填充这些新列中的单元格。

结果是一个名为ws_gini3的新 tibble。对基础 R 的head()函数的调用返回前六个观测值，以便你了解刚刚创建的内容。这是将我们的数据准备与另一个数据集合并的第一步：

ws_gini2 %>%
  select(-c(rank)) -> ws_gini2

ws_gini2 %>%
  group_by(Tm, Year) %>%
  mutate(id = row_number(WS)) %>%
  pivot_wider(names_from = id, values_from = WS) -> ws_gini3
head(ws_gini3)
## # A tibble: 6 × 16
## # Groups:   Tm, Year [6]
##   Year  Tm      `1`   `2`   `3`   `4`   `5`   `6`
##   <fct> <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1991  ATL     0     0     0     0     1.1   1.8
## 2 1991  BOS     0     0     0     0     0.3   1.2
## 3 1991  CHH     0     0.1   0.3   0.6   1.8   1.8
## 4 1991  CHI     0.5   0.9   1.5   1.7   2     2.3
## 5 1991  CLE     0     0     0.2   0.6   1     1.3
## 6 1991  DAL     0.1   0.4   0.6   0.6   0.6   0.7
##    `7`   `8`   `9`  `10`  `11`  `12`  `13`  `14`
##   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1.9   2.5   4     4.4   5.4   5.6   6.3  11.4
## 2 3.5   4.7   5.9   6.6   7.5   7.9   8.3  10
## 3 2     2     2.1   2.7   3     3     4.1   4.8
## 4 4.1   4.2   5.7  10.3  11.2  20.3  NA    NA  
## 5 1.5   1.6   2     2.4   3.1   3.4   9     9.8
## 6 0.7   1     1.6   1.7   4.3   5.3   5.5   7.6

编号列根本不与变量rank相关联；事实上，胜利份额现在是按升序从左到右排序的。这是可以的，因为排序或顺序不再重要。

我们随后从基础 R 中调用names()函数来重命名所有ws_gini3列名。当然，这包括变量Year和Tm，它们将被分别重命名为season_end和team，以与我们的第十二章数据保持一致。head()函数当然返回前六个观测值：

names(ws_gini3) = c("season_end", "team", "ws1", "ws2", "ws3", "ws4", 
                    "ws5", "ws6", "ws7", "ws8", "ws9", "ws10", "ws11", 
                    "ws12", "ws13", "ws14")

head(ws_gini3)
## # A tibble: 6 × 16
## # Groups:   team, season_end [6]
##   season_end team    ws1   ws2   ws3   ws4   ws5   ws6   
##   <fct>      <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> 
## 1 1991       ATL     0     0     0     0     1.1   1.8   
## 2 1991       BOS     0     0     0     0     0.3   1.2   
## 3 1991       CHH     0     0.1   0.3   0.6   1.8   1.8   
## 4 1991       CHI     0.5   0.9   1.5   1.7   2     2.3   
## 5 1991       CLE     0     0     0.2   0.6   1     1.3   
## 6 1991       DAL     0.1   0.4   0.6   0.6   0.6   0.7  
##  ws7   ws8   ws9  ws10  ws11  ws12  ws13  ws14
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1.9   2.5   4     4.4   5.4   5.6   6.3  11.4
## 2 3.5   4.7   5.9   6.6   7.5   7.9   8.3  10  
## 3 2     2     2.1   2.7   3     3     4.1   4.8
## 4 4.1   4.2   5.7  10.3  11.2  20.3  NA    NA  
## 5 1.5   1.6   2     2.4   3.1   3.4   9     9.8
## 6 0.7   1     1.6   1.7   4.3   5.3   5.5   7.6

接下来，我们调用mutate()函数来创建一个名为gini_index的新变量，它等于 ws_gini3 数据集中每个team和season_end组合计算的基尼系数，四舍五入到小数点后两位。基尼系数是通过再次调用ineq()函数从ineq包中计算的，该函数将变量ws1到ws14作为参数。通过将na.rm参数设置为TRUE，我们指示ineq()函数跳过数据中的不可用（NA）值；如果我们将其设置为FALSE，则ineq()函数将为每个具有少于 14 个胜利份额的team和season_end组合返回NA。

结果是一个名为ws_gini4的新 tibble。head()函数打印出前六个记录：

ws_gini3 %>%
  mutate(gini_index = round(ineq(c(ws1, ws2, ws3, ws4, ws5, ws6, ws7, 
                                   ws8, ws9, ws10, ws11, ws12, ws13, 
                                   ws14, na.rm = TRUE)), 
                                   digits = 2)) -> ws_gini4

head(ws_gini4)
## # A tibble: 6 × 17
## # Groups:   team, season_end [6]
##   season_end team    ws1   ws2   ws3   ws4   ws5   ws6   
##   <fct>      <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> 
## 1 1991       ATL     0     0     0     0     1.1   1.8   
## 2 1991       BOS     0     0     0     0     0.3   1.2   
## 3 1991       CHH     0     0.1   0.3   0.6   1.8   1.8   
## 4 1991       CHI     0.5   0.9   1.5   1.7   2     2.3   
## 5 1991       CLE     0     0     0.2   0.6   1     1.3   
## 6 1991       DAL     0.1   0.4   0.6   0.6   0.6   0.7   
##   ws7   ws8   ws9  ws10  ws11  ws12  ws13  ws14 gini_index
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>      <dbl>
## 1 1.9   2.5   4     4.4   5.4   5.6   6.3  11.4       0.54
## 2 3.5   4.7   5.9   6.6   7.5   7.9   8.3  10         0.52
## 3 2     2     2.1   2.7   3     3     4.1   4.8       0.39
## 4 4.1   4.2   5.7  10.3  11.2  20.3  NA    NA         0.53
## 5 1.5   1.6   2     2.4   3.1   3.4   9     9.8       0.56
## 6 0.7   1     1.6   1.7   4.3   5.3   5.5   7.6       0.53

然后，我们再次调用read_csv()函数来导入存储在我们默认工作目录中的records.csv文件；这是我们在第十二章中导入的相同.csv 文件。我们再次将其称为records：

records <- read_csv("records.csv")

records 数据集包括常规赛的胜负记录、常规赛胜率以及一个等于 0 或 1 的二进制变量，其中 0 表示一支球队没有赢得冠军，而 1 表示相反。该数据集包含了 1991 年至 2018 年间每个 NBA 赛季的这些记录。因为从 Kaggle 下载的数据集截止到 2017 年，所以我们调用 dplyr filter() 函数来筛选出变量 season_end（现在为数值型）小于 2018 的 records 数据集子集：

records %>%
  filter(season_end < 2018) -> records 

然后，我们通过三次调用基础 R 的 as.factor() 函数将变量 season_end、team 和 champ（这是之前提到的二进制变量）转换为因子变量。提醒一下，如果变量只能取有限个值，它们应该被转换为因子：

records$season_end <- as.factor(records$season_end)
records$team <- as.factor(records$team)
records$champ <- as.factor(records$champ)

我们即将在类似变量 season_end 和 team 上连接 ws_gini4 和 records。然而，ws_gini4 中的变量 team 被填充了每个队伍的三字母缩写（例如，ATL），而 records 中的变量 team 被填充了完整的队伍名称（例如，亚特兰大老鹰）。两次调用基础 R 的 levels() 函数允许我们交叉检查这两个变量：

levels(ws_gini4$team)
[1] "ATL" "BOS" "BRK" "CHA" "CHH" "CHI" "CHO" "CLE" "DAL" "DEN"
[11] "DET" "GSW" "HOU" "IND" "LAC" "LAL" "MEM" "MIA" "MIL" "MIN"
[21] "NJN" "NOH" "NOK" "NOP" "NYK" "OKC" "ORL" "PHI" "PHO" "POR"
[31] "SAC" "SAS" "SEA" "TOR" "UTA" "VAN" "WAS" "WSB"

levels(records$team)
##  [1] "Atlanta Hawks"                     "Boston Celtics"                   
##  [3] "Brooklyn Nets"                     "Charlotte Bobcats"                
##  [5] "Charlotte Hornets"                 "Chicago Bulls"                    
##  [7] "Cleveland Cavaliers"               "Dallas Mavericks"                 
##  [9] "Denver Nuggets"                    "Detroit Pistons"                  
## [11] "Golden State Warriors"             "Houston Rockets"                  
## [13] "Indiana Pacers"                    "Los Angeles Clippers"             
## [15] "Los Angeles Lakers"                "Memphis Grizzlies"                
## [17] "Miami Heat"                        "Milwaukee Bucks"                  
## [19] "Minnesota Timberwolves"            "New Jersey Nets"                  
## [21] "New Orleans Hornets"               "New Orleans Pelicans"             
## [23] "New Orleans/Oklahoma City Hornets" "New York Knicks"                  
## [25] "Oklahoma City Thunder"             "Orlando Magic"                    
## [27] "Philadelphia 76ers"                "Phoenix Suns"                     
## [29] "Portland Trail Blazers"            "Sacramento Kings"                 
## [31] "San Antonio Spurs"                 "Seattle SuperSonics"              
## [33] "Toronto Raptors"                   "Utah Jazz"                        
## [35] "Vancouver Grizzlies"               "Washington Bullets"               
## [37] "Washington Wizards"

然后，我们调用 car 包中的 recode() 函数将 ws_gini4 中每个 ATL 实例重命名为亚特兰大老鹰，每个 BOS 实例重命名为波士顿凯尔特人，等等，以使变量 team 与 records 数据集中的相同变量对齐：

ws_gini4$team <- recode(ws_gini4$team, "'ATL' = 'Atlanta Hawks';
                        'BOS' = 'Boston Celtics';
                        'BRK' = 'Brooklyn Nets';
                        'CHA' = 'Charlotte Bobcats';
                        'CHH' = 'Charlotte Hornets';
                        'CHI' = 'Chicago Bulls';
                        'CHO' = 'Charlotte Hornets';
                        'CLE' = 'Cleveland Cavaliers';
                        'DAL' = 'Dallas Mavericks';
                        'DEN' = 'Denver Nuggets';
                        'DET' = 'Detroit Pistons';
                        'GSW' = 'Golden State Warriors';
                        'HOU' = 'Houston Rockets';
                        'IND' = 'Indiana Pacers';
                        'LAC' = 'Los Angeles Clippers';
                        'LAL' = 'Los Angeles Lakers';
                        'MEM' = 'Memphis Grizzlies';
                        'MIA' = 'Miami Heat';
                        'MIL' = 'Milwaukee Bucks';
                        'MIN' = 'Minnesota Timberwolves';
                        'NJN' = 'New Jersey Nets';
                        'NOH' = 'New Orleans Hornets';
                        'NOK' = 'New Orleans/Oklahoma City Hornets';
                        'NOP' = 'New Orleans Pelicans';
                        'NYK' = 'New York Knicks';
                        'OKC' = 'Oklahoma City Thunder';
                        'ORL' = 'Orlando Magic';
                        'PHI' = 'Philadelphia 76ers';
                        'PHO' = 'Phoenix Suns';
                        'POR' = 'Portland Trail Blazers';
                        'SAC' = 'Sacramento Kings';
                        'SAS' = 'San Antonio Spurs';
                        'SEA' = 'Seattle SuperSonics';
                        'TOR' = 'Toronto Raptors';
                        'UTA' = 'Utah Jazz';
                        'VAN' = 'Vancouver Grizzlies';
                        'WAS' = 'Washington Wizards';
                        'WSB' = 'Washington Bullets'")

现在，变量 team 在 ws_gini4 和 records 之间已经对齐，我们可以通过调用 dplyr 包中的 left_join() 函数将这两个对象合并成一个单一的数据集，即 ws_gini_records：

left_join(ws_gini4, records, 
          by = c("season_end", "team")) -> ws_gini_records

然后，我们调用 dplyr glimpse() 函数以返回 ws_gini_records 数据集的转置视图：

glimpse(ws_gini_records) 
## Rows: 786
## Columns: 21
## Groups: team, season_end [786]
## $ season_end <fct> 1991, 1991, 1991, 1991, 1991, 1991, 1991, 19...
## $ team       <fct> Atlanta Hawks, Boston Celtics, Charlotte Hor...
## $ ws1        <dbl> 0.0, 0.0, 0.0, 0.5, 0.0, 0.1, 0.1, 0.1, 0.1,...
## $ ws2        <dbl> 0.0, 0.0, 0.1, 0.9, 0.0, 0.4, 0.3, 0.1, 0.2,...
## $ ws3        <dbl> 0.0, 0.0, 0.3, 1.5, 0.2, 0.6, 0.3, 0.5, 0.2,...
## $ ws4        <dbl> 0.0, 0.0, 0.6, 1.7, 0.6, 0.6, 0.3, 0.5, 0.3,...
## $ ws5        <dbl> 1.1, 0.3, 1.8, 2.0, 1.0, 0.6, 0.5, 0.5, 1.0,...
## $ ws6        <dbl> 1.8, 1.2, 1.8, 2.3, 1.3, 0.7, 0.6, 1.3, 1.3,...
## $ ws7        <dbl> 1.9, 3.5, 2.0, 4.1, 1.5, 0.7, 0.7, 3.4, 1.7,...
## $ ws8        <dbl> 2.5, 4.7, 2.0, 4.2, 1.6, 1.0, 0.9, 3.5, 1.9,...
## $ ws9        <dbl> 4.0, 5.9, 2.1, 5.7, 2.0, 1.6, 1.0, 3.8, 2.1,...
## $ ws10       <dbl> 4.4, 6.6, 2.7, 10.3, 2.4, 1.7, 1.3, 4.8, 2.5...
## $ ws11       <dbl> 5.4, 7.5, 3.0, 11.2, 3.1, 4.3, 1.7, 5.5, 5.3...
## $ ws12       <dbl> 5.6, 7.9, 3.0, 20.3, 3.4, 5.3, 2.2, 8.0, 7.1...
## $ ws13       <dbl> 6.3, 8.3, 4.1, NA, 9.0, 5.5, 3.9, 8.7, 9.9, ...
## $ ws14       <dbl> 11.4, 10.0, 4.8, NA, 9.8, 7.6, 6.3, 9.9, 12....
## $ gini_index <dbl> 0.54, 0.52, 0.39, 0.53, 0.56, 0.53, 0.53, 0....
## $ wins       <dbl> 43, 56, 26, 61, 33, 28, 20, 50, 44, 52, 41, ...
## $ losses     <dbl> 39, 26, 56, 21, 49, 54, 62, 32, 38, 30, 41, ...
## $ pct        <dbl> 0.52, 0.68, 0.32, 0.74, 0.40, 0.34, 0.24, 0....
## $ champ      <fct> 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,...

ws_gini_records 数据集包含 786 行和 21 列——786 行是因为从 ws_gini4 和 records 中得到的行数，而 21 列是因为 ws_gini4 和 records 之间变量的总和减去变量 season_end 和 team。然而，我们只需要这些变量的一部分。因此，我们调用 dplyr select() 函数将 ws_gini_records 数据集缩减到 season_end、team、gini_index、wins、losses、pct 和 champ 这些变量。变量 gini_index 到 champ 占据 ws_gini_records 的最后五个位置：

ws_gini_records %>%
  select(season_end, team, gini_index:champ) -> ws_gini_records 

接下来，我们将根据变量 champ 对赢分分布进行分组，并计算基尼系数，然后执行我们的第一次 t 检验。

13.8.2 t 检验

现在我们有一个包含 1991 年至 2017 年间每个 team 和 season_end 组合的赢分基尼系数以及这些相同 team 和 season_end 组合的记录的单个数据集，我们可以开始我们的测试和分析工作。仅仅计算一对组均值、记录结果并突出任何差异是不够的。平均值之间的差异可能或可能不具有意义；因此，我们进行统计检验以确定方差是否可能由偶然因素引起，或者是否比这更重要。

我们首先使用一段 dplyr 代码，通过该代码将 ws_gini_records 数据集传递给 group_by() 和 summarize() 函数。summarize() 函数计算二进制变量 champ 中每个级别或因子的 gini_index 均值，并四舍五入到小数点后两位。我们的结果被转换成一个名为 ws_gini_summary2 的 tibble：

ws_gini_records %>%
  group_by(champ) %>%
  summarize(mean = round(mean(gini_index), digits = 2)) -> ws_gini_summary2
print(ws_gini_summary2)
## # A tibble: 2 × 2
##   champ  mean
##   <fct> <dbl>
## 1 0      0.49
## 2 1      0.51

在我们的数据集中，冠军球队——1991 年至 2017 年每赛季一支，共 27 支——的平均基尼系数为 0.51，而未赢得联赛冠军的球队的基尼系数平均为 0.49。换句话说，1991 年至 2017 年间，冠军球队的赢分分布比其他球队更不平等。

我们将进行 t 检验以确定这是否构成统计上显著的变化。再次强调，t 检验是一种统计检验，它比较两个数据系列的平均值。它考虑了平均值之间的差异以及组方差，并结合记录数来确定方差是否由偶然因素引起，因此基本上等于零，或者，方差是否有意义，因此与零不同。如果前者，我们将无法拒绝零假设；在后者的情况下，我们将拒绝零假设，并接受备择假设。在这里，我们的零假设是基尼系数对谁赢得或未赢得 NBA 锦标赛没有影响。如果我们从 t 检验中获得一个高 p 值，大于我们预定义的 5% 阈值，我们将无法拒绝零假设；否则，我们将拒绝零假设，接受备择假设，并得出结论：更高的基尼系数——即更不平等球员生产力——有助于 NBA 锦标赛。

在此基础上，我们建立了两个新的数据集，ws_giniX，它是基于变量 champ 等于 0 的 ws_gini_records 过滤后的结果，以及 ws_giniY，它是基于变量 champ 相反等于 1 的 ws_gini_records 过滤后的结果。t 检验是对 ws_gini_records 变量的 gini_index 进行的：

ws_gini_records %>%
  filter(champ == 0) -> ws_giniX
ws_gini_records %>%
  filter(champ == 1) -> ws_giniY

t.test(ws_giniX$gini_index, ws_giniY$gini_index)
## 
##  Welch Two Sample t-test
## 
## data:  ws_giniX$gini_index and ws_giniY$gini_index
## t = -2.5402, df = 31.156, p-value = 0.01628
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.039949859 -0.004371617
## sample estimates:
## mean of x mean of y 
## 0.4911726 0.5133333

我们的 t 检验的 p 值等于 0.02，因为它低于我们预定义的通常接受的显著性阈值 0.05，所以我们拒绝均值在统计上相等的零假设，这意味着方差在统计上是显著的。换句话说，冠军队伍比所有其他队伍拥有更多的不平等赢分分布的事实，至少在 1991 年至 2017 年之间是有意义的。坦白说，这与传统观念相悖；人们一直认为最“平衡”和“全面”的队伍也是最成功的队伍。

这些结果最好用一对箱线图来可视化（见图 13.5）。但首先，我们调用基础 R 的rbind()函数，通过行将 ws_giniX 和 ws_giniY 数据集连接起来，从而在过程中创建了一个名为 ws_giniXY 的新对象。ws_giniXY 对象然后成为我们的数据源。我们的 x 轴变量是二元变量champ，我们的 y 轴变量是gini_index。scale_x_discrete()函数将 x 轴标签League Champions和All Other Teams添加到变量champ的1和0代替。

图 13.5 对冠军队伍和所有其他队伍之间的均值、中位数和基尼系数分布进行可视化的成对箱线图

ggplot()函数自动绘制水平线来表示中位数；stat_summary()函数添加轻点来表示均值。

以下是我们数据处理和数据处理代码：

ws_giniXY <- rbind(ws_giniX, ws_giniY)
ggplot(ws_giniXY, aes(x = champ, y = gini_index)) +
  geom_boxplot() +
  labs(title = 
         "Comparison of Gini Coefficients based on Season-End Disposition",
       x = "", 
       y = "Gini Coefficients", subtitle = "1991-2017") +
  geom_boxplot(color = "darkorange4", fill = "darkorange1") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(plot.title = element_text(face = "bold")) +
  scale_x_discrete(breaks = c("1", "0"),
                   labels = c("League Champions", "All Other Teams")) 

在显示一个总体均值与另一个总体均值之间的差异方面，并没有什么特别值得注意的；然而，我们的箱线图显示了总体中位数以及分布之间的差异，其中一个的分散程度明显小于另一个。

当 t 检验告诉我们两个均值之间的方差是否等于零或非零，从而确定我们是否应该拒绝零假设时，效应大小测试告诉我们两个分布之间的标准化差异有多大或有多小。我们将在下一节转向效应大小测试。其中一些测试直到现在才被介绍。

13.8.3 效应大小测试

最流行或最常见的效应大小测试是 Cohen 的 d，它计算两个均值之间的差异，并将其除以相同两个总体之间的平均标准差。我们在之前章节中已经执行了 Cohen 的 d 测试，其中我们也运行了 t 检验。

接下来，我们调用effsize包中的cohen.d()函数，传递与最初分配给我们的 t 检验相同的参数对，并得到一个 d 估计值，该估计值量化了一个均值相对于另一个均值是大于还是小于多少个标准差。cohen.d()函数将这个 d 估计值转换为一个定性效应大小评级，等于可忽略、小、中或大：

cohen.d(ws_giniX$gini_index, ws_giniY$gini_index)
## 
## Cohen's d
## 
## d estimate: -0.3165796 (small)
## 95 percent confidence interval:
##       lower       upper 
## -0.70133815  0.06817886

根据我们的 Cohen’s d 检验，变量gini_index在 ws_giniX 与 ws_giniY 中的效应量等于-0.32，这表示效应量较小。Cohen’s d 的估计值将根据我们调用cohen.d()函数时参数的顺序是正还是负。在这里，它是负的，因为 ws_giniX 中的gini_index平均值小于 ws_giniY 中的gini_index平均值，而 Cohen’s d 是从后者减去前者。

将分子视为等于效应量的均值差异，这反过来等于信号，将分母视为平均（合并）标准差，这等于噪声。从某种意义上说，Cohen’s d 返回一个信号与噪声的比率，其中系数或 d 估计值越远离 0，效应量就越大。

接下来，我们将从effectsize包中运行 Cohen’s d 测试，以及该包中的另外两个效应量测试，Hedges’ g 和 Glass’s delta，并比较和对比结果。但首先，这里有一些关于效应量测试的附加背景信息：

• 再次强调，Cohen’s d 通过计算两个均值之间的差异，然后除以两个总体之间的合并标准差来返回效应量。因此，Cohen’s d 不考虑记录数，这就是我们之前说 Cohen’s d 是补充 t 检验的适当统计检验，而不是相同检验的替代品的原因。毕竟，当我们只有 50 条记录来评估时，结果更有可能是由于偶然性，而当我们有 5,000 条记录时，Cohen’s d 效应量测试是不会识别出这一点的。

• 提及 Cohen’s d 忽略总体大小或记录数的另一个原因是，当总体大小较小或两个总体大小不同时，Cohen’s d 可能向其分母提供一个膨胀的标准化均值差异估计。为了解决这个问题，Hedges’ g 被引入作为对 Cohen’s d 的调整。Hedges’ g 通过在分母中包含一个校正因子来考虑小记录数的潜在偏差，从而提供对效应量的更准确估计。当记录数少于 20 条时，它是一个合适的替代品；否则，Hedges’ g 的工作方式与 Cohen’s d 相同；例如，如果 Hedges’ g 也返回一个效应量等于-0.32，我们将评估该估计为小效应。

• Glass’s delta 将两组均值之差除以传递给glass_delta()函数的第二个组的标准差，而不是两组之间的合并或平均标准差。这意味着如果两个标准差不同，我们应该预期得到不同的结果。我们仍然会得到一个介于-1 和+1 之间的效应量，这将被类似于 Cohen’s d 或 Hedges’ g 的方式进行评估。

• 可能不用说，但 Hedges 的 g 和 Glass 的 delta 都不应该取代 t-test；就像 Cohen 的 d 一样，它们都是 t-test 的补充。

话虽如此，我们接下来依次调用cohens_d``(), hedges_g``(), 和 glass_ delta()函数：

cohens_d(ws_giniX$gini_index, ws_giniY$gini_index)
## Cohen's d |        95% CI
## -------------------------
## -0.32     | [-0.70, 0.07]
## 
## - Estimated using pooled SD.
hedges_g(ws_giniX$gini_index, ws_giniY$gini_index)
## Hedges' g |        95% CI
## -------------------------
## -0.32     | [-0.70, 0.07]
## 
## - Estimated using pooled SD.
glass_delta(ws_giniX$gini_index, ws_giniY$gini_index)
## Glass' delta |         95% CI
## -----------------------------
## -0.51        | [-0.93, -0.09]

我们的第一点，也许是最明显的收获是，Cohen 的 d 测试返回的结果与我们的第一个 Cohen 的 d 测试结果相同——正如它应该的那样。

我们的第二个收获是，Hedges 的 g 的结果与 Cohen 的 d 的结果相匹配。这并不令人惊讶，因为 Hedges 的 g 效应量计算方法与 Cohen 的 d 相似，即总体均值之差除以平均或合并的标准差——只不过 Hedges 的 g 通过在分母中考虑计数来添加一个“校正”。因此，当总体大小小于 20 时，通常推荐使用 Hedges 的 g 而不是 Cohen 的 d。当两者都大于 20（如这里所示）时，Hedges 的 g 通常返回与 Cohen 的 d 相同的结果。

我们的第三个，也许是最重要的收获是，Glass 的 delta 效应量方法返回的结果与我们的 Cohen 的 d 和 Hedges 的 g 测试非常不同。仅基于 Glass 的 delta 效应量估计，我们就会得出结论说变量gini_index在 ws_giniX 和 ws_giniY 之间的差异是中等，而不是小，因此比 Cohen 的 d 和 Hedges 的 g 测试所暗示的更为显著。

我们被告知，当两组数据之间的标准差显著不同时，应该接受 Glass 的 delta 估计而不是 Cohen 的 d 和 Hedges 的 g。基础 R 的sd()函数返回标准差；在这里，我们在sd()函数前面加上round()函数，以便返回的标准差包括小数点后两位，而不是默认的七位：

round(sd(ws_giniX$gini_index), digits = 2)
## [1] 0.07
round(sd(ws_giniY$gini_index), digits = 2)
## [1] 0.04

标准差等于方差的平方根，因此我们也可以通过调用基础 R 的sqrt``()和var()函数来计算标准差：

round(sqrt(var(ws_giniX$gini_index)), digits = 2)
## [1] 0.07
round(sqrt(var(ws_giniY$gini_index)), digits = 2)
## [1] 0.04

我们接着调用基础 R 中的var.test()函数来运行所谓的 F-test。F-test 计算 F 统计量，即两个方差的比率，并返回一个 p 值。p 值应该像其他统计测试的 p 值一样进行评估：

var.test(ws_giniX$gini_index, ws_giniY$gini_index)
## 
##  F test to compare two variances
## 
## data:  ws_giniX$gini_index and ws_giniY$gini_index
## F = 2.6659, num df = 758, denom df = 26, p-value = 0.003528
## alternative hypothesis: true ratio of variances is not equal to 1
## 95 percent confidence interval:
##  1.410118 4.349496
## sample estimates:
## ratio of variances 
##           2.665942

因为 p 值本质上等于零，我们应该拒绝零假设，并得出结论说方差，因此标准差，在统计上是不同的。因此，我们应该接受 Glass 的 delta 效应量结果而不是 Cohen 的 d 和 Hedges 的 g 结果，并得出结论说效应量是中等而不是小。

或者我们应该这样做吗？虽然 Cohen 的 d 和 Hedges 的 g 平均或合并了两组数据的标准差，但 Glass 的 delta 只将第二个参数的标准差作为分母。那么，我们重新运行我们的效应量测试，这次反转参数的顺序：

cohens_d(ws_giniY$gini_index, ws_giniX$gini_index)
## Cohen's d |        95% CI
## -------------------------
## 0.32      | [-0.07, 0.70]
## 
## - Estimated using pooled SD.
hedges_g(ws_giniY$gini_index, ws_giniX$gini_index)
## Hedges' g |        95% CI
## -------------------------
## 0.32      | [-0.07, 0.70]
## 
## - Estimated using pooled SD.
glass_delta(ws_giniY$gini_index, ws_giniX$gini_index)
## Glass' delta |       95% CI
## ---------------------------
## 0.31         | [0.07, 0.56]

这次，我们在所有三个效应量测试中都得到了相同的结果。因此，我们可以自信地得出结论，变量gini_index在 ws_giniX 和 ws_giniY 数据集之间的效应量是小的，这当然比可以忽略不计更为重要，但也不如中等重要。

在下一节中，我们将重复这些相同的测试，并比较胜败球队的胜率之间的基尼系数。

13.9 胜率不平等以及胜负情况

没有必要进行进一步的数据整理，所以我们将直接进行另一个 t 检验。在这里，我们将测试确定胜率基尼系数在常规赛胜率中是否重要。

13.9.1 t 检验

我们首先将 ws_gini_records 数据集传递给dplyr group_by()和summarize()函数，其中summarize()计算平均基尼系数，四舍五入到小数点后两位，而group_by()根据胜率分离结果。因为我们已经在group_by()函数的参数中包含了一个逻辑运算符，所以当结果传递给一个名为 ws_gini_summary3 的 tibble 时，因此结果将在TRUE和FALSE之间分割：

ws_gini_records %>%
  group_by(pct >= 0.50) %>%
  summarize(mean = round(mean(gini_index), digits = 2)) -> ws_gini_summary3
print(ws_gini_summary3)
## # A tibble: 2 × 2
##   `pct >= 0.5`  mean
##   <lgl>        <dbl>
## 1 FALSE         0.48
## 2 TRUE          0.5

胜利球队的平均基尼系数高于输球球队，因此胜率分布更不平等，至少在 1991 年至 2017 赛季之间是这样的。差异相对较小，但考虑到记录数量，可能具有统计学意义。我们将运行 t 检验以确定这一点。

因此，我们建立了另外两个数据集：ws_giniA，它是 ws_gini_records 子集，其中变量pct等于或大于0.50，以及 ws_giniB，它是 ws_gini_records 子集，其中变量pct小于0.50。我们的 t 检验比较了 ws_giniA（1991 年至 2017 年间至少赢得一半常规赛比赛的球队子集）和 ws_giniB（常规赛比赛中赢得少于一半比赛的球队子集）之间的gini_index平均值：

ws_gini_records %>%
  filter(pct >= 0.50) -> ws_giniA
ws_gini_records %>%
  filter(pct < 0.50) -> ws_giniB

t.test(ws_giniA$gini_index, ws_giniB$gini_index)
## 
##  Welch Two Sample t-test
## 
## data:  ws_giniA$gini_index and ws_giniB$gini_index
## t = 3.5935, df = 641.1, p-value = 0.0003513
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.008383264 0.028584666
## sample estimates:
## mean of x mean of y 
##  0.500000  0.481516

p 值基本上等于 0，因此，我们再次应该拒绝零假设，并得出结论，基尼系数的方差因此具有统计学意义。

然后，我们通过一对ggplot2箱形图来可视化我们的结果（见图 13.6）：

ws_giniAB <- rbind(ws_giniA, ws_giniB)
mutate(ws_giniAB, win_pct = ifelse(pct >= 0.50, "y", "n")) -> ws_giniAB
ggplot(ws_giniAB, aes(x = win_pct, y = gini_index)) + 
  geom_boxplot() +
  labs(title = 
         "Comparison of Gini Coefficients based on Winning Percentage",
       subtitle = "1991-2017",
       x = "", 
       y = "Gini Coefficients") +
  geom_boxplot(color = "darkorange4", fill = "darkorange1") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "white", fill = "white") + 
  theme(plot.title = element_text(face = "bold")) +
  scale_x_discrete(breaks = c("y", "n"),
                   labels = c("Winning Teams", "Losing Teams")) 

图 13.6 显示胜败球队之间均值、中位数和基尼系数分布的成对箱形图

接下来，我们将运行一系列效应量测试。

13.9.2 效应量测试

在我们接下来的代码块中，我们调用来自effectsize包的cohens_d()、hedges_g()和glass_delta()函数：

cohens_d(ws_giniA$gini_index, ws_giniB$gini_index)
## Cohen's d |       95% CI
## ------------------------
## 0.27      | [0.12, 0.41]
## 
## - Estimated using pooled SD.
hedges_g(ws_giniA$gini_index, ws_giniB$gini_index)
## Hedges' g |       95% CI
## ------------------------
## 0.27      | [0.12, 0.41]
## 
## - Estimated using pooled SD.
glass_delta(ws_giniA$gini_index, ws_giniB$gini_index)
## Glass' delta |       95% CI
## ---------------------------
## 0.24         | [0.11, 0.37]

Cohen 的 d 和 Hedges 的 g 估计值彼此匹配，但 Glass 的 delta 估计值略有不同。无论如何，这些结果表明，在这种情况下，效应量是小的。

最后，我们将创建与第十二章中相同的胜率区间，然后绘制每个区间的基尼系数。我们的目的是确定常规赛胜率如何随着球员生产力的不平等增加而变化趋势。

13.10 基尼系数区间与胜率对比

我们的第一步是将 ws_gini_records 数据集传递给 dplyr mutate() 和 case_when() 函数，以创建一个名为 ws_gini_band 的分类变量，该变量是从数值变量 gini_index 派生出来的。例如，当变量 gini_index 等于或大于 0.50 时，派生变量 ws_gini_band 将等于 >0.50；当 gini_index 大于或等于 0.45 且小于 0.50 时，派生变量 ws_gini_band 则等于 >0.45，依此类推。

我们随后调用 as.factor() 函数将 ws_gini_band 转换为因子变量。head() 函数返回前三个观测值。

ws_gini_records %>%
  mutate(ws_gini_band = 
           case_when(gini_index >= .50 ~ ">0.50",
                     gini_index >= .45 & gini_index < .50 ~ ">0.45",
                     gini_index >= .40 & gini_index < .45 ~ ">0.40",
                     gini_index >= .35 & gini_index < .40 ~ ">0.35",
                     gini_index >= .30 & gini_index < .35 ~ ">0.30",
                     gini_index >= .25 & gini_index < .30 ~ ">0.25",
                     gini_index < .25 ~ "<0.25")) -> ws_gini_records

ws_gini_records$ws_gini_band <- as.factor(ws_gini_records$ws_gini_band)
head(ws_gini_records, n = 3)
## # A tibble: 3 × 8
## # Groups:   team, season_end [3]
##   season_end team              gini_index  wins losses   pct 
##   <fct>      <fct>                  <dbl> <dbl>  <dbl> <dbl> 
## 1 1991       Atlanta Hawks           0.54    43     39  0.52 
## 2 1991       Boston Celtics          0.52    56     26  0.68 
## 3 1991       Charlotte Hornets       0.39    26     56  0.32 
##  champ  ws_gini_band
##  <fct>  <fct>       
## 1 0     >0.50       
## 2 0     >0.50       
## 3 0     >0.35  

然后，我们将 ws_gini_records 传递给 dplyr group_by() 和 summarize() 函数，其中 summarize() 函数计算变量 pct 的平均值，保留小数点后两位，而 group_by() 函数则根据变量 ws_gini_band 的每个级别或因子来分隔结果。结果被转换为名为 gini_summary4 的 tibble。

ws_gini_records %>%
  group_by(ws_gini_band) %>%
  summarize(mean_pct = round(mean(pct), digits = 2)) -> ws_gini_summary4
print(ws_gini_summary4)
## # A tibble: 6 × 2
##   ws_gini_band mean_pct
##   <fct>           <dbl>
## 1 >0.25            0.22
## 2 >0.30            0.46
## 3 >0.35            0.43
## 4 >0.40            0.47
## 5 >0.45            0.52
## 6 >0.50            0.59

注意，当派生变量 ws_gini_band 等于 <0.25 时，没有返回任何结果。

这是我们使用 gini_summary4 作为数据源并绘制变量 ws_gini_band 沿 x 轴和变量 mean_pct 沿 y 轴的 ggplot2 条形图（见图 13.7）：

ggplot(ws_gini_summary4, aes(x = ws_gini_band, y = mean_pct)) + 
  geom_bar(stat = "identity", width = .6, fill = "steelblue1") + 
  labs(title = "Gini Coefficients and Winning Percentages",
       subtitle = "1991-2017", 
       x = "Gini Coefficient Bands", 
       y = "Average Regular Season Winning Percentage") + 
  ylim(0, 0.7) +
  geom_text(aes(x = ws_gini_band, y = mean_pct, 
                label = mean_pct, vjust = -0.3, fontface = "bold")) +
  theme(plot.title = element_text(face = "bold")) 

图 13.7 一条条形图显示，更高的基尼系数——即更不平等的赢分分布——主要与更高的常规赛胜率相一致。

我们的条形图显示，1991 年至 2017 年间的 NBA 球队，随着基尼系数区间的每个连续增加，常规赛胜率主要呈递增到显著增加的趋势——这些区间代表了球员生产力的不平等。我们有一个异常值，基尼系数大于 0.35 且小于 0.40，这是由于相对较低的记录计数。

因此，我们已经证明，至少在 1991 年至 2017 年间，最成功的 NBA 球队并不是最“平衡”和“全面”的球队。事实上，恰恰相反。换句话说，我们两次拒绝了关于赢分中的基尼系数对结果没有影响的零假设，首先是在联赛冠军方面，然后是在常规赛胜率方面。换句话说，我们再次挑战并反驳了传统智慧。在第十四章中，我们将挑战“防守赢得冠军”的观点。

同时，我们希望我们保持了承诺，尽管再次（也是最后一次）与基尼系数和洛伦兹曲线一起工作，但仍有足够的新的统计、数据可视化和编程材料来保持你的兴趣。例如，我们了解到除了 Cohen 的 d 值之外，还有其他效应量测试可以补充 t 检验；我们展示了如何运行这些测试，并讨论了在什么情况下这些测试可能最适合。我们进行了第一次 F 检验，并回顾了何时以及如何从你的统计测试工具箱中提取这样的测试。我们还展示了如何创建for循环以避免编写可重复的代码块，然后如何编写自己的函数，如果 R 已经有了你需要的功能，那么就不需要这样做。虽然这本身不是统计学的，但如果你想将 R 技能提升到最高水平，你需要熟悉for循环和用户定义的函数。

摘要

• 统计分散性，尤其是基尼系数，是理解的重要概念，因为它们有众多关键应用。城市层面的收入不平等与学校表现之间是否存在关联，这应该纳入资金和资源配置的考量？高收入不平等是否与传染病的暴露相关，如果是这样，基尼系数是否应该驱动预防策略？从账单角度来看，是否存在某些医疗程序比其他程序具有更高的基尼系数，如果是这样，是否需要额外的法规？基尼系数在证券回报中是否应该触发风险和收益的计算并影响投资决策？

• 此外，我们展示了for循环只是 R 让我们以无重复的方式执行可重复任务的一种方式，从而从开发角度减轻单调性，从支持角度减轻维护性。对于任何严肃的 R 程序员来说，这里绝对有巨大的投资回报。

• 我们还展示了如何创建用户定义的函数。尽管 R 似乎为几乎所有操作都提供了多个函数，但我们仍然有能力在需要时在 R 中编写自己的函数。

• 虽然效应量测试应该仅补充 t 检验（或我们可能会拒绝或未能拒绝零假设的其他类似测试，例如独立性卡方检验），但它们的意义和结果实际上可能更符合你听众中的外行人的理解。

• 本章中展示的效应量测试（不考虑第九章中的 Cramer’s V 测试），Cohen’s d 是最常见且最稳健的。在大多数情况下，Hedges’ g 和 Cohen’s d 会返回相似的结果；然而，当你只处理少量记录时，你可能想要运行一个 Hedges’ g 测试。Glass’s delta 测试只有在你想控制两个标准差中的哪一个应该成为你的效应量分母，而不是两个组中两个标准差的平均值时才有意义。

• 在联赛中，关于胜利份额分布的 Gini 系数最近已经从 20 世纪 90 年代初的水平下降。

• 尽管如此，不平等的胜利份额分布主要与夺冠球队和常规赛胜场数多于败场数的球队相关。相反，不那么不平等的胜利份额分布（它们并不真正相等）主要与输球球队相关。这些结果得到了我们的 t 检验特别是效应量测试的支持。这些结果与第十二章中的结果相似，表明薪资和生产力是良好匹配的。

14 中级和高级建模

本章涵盖

• 拟合和评估方差分析和逻辑回归模型

• 计算概率、优势比和对数优势

• 计算和绘制敏感性和特异性

• 运行相关测试

• 创建新的和改进的箱线图

“防守赢得冠军”这一理念可能源自传奇大学橄榄球教练保罗·“熊”布莱恩特，他在 20 世纪 60 年代和 70 年代带领阿拉巴马红潮队赢得了六次全国冠军。同样的理念随后扩展到篮球领域，尤其是 NBA。尽管 NBA 球队大约一半的时间和精力用于进攻，另一半用于防守，但防守比进攻更重要的观点占据了主导地位，并成为体育界传统智慧的一部分。

我们在这里的目的就是要反复测试这样一个观点：在 NBA 中，防守比进攻更能影响常规赛的胜利和季后赛的出场。我们将计算相关系数；运行相关测试；展示如何拟合和评估方差分析（ANOVA）模型，这是一种用于分析三个或更多组均值差异的统计模型，并确定这些差异的显著性；以及展示如何拟合和评估逻辑回归，这是解决分类问题最流行的方法——同时比较和对比防守与进攻的影响。

我们有多个包需要加载，包括许多我们尚未使用的包。我们将从这里开始。

14.1 加载包

如同往常，我们将使用内置和包装函数的组合来实现我们的目标；毫无疑问，你现在应该已经熟悉了tidyverse和patchwork包，但以下是我们将在本章中需要的其他包：

• 模型输出的图形展示——来自 ANOVA 的诊断图和来自逻辑回归的一对受试者工作特征（ROC）曲线——将使用基础 R 功能创建。其余的图形将使用ggplot2包创建，它是tidyverse的一部分。此外，我们将通过调用ggpubr包中的ggpaired()函数来扩展ggplot2，以创建与之前的箱线图非常不同的成对箱线图。你可能还记得，我们在第七章中加载了ggpubr包，并从中调用了stat_compare_means()函数，以自动将 p 值添加到成对的ggplot2箱线图中。

• 我们将从基础 R 的glm()函数拟合逻辑回归。然后我们将调用pscl、SciViews、questionr、caret和pROC包中的函数来返回模型结果并提供其他见解。

我们不会通过连续调用基础 R 的library()函数来逐步加载这些包，而是创建一个名为packages的向量，然后将其传递给基础 R 的lapply()函数（你可能还记得我们第一次在第三章中调用lapply()函数）：

packages <- c("tidyverse", "patchwork", "ggpubr", "pscl", "SciViews", 
              "questionr", "caret", "pROC")

lapply(packages, library, character.only = TRUE)

我们将导入并处理我们的数据，从第十章中首次介绍的工作薪资数据集开始。记住，薪资数据集包含的不仅仅是 2000 年至 2017 年间每个 NBA 球队球员薪资的总和；它还包括常规赛胜利和赛季结束情况。

14.2 导入和数据处理

薪资数据集是一个保存在我们默认工作目录的 .csv 文件；文件包含以下内容：

• 2000 年至 2017 年间每个 NBA 球队的实付和通胀调整后的薪资。实付薪资是从波士顿凯尔特人球迷网站获得的，而通胀调整后的薪资是使用 www.usinflationcalculator.com 的工具计算的。

• 在这些相同赛季间每个球队的常规赛胜利总数和季后赛结果。这些数据是从 www.basketball-reference.com 爬取的。

我们调用 read_csv() 函数从 readr 包中导入薪资数据集：

salaries <- read_csv("salaries.csv")

薪资数据集包含比我们所需更多的数据，同时也不够用；此外，它甚至没有以最适合我们需求的方式格式化。因此，在我们能够运行任何统计测试和拟合任何模型之前，我们需要运行一系列数据处理操作——数据子集、数据集重塑、创建派生变量以及将薪资与其他数据集合并。

14.2.1 数据子集和重塑

我们首先调用 dplyr 包中的 select() 函数，对薪资进行子集化，创建两个新的数据集，分别命名为 first_salaries 和 second_salaries：

• 第一份薪资数据集包含变量 Team 以及变量 w2017 到 w2008。Team 是一个包含每个 NBA 球队全名的字符串，而 w2017 到 w2008 是包含它们常规赛胜利总数的数值变量。

• 第二份薪资数据集包含变量 Team 以及变量 pc2017 到 pc2008。目前，pc2017 到 pc2008 是数值变量，但它们的单元格实际上填充了三种季节结束或季后赛结果因素之一。

salaries %>%
  select(Team, w2017:w2008) -> first_salaries

salaries %>%
  select(Team, pc2017:pc2008) -> second_salaries

接下来，我们调用 tidyr pivot_longer() 函数，将 first_salaries 和 second_salaries 数据集从宽格式转换为长格式。

在以下代码的第一个代码块中，我们将 first_salaries 传递给 pivot_longer() 函数，其中 w2017 到 w2008 变量被转换成名为 year 的新变量中的因素，并且它们的旧值汇总到另一个名为 wins 的新变量中。结果被转换成名为 first_stats 的 tibble。

在第二个代码块中，second_salaries 数据集被传递给 pivot_longer() 函数，其中新的变量 season 和 playoffs 取代了 pc2017 到 pc2008。然后，这些结果被转换成另一个名为 second_stats 的 tibble。

first_salaries %>%
  pivot_longer(col = c(w2017:w2008),
               names_to = "year",
               values_to = "wins") -> first_stats

second_salaries %>%
  pivot_longer(col = c(pc2017:pc2008),
               names_to = "season",
               values_to = "playoffs") -> second_stats

基础 R 的dim()函数返回first_stats的行和列数；它包含 300 行，即每个独特的队伍和年份组合一行，以及三列。head()和tail()函数，同样来自基础 R，分别返回first_stats中的前三个和最后三个观测值。默认情况下，R 返回六条记录，但你可以告诉 R 返回你想要的任何数量的记录。在这里，我们指示 R 每次只返回三条记录：

dim(first_stats)
## [1] 300   3

head(first_stats, n = 3)
## # A tibble: 3 × 3
##   Team           year  wins
##   <chr>         <chr> <int>
## 1 Atlanta Hawks w2017    43
## 2 Atlanta Hawks w2016    48
## 3 Atlanta Hawks w2015    60

tail(first_stats, n = 3)
## # A tibble: 3 × 3
##   Team                year  wins
##   <chr>              <chr> <int>
## 1 Washington Wizards w2010    26
## 2 Washington Wizards w2009    19
## 3 Washington Wizards w2008    43

我们接着再次运行这三个相同的命令，但在过程中用第二个 _stats 替换了第一个 _stats：

dim(second_stats)
## [1] 300   3

head(second_stats, n = 3)
## # A tibble: 3 × 3
##   Team          season  playoffs
##   <chr>         <chr>      <int>
## 1 Atlanta Hawks X2017pc       10
## 2 Atlanta Hawks X2016pc       10
## 3 Atlanta Hawks X2015pc       10

tail(second_stats, n = 3)
## # A tibble: 3 × 3
##   Team               season  playoffs
##   <chr>              <chr>      <int>
## 1 Washington Wizards X2010pc        0
## 2 Washington Wizards X2009pc        0
## 3 Washington Wizards X2008pc       10

因此，我们现在有两个比前辈更长的有效数据集；每个对象中的每条记录现在都包含一个独特的队伍和赛季组合，并辅以常规赛胜利（在first_stats的情况下）或赛季结束结果（在second_stats的情况下）。这些是从中可以创建派生变量、与其他数据集合并，然后最终用于统计测试和统计模型的对象。

14.2.2 提取子字符串以创建新变量

在我们即将到来的代码块中，我们同时调用dplyr mutate()函数和stringr包中的str_sub()函数，后者是tidyverse的一部分，将变量year中的所有元素转换为更易读和实用的格式，例如，w2017变为简单的2017。如果只是为了这个原因，我们的图表如果只包含年份而不是前面跟着一个单字节字符的年份，那么它们就会更有意义，这个字符曾经表示常规赛胜利，但现在已经重新分配了用途。

调用mutate()函数创建一个名为season的新变量，该变量是从字符字符串变量year派生出来的。然后，我们调用str_sub()函数，使我们的新变量成为一个字符向量，同时也是year的子字符串。str_sub()函数接受三个参数：第一个是需要操作的字符字符串的名称；第二个和第三个参数是需要从右到左提取的起始和结束位置。我们提取的是第一个到第四个字符，因此-4和-1是我们的下一个两个参数。然后我们调用select()函数，对除了year之外的所有变量对first_stats数据集进行子集化。

最后，我们调用基础 R 的as.factor()函数将我们的新变量从字符字符串转换为因子变量。head()函数返回新改进的first_stats数据集中的前三条记录：

first_stats %>%
  mutate(season = str_sub(year, -4, -1)) -> first_stats

first_stats %>%
  select(-year) -> first_stats

first_stats$season <- as.factor(first_stats$season)

head(first_stats, n = 3)
## # A tibble: 3 × 3
##   Team           wins season
##   <chr>         <int> <fct> 
## 1 Atlanta Hawks    43 2017  
## 2 Atlanta Hawks    48 2016  
## 3 Atlanta Hawks    60 2015

在所有这些之后，我们仅仅将变量year（例如，w2017、w2016等，是一个字符字符串）替换为变量season（例如，2017、2016等，是一个因子变量）。

14.2.3 合并数据

对于second_stats，我们再次调用dplyr select()函数，将其缩减为只包含playoffs变量：

second_stats %>%
  select(playoffs) -> second_stats

现在我们可以通过调用基础 R 的cbind()函数将 first_stats 和 second_stats 连接起来，并通过调用cbind()函数创建一个新的数据集。由于 first_stats 具有 300 × 3 的维度，而 second_stats 现在具有 300 × 1 的维度，我们的新数据集 stats 包含 300 行和四列。然后我们调用head()函数，以便 R 返回前三条记录：

stats <- cbind(first_stats, second_stats)
head(stats, n = 3)
##            Team wins season playoffs
## 1 Atlanta Hawks   43   2017       10
## 2 Atlanta Hawks   48   2016       10
## 3 Atlanta Hawks   60   2015       10

现在我们有一个包含每个独特球队和赛季组合常规赛胜利和赛季末结果的单一数据集。

14.2.4 导入和整理额外的数据集

我们有 10 个额外的.csv 文件需要导入。每个.csv 文件包含一个赛季的团队级统计数据，例如胜负、每场比赛得分以及得分与失分的平均差。数据是从 NBA 官方网站抓取并复制到 Microsoft Excel 中的；然后文件以.csv 扩展名保存，并随后存储在我们的默认工作目录中。因此我们调用read_csv()函数 10 次来导入这 10 个文件：

nba2017 <- read_csv("nba2017.csv")
nba2016 <- read_csv("nba2016.csv")
nba2015 <- read_csv("nba2015.csv")
nba2014 <- read_csv("nba2014.csv")
nba2013 <- read_csv("nba2013.csv")
nba2012 <- read_csv("nba2012.csv")
nba2011 <- read_csv("nba2011.csv")
nba2010 <- read_csv("nba2010.csv")
nba2009 <- read_csv("nba2009.csv")
nba2008 <- read_csv("nba2008.csv")

这些文件中的每一个都包含 30 行，即每个球队一行，以及 27 列的数据。然后我们调用基础 R 的rbind()函数将这些 10 个数据集合并成一个名为 nba 的数据集：

nba <- rbind(nba2017, nba2016, nba2015, nba2014, nba2013, nba2012, 
             nba2011, nba2010, nba2009, nba2008)

调用dim()函数后返回行和列计数。这证实了（1）虽然我们之前每个数据集都有 30 条记录，但我们现在有一个包含 300 行（30 条记录 × 10 个数据集）的数据集；并且（2）我们仍然有 27 列，或变量：

dim(nba)
## [1] 300  27

然后我们调用mutate()函数来创建一个新的名为season的 nba 变量。rep()和c()函数从顶部开始填充我们的新变量，首先是 30 个 2017 年的实例，然后是 30 个 2016 年的实例，接着是 30 个 2015 年的实例，以此类推，直到 2008 年。随后的调用as.factor()函数将season转换为因子变量。

如前几章所述，在调用其他数据处理函数之前验证不频繁操作的完整性总是一个好的做法。首先，我们调用head()和tail()函数来打印变量season中的前三个和最后三个值；我们应该得到三个 2017 年的实例，然后是三个 2008 年的实例。然后，我们调用基础 R 的summary()函数，其中season而不是整个 NBA 数据集作为参数传递。因为season是一个因子变量，R 将返回每个级别的行数。我们当然应该得到 30 行的 10 个计数：

nba %>%
  mutate(season = rep(c(2017:2008), each = 30)) -> nba
nba$season <- as.factor(nba$season)

head(nba$season, n = 3)
## [1] 2017 2017 2017
## Levels: 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017

tail(nba$season, n = 3)
## [1] 2008 2008 2008
## Levels: 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017

summary(nba$season)
## 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 
##   30   30   30   30   30   30   30   30   30   30

一切都检查无误，这意味着我们可以继续进行进一步的数据整理操作。

我们再次调用mutate()函数来创建一个名为O_PTS的派生变量，它表示每场比赛允许的平均得分。我们的数据集中有一个名为PTS的变量，表示每场比赛的平均得分，还有一个名为PTS_DIFF的变量，表示得分和允许得分的差值。因此O_PTS等于PTS和PTS_DIFF之间的差值：

nba %>%
  mutate(O_PTS = PTS - PTS_DIFF) -> nba

然后我们调用select()函数对变量Team、PTS、PTS_DIFF、season和O_PTS进行子集化 nba：

nba %>%
  select(Team, PTS, PTS_DIFF, season, O_PTS) -> nba

调用dplyr glimpse()函数会返回 nba 数据集的降维视图以及数据的转置视图：

glimpse(nba)
## Rows: 300
## Columns: 5
## $ Team     <chr> "Golden State Warriors", "San Antonio Spurs", "Houst...
## $ PTS      <dbl> 115.9, 105.3, 115.3, 108.0, 110.3, 108.7, 106.9, 100...
## $ PTS_DIFF <dbl> 11.6, 7.2, 5.8, 2.6, 3.2, 4.3, 4.2, 3.9, 1.8, 0.8, -...
## $ season   <fct> 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017...
## $ O_PTS    <dbl> 104.3, 98.1, 109.5, 105.4, 107.1, 104.4, 102.7, 96.8...

因为 nba 中剩余的列不一定按照最合理的顺序排列，所以我们将演示在 R 中重新排列列的一种方法。我们之前已经调用过dplyr包中的select()函数来对数据集进行子集化；在这里，通过传递 nba 数据集中剩余的所有列，select()函数按照传递的顺序重新排列列。再次调用glimpse()函数返回结果：

nba %>%
  select(Team, season, PTS, O_PTS, PTS_DIFF) -> nba

glimpse(nba)
## Rows: 300
## Columns: 5
## $ Team     <chr> "Golden State Warriors", "San Antonio Spurs", "Houst...
## $ season   <fct> 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017...
## $ PTS      <dbl> 115.9, 105.3, 115.3, 108.0, 110.3, 108.7, 106.9, 100...
## $ O_PTS    <dbl> 104.3, 98.1, 109.5, 105.4, 107.1, 104.4, 102.7, 96.8...
## $ PTS_DIFF <dbl> 11.6, 7.2, 5.8, 2.6, 3.2, 4.3, 4.2, 3.9, 1.8, 0.8, -...

glimpse()函数总是从上到下返回完整的变量列表，否则这些变量从左到右排列。

14.2.5 再次进行数据连接

回到 stats 数据集，我们调用as.factor()函数将变量playoffs转换为因子变量。当球队未能晋级季后赛时，playoffs等于0；当球队晋级季后赛但随后被淘汰时，playoffs等于10；当球队赢得 NBA 冠军时，playoffs等于11：

stats$playoffs <- as.factor(stats$playoffs)

然后，我们调用dplyr left_join()函数，通过两个变量Team和season（它们在两个数据集中都有）来连接 nba 和 stats 数据集：

nba_stats <- left_join(stats, nba, by = c("Team", "season"))

因此，nba_stats 包含七个列，或者说 nba 和 stats 数据集之间每个唯一的列。

虽然这里使用了左连接，但以下列表中描述的任何连接操作都可以与 nba 和 stats 一起使用并产生相同的结果：

• 左连接或左外连接（如前述代码所示）将一个数据集中的每一行与另一个数据集中匹配的行合并。

• 右连接或右外连接做的是同样的事情，但数据集的顺序被交换了。

• 外连接或全外连接保留两个数据集中的每一行。

• 自然连接或内连接只保留两个数据集中匹配的行。

我们将通过依次调用dplyr right_join()、inner_join()和full_join函数，然后四次调用head()函数来返回每个操作的顶部三条记录：

nba_stats_right <- right_join(stats, nba, by = c("Team", "season"))
nba_stats_full <- inner_join(stats, nba, by = c("Team", "season"))
nba_stats_inner <- full_join(stats, nba, by = c("Team", "season"))

head(nba_stats, n = 3)
##            Team wins season playoffs   PTS O_PTS PTS_DIFF
## 1 Atlanta Hawks   43   2017       10 103.2 104.1     -0.9
## 2 Atlanta Hawks   48   2016       10 102.8  99.2      3.6
## 3 Atlanta Hawks   60   2015       10 102.5  97.1      5.4
head(nba_stats_right, n = 3)
##            Team wins season playoffs   PTS O_PTS PTS_DIFF
## 1 Atlanta Hawks   43   2017       10 103.2 104.1     -0.9
## 2 Atlanta Hawks   48   2016       10 102.8  99.2      3.6
## 3 Atlanta Hawks   60   2015       10 102.5  97.1      5.4
head(nba_stats_full, n = 3)
##            Team wins season playoffs   PTS O_PTS PTS_DIFF
## 1 Atlanta Hawks   43   2017       10 103.2 104.1     -0.9
## 2 Atlanta Hawks   48   2016       10 102.8  99.2      3.6
## 3 Atlanta Hawks   60   2015       10 102.5  97.1      5.4
head(nba_stats_inner, n = 3)
##            Team wins season playoffs   PTS O_PTS PTS_DIFF
## 1 Atlanta Hawks   43   2017       10 103.2 104.1     -0.9
## 2 Atlanta Hawks   48   2016       10 102.8  99.2      3.6
## 3 Atlanta Hawks   60   2015       10 102.5  97.1      5.4

如您所见，无论调用的是哪种连接操作，结果都是完全相同的。

14.2.6 创建标准化变量

最后，我们连续三次调用dplyr group_by()和mutate()函数，以标准化nba_stats数据集中的四个数值变量中的三个。再次强调，标准化是将变量转换为相同尺度的过程；当这些相同的变量还跨越几个年份——在我们的案例中，是 10 个 NBA 赛季，其中周期性规则变化和比赛风格的变化使得跨年度比较变得困难，甚至不切实际——标准化就变得很有意义。此外，通过标准化关键指标，我们可以获得从原始数据中无法获得的信息。从更实际的角度来看，标准化纠正了 2012 年常规赛的胜利总数，因为那年由于球员罢工，球队没有进行 82 场常规赛。

通过计算数据点的 z 分数来标准化变量，这些 z 分数等于数据点相对于总体平均值的正负标准差数。让我们以变量wins为例。通过调用mutate()函数，我们创建了一个名为z_wins的新变量，它是常规赛胜利的 z 分数。z 分数是通过从胜利的平均值中减去实际胜利数，然后除以这个差值来计算的。通过首先调用group_by()函数，我们指示 R 每年计算 z 分数。随后的round()函数调用从基础 R 中将我们的 z 分数减少到小数点后两位。

nba_stats %>%
  group_by(season) %>%
  mutate(z_wins = (wins - mean(wins)) / sd(wins)) -> nba_stats
  nba_stats$z_wins <- round(nba_stats$z_wins, digits = 2)

nba_stats %>%
  group_by(season) %>%
  mutate(z_pts = (PTS - mean(PTS)) / sd(PTS)) -> nba_stats
  nba_stats$z_pts <- round(nba_stats$z_pts, digits = 2)  

nba_stats %>%
  group_by(season) %>%
  mutate(z_o_pts = (O_PTS - mean(O_PTS)) / sd(O_PTS)) -> nba_stats
  nba_stats$z_o_pts <- round(nba_stats$z_o_pts, digits = 2) 

head()函数返回前三条记录：

head(nba_stats, n = 3)
## # A tibble: 3 × 10
## # Groups:   season [3]
##   Team           wins season playoffs   PTS O_PTS PTS_DIFF 
##   <chr>         <dbl> <fct>  <fct>    <dbl> <dbl>    <dbl>  
## 1 Atlanta Hawks    43 2017   10        103\. 104\.      -0.9   
## 2 Atlanta Hawks    48 2016   10        103\.  99.2      3.6   
## 3 Atlanta Hawks    60 2015   10        102\.  97.1      5.4   
## z_wins z_pts z_o_pts
##  <dbl> <dbl>   <dbl>
## 1 0.18 -0.58   -0.37
## 2 0.5   0.04   -0.93
## 3 1.41  0.58   -0.97

现在，让我们以 2017 年的亚特兰大老鹰队为例。他们的 43 场常规赛胜利比 2017 年的平均值高出 0.18 个标准差，这在当年每个球队都进行了 82 场常规赛的情况下是有道理的。他们的每场比赛得分 103.2 分，比 2017 年的平均值低 0.58 个标准差，因此老鹰队在 2016-17 赛季以胜利结束，但每场比赛的得分低于联盟平均水平。但老鹰队是一支防守更好的球队；他们每场比赛允许得 104.1 分，比 2017 年的平均值低 0.37 个标准差。这意味着 2017 年的老鹰队每场比赛允许的得分几乎比他们自己得分多一个。

接下来，我们将创建一个ggplot2条形图和一个ggplot2直方图，以提供对我们数据的初步洞察。

14.3 探索数据

要创建条形图，我们首先需要总结我们的数据。因此，我们调用dplyr包中的group_by()和summarize()函数，计算nba_stats数据集中每个 10 个 NBA 赛季的数值变量PTS的平均值。我们的目的是显示数据集中每个 NBA 赛季每场比赛的平均得分，并发现任何趋势。结果四舍五入到小数点后两位，然后转换为名为first_tibble的 tibble：

nba_stats %>%
  group_by(season) %>%
  summarize(pts_avg = round(mean(PTS), digits = 2)) -> first_tibble
print(first_tibble)
## # A tibble: 10 × 2
##    season pts_avg
##    <fct>    <dbl>
##  1 2008      99.9
##  2 2009      99.9
##  3 2010     100\. 
##  4 2011      99.6
##  5 2012      96.3
##  6 2013      98.1
##  7 2014     101\. 
##  8 2015     100\. 
##  9 2016     103\. 
## 10 2017     106.

我们的ggplot2条形图以 first_tibble 作为数据源，并在 x 轴上绘制变量season，在 y 轴上绘制变量pts_avg（见图 14.1）。

图 14.1 2008 年至 2017 年间每个 NBA 赛季每场比赛和每支球队的平均得分

geom_bar()函数指示 R 创建一个条形图。默认情况下，R 将为每个 x 值的行计数进行计算和可视化；我们覆盖了这一点，并在过程中通过添加stat = "identity"参数告诉 R 将每个 x 值与我们的 y 轴变量绑定。否则，条形图的宽度是默认宽度的一半，并且用不同深度的钢蓝色着色和填充。

geom_text()函数将 y 值附加到条形图的顶部。由于这个添加，我们随后需要调用ylim()函数来扩展 y 轴的长度：

ggplot(first_tibble, aes(x = season, y = pts_avg)) +
  geom_bar(stat = "identity", width = .5, 
           color = "steelblue4", fill = "steelblue1") +
  labs(title = "Average Points per Game per Team by Season", 
       subtitle = "2008-17",
       x = "Season", 
       y = "Average Points per Game") +
  geom_text(aes(label = (pts_avg), vjust = -0.3, fontface = "bold")) +
  ylim(0, 110) +
  theme(plot.title = element_text(face = "bold"))

一方面，我们没有看到每场比赛得分在年与年之间的巨大变化——当然，这也必须等于每场比赛的失分。另一方面，然而，我们看到 2012 年的最低得分是 96.26，2017 年的最高得分是 105.59，这种差异是显著的。

接下来，我们绘制一个直方图来可视化整个 nba_stats 数据集中变量PTS的分布（见图 14.2）。因此，nba_stats 是我们的数据源，PTS是我们的 x 轴变量。

图 14.2 2008 年至 2017 年间每个 NBA 球队的每场比赛得分分布

我们的历史图将包含 15 个箱。箱的数量应该与你的数据中的记录数成比例。一个经验法则建议箱的数量应该大约等于记录数的平方根，不超过 20。我们在 nba_stats 数据集中有 300 个观测值；300 的平方根等于 17.3，所以按照这个规则，15 个箱似乎足够合适。

调用geom_line()函数两次指示 R 绘制两条垂直线，一条表示人口平均值的虚线，另一条表示人口中位数——ggplot2的线条默认为实线：

ggplot(nba_stats, aes(x = PTS)) +
  geom_histogram(fill = "steelblue1", color = "steelblue4", bins = 15) + 
    geom_vline(aes(xintercept = mean(PTS)),
             color = "black", linetype = "longdash", size = .8) +
    geom_vline(aes(xintercept = median(PTS)),
             color = "black", size = .8) +
  labs(title = "Distribution of Points Scored per Game per Team",
       subtitle = "2008-17",
       caption = "dashed line represents the mean
          solid line represents the median",
       x = "Average Points Scored per Game",
       y = "Frequency") +
  theme(plot.title = element_text(face = "bold"))

看起来变量PTS具有正态分布，或者说高斯分布。换句话说，分布关于平均值对称，数据中最频繁出现的值接近平均值，最不频繁出现的值离平均值最远。

但视觉检查并不总是可靠的。因此，我们接下来调用基础 R 中的shapiro.test()函数来运行 Shapiro-Wilk 测试，这可能是最常见的正态性测试。在 Shapiro-Wilk 测试的情况下，我们寻找的 p 值高于 0.05 以假设正态性：

shapiro.test(nba_stats$PTS)
## 
##  Shapiro-Wilk normality test
## 
## data:  nba_stats$PTS
## W = 0.99016, p-value = 0.04124

由于 p 值小于 0.05 的显著性阈值，我们应该假设来自 nba_stats 数据集的变量PTS的分布不是（相当）正态分布，尽管表面上看起来相反。这是我们进行测试时需要注意的事情，我们将在下一部分进行讨论。

14.4 相关性

我们首先计算并比较z_wins和z_o_pts与z_wins和z_pts之间的相关系数。因此，我们首先计算常规赛胜利和让分标准化的相关系数，然后计算胜利和得分的标准化版本之间的相同系数。如果让分在常规赛胜利方面比得分更重要，或者如果防守比进攻更重要，z_o_pts与z_wins的相关性应该比z_pts与z_wins的相关性更强。然后，我们将运行一对相关系数测试，使用相同的变量组合，并基于 p 值的比较做出类似的假设。

14.4.1 计算和绘制相关系数

在 R 中计算相关系数足够简单；我们只需从基础 R 调用cor()函数，并传递两个数值变量：

cor(nba_stats$z_wins, nba_stats$z_o_pts)
## [1] -0.5844698

cor(nba_stats$z_wins, nba_stats$z_pts)
## [1] 0.5282497

因此，让分与胜利的相关性（-0.58）确实比得分（0.53）更强，但这两个相关系数的差异是可以忽略不计的。实际上，它们几乎同样远离完全中性的状态，这根本不表明防守在物质上比进攻更重要，至少就 2008 年至 2017 年间的常规赛胜利而言。

相关系数可以通过相关图（通常称为散点图）很好地可视化。这些图在ggplot2中通过将数据源和两个数值变量作为参数传递给ggplot()函数，然后调用geom_point()函数来构建（见图 14.3）。

图 14.3 左侧可视化展示了让分与胜利的相关性；右侧可视化展示了得分与胜利的相关性。

geom_smooth()函数添加了一条线性回归线，并且默认情况下，在线上和线下添加了 95%的置信区间——我们通过向geom_smooth()添加参数se = FALSE来覆盖这些置信区间。xlim()函数确保两个图表的 x 轴相互匹配。我们两个相关系数图表中的第一个，p1，可视化展示了让分与胜利的相关性，而我们的第二个相关系数图表，p2，可视化展示了得分与胜利的相关性：

p1 <- ggplot(nba_stats, aes(x = z_o_pts, y = z_wins)) + 
  geom_point() +
  labs(title = " Points Allowed vs. Wins (2008-17)",
       subtitle = "correlation coefficient = -0.58",
       x = "Points Allowed (standardized)", y = "Wins (standardized)") + 
  geom_smooth(method = lm, se = FALSE) +
  xlim(-3.3, 3.3) +
  theme(plot.title = element_text(face = "bold"))

p2 <- ggplot(nba_stats, aes(x = z_pts, y = z_wins)) + 
  geom_point() +
  labs(title = "Points Scored vs. Wins (2008-17)",
       subtitle = "correlation coefficient = 0.53",
       x = "Points Scored (standardized)", y = "Wins (standardized)") + 
  geom_smooth(method = lm, se = FALSE) +
  xlim(-3.3, 3.3) +
  theme(plot.title = element_text(face = "bold"))

我们随后从patchwork包中调用plot_layout()函数，将 p1 和 p2 组合成一个单一的对象，这样两个图表就可以并排放置，便于比较（见图 14.3）：

p1 + p2 + plot_layout(ncol = 2)

这两个图表基本上是彼此的镜像。

让我们按赛季绘制O_PTS和wins以及PTS和wins之间的净相关系数。首先，我们需要创建 nba_stats 数据集的另一个汇总。因此，我们再次调用dplyr group_by()和summarize()函数，这两个函数一起计算了每个 NBA 赛季在 nba_stats 数据集中PTS和wins的相关系数与O_PTS和wins的相关系数之间的绝对差异——注意调用基础 R 的abs()函数。由于我们按赛季子集化这些结果，使用原始数据而不是它们的标准化等效值（例如，wins而不是z_wins）是完全可以接受的。

结果四舍五入到小数点后两位，然后转换为一个名为 second_tibble 的 tibble：

nba_stats %>%
  group_by(season) %>%
  summarize(cor_dif = round(cor(PTS, wins) - abs(cor(O_PTS, z_wins)), 
                            digits = 2)) -> second_tibble
print(second_tibble)
## # A tibble: 10 × 2
##    season cor_dif
##    <fct>    <dbl>
##  1 2008     -0.03
##  2 2009     -0.36
##  3 2010     -0.16
##  4 2011     -0.35
##  5 2012      0.08
##  6 2013      0.08
##  7 2014     -0.06
##  8 2015      0.23
##  9 2016      0.01
## 10 2017     -0.01

然后，我们使用第二个ggplot2柱状图可视化这些结果（见图 14.4）。再次调用geom_text()函数，在柱子“高度”之外添加标签，这些标签与我们的 y 轴变量cor_dif相关，这是我们刚刚创建并放入 second_tibble 中的。

图 14.4 得分与胜利以及得分允许与胜利之间的相关系数的年度差异

由于我们的柱状图包含正负结果组合，我们通过调用vjust()和hjust()函数来控制的标签对齐，需要一些额外的逻辑。因此，我们调用两次基础 R 的ifelse()函数来控制或自定义标签的对齐，这取决于变量cor_dif是否为非负数或负数。如果cor_dif等于或大于0，我们标签的垂直调整应等于-0.5，而水平调整应等于0.5；如果该条件不满足，垂直和水平调整应分别等于1.3和0.5。

为了将标签放入我们的柱状图中，我们需要调用ylim()函数，从而延长 y 轴的长度：

ggplot(second_tibble, aes(x = season, y = cor_dif)) +
  geom_bar(stat = "identity", width = .7, color = "gold4", 
           fill = "gold1") +
  labs(title = "Annual Differences in Absolute Correlations",
       subtitle = "2008-17",
       caption = "when negative, points allowed mattered more;
            when positive, points scored mattered more",
       x = "Season", 
       y = "Absolute Correlation Difference") +
  geom_text(aes(label = cor_dif, y = cor_dif, fontface = "bold",
               vjust = ifelse(cor_dif >= 0, -0.5, 1.3),
               hjust = ifelse(cor_dif >= 0, 0.5, 0.5))) +
  ylim(-.4, .4) +
  theme(plot.title = element_text(face = "bold"))

每个柱子代表PTS和wins以及O_PTS和wins之间的相关系数的绝对差异。以 2010 赛季为例——PTS和wins之间的相关系数减去O_PTS和wins之间的相关系数等于-0.16。换句话说，在 2010 年，O_PTS与wins的相关性比PTS更强，这表明当时的防守比进攻更重要。事实上，从 2008 年到 2011 年，每年允许的得分与常规赛胜利的相关性都更强，但在接下来的六个 NBA 赛季中，得分与胜利的相关性比允许的得分与胜利的相关性更强。

我们的条形图给出了得分与允许得分相对于常规赛胜利的相对重要性的年度视图；这是仅仅通过在整个数据系列中计算相关系数所无法获得的视角。我们的结果表明，最近，进攻实际上比防守更重要。但差异通常是可以忽略不计的；至少在 2012 年至 2017 年之间，我们没有看到像 2009 年和 2011 年那样的相关系数差异。

14.4.2 运行相关测试

即使相关系数等于除 0 以外的某个数字，它可能或可能不显著地不同于 0，至少在统计意义上是这样，这就是为什么相关测试能增加价值。与其它统计测试一样，相关测试返回一个 p 值，基于预定义的 5%显著性水平，我们可以拒绝或无法拒绝无相关性的零假设。我们的零假设是没有任何有意义的关系或相关性；如果返回的 p 值小于或等于 0.05，我们将拒绝这个假设；否则，我们将无法拒绝它。

因此，我们调用基础 R 的cor.test()函数两次来运行一对相关测试，第一次是z_wins和z_o_pts之间的相关测试，第二次是z_wins和z_pts之间的相关测试。我们的目的是比较和对比允许得分与得分以及常规赛胜利之间的结果。如果防守比进攻更重要，我们预计我们的第一次相关测试将返回比第二次相关测试更低的 p 值。

但首先，我们调用基础 R 的options()函数，并传递scipen = 999参数来禁用科学记数法：

options(scipen = 999)

cor.test(nba_stats$z_wins, nba_stats$z_o_pts)
## 
##  Pearson's product-moment correlation
## 
## data:  nba_stats$z_wins and nba_stats$z_o_pts
## t = -12.434, df = 298, p-value < 0.00000000000000022
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.6543987 -0.5046282
## sample estimates:
##        cor 
## -0.5844698

cor.test(nba_stats$z_wins, nba_stats$z_pts)
## 
##  Pearson's product-moment correlation
## 
## data:  nba_stats$z_wins and nba_stats$z_pts
## t = 10.74, df = 298, p-value < 0.00000000000000022
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.4414140 0.6052828
## sample estimates:
##       cor 
## 0.5282497

由于这两个测试的 p 值都小于 0.05 的显著性阈值，因此两个相关测试都是统计显著的；事实上，两个相关测试之间的 p 值完全相同，这表明允许得分与得分以及常规赛胜利之间没有实质性的差异。

基于这些结果——仅基于这些结果，因为我们还有额外的测试要执行——我们不能得出结论说允许得分比得分更重要，或者防守在常规赛胜利中比进攻更重要。接下来，我们将拟合一对单因素 ANOVA 模型。

14.5 方差分析模型

而 t 测试是一种统计测试，用于确定两个数据系列的平均值是否有显著差异，方差分析（ANOVA）是一种方法，用于确定三个或更多数据系列的平均值是否在统计上彼此不同。我们首先整理数据，进行可视化，然后拟合并评估一对 ANOVA 模型。否则，我们将继续评估常规赛胜利与得分以及允许得分。

14.5.1 数据处理和可视化

ANOVA 需要分类预测变量和定量目标变量。我们在z_wins中有一个定量因变量，但我们还没有任何分类预测变量。在下面的代码块中，我们调用dplyr mutate()和case_when()函数来创建一个新分类变量o_pts_cat，该变量是从z_o_points变量派生出来的。当z_o_pts小于-1 时，o_pts_cat等于A；当z_o_pts大于或等于-1 且小于 0 时，o_pts_cat等于B；当z_o_pts等于或大于 0 且小于或等于 1 时，o_pts_cat等于C；当z_o_pts大于 1 时，o_pts_cat等于D。然后，我们通过调用基础 R 的as.factor()函数将新变量转换为因子：

nba_stats %>%
  mutate(o_pts_cat = case_when(z_o_pts < -1 ~ "A",
                               z_o_pts >= -1 & z_o_pts < 0 ~ "B",
                               z_o_pts >= 0 & z_o_pts <= 1 ~ "C",
                               z_o_pts > 1 ~ "D")) -> nba_stats
nba_stats$o_pts_cat <- as.factor(nba_stats$o_pts_cat)

然后，我们再次调用mutate()和case_when()函数，从z_pts创建一个类似变量。这个变量也是通过再次调用as.factor()函数转换为因子的：

nba_stats %>%
  mutate(pts_cat = case_when(z_pts < -1 ~ "A",
                             z_pts >= -1 & z_pts < 0 ~ "B",
                             z_pts >= 0 & z_pts <= 1 ~ "C",
                             z_pts > 1 ~ "D")) -> nba_stats
nba_stats$pts_cat <- as.factor(nba_stats$pts_cat)

然后，我们调用基础 R 的summary()函数两次，以返回变量o_pts_cat和pts_cat中每个因子级别或类别的记录数。对于数值变量，summary()函数返回一系列基本或描述性统计量，但对于我们刚刚创建的两个因子变量，summary()函数则返回记录数：

summary(nba_stats$o_pts_cat)
##   A   B   C   D 
##  43 103 105  49
summary(nba_stats$pts_cat)
##   A   B   C   D 
##  49 109  97  45

最重要的是，没有不可用（NAs，或缺失数据），因此我们已经成功地为nba_stats数据集中的每个记录分配了o_pts_cat和pts_cat类别。否则，这些变量在 300 个观测值中的三分之二以上等于B或C，这意味着在 2008 年至 2017 赛季之间，超过三分之二的 NBA 球队在得分和失分上与联盟平均值的±一个标准差范围内。

让我们通过两个系列的箱线图来绘制o_pts_cat和pts_cat与变量z_wins的相关性，或者不相关性。但首先，这里有一个关于箱线图的快速复习，箱线图有时也被称为箱线和胡须图：

• 箱子代表四分位距（IQR），或位于第 25 百分位数和第 75 百分位数之间的每个数据点；因此，IQR 包含了数据中间的 50%。

• 胡须，或从箱子顶部和底部延伸出的线条，代表上四分位数和下四分位数。

• 任何超出胡须的数据点都被认为是异常值；这些数据点与总体中位数相比大约有三个标准差或更多。

• 每个箱子中的水平线代表总体中位数；R 会自动为我们绘制这条线。

我们的第一系列箱线图，p3，指向nba_stats数据集。这些箱线图与我们之前创建的不同；在我们介绍代码之前，你需要了解以下内容：

• 在aes()函数内部，我们传递o_pts_cat作为我们的 x 轴变量，z_wins作为我们的 y 轴变量，因此我们正在通过o_pts_cat中的每个因素水平可视化标准化的常规赛胜利数的分布。

• 此外，我们将o_pts_cat传递给填充，这意味着我们的箱线图将采用默认的ggplot2调色板，而不是指定的或统一的填充。回想一下，fill通过几何形状的填充颜色来定义，而颜色参数定义了边界颜色。

• 我们向geom_boxplot()函数添加了两个可选参数：

  • 当notch等于TRUE（默认为FALSE）时，我们指示 R 绘制带凹槽的箱线图而不是标准箱线图。从视觉角度来看，凹槽“挤压”了中位数周围的箱子；从统计角度来看，凹槽是中位数周围置信区间的显示。其附加价值在于凹槽用于比较组别；如果两个或更多箱子的凹槽没有重叠，我们就有了强有力的证据表明中位数有显著差异。尽管我们更感兴趣的是组均值而不是中位数，但这两个度量实际上非常接近，无论o_pts_cat因素水平如何。

  • boxplot()函数中的第二个参数alpha调整了箱子的不透明度；实际上，alpha参数可以被传递来调整任何几何形状的不透明度。值必须在0到1之间，其中较低的值等于更高的不透明度。

• 通过调用stat_summary()函数，我们在每个代表均值的箱中添加了一个实心白色点。

• 我们添加了一个图例并将其放置在每个图的底部。图例几乎可以放置在任何地方，包括在图内部。

• 最后，调用scale_fill_discrete()函数允许我们自定义图例名称和图例标签。默认情况下，我们的图例将被命名为o_pts_cat，标签将与o_pts_cat因素水平相等——这两者都不太直观。

正如之前描述的代码块所示：

p3 <- ggplot(nba_stats, aes(x = o_pts_cat, y = z_wins, fill = o_pts_cat)) +
  geom_boxplot(notch = TRUE, alpha = 0.5) +
  labs(title = "Points Allowed vs. Wins", 
       subtitle = "2008-17",
       x = "Standardized Points Allowed Category", 
       y = "Standardized Regular Season Wins") +
  stat_summary(fun = mean, geom = "point", 
               shape = 20, size = 8, color = "white", fill = "white") + 
  theme(legend.position = "bottom") +
  scale_fill_discrete(name = "Points\nAllowed\nZ-Score", 
                      labels = c("< -1", "-1 to 0", "0 to 1","> 1")) +
  theme(plot.title = element_text(face = "bold")) 

我们的第二个箱线图系列，p4，与 p3 相似，除了我们将o_pts_cat替换为pts_cat作为我们的 x 轴变量和填充。因此，在这里，我们正在绘制标准化的常规赛胜利数的分布与pts_cat中的每个因素水平的对比：

p4 <- ggplot(nba_stats, aes(x = pts_cat, y = z_wins, fill = pts_cat)) +
  geom_boxplot(notch = TRUE, alpha = 0.5) +
  labs(title = "Points Scored vs. Wins", 
       subtitle = "2008-17",
       x = "Standardized Points Scored Category", 
       y = "Standardized Regular Season Wins") +
  stat_summary(fun = mean, geom = "point", 
               shape = 20, size = 8, color = "white", fill = "white") + 
  theme(legend.position = "bottom") +
  scale_fill_discrete(name = "Points\nScored\nZ-Score", 
                      labels = c("< -1", "-1 to 0", "0 to 1", "> 1")) +
  theme(plot.title = element_text(face = "bold"))

我们的两个图已经被保存在内存中。然后我们通过调用patchwork包中的plot_layout()函数将 p3 和 p4 捆绑在一起，并将我们的箱线图打印为一个图形对象（见图 14.5）：

p3 + p4 + plot_layout(ncol = 2)

图 14.5 在左侧，四个标准化的允许类别点与标准化的常规赛胜利数进行对比；在右侧，四个标准化的得分类别点与标准化的常规赛胜利数进行对比。

显然，在 2008 年至 2017 年 NBA 赛季中防守或进攻表现更成功的队伍在常规赛中通常也表现更出色。此外，两个图中似乎都没有重叠的凹槽，这表明可能存在统计上显著的方差。

14.5.2 单因素 ANOVA

现在，让我们进行一对单因素 ANOVA——“单因素”是因为我们正在分析只有一个预测变量 o_pts_cat 以及随后 pts_cat 对目标变量 z_wins 的影响。我们的目的是确定 o_pts_cat 和 pts_cat 的因子水平之间是否存在统计上的显著差异，并且确定一个因子水平组对 z_wins 的影响是否比另一个因子水平组更大。

我们拟合单因素 ANOVA 的方式与拟合简单线性回归类似，只是我们调用基础 R 的 aov() 函数而不是 lm() 函数。然后我们通过一个波浪线分隔目标变量和预测变量，并将指向我们的数据源 nba_stats 的指针作为参数传递：

fit1 <- aov(z_wins ~ o_pts_cat, data = nba_stats)

然后，我们调用 summary() 函数以返回结果：

summary(fit1)
##              Df Sum Sq Mean Sq F value              Pr(>F)    
## o_pts_cat     3  96.56   32.19   49.32 <0.0000000000000002 ***
## Residuals   296 193.16    0.65                                
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

p 值基本上等于 0，这意味着 z_wins 的均值在统计上存在显著差异，这与变量 o_pts_cat 的四个因子水平相关联。

现在，我们通过调用基础 R 的 plot() 函数来检查一对诊断图（见图 14.6）。诊断图用于评估模型完整性。默认情况下，R 返回最多四个诊断图，但我们只对检查组间方差相等和残差正态性感兴趣，因此只需要两个诊断图（Residuals vs. Fitted 和 Normal QQ），所以我们将 which 参数传递给基础 R 的 plot() 函数，只打印两个图（在一列中）而不是四个：

plot(fit1, which = c(2, 1))

图 14.6 我们第一个 ANOVA 模型的诊断图

Residuals vs. Fitted plot 展示了残差与拟合值之间的关系，即每个队伍标准化的常规赛胜利数与各自 o_pts_cat 因子水平的 z_wins 均值之间的关系。那些常规赛胜利数超过其组或类别平均值的队伍有正残差；那些常规赛胜利数少于其组或类别平均值的队伍有负残差。

为了使 fit1 完全满足单因素 ANOVA 对组间方差相等的假设，残差应该在每个拟合值水平上均匀分散。然而，我们可以清楚地看到，残差在最高拟合值水平上比其他水平分散得更少，因此组间方差相等的假设可能已被违反，尽管不是显著违反。

正态 Q-Q 图本身并不显示残差的分布，但它确实提供了一个视觉线索，说明残差是否呈正态分布。如果残差呈正态分布，正态 Q-Q 点将重叠在对角线上；如果不呈正态分布，我们将会看到严重的偏离对角线，最可能出现在一个或两个尾部。在我们的案例中，点在两个尾部都有轻微的偏离，但总体上，它们很好地重叠在对角线上。结论是，虽然 fit1 可能是一个不太完美的模型，但它并不是一个需要纠正行动和重做的“坏”模型。

现在，让我们通过交换预测变量来拟合第二个 ANOVA：因此，fit2 测试了分类变量pts_cat对数值变量z_wins的影响。我们调用aov()函数来运行我们的 ANOVA，然后调用summary()函数来返回结果：

fit2 <- aov(z_wins ~ pts_cat, data = nba_stats)
summary(fit2)
##              Df Sum Sq Mean Sq F value              Pr(>F)    
## pts_cat       3  75.04  25.014   34.49 <0.0000000000000002 ***
## Residuals   296 214.68   0.725                                
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

再次，p 值基本上等于 0，这意味着对于z_wins的均值差异也可以归因于pts_cat的四个因素水平，这在统计上也是显著的。

让我们再次调用plot()函数来打印 fit2 诊断结果，并与我们的第一次方差分析进行比较（见图 14.7）：

plot(fit2, which = c(2, 1))

图 14.7 第二次方差分析的诊断图

首先，关于残差与拟合值图，fit2 的残差似乎在拟合值每个水平上的分布比 fit1 更均匀，这表明组间方差相等。其次，关于正态 Q-Q 图，点似乎比 fit1 的残差更多地重叠在对角线上，这表明分布更接近正态分布。

最后，我们将 fit1 和 fit2 传递给基础 R 的AIC()函数，以便计算两个 ANOVA 的赤池信息准则（AIC）。AIC 权衡了解释的变异与预测变量的数量，并返回一个分数。对于单个模型，AIC 没有意义，但为了模型选择的目的——特别是 fit1 与 fit2 的比较，其中我们具有相同的 p 值——AIC 是一个流行的最佳拟合度量，其中 AIC 分数越低越好：

AIC(fit1, fit2)
##      df      AIC
## fit1  5 729.2831
## fit2  5 760.9676

至少基于这两个 AIC 分数，fit1 似乎比 fit2 更好地解释了z_wins的变化；换句话说，防守比进攻更好地解释了常规赛的方差。这当然可能是真的，但优势至多微不足道，因此几乎不具有压倒性。

因此，基于相关性测试和方差分析模型，我们可以自信地得出结论，在影响常规赛胜利方面，防守至多只有微小的优势。接下来，我们将运行一对逻辑回归，以确定防守或进攻哪个更好地预测哪些球队能进入或不能进入季后赛。

14.6 逻辑回归

回到第五章，我们拟合了一对 线性 回归，以确定哪些 hustle 统计量可能对胜利有统计学上的显著影响以及影响的程度；换句话说，我们回归了一个连续变量与其他连续变量。另一方面，逻辑回归是一种通过将二元目标变量与一个或多个（通常是）连续预测变量回归的方法。我们在这里的目的是通过运行一对简单的逻辑回归来实现这一点——简单是因为每个模型将只包含一个预测变量，即 z_o_pts 或 z_pts，而不是多个预测变量，以便比较和对比进攻和防守对季后赛资格的影响。

在我们深入探讨逻辑回归的细节之前——警告：逻辑回归比线性回归更复杂——让我们通过创建一个派生目标变量来整理 nba_stats 数据集，然后将其拆分为两个互斥的子集，用于训练和预测。

14.6.1 数据整理

首先，我们将 nba_stats 传递给 dplyr mutate() 函数和基础 R 的 ifelse() 函数，创建一个名为 playoffs2 的新变量。如果变量 playoffs（它是一个具有水平 0、10 和 11 的因子变量）等于 0，则 playoffs2 也应等于 0；如果 playoffs 等于除 0 以外的任何值，则 playoffs2 应该改为等于 1。

基础 R 的 head() 和 tail() 函数分别返回 nba_stats 中的前 10 个和最后 10 个观测值，但略有不同。我们不是返回 nba_stats 中的每一列，而是指示 R 只返回位置 1、3、4 和 13 的变量。请注意，我们必须包含位置编号，以便此代码能够运行；如果我们使用变量名而不是位置编号，R 将引发错误：

nba_stats %>%
  mutate(playoffs2 = ifelse(playoffs == 0, 0, 1)) -> nba_stats
head(nba_stats[,c(1, 3, 4, 13)], 10)
## # A tibble: 10 × 4
## # Groups:   season [10]
##    Team          season playoffs playoffs2
##    <chr>         <fct>  <fct>        <dbl>
##  1 Atlanta Hawks 2017   10               1
##  2 Atlanta Hawks 2016   10               1
##  3 Atlanta Hawks 2015   10               1
##  4 Atlanta Hawks 2014   10               1
##  5 Atlanta Hawks 2013   10               1
##  6 Atlanta Hawks 2012   10               1
##  7 Atlanta Hawks 2011   10               1
##  8 Atlanta Hawks 2010   10               1
##  9 Atlanta Hawks 2009   10               1
## 10 Atlanta Hawks 2008   10               1

tail(nba_stats[,c(1, 3, 4, 13)], 10)
## # A tibble: 10 × 4
## # Groups:   season [10]
##    Team               season playoffs playoffs2
##    <chr>              <fct>  <fct>        <dbl>
##  1 Washington Wizards 2017   10               1
##  2 Washington Wizards 2016   0                0
##  3 Washington Wizards 2015   10               1
##  4 Washington Wizards 2014   10               1
##  5 Washington Wizards 2013   0                0
##  6 Washington Wizards 2012   0                0
##  7 Washington Wizards 2011   0                0
##  8 Washington Wizards 2010   0                0
##  9 Washington Wizards 2009   0                0
## 10 Washington Wizards 2008   10               1

然后，我们将 nba_stats 传递给 dplyr filter() 和 row_number() 函数，将大约每四条记录中的一条转移到名为 test 的子集中。接下来，通过调用 dplyr anti_join() 函数，我们将不在 test 中的所有 nba_stats 记录抛入另一个名为 train 的子集中：

nba_stats %>%
  filter(row_number() %% 4 == 1) -> test
train <- anti_join(nba_stats, test)

我们将在 train 上训练我们的逻辑回归，然后在 test 上进行预测。这正是我们在第五章中针对我们的多元线性回归所采取的方法；事实上，这正是我们在那一章中首次使用来将我们的数据拆分为 train 和 test 的相同代码。

连续调用基础 R 的 dim() 函数返回 train 和 test 的行数和列数：

dim(train)
## [1] 220  13
dim(test)
## [1] 80 13

我们可以看到，train 包含了 nba_stats 中的 300 条记录中的 220 条，即大约 73% 的总记录数，而 test 包含剩余的 80 条记录。

14.6.2 模型开发

首先，让我们考虑关于逻辑回归的一些关键细节：

• 响应变量或目标变量必须是二元的，其中因素水平通常等于 0 或 1，或者 0 代表否，1 代表是。实际上，我们刚刚创建了一个名为playoffs2的二值目标变量，其中0表示一支球队未能晋级季后赛，1表示一支球队确实晋级了季后赛。

• 逻辑回归是一种预测目标变量等于 1 的概率的方法。例如，我们可以运行逻辑回归来预测一名高中生被哈佛大学录取的概率、明天下雨的概率，或者一支 NBA 球队进入季后赛的概率。

• 我们的逻辑回归将根据允许得分和得分之间的标准化分数来建模晋级季后赛的概率。例如，给定预测变量z_o_pts的值的晋级季后赛的概率可以写成 Pr(playoffs2 = Yes|z_o_pts)，或简称为p(playoffs2)。

• 概率始终等于 0 和 1 之间的某个数字。然后，我们将预测任何p(playoffs2)等于或大于 0.50 的球队的 playoffs2 = 是。

• 这也是为什么我们不能用线性回归来解决分类问题；当预测变量等于相对极端值时，线性模型实际上能够预测小于 0 和大于 1 的概率。为了避免数学上不可能的结果，逻辑回归使用一种称为最大似然估计的方法来预测始终介于 0 和 1 之间的概率。

• 最大似然估计从以下方程预测概率：log[p(X) / (1 - p(X))] = B[0] + B[1]X[1]。这个方程的左边称为对数几率，或 logit；因此，右边是我们计算对数几率的方法，其中X[1]等于预测变量，B[1]等于预测变量的系数。当我们开始评估第一个模型的结果时，我们将对此进行更多讨论。

现在我们来拟合我们两个回归模型中的第一个。

拟合我们两个模型中的第一个

要拟合逻辑回归，我们调用基础 R 的glm()函数，即广义线性模型，它代表一类包括逻辑回归的模型。逻辑回归的语法与线性模型和基础 R 的lm()函数类似，除了我们需要传递family = "binomial"参数来告诉 R 运行逻辑回归而不是其他广义线性模型。请注意，我们是在 train 上拟合模型，而不是在 nba_stats 上。

我们将目标二值变量playoffs2对连续预测变量z_o_pts进行回归。然后，我们调用基础 R 的summary()函数并传递模型名称 fit3，以返回结果：

fit3 <- glm(playoffs2 ~ z_o_pts, family = "binomial", data = train)
summary(fit3)
## 
## Call:
## glm(formula = playoffs2 ~ z_o_pts, family = "binomial", data = train)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.17428  -0.77250  -0.01473   0.76694   2.13669  
## 
## Coefficients:
##             Estimate Std. Error z value         Pr(>|z|)    
## (Intercept)   0.1998     0.1727   1.157            0.247    
## z_o_pts      -1.7210     0.2317  -7.428 0.00000000000011 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 304.98  on 219  degrees of freedom
## Residual deviance: 210.91  on 218  degrees of freedom
## AIC: 214.91
## 
## Number of Fisher Scoring iterations: 5

让我们交替回顾这些结果的一部分并获取一些额外的指标。首先，z_o_pts 的 p 值几乎等于 0，这意味着它对 playoffs2 有统计学上的显著影响；也就是说，允许的得分确实对 NBA 球队是否进入季后赛有影响。

其次，虽然线性回归返回 R² 和调整 R² 统计量，这些量度模型预测因子解释的集体方差，但逻辑回归没有这样的等效量度。然而，pscl 包中的 pR2() 函数返回广义线性模型中所谓的 McFadden 伪 R² 测量值。它否则测量逻辑回归模型中的拟合优度。它通过比较拟合模型的似然值与零模型（null model）的似然值来量化模型解释的方差比例，返回介于 0 和 1 之间的某个值，数值越高，预测能力越强。伪 R² 低至 0.4 或甚至 0.2 通常被认为表示拟合良好。在下面的代码中，我们将模型名称 fit3 传递给 pR2() 函数以获取 McFadden 伪 R²：

pR2(fit3)["McFadden"]
## fitting null model for pseudo-r2
##  McFadden 
## 0.3084425

因为 McFadden 伪 R² 等于 0.31，因此我们可以得出结论，z_o_pts 对数据是一个良好的拟合。

第三，caret 包包含一个名为 varImp() 的函数，该函数定量测量模型预测因子的重要性或相关性。这个度量本身没有意义，但当我们将其与同一模型中的其他预测因子或竞争简单回归中的另一个预测因子进行比较时，它允许我们比较和对比它们对同一目标变量的影响。我们只需要将 fit3 传递给 varImp() 函数。我们将在运行第二个逻辑回归后返回这些结果：

varImp(fit3)
##          Overall
## z_o_pts 7.428127

第四，fit3 的 AIC 等于 214.91；summary() 函数为广义线性模型返回此度量，而对于线性回归和方差分析（ANOVA），我们需要运行 AIC() 函数来获取 AIC。同样，AIC 在比较竞争模型之前没有任何意义，所以我们将 AIC 放在一边暂时不谈。

第五，我们现在需要继续讨论预测变量系数的话题；在 fit3 中，z_o_pts 系数等于 -1.72。首先，重要的是要理解概率是如何转换为对数几率以及反过来：

• 概率是某个事件发生的可能性。例如，从纽约到伦敦的航班准时起飞的概率可能是 70%。

• 几率，或者更准确地说，成功的几率，等于成功的概率除以失败的概率。因此，我们的航班准时起飞的几率等于几率比，即 0.70 除以 0.30，等于 2.33。

• 对数几率仅仅是几率比的自然对数。在 R 中计算自然对数的一种方法是通过调用 SciViews 包中的 ln() 函数并将几率比传递给它：

ln(2.33)
## [1] 0.8458683

对于我们的目的来说更为重要的是，以下是如何将对数优势转换为优势比，以及如何将优势比转换为我们可以理解的概率：

• 优势比等于自然对数的指数，其中e是一个数学常数，等于 2.72，在我们的例子中，对数优势等于 0.85。R 使我们很容易做到这一点——我们只需调用基础 R 的exp()函数并将对数优势传递给它以将其转换为优势比：

exp(0.85)
## [1] 2.339647

• 概率等于优势比，即我们的例子中的 2.34，除以 1 和 2.34 之和，即 3.34：

2.34 / 3.34
## [1] 0.7005988

经过这一切，我们回到了 70%的概率，即我们的纽约至伦敦航班准时起飞。

现在，关于我们的逻辑回归模型，我们可以将z_o_pts系数从对数优势转换为概率，然后评估当z_o_pts系数增加或减少一个单位时，我们的因变量playoffs2的平均变化。

而不是将对数优势转换为优势比，然后再将优势比转换为概率，我们只需将对数优势传递给基础 R 的plogis()函数，直接从对数优势计算概率：

plogis(-1.72)
## [1] 0.1518712

因此，z_o_pts的一个单位增加或减少将对应于季后赛资格概率的大约 15%的变化。

现在我们已经在训练数据集上拟合了逻辑回归模型，我们可以使用它来对测试数据集进行预测。因此，我们将我们的模型和数据传递给基础 R 的predict()函数。通过将type = "response"作为predict()函数的第三个参数添加，我们指示 R 以 Pr(playoffs2 = Yes|z_o_pts)的形式返回预测概率。

predicted_fit3 <- predict(fit3, test, type = "response")

如果我们调用print()函数，R 将返回一个概率矩阵，其中所有概率都在 0 到 1 之间，对应于测试中的 80 条记录。相反，我们将测试传递给dplyr select()函数以创建一个名为 actuals 的子集，它仅包括变量playoffs2。然而，我们首先调用dplyr ungroup()函数来解除playoffs2和season变量之间的耦合；否则，actuals 将不必要地包含这两个变量：

test %>%
  ungroup(season) %>%
  select(playoffs2) -> actuals

然后，我们将 actuals 传递给dplyr的rename()函数；rename()函数将赋值运算符右侧的变量重命名为左侧的内容：

actuals %>%
  rename(actual_values = playoffs2) -> actuals

转换话题，我们接下来创建一个新的对象，称为 predictions，它等于通过调用基础 R 的as.data.frame()函数将 predicted_fit3 从矩阵转换为数据框的 predicted_fit3：

predictions <- as.data.frame(predicted_fit3)

然后，我们将 predictions 传递给rename()函数；作为一个矩阵和一个数据框，predicted_fit3 中的单个变量实际上是predicted_fit3。通过调用rename()函数，我们将它改为等于predicted_values：

predictions %>%
  rename(predicted_values = predicted_fit3) -> predictions

接下来，我们将预测值传递给dplyr mutate()和基础 R 的ifelse()函数，根据条件逻辑创建一个派生变量。当变量predicted_values等于或大于0.50时，predicted_values2应等于1；否则，它应等于0：

predictions %>%
  mutate(predicted_values2 = 
           ifelse(predicted_values >= 0.50, 1, 0)) -> predictions

现在我们有一对单变量对象，它们都与测试相关联——actual_values包含一个二进制变量，表示 NBA 球队是否进入季后赛，而predictions包含一个二进制变量predicted_values，表示预测拟合 3 是否预测这些球队进入季后赛。

然后，我们将这两个变量传递给基础 R 的table()函数，创建所谓的混淆矩阵。print()函数返回结果。传递的变量必须绝对为二进制，才能使此操作运行：

confusion_matrix <- table(actuals$actual_values,     predictions$predicted_values2)
print(confusion_matrix)
##    0  1
## 0 19 11
## 1 10 40

我们的混淆矩阵既类似于我们在第九章创建的列联表，又不同于它，正如以下解释所示：

• 混淆矩阵是一个表格，通过显示真正例（TP）、真正负（TN）、假正例（FP）和假负例（FN）的计数来总结分类模型的性能。混淆矩阵是我们从中可以推导出关键预测拟合 3 性能指标的来源。

• 真阳性指的是模型正确预测了正面结果的情况。当一个正面结果相当于一支 NBA 球队进入季后赛时，我们有 40 个这样的实例。

• 真阴性指的是模型正确预测了负面结果的情况。当一个负面结果相当于一支 NBA 球队未能进入季后赛时，我们有 19 个这样的实例。

• 假阳性指的是模型错误地预测了正面结果的情况。我们有 11 个这样的实例。

• 假阴性指的是模型错误地预测了负面结果的情况。我们有 10 个这样的实例。

• 敏感性，也称为真正率，是衡量分类模型在所有正例中正确识别的真正例比例的指标。

  • 敏感性 = TP / (TP + FN)

• 特异性，也称为真正负率，是衡量分类模型在所有负例中正确识别的真正负例比例的指标。

  • 特异性 = TN / (TN + FP)

• 敏感性相对于特异性的相对重要性通常取决于上下文。考虑对一种罕见但高度侵袭性的癌症进行的检测。假阴性可能导致严重后果，因为它们可能会延迟或甚至阻止治疗，导致致命结果。最大化真阳性并最小化假阴性比最小化假阳性更为重要。另一个需要考虑的例子是法律和秩序，特别是在民主国家，在那里最大限度地减少错误定罪，或假阳性，非常重要。在其他情况下，例如，NBA 球队是否成功晋级季后赛，敏感性和特异性可能具有同等的重要性。

• 误分类错误率，有时也称为分类错误或只是错误率，是分类模型中误分类实例的度量。因此，它代表了错误预测的百分比。

  • 误分类错误率 = (FP + FN) / n

• 模型准确率是错误率的倒数；因此，它代表了正确预测的百分比。

  • 模型准确率 = (TP + TN) / n 或 1 - (FP + FN) / n

在 R 中计算敏感性和特异性率很容易；我们只需将我们的二元变量actual_values和predicted_values2传递给caret包中的sensitivity()和specificity()函数。为了得到正确的结果，你必须以与之前传递给table()函数相同的顺序传递变量：

sensitivity(actuals$actual_values, predictions$predicted_values2)
## [1] 0.8
specificity(actuals$actual_values, predictions$predicted_values2)
## [1] 0.6333333

由于敏感性率高于特异性率，因此我们可以得出结论，我们的第一个逻辑回归，predicted_fit3，在识别真阳性方面比识别真阴性更好。

然后，我们使用算术运算来计算错误率并推导出模型准确率。再次强调，误分类错误率，或简称为错误率，等于假阳性和假阴性之和除以记录数：

print(misclassification_error <- (11 + 10) / 80)
## [1] 0.2625

模型准确率仅仅是错误率的倒数：

print(accuracy <- 1 - misclassification_error)
[## 1] 0.7375

如此高的准确率表明 predicted_fit3 具有相当强的预测能力。

最后，我们将结合pROC包中的roc()函数和基础 R 中的plot()函数来计算所谓的曲线下面积（AUC），然后绘制 ROC 曲线，这在本章前面已经讨论过。AUC 通过同等考虑敏感性和特异性率来量化分类模型的预测能力。当 AUC 等于 1 的最大值时，模型可以完美地区分正例和负例；当等于 0.5 时，模型的性能不比随机机会更好。因此，AUC 越高，越好。ROC 曲线通过在 x 轴上绘制特异性率，在 y 轴上绘制敏感性率来可视化这一点。

而错误率衡量的是从总记录数中误分类实例的比例，因此关注的是单个预测，而 AUC 衡量的是分类模型的整体判别能力，即它区分正例和负例的能力。尽管这两个度量不同，但它们通常非常一致。

在以下代码中，我们按照顺序将actual_values和predicted_values2传递给roc()函数和print()函数以获取 AUC：

roc_curve <- roc(actuals$actual_values, predictions$predicted_values2)
print(roc_curve)
## Call:
## roc.default(response = actuals$actual_values, 
##     predictor = predictions$predicted_values2)
##
## Data: predictions$predicted_values2 in 30 controls
##    (actuals$actual_values 0) < 50 cases (actuals$actual_values 1).
## Area under the curve: 0.73

AUC 等于 0.73 表明模型相当强大。

我们通过调用plot()函数来得到 ROC 曲线（见图 14.8）。Base R 的绘图功能比其优雅性更实用，但我们仍然可以给曲线着色并自定义标题和轴标签：

plot(roc_curve, 
     col = "red", 
     main = "ROC Curve: AUC = 0.73",
     xlab = "Specificity: TN / (TN + FP)",
     ylab = "Sensitivity: TP / (TP + FN)") 

图 14.8 展示了我们的第一个逻辑回归的 ROC 曲线，其中 x 轴表示真正的负例，y 轴表示真正的正例。

让我们拟合第二个回归，然后比较和对比我们的两个模型。

拟合我们的第二个模型

我们第二个也是最后一个模型 fit4，将playoffs2对z_pts进行回归。我们在最后绘制了第二个 ROC 曲线（见图 14.9）：

fit4 <- glm(playoffs2 ~ z_pts, family = "binomial", data = train)
summary(fit4)
## 
## Call:
## glm(formula = playoffs2 ~ z_pts, family = "binomial", data = train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8007  -1.0788  -0.0708   1.1246   1.5395  
## 
## Coefficients:
##             Estimate Std. Error z value  Pr(>|z|)    
## (Intercept) -0.02059    0.14104  -0.146     0.884    
## z_pts        0.63463    0.15263   4.158 0.0000321 ***
## ---

## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 304.98  on 219  degrees of freedom
## Residual deviance: 285.32  on 218  degrees of freedom
## AIC: 289.32
## 
## Number of Fisher Scoring iterations: 4

plogis(0.63)
## [1] 0.6524895

pR2(fit4)["McFadden"]
## fitting null model for pseudo-r2
##  McFadden 
## 0.06446806

varImp(fit4)
##        Overall
## z_pts 4.157984

predicted_fit4 <-predict(fit4, test, type = "response")

predictions <- as.data.frame(predicted_fit4)

predictions %>%
  rename(predicted_values = predicted_fit4) -> predictions

predictions %>%
  mutate(predicted_values2 = 
           ifelse(predicted_values >= 0.50, 1, 0)) -> predictions

confusion_matrix <- table(actuals$actual_values, 
                          predictions$predicted_values2)
print(confusion_matrix)
##    0  1
## 0 27  3
## 1 22 28

sensitivity(actuals$actual_values, predictions$predicted_values2)
## [1] 0.56
specificity(actuals$actual_values, predictions$predicted_values2)
## [1] 0.9

print(misclassification_error <- (3 + 22) / 80)
## [1] 0.3125

print(accuracy <- 1 - misclassification_error)
## [1] 0.6875

roc_curve <- roc(actuals$actual_values, predictions$predicted_values2)
print(roc_curve)
## Call:
## roc.default(response = actuals$actual_values,
##     predictor = predictions$predicted_values2)
##
## Data: predictions$predicted_values2 in 30 controls
##    (actuals$actual_values 0) < 50 cases (actuals$actual_values 1).
## Area under the curve: 0.73

plot(roc_curve, 
     col = "blue", 
     main = " ROC Curve: AUC = 0.73",
     xlab = "Specificity: TN / (TN + FP)",
     ylab = "Sensitivity: TP / (TP + FN)")

图 14.9 展示了我们的第二个逻辑回归的 ROC 曲线，其中 x 轴表示真正的负例，y 轴表示真正的正例。虽然我们的第一个模型返回的灵敏度率高于特异性率，但第二个模型返回的正好相反。然而，相应的 AUC 基本相等。

让我们回顾一下结果，并将它们与 fit3 和 predicted_fit3 进行比较（见表 14.1）。

表 14.1 展示了我们的逻辑回归模型的并列结果

度量	fit3	fit4	备注
预测因子 p 值	0.00000000000011	0.0000321	z_o_pts和z_pts都对playoffs2有显著的统计影响。然而，z_o_pts的 p 值低于z_pts。
伪 R²	0.31	0.06	z_o_pts是两个预测因子中更好的。
AIC	214.91	289.32	AIC 根据拟合和复杂性的组合来评估模型，AIC 越低，越好。由于这两个模型都是简单的回归，AIC 分数否则表明 fit3 是更好的数据拟合。
变量重要性	7.43	4.16	z_o_pts是目标变量playoffs2差异中更重要的贡献者。
灵敏度	0.80	0.56	predicted_fit3 在真正例率方面是两个模型中更强的。
特异性	0.63	0.90	predicted_fit4 在真正例率方面是两个模型中更强的。
错误率	0.26	0.31	predicted_fit3 的错误率更低。
模型准确率	0.74	0.69	因此，predicted_fit3 具有更高的模型准确率。
AUC	0.73	0.73	predicted_fit4 的 AUC 略高。

考虑到我们的逻辑回归，我们必须得出结论，失分对 NBA 球队是否至少在 2007 年至 2018 年赛季期间进入季后赛有更大的影响。

但正如我们的相关性和 ANOVA 模型测试一样，z_o_pts 可能比 z_pts 具有的任何优势至多是可以忽略不计的。事实上，最好的总体结论是，失分和得分对常规赛胜利以及球队是否进入季后赛的影响大致相等。换句话说，防守并不比进攻重要得多。

话虽如此，为什么那么多人——包括球员、教练和总经理——仍然坚持认为防守显然且毫无疑问比进攻更重要？我们可能真的有下一个答案。

14.7 配对数据前后

答案可能追溯到常规赛和季后赛中大多数 NBA 冠军球队的得分和失分差异。让我们探索这个可能性。

我们首先将 nba_stats 数据集传递给 dplyr filter() 函数，以子集化 playoffs 因子变量等于 11 的 10 条记录。因子级别等于 11 仅适用于联赛冠军。然后，将 nba_stats 传递给 dplyr select() 函数，以 Team、season、PTS 和 O_PTS 变量对其进行子集化。最后，我们调用 dplyr 的 arrange() 函数按 season 变量对 nba_stats 进行排序。结果被转换为一个 10 × 3 的 tibble，称为 df1：

nba_stats %>%
  filter(playoffs == 11) %>%
  select(Team, season, PTS, O_PTS) %>%
  arrange(season) -> df1

然后，我们再次调用 select() 函数，对 df1 中的除 Team 之外的所有变量进行子集化：

df1 %>%
  select(-Team) -> df1

现在，我们有一个整洁的对象，其中包含了 nba_stats 中 10 个 NBA 冠军球队的常规赛得分和失分平均数。接下来，我们调用基础 R 的 data.frame() 函数来创建 df1 的季后赛等价物。

我们的新对象 df2 包含三个向量：一个名为 season 的因子变量，等于 2008 年至 2017 年；一个名为 PTS 的数值变量，等于每场比赛的得分；以及一个名为 O_PTS 的数值变量，等于每场比赛的失分（季后赛结果是从 www.basketball-reference.com 获取的）：

df2 <- data.frame(season = as.factor(c(2008:2017)),
                     PTS = c(94.0, 102.4, 101.1, 98.2, 97.3, 97.1, 
                             106.3, 103.3, 104.8, 119.3),
                     O_PTS = c(88.8, 95.2, 97.3, 92.4, 90.2, 90.7, 
                               97.0, 95.5, 96.2, 105.8))

我们然后将 df1 和 df2 传递给 rbind() 函数，该函数通过行将数据对象连接起来。在这个过程中，我们创建了一个 20 × 4 的 tibble，称为 df3：

df3 <- rbind(df1, df2)

最后，我们在 df3 中添加一个新的变量 Season（再次强调，R 是一个区分大小写的编程语言，所以 Season 与 season 不同），其中前 10 条记录等于 Regular Season，后 10 条记录等于 Playoffs。然后我们调用 print() 函数以完整的形式返回 df3：

df3$Season <- rep(c("Regular Season", "Playoffs"), each = 10)
print(df3)
## # A tibble: 20 × 4
## # Groups:   season [10]
##    season   PTS O_PTS Season        
##    <fct>  <dbl> <dbl> <chr>         
##  1 2008   100\.   90.2 Regular Season
##  2 2009   107\.   99.2 Regular Season
##  3 2010   102\.   97   Regular Season
##  4 2011   100\.   96   Regular Season
##  5 2012    98.5  92.5 Regular Season
##  6 2013   103\.   95   Regular Season
##  7 2014   105\.   97.7 Regular Season
##  8 2015   110    99.9 Regular Season
##  9 2016   104\.   98.3 Regular Season
## 10 2017   116\.  104\.  Regular Season
## 11 2008    94    88.8 Playoffs      
## 12 2009   102\.   95.2 Playoffs      
## 13 2010   101\.   97.3 Playoffs      
## 14 2011    98.2  92.4 Playoffs      
## 15 2012    97.3  90.2 Playoffs      
## 16 2013    97.1  90.7 Playoffs      
## 17 2014   106\.   97   Playoffs      
## 18 2015   103\.   95.5 Playoffs      
## 19 2016   105\.   96.2 Playoffs      
## 20 2017   119\.  106\.  Playoffs

然后，我们将 df3 以及特定的变量Season和O_PTS传递给ggpubr包中的ggpaired()函数来绘制常规赛和季后赛允许的得分图。ggpaired()函数创建了一对前后箱线图，显示了常规赛和季后赛允许的得分分布，并在相同的球队之间绘制连接线，以便我们可以比较每支球队的业绩（见图 14.10）。

图 14.10 展示了 2008 年至 2017 赛季所有 NBA 冠军球队在常规赛和季后赛期间每场比赛允许的得分对比的配对箱线图。大多数球队在季后赛中每场比赛允许的得分比常规赛中要少。

我们还可以自定义连接线的颜色和宽度，并从几个ggplot2调色板（aaas，代表美国科学促进会，是众多科学期刊调色板之一）中选择颜色方案：

ggpaired(df3, x = "Season", y = "O_PTS",
         color = "Season", line.color = "gray", line.size = 0.4,
         palette = "aaas",
         main = "Points Allowed Comparison: Regular Season versus Playoffs
            NBA Champions Only (2008-17)", 
         xlab = "",
         ylab = "Points Allowed per Game")

这里是关键要点：在 2008 年至 2017 赛季的 10 支 NBA 冠军球队中，有 8 支球队在季后赛中允许的得分比常规赛中要少。

但大多数这些球队在季后赛中每场比赛的得分也比常规赛中要少（见图 14.11）；这因此表明他们的对手在季后赛中防守也更好：

ggpaired(df3, x = "Season", y = "PTS",
         color = "Season", line.color = "gray", line.size = 0.4,
         palette = "aaas",
         main = "Points Scored Comparison: Regular Season versus Playoffs
            NBA Champions Only (2008-17)",
         xlab = "",
         ylab = "Points Scored per Game")

图 14.11 展示了 2008 年至 2017 赛季所有 NBA 冠军球队在常规赛和季后赛期间每场比赛得分的配对箱线图。大多数球队在季后赛中每场比赛的得分也比常规赛中要少。

在大多数季后赛比赛中得分的数量比大多数常规赛比赛中要少，这很可能导致了这样的印象：防守，而不是进攻，赢得了冠军。但最终，防守并不能赢得冠军；根据我们的测试结果系列，防守最多只是比进攻略多一点区分度，而这远远不能等同于今天的传统智慧。我们基于计算相关系数、运行相关测试、拟合方差分析模型，然后拟合一对逻辑回归的一致性得出这个结论。

在下一章中，我们将探讨 80-20 法则，并展示如何创建包含两个 y 轴的图表，即帕累托图。

摘要

• 我们应用了三种统计技术——相关性测试、方差分析和逻辑回归——交替测试了允许的得分和得分的效应，对常规赛胜利和季后赛资格的影响，针对 10 个赛季的 NBA 数据集。我们所有的测试都返回了具有统计学意义的成果，并且所有测试都强烈表明防守可能略微比进攻更重要，这几乎与传统的观点——防守比进攻更重要——不相符。

• 每场比赛允许的得分和每场比赛的得分几乎与常规赛的胜利数同样相关。此外，与胜利数配对的两个变量之间的相关性测试结果显示，p 值远低于预定义的 5%显著性阈值。

• 根据我们的单因素方差分析，允许的得分和得分的效应对常规赛胜利相似，我们的模型再次返回了低于显著性阈值的相等 p 值。

• 根据我们的逻辑回归分析，每场常规赛允许的得分和每场常规赛的得分总体上都是同等有效的预测因子（或者至少大致如此），用于预测谁将或不会获得季后赛资格。一个预测模型的错误率较低，因此模型准确率较高，但另一个模型的 AUC 值更高。

• 再次强调，我们所有的测试都产生了具有统计学意义的成果，但没有证据表明防守明显且无疑比进攻更重要。

• 否则，当变量处于不同尺度时，标准化变量绝对是必要的；在其他时候，当数据跨越数年时，标准化相同的变量是一种最佳实践。将原始数据转换为 z 分数可能是最常见的标准化方法，但我们在第十九章中还将介绍其他标准化技术。

• 理解在何种条件下运行哪种统计测试是至关重要的。在前几章中，我们运行了 t 检验和卡方检验；然而，当比较三个或更多数据系列，并且存在定量目标变量和分类预测变量时，方差分析应该是你的首选方法。当处理连续目标变量时，应拟合线性回归；当处理二元目标变量时，应拟合逻辑回归。

• 逻辑回归可能是最常见的分类模型。为了正确理解和应用结果，了解概率、优势比和 log odds 之间的差异，以及如何将值从一种转换为另一种，是绝对关键的。同样关键的是了解如何创建和解释混淆矩阵，以及如何从中推导出关键指标以准确评估模型拟合度。

15 林迪效应

本章涵盖

• 检验 80-20 法则

• 使用帕累托图可视化 80-20 法则

• 创建小提琴图

• 创建成对直方图

林迪效应，或称林迪定律，表明非易腐物品，如印刷书籍或企业，其预期寿命等于其当前年龄。例如，如果《了不起的盖茨比》已经印刷了 100 年，我们可以预期它还会再印刷 100 年。基本上，某物存在的时间越长，它继续存在的机会就越大。这个概念是以纽约市一家名为林迪的前熟食店的名字命名的，尽管如此，它还是开业了近一个世纪。林迪效应不适用于人类、水果或其他易腐物品；毕竟，我们无法期望一个 75 岁的男人再活 75 年，或者香蕉永远保持新鲜。

从统计学的角度来看，林迪效应遵循右偏态，或正偏态，的概率分布；也就是说，一个数值变量在连续区间上的分布，当 x 接近 0 时达到峰值，然后随着 x 的增加而逐渐变薄。我们的第一个可视化（见图 15.1）展示了这一效应；它是一个ggplot2密度图，显示了从 1946 年 NBA 成立到 2020 年（各城市、各州和昵称之间的独特球队名称数量等于球队数量）NBA 球队的年数分布。简单来说，它显示大多数 NBA 球队只存在了几年的时间，而较少的球队存在了很长时间。

图 15.1 NBA 球队在联盟中的年数分布可视化；当林迪效应适用时，我们会看到一个右偏态，或正偏态，的分布。因此，林迪效应对应于与 80-20 法则紧密相关的帕累托概率分布。

分布明显呈右偏态；分布的左侧尾部聚集的值比其他任何地方都多，而分布的右侧尾部则显著更长。这种分布与帕累托概率分布非常吻合。帕累托分布是以意大利土木工程师、经济学家和社会学家维弗雷多·帕累托的名字命名的，它是一种幂律分布，因此是非线性概率分布。至少在精神上，如果不是在字面上，它暗示了 80%的所有结果都只是由 20%的原因造成的。例如，一家公司的 80%的销售额来自其 20%的客户，或者所有 R 代码的 80%都是由 20%的库驱动的。反之亦然：你可能只有 80%的时间穿 20%的衣服，或者你可能只有 80%的时间观看 20%的电视频道。我们把这称为 80-20 法则。

在这里，我们的目的是测试 1946 年至 2020 年间所有 NBA 球队在比赛和胜利方面的 80-20 法则。是否可能的情况是，所有 NBA 球队中 20%的球队——这些球队不断涌现和消失——占所有比赛和胜利的 80%？在这个过程中，我们将展示两种创建帕累托图的方法，帕累托图是一种组合条形图和折线图，分别显示主要和次要 y 轴上的单元和增量频率。我们将像往常一样，首先加载我们所需的包。

15.1 加载包

我们将再次使用熟悉和不那么熟悉的包的组合：

• 我们的数据将通过 dplyr 和 tidyr 函数的混合进行整理，并且一些可视化将在 ggplot2 中创建，因此我们首先加载 tidyverse 包。

• 我们的一些可视化将捆绑成一个单独的图形对象，用于打印和展示目的，因此我们随后加载 patchwork 包。

• 我们将再次调用 car 包中的 recode() 函数来重命名向量中的元素。

• 通过 ggpubr 包，我们将介绍两种新的可视化类型：小提琴图和成对直方图。

• ggQC 和 gcc 包是新的。我们的第一个帕累托图将通过 ggplot2 和 ggQC 函数的组合创建；我们的第二个帕累托图将使用 gcc 包创建。

因此，我们调用 library() 函数六次，依次加载这六个包：

library(tidyverse)
library(patchwork)
library(car)
library(ggpubr)
library(ggQC)
library(qcc)

接下来，我们将导入我们的数据集。

15.2 导入和查看数据

我们的数据集是一个保存在我们默认工作目录中的 Microsoft Excel 电子表格，以.csv 扩展名保存；它包含 1946 年至 2020 赛季每个 NBA 球队的比赛和胜利次数，从 www.nba.com 和 www.basketball-reference.com 爬取而来。我们调用 readr 的 read_csv() 函数来导入我们的数据：

df1 <- read_csv("nba_lindy.csv") 

然后，我们从 dplyr 包中调用 glimpse() 函数来返回我们数据集的转置视图：

glimpse(df1)
## Rows: 89
## Columns: 8
## $ franchise       <chr> "Atlanta Hawks", "Atlanta Hawks", "St. Louis ...
## $ parent_child    <chr> "parent", "child", "child", "child", "child",...
## $ active_inactive <chr> "active", "active", "inactive", "inactive", "...
## $ start           <dbl> 1949, 1968, 1955, 1951, 1949, 1946, 1976, 201...
## $ end             <dbl> 2020, 2020, 1967, 1954, 1950, 2020, 2020, 202...
## $ years           <dbl> 72, 53, 13, 4, 2, 75, 45, 9, 35, 1, 31, 21, 1...
## $ games           <dbl> 5693, 4273, 1008, 280, 132, 5869, 3622, 718, ...
## $ wins            <dbl> 2808, 2109, 555, 90, 54, 3462, 1533, 325, 118...

我们的数据集，df1，包含 89 行，即每个 NBA 球队一行，以及八个列。请注意，尽管 NBA 现在由 30 支球队或球队组成，但 NBA 在 1946 年至 1965 年期间通常只有八支球队，直到 1977 年不超过 20 支球队，直到 2004 赛季才有 30 支球队。以下是按变量分解的说明：

• franchise—自 1946 年以来 NBA 历史上每个特许经营的全名。让我们通过两个例子来了解一下。亚特兰大老鹰队是 30 支活跃的 NBA 球队（特许经营）之一。他们的根源可以追溯到 1949 年，当时他们在伊利诺伊州和爱荷华州的三座小城镇之间交替进行主场比赛，当时被称为三城老鹰队。1951 年，他们搬迁到了密尔沃基，并成为了密尔沃基老鹰队；1955 年，他们再次搬迁，这次搬到了圣路易斯，因此成为了圣路易斯老鹰队。最后，在 1968 年，他们搬到了亚特兰大。因此，df1 中有五个“老鹰”记录——每个独特的球队或子记录一个，还有一个汇总记录，即父记录，它汇总了所有子记录的总和。或者以波士顿凯尔特人队为例。他们一直都在波士顿打球，并且一直被称为凯尔特人队，所以 df1 中只包含一个波士顿凯尔特人特许经营的记录。现在这是一个字符字符串，但很快我们就会将其转换为因子变量。

• parent_child—现在是一个字符字符串，很快将被转换为因子变量。该变量等于parent、parent_only或child。就 df1 中唯一的波士顿凯尔特人记录而言，parent_child等于parent_only，因为没有子记录。对于五个“老鹰”记录，parent_child对于汇总记录等于parent，而对于剩余的四个记录等于child。

• active_inactive—也是一个字符变量，将被转换为因子；如果球队（特许经营）目前处于 NBA 中，则该变量对所有父记录和子记录等于active；如果不处于 NBA 中，则等于inactive。

• start—等于任何特许经营或特许经营名称的第一个赛季，例如，1949 年等于 1948-49 赛季。现在这是一个整数，并将保持为整数。

• end—等于任何特许经营或特许经营名称的最后一个赛季；这也是一个整数。

• years—等于存在的年数或赛季数；这也是一个整数。

• games—一个整数，等于所玩的总比赛数。

• wins—一个整数，等于赢得的总比赛数。

现在我们通过三次调用基础 R 的as.factor()函数将变量franchise、parent_child和active_inactive转换为因子。再次强调，当变量只能取有限集合的值时，它们最好被转换为因子：

df1$franchise <- as.factor(df1$franchise)
df1$parent_child <- as.factor(df1$parent_child)
df1$active_inactive <- as.factor(df1$active_inactive)

我们随后调用基础 R 的summary()函数，该函数返回关于 df1 数值变量的描述性统计信息以及关于因子变量的按层级的记录计数：

summary(df1)
##                  franchise       parent_child active_inactive
##  Atlanta Hawks        : 2   child      :42    active  :46    
##  Baltimore Bullets    : 2   parent     :16    inactive:43    
##  Brooklyn Nets        : 2   parent_only:31                   
##  Charlotte Hornets    : 2                                    
##  Detroit Pistons      : 2                                    
##  Golden State Warriors: 2                                    
##  (Other)              :77                                    
##      start           end           years           games     
##  Min.   :1946   Min.   :1946   Min.   : 1.00   Min.   :  60  
##  1st Qu.:1949   1st Qu.:1962   1st Qu.: 5.00   1st Qu.: 328  
##  Median :1967   Median :2020   Median :19.00   Median :1522  
##  Mean   :1968   Mean   :1995   Mean   :26.94   Mean   :2140  
##  3rd Qu.:1978   3rd Qu.:2020   3rd Qu.:50.00   3rd Qu.:4025  
##  Max.   :2015   Max.   :2020   Max.   :75.00   Max.   :5869  
##                                                            
##      wins     
##  Min.   :  11  
##  1st Qu.: 147  
##  Median : 704  
##  Mean   :1062  
##  3rd Qu.:1938  
##  Max.   :3462  

下面是summary()函数刚刚告诉我们关于数据集的概要：

• 有 31 个特许经营，包括波士顿凯尔特人队，没有子记录。这些球队从未搬迁或更改名称，但它们不一定活跃。

• 有 16 个额外的特许经营商（总共 47 个），它们要么是从现在所在城市以外的其他城市开始比赛的，要么至少在联盟的第一年就更改了名称一次或多次。

• 有 30 个活跃的特许经营商，这是通过减去 46 个活跃特许经营商的数量和 16 个记录（其中 parent_child 变量等于 parent）得到的。

• 至少有一支球队只打了一年，而至少有一支球队已经存在了 75 年。

• 至少有一支球队在解散前只打了 60 场比赛，而有一支球队参加了 5,869 场比赛。

• 至少有一支球队只赢了 11 场比赛，而至少有一支球队赢得了 3,462 场比赛。

• 关于变量 years、games 和 wins，平均值始终大于中位数；这当然很好地对应了右偏斜，或正偏斜的分布。

现在我们对数据有一些好的，但主要是表格式的洞察，我们将通过创建两个小提琴图和成对直方图来可视化大部分相同的内容。你会看到小提琴图与箱线图有许多相同的属性；然而，小提琴图还显示了沿 y 轴不同值处的数值变量的密度。成对直方图，有时被称为叠加直方图（你很快就会明白为什么），提供了一种可视化方式，通过这种方式，两个分布是并排比较的，而不是在单独的图表中，这当然使得同时比较和对比两个数值变量的分布变得容易得多。本书的一个目标就是介绍主流之外的可视化，讨论它们使用的最佳案例，并演示如何创建它们。特别是这一章包括了一些这样的图表。

15.3 可视化数据

我们接下来的任务是调用 dplyr 包中的 filter() 函数来对 df1 进行子集化，其中变量 parent_child 不等于 parent；再次强调，R 中的 != 运算符表示不等于。换句话说，我们正在对 df1 进行子集化——创建一个名为 f2 的新对象——其中变量 parent_child 等于 parent_only 或 child。因此，我们在创建 df2 的同时有效地消除了 df1 的汇总记录：

df1 %>%
  filter(parent_child != "parent") -> df2

然后，我们调用基础 R 中的 dim() 函数，它返回 df2 的维度，即行和列计数：

dim(df2)
## [1] 73  8

当然，我们仍然有原始的八个变量，但 df2 只包含 73 条记录，而 df1 包含 89 条。

15.3.1 创建和评估小提琴图

现在让我们创建我们的成对小提琴图。小提琴图是箱线图和密度图的混合体，它可视化数值数据系列的分布。我们的第一个图可视化变量 games 的分布，第二个图可视化变量 wins 的分布：

• 两个图表都是通过调用 ggpubr 包中的 ggviolin() 函数创建的，而 ggpubr 只是众多 ggplot2 扩展之一。如果遇到 ggpubr 和其他 ggplot2 扩展的问题，通常是语法问题；它们倾向于使用 ggplot2、基础 R 和其他杂项命令的随机组合。但如果你能克服代码的怪癖，那么回报将是值得努力的。

• 我们刚刚创建的对象，df2，是两个图表的数据源。这意味着我们正在可视化每个独特的特许经营或团队名称的游戏和胜利分布，并忽略那些在 df1 中变量 parent_child 等于 parent 的记录。

• 小提琴图只需要一个 y 轴变量；在我们的第一个图中，y 等于 games，在第二个图中，y 等于 wins。

• 我们的小提琴图每个都包含一个嵌入的箱线图；这样我们仍然可以识别出四分位数范围 (IQR)、均值和中位数、下四分位数和上四分位数以及任何异常值。与之前章节中的箱线图一样，R 自动在 IQR 内部用水平线表示中位数；在 ggviolin() 函数之后，我们 添加 stat_summary() 函数，就像我们之前多次做的那样，以添加一个代表均值的实心点。

• ggplot2 theme() 函数将粗体字体应用于两个标题。

两个图表，p2 和 p3 的代码块如下所示：

p2 <- ggviolin(df2, y = "games",
               color = "darkslategray1", fill = "salmon1",
               add = "boxplot", add.params = list(fill = "white"),
               main = "Distribution of Games Played:\nAll NBA Franchises",
               font.main = "bold",
               subtitle = "1946-2020", 
               xlab = "", 
               ylab = "Games Played") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "darkslategray1", fill = "darkslategray1") + 
  theme(axis.text.x = element_blank())

p3 <- ggviolin(df2, y = "wins",
               color = "darkslategray1", fill = "salmon1",
               add = "boxplot", add.params = list(fill = "white"),
               main = "Distribution of Games Won:\nAll NBA Franchises",
               font.main = "bold",
               subtitle = "1946-2020", 
               xlab = "", 
               ylab = "Games Won") +
  stat_summary(fun = mean, geom = "point", shape = 20, size = 8, 
               color = "darkslategray1", fill = "darkslategray1") + 
  theme(axis.text.x = element_blank())

我们不会立即打印出小提琴图，而是将它们保存在内存中，同时我们继续创建 ggpubr 配对直方图。但首先，我们需要做一些数据处理。

15.3.2 创建配对直方图

我们通过管道操作符将 df2 数据集传递给 tidyr 包中的 pivot_longer() 函数。pivot_longer() 函数将 df2 中的 games 和 wins 变量转换为新变量 games 中的级别，并将它们的值投掷到另一个新变量 counts 中。最终结果是名为 df3 的 tibble。然后我们调用 as.factor() 函数将变量 games 从字符字符串转换为因子；counts 变量是整数。

接下来，我们调用 car 包中的 recode() 函数，将 games 变量中的 games 和 wins 元素分别重命名为 Played 和 Won。通常，recode() 函数用于修改变量中的值，但正如我们在这里所展示的，当需要重命名变量时也可以调用它。因此，它适合作为 rename() 函数的替代品。

R 基础函数 head() 返回 df3 中的前 10 条记录，但在此代码的最后部分对变量 franchise、games 和 counts 进行了子集操作。为了使此代码行运行，你必须包含变量位置而不是变量名称：

df2 %>%
  pivot_longer(cols = c("games", "wins"),
               names_to = "games",
               values_to = "counts") -> df3

df3$games <- as.factor(df3$games)

df3$games <- recode(df3$games, "games" = "Played",
                        "wins" = "Won")
head(df3[,c(1, 7, 8)], 10)
## # A tibble: 10 × 3
##    franchise             games  counts
##    <fct>                 <fct>   <int>
##  1 Atlanta Hawks         Played   4273
##  2 Atlanta Hawks         Won      2109
##  3 St. Louis Hawks       Played   1008
##  4 St. Louis Hawks       Won       555
##  5 Milwaukee Hawks       Played    280
##  6 Milwaukee Hawks       Won        90
##  7 Tri-Cities Blackhawks Played    132
##  8 Tri-Cities Blackhawks Won        54
##  9 Boston Celtics        Played   5869
## 10 Boston Celtics        Won      3462

现在我们可以通过调用 ggpubr 包中的 gghistogram() 函数来创建我们的成对直方图。通过调用 gghistogram() 函数，我们在同一个图形对象中创建两个直方图。我们能够在同一个可视化中叠加两个图表，因为 gghistogram() 自动以不透明的色调打印两个直方图，从而使得即使在它们重叠的地方也能查看两个分布：

• 我们刚刚创建的 tibble，df3，是我们的数据源。

• 与箱线图只需要 y 轴变量不同，直方图只需要 x 轴变量；在这里，我们的 x 轴变量是 counts。因为 counts 与因子变量 games 相关联，其水平等于 games 和 wins，因此我们的一个直方图因此可视化游戏的分布，或所玩的游戏，而我们的另一个直方图可视化胜利的分布。

• 与 ggplot2 箱线图一样，我们控制箱的数量。我们的两个箱线图都包含 15 个箱，这接近于 df3 记录数的平方根。

• add 参数插入代表每个分布均值的垂直虚线。

• 通过将 rug 参数设置为 TRUE，R 在 x 轴边缘添加一个 rug 图。Rug 图是以标记形式显示数据分布的一维展示，通常与同一数据系列的二维展示相辅相成。当你的数据集包含相对较少的记录时，rug 图才实用。

我们成对直方图 p4 的代码块如下：

p4 <- gghistogram(df3, x = "counts", bins = 15,
   add = "mean", rug = TRUE,
   main = "Distributions of Games Played and Won",
   font.main = "bold", 
   subtitle = "1946-2020", 
   xlab = "Games Played / Games Won", 
   ylab = "Frequency",
   legend.title = "", font.legend = "bold",
   legend = "top",
   color = "games", fill = "games") 

15.3.3 打印我们的图表

我们暂时将 p4 保存在内存中，然后通过调用 patchwork 包中的 plot_layout() 函数将其与 p2 和 p3 合并成一个单一的对象（见图 15.2）。p2 和 p3 在顶部行并排打印，而 p4（其宽度等于 p2 加 p3）在底部行显示（注意我们代码中的减号运算符）：

p2 + p3 - p4 + plot_layout(ncol = 1)

图 15.2 顶部显示的是 1946 年至 2020 年间所有当前和过去 NBA 联盟的球队所玩和赢得的比赛的分布。底部，成对直方图可视化相同的数据系列。

尽管小提琴图比箱线图少见或不受欢迎，因此在随机样本的最终用户中可能不会引起太大的共鸣，但至少有一个原因让你应该更喜欢小提琴图：它们显示了数据系列的完整分布，而箱线图仅仅显示了汇总统计量。（当然，我们选择提供两者的最佳结合，通过在小提琴图中添加嵌入的箱线图来实现。）你可能根据受众的复杂程度选择其中之一。

小提琴图也通过使用概率密度函数（PDF）来显示数据系列的形状，就像密度图一样。事实上，如果可能的话，我们可以垂直切割我们的小提琴图中间，然后旋转左半部分 90 度，它们看起来会非常像我们之前创建的密度图（参见图 15.1）。PDF 的宽度表示对应值在数据中观察到的频率，其中较宽的区域表示较高的频率，而细长的区域表示较低的频率。

数据呈右偏态。我们知道这一点，因为在我们两个小提琴图中，最宽的区域是 y 值接近 0 的一些数字。我们也知道这一点，因为在我们嵌入的箱线图中，代表均值（用实心点表示）的线条都高于代表中位数（用相同图中的水平线表示）的线条。数据呈右偏态这一点可能通过我们的配对直方图变得更加明显。在同一个可视化中绘制两个直方图是一种很好的技术，当你想要或需要比较和对比两个分布到因子级别时。

然而，我们的小提琴图和配对直方图并没有告诉我们 80-20 规则是否生效；换句话说，我们还没有弄清楚当前和过去的 NBA 球队中，是否有 20%的球队占据了 80%的比赛或胜利。数据肯定是非线性的，但我们还没有弄清楚非线性到什么程度。这就是为什么我们需要帕累托图。

15.4 帕累托图

在我们演示如何创建和解释帕累托图之前，让我们先谈谈帕累托图。帕累托图既是柱状图也是线形图，具有主要和次要的 y 轴。柱状图的长度通常代表频率，但它也可以代表时间、金钱或某种其他成本函数。柱状图通常垂直排列，并且必须按降序排列。而柱状图代表单位频率，线代表按百分比测量的累积频率；因此，线上的点对应于柱状图。

帕累托图本质上是一种质量控制工具，它提供了一个视觉提示，揭示了原因和效果，这些原因和效果往往遵循 80-20 规则或至少是非线性的。例如，帕累托图可能显示 80%的应用程序故障是由 20%已知的错误引起的。对于一个优先考虑团队工作负载的应用程序开发经理来说，这不仅仅是一个有趣的信息片段——这是一个可操作的见解。以下是一些需要考虑的更多例子：

• 一个客户服务经理正在分析投诉。帕累托图可能显示 80%的店内投诉与员工行为和照明不佳有关，这两者加起来只占所有投诉类型的 20%。这表明，仅通过解决这两个领域，投诉量可以减少多达 80%。

• 一位呼叫中心主管正在审查平均应答速度数据，该数据显示了每日违反自我设定的服务水平。随后进行的帕累托分析显示，80%的平均应答速度不达标的来电发生在 30 分钟时间间隔的 20%内。主管随后知道何时或何地增派人员。

• 一家汽车经销商的经理被展示了一个帕累托图，显示 80%的车辆是由 20%的销售人员销售的。现在经理知道哪些员工值得奖励，哪些员工可能需要额外的销售培训。

• 一位电子商务经理发现，他们的客户 80%的浏览时间花在了网站的 20%页面上；这告诉经理在哪里放置大部分广告以及如何收费。

帕累托图不一定总是显示 80-20 的比例，这是可以的。真正重要的是 80-20 法则的精神，它仅仅建议大多数结果都有少数几个原因。这意味着许多问题可以通过较低的努力水平得到解决，或者至少得到缓解。

现在，我们将创建一对帕累托图，显示 NBA 球队和所玩游戏以及所赢游戏的相对无害的关系。我们的帕累托图将使用不同的 R 包创建，这样您可以选择最适合您的包和方法。

15.4.1 ggplot2 和 ggQC 包

我们的两个帕累托图中的第一个是由ggplot2和名为ggQC的包组合构建的，这个包可以用来创建多种质量控制图。我们首先为两个帕累托图创建数据源。我们调用dplyr filter()函数来对 df1 进行子集化，其中变量parent_child不等于child，这也意味着我们在对 df1 进行子集化，其中相同的变量等于parent或parent_only：

df1 %>%
  filter(parent_child != "child") -> df4

然后，我们运行基础 R 中的dim()函数来获取我们刚刚创建的数据集 df4 的行数：

dim(df4)
## [1] 47  8

我们的数据集包含 47 行。以下dplyr代码块统计了变量active_inactive的记录数：

df4 %>%
  group_by(active_inactive) %>%
  tally()
## # A tibble: 2 × 2
##   active_inactive     n
##   <fct>           <int>
## 1 active             30
## 2 inactive           17

这些结果完全合理——NBA 现在由 30 支球队或分支机构组成，因此 df4 包含 30 个活跃的分支机构以及 17 个非活跃的分支机构是我们应该预期的结果。

我们的第一张帕累托图（见图 15.3）显示了 47 个过去和现在的 NBA 球队（条形图）所玩游戏的数量以及总游戏量的累积百分比（折线图）。

图 15.3 使用ggplot2和ggQC构建的帕累托图，显示了 NBA 球队和所玩游戏之间的非线性关系

因为我们正在创建ggplot2可视化，所以我们使用 df4 初始化我们的绘图，其中变量games按变量franchise分组，作为数据源。如果我们不先将dplyr代码通过管道传递到ggplot()函数，我们的 x 轴标签就不会正确排序。

我们的自变量是franchise，而我们的主要 y 轴变量是games。ggQC包中的stat_pareto()函数会自动绘制一条映射到次要 y 轴的线。x 轴标签以 90 度角倾斜以便于适配：

df4 %>%
  group_by(franchise) %>%
  summarize(games) %>%
ggplot(aes(x = franchise, y = games)) +
        theme(axis.text.x = element_text(angle = 90, 
                                         hjust = 1, vjust = 0.5)) +
        stat_pareto() +
  ggtitle("Pareto Chart: Games Played (1946-2020)") +
  xlab("") +
  ylab("Games Played") +
  theme(plot.title = element_text(face = "bold"))  

有几点需要提及：

• 我们的主要 y 轴（在左侧）代表所有 NBA 球队所进行的所有比赛；如果我们的 47 个条形堆叠在一起而不是代表 x 轴上的不同刻度，那么一个条形将达到与线相同的精确高度。

• 如果我们将 47 个 NBA 球队分成，比如说，8 或 10 组，我们当然会有更少的条形，但条形会更高。虽然这种操作无疑会通过消除大部分空白空间来改善美观，但它也会掩盖结果。想想我们虚构的呼叫中心主管的帕累托图——将 30 分钟的增量合并为一小时的增量可能会隐藏结果，更重要的是，使得实施纠正行动计划变得更加困难。

• 80-20 法则并不适用——在 1946 年至 2020 赛季之间，活跃和停用的 20%的球队参加了不到 50%的所有 NBA 比赛，而 80%的比赛都与大约 45%的所有 NBA 球队有关，无论是过去还是现在。但尽管 80-20 法则并不适用，NBA 球队和比赛之间的关系仍然是非线性的。

• 我们的帕累托图——或者任何帕累托图——类似于递减回报的图表。递减回报定律指出，例如，将额外的人手投入到进度落后的项目中，将带来递减的收益，直到补充的新员工不再带来任何价值。另一个例子是多元线性回归：我们可以将更多的独立变量投入模型中，从而提高 R²，但与此同时，随着每个添加零预测价值的后续变量，调整后的 R²会递减。活跃的 NBA 球队在 1946 年至 2020 年之间占所有 NBA 比赛的 98%以上；因此，我们并不一定需要其他 17 个球队来全面了解总比赛数。

• 帕累托图是洛伦兹曲线的镜像（参见第十二章和第十三章）。一个显示了非线性，另一个显示了不平等，但最终，这两个是或多或少同义的。非线性和不平等都代表了与均匀性或线性的偏离。非线性涉及对直线、比例或线性关系的偏离，而不平等则是指对平等分布或处理的偏离。

现在，让我们继续我们的第二个帕累托图。

15.4.2 qcc 包

我们的第二个也是最后一个帕累托图使用 qcc 包中的 pareto.chart() 函数，这是一个允许构建质量控制图的另一个包。这次，我们的目的是可视化过去和现在 NBA 联盟之间通过赢得的比赛建立的关系。pareto.chart() 函数的优点是它不仅绘制了帕累托图，还返回了数据的表格视图。否则，请注意以下操作来修剪我们的图形（见图 15.4）：

• 我们添加了 x 轴标签，并默认了两个 y 轴标签。

• 我们已经修改了条形图的颜色方案，至少在线上看起来，使其类似于热指数。

• pareto.chart() 函数接受一个数据集和一个数值变量作为参数；与 ggplot() 不同，它不允许我们设置 x 轴变量。因此，pareto.chart() 函数插入了一个字母和数字方案，用于 x 轴标签，这些标签与表格结果相关联。然后我们选择使用 xaxt 参数来移除这些标签：

pareto.chart(df4$wins, 
  main = "Pareto Chart: Games Won (1946-2020)", 
  xlab = "NBA Franchises",
  col = heat.colors(length(df4$wins)),
  xaxt = "n")
##     
## Pareto chart analysis for df4$wins
  Frequency      Cum.Freq.     Percentage   Cum.Percent.
## B   3462.00000000  3462.00000000     5.54612156     5.54612156
## N   3429.00000000  6891.00000000     5.49325558    11.03937714
## W   2950.00000000  9841.00000000     4.72589792    15.76527506
## T   2840.00000000 12681.00000000     4.54967800    20.31495306
## J   2826.00000000 15507.00000000     4.52725001    24.84220307
## A   2808.00000000 18315.00000000     4.49841402    29.34061709
## I   2774.00000000 21089.00000000     4.44394604    33.78456313
## Z   2624.00000000 23713.00000000     4.20364615    37.98820929
## U   2349.00000000 26062.00000000     3.76309634    41.75130563
## K   2286.00000000 28348.00000000     3.66217039    45.41347602
## X   2271.00000000 30619.00000000     3.63814040    49.05161642
## E   2258.00000000 32877.00000000     3.61731441    52.66893083
## Q   2231.00000000 35108.00000000     3.57406043    56.24299125
## A1  2227.00000000 37335.00000000     3.56765243    59.81064368
## Y   2211.00000000 39546.00000000     3.54202044    63.35266412
## D1  2187.00000000 41733.00000000     3.50357246    66.85623658
## C1  2060.00000000 43793.00000000     3.30011855    70.15635513
## F   1889.00000000 45682.00000000     3.02617667    73.18253180
## L   1823.00000000 47505.00000000     2.92044472    76.10297651
## H   1796.00000000 49301.00000000     2.87719073    78.98016725
## M   1706.00000000 51007.00000000     2.73301080    81.71317805
## G   1657.00000000 52664.00000000     2.65451283    84.36769088
## C   1533.00000000 54197.00000000     2.45586492    86.82355580
## P   1378.00000000 55575.00000000     2.20755503    89.03111083
## V   1212.00000000 56787.00000000     1.94162315    90.97273397
## D   1083.00000000 57870.00000000     1.73496524    92.70769921
## R   1003.00000000 58873.00000000     1.60680529    94.31450450
## B1   982.00000000 59855.00000000     1.57316331    95.88766781
## O    864.00000000 60719.00000000     1.38412739    97.27179520
## S    704.00000000 61423.00000000     1.12780750    98.39960270
## H1   158.00000000 61581.00000000     0.25311589    98.65271859
## T1   157.00000000 61738.00000000     0.25151389    98.90423248
## I1   147.00000000 61885.00000000     0.23549390    99.13972638
## N1   132.00000000 62017.00000000     0.21146391    99.35119029
## R1   122.00000000 62139.00000000     0.19544391    99.54663420
## P1    46.00000000 62185.00000000     0.07369197    99.62032617
## G1    37.00000000 62222.00000000     0.05927397    99.67960014
## J1    30.00000000 62252.00000000     0.04805998    99.72766012
## E1    25.00000000 62277.00000000     0.04004998    99.76771010
## Q1    22.00000000 62299.00000000     0.03524398    99.80295409
## S1    22.00000000 62321.00000000     0.03524398    99.83819807
## L1    20.00000000 62341.00000000     0.03203999    99.87023806
## U1    19.00000000 62360.00000000     0.03043799    99.90067604
## F1    18.00000000 62378.00000000     0.02883599    99.92951203
## M1    18.00000000 62396.00000000     0.02883599    99.95834802
## O1    15.00000000 62411.00000000     0.02402999    99.98237801
## K1    11.00000000 62422.00000000     0.01762199   100.00000000  

图 15.4 使用 gcc 包构建的帕累托图，显示了与赢得的比赛相关的类似非线性关系，随后是数据的表格视图，这两者都是使用相同的代码库同时生成的

虽然美学上显然与我们的第一个帕累托图不同，但结果并没有那么不同——在 1946 年和 2020 年 NBA 赛季之间，大约 20% 的活跃和非活跃联盟赢得了所有比赛的 45%，而赢得的 80% 的比赛都与大约 42% 的过去和现在联盟相关联。再次强调，没有 80-20 规则，但仍然存在更多的非线性。

在下一章中，我们将考虑当其他人看到因果关系时，随机性可能实际上确实存在的可能性。

摘要

• 在理解 80-20 规则之前，很难理解大多数因果关系。

• 80-20 规则实际上是对非线性的一种委婉说法；毕竟，80% 的结果并不总是映射到 20% 的根本原因。然而，世界上的许多方面在某种程度上是非线性的，因此是杂乱的，必须理解和接受，然后才能触发正确的分析类型。

• 帕累托图是可视化原因和效果以及实现“物有所值”的纠正措施的最佳解决方案。

• R 提供了大量创建帕累托图的选项，包括内置函数和ggplot2（无需扩展）。我们仅展示了其中两种最佳选项。

• 在此过程中，我们还证明了 NBA 球队与比赛进行和赢得的关系都是非线性的。

• 我们介绍了新的可视化技术：小提琴图作为图形显示连续数据分布的另一种选择，然后在同一图表中配对直方图。

16 随机性 versus 因果关系

本章涵盖了

• 拉普拉斯的成功法则

• 热手

• 识别随机性、顺序和因果关系

• 模拟抛硬币

• 将 ggplot2 对象插入到其他 ggplot2 对象中

在 18 世纪早期，一位名叫皮埃尔-西蒙·拉普拉斯的法国学者和博学家开发了一个公式，用于从低观察计数开始计算概率。假设有 n 次独立的试验，只能导致成功或失败；我们可能通过应用以下公式来计算下一次试验成功的概率 (p) (s) (n)：p = s / n。然而，假设只有五次独立的试验和五次成功。因此，第六次试验成功的概率将是 100%；或者，如果前五次都失败了，成功的概率将是 0%。传统的或习惯的计算概率的方法没有考虑到在观察计数低和方差机会相对最小的情况下，不同结果的可能性，因此并不十分有意义。

介绍拉普拉斯。具有讽刺意味的是，拉普拉斯并非通过观察某些罕见现象，而是通过估计太阳升起的概率来发展了后来成为成功法则的东西。如果 p 等于成功的概率，s 等于先前的成功次数，n 等于完成的试验次数，那么拉普拉斯的成功法则估计 p = (s + 1) / (n + 2)。因此，如果在五个独立的试验中都有成功，第六次试验成功的概率将不会是 100%，而是 86%。如果前五次试验都失败了，拉普拉斯的成功法则估计第六次试验成功的概率为 14%。

一系列独立的试验通常会导致成功和失败的一些混合。但拉普拉斯的成功法则最流行的用例是估计一系列先前的成功之后的成功率，无论先前的独立试验数量是多少。

正因如此，我们才在这里。我们的目的是了解拉普拉斯概率曲线，并探讨在一系列先前的成功之后，是否自由投篮命中率遵循这样的曲线，至少在精神上如此。我们的问题将包括以下内容：

• 自由投篮命中率是否会随着每一次后续的成功而增加，或者自由投篮命中率根本不遵循任何模式？

• 是否可以从先前的尝试中估计自由投篮尝试的成功率，或者命中和失球是否类似于一系列的抛硬币？

• 当我们分析一系列的自由投篮命中和失球时，是否存在顺序和因果关系，或者只是随机性？

• 是否存在“手感热”这样的东西，或者“手感热”仅仅是一种认知错觉？

我们将加载我们的包，导入我们的数据，运行一系列数据整理操作，进一步讨论继起规则和热手现象，然后进行我们的分析。我们的分析将分为两部分：我们将检查三名联赛领先者的罚球射击，然后我们将评估单个数据系列中每位球员的相同表现。准备好迎接一个严重的剧情转折。

16.1 加载包

除了tidyverse（我们将使用dplyr函数整理数据，并使用ggplot2函数创建可视化）之外，我们只需要加载一个相对不为人知的包，名为runner，它包含用于范围和大小连串的函数。因此，我们调用library()函数加载tidyverse和runner包：

library(tidyverse)
library(runner)

接下来，我们将导入或重新导入我们在第八章中使用过的相同数据集。

16.2 导入和整理数据

然后，我们调用read_csv()函数来导入一个从www.bigdataball.com下载并保存在我们默认工作目录中的.csv 文件。我们的数据集——即我们在第八章探索最优停止规则时首次导入的数据——包含了 2019-20 NBA 常规赛和季后赛几乎每一场比赛的详细信息。在这个过程中，我们创建了一个名为 ft 的对象。

我们已经知道我们的数据有 543,149 行长和 44 列宽；因此，如果你在个人电脑上工作而不是服务器上，加载比赛数据集可能需要几秒钟：

ft <- read_csv("pbp.csv")

我们的数据比我们需要的更宽更长。因此，我们接下来调用dplyr包中的select()函数来仅对几个变量进行数据子集：

ft %>%
  select(date, event_type, player, points, result, type) -> ft

我们将 ft 缩减到以下变量：

• date——每个比赛发生的日期，格式为 yyyy-mm-dd。这是一个字符字符串，将很快被转换为日期类型。

• event_type——比赛的类型（例如，跳球、犯规、失误）。在第八章中，我们将event_type从字符字符串转换为因子变量，然后最终将数据子集为event_type等于shot（代表投中三分）或miss（代表投篮未命中）。

• player——负责事件类型或比赛的球员的名字，格式为“姓 名”。这是一个字符字符串，将保持为字符字符串。

• points——任何比赛直接导致得分的数量。在可以直接导致得分的场合和地方，这个值至少为 0，最多为 3；当比赛不可能导致任何得分——例如，篮板、驱逐或暂停——得分等于 NA。这是一个整数，现在并将保持为整数。

• result——在投篮或罚球尝试之后得分或失分；否则等于 NA。这是一个字符字符串，将被转换为因子变量。

• type——与event_type类似，但描述得稍微详细一些。例如，当event_type等于rebound时，type可能等于rebound offensive；或者当event_type等于miss时，type可能等于Floating Jump Shot。现在这是一个将被转换为因子变量的字符字符串。

然后，我们调用来自dplyr的filter()函数，以缩短我们的数据长度：

ft %>%
  filter(event_type == "free throw", type != "Free Throw Technical") -> ft

我们对ft进行了子集处理，其中event_type等于free throw且type不等于Free Throw Technical。这里需要一些解释。

在第八章中，我们对所有投篮尝试的逐场数据进行了子集处理，这要求我们应用filter()函数，其中event_type等于shot或miss——因为shot代表成功的投篮尝试，而miss代表不成功的投篮尝试。相反，每次罚球尝试——无论是命中还是未命中——都会在event_type等于free throw的情况下被计算在内；然后我们必须将event_type与变量result结合，result等于made或missed，以确定任何尝试的罚球是否成功。

如果你对篮球不熟悉，你可能想知道罚球究竟是什么。许多防守犯规会导致进攻球员被允许投掷一次或通常两次罚球——有时，根据情况，甚至可以投掷三次罚球。罚球是从距离篮筐 15 英尺的线后进行的无干扰或未受保护的投篮。比赛计时器暂停，场上的每位球员都必须站在射手的一侧或其后，直到最后一次罚球尝试完成。成功的罚球，通常被称为罚球，总是值一分。一个好的射手或得分手可能在他的投篮尝试中命中 45%，但他的罚球命中率可能达到 80%或更高。

我们排除了技术罚球，因为它们只占所有尝试罚球的一小部分，这样做简化了我们对成功尝试连串的规模和范围的评估工作。为了提供一些背景信息，Giannis Antetokounmpo，密尔沃基雄鹿队的前锋，昵称希腊怪物，在 2019-20 赛季常规赛中尝试了 629 次罚球，位列联盟第二，然后在随后的季后赛中又尝试了额外的 81 次罚球。在这 710 次总尝试中，只有 3 次是技术罚球，即对方球队被吹罚技术犯规而产生的罚球。关于 Antetokounmpo 的更多内容，你很快就会听到。

与此同时，我们将自由投篮与投篮尝试进行对比，投篮尝试可以从距离篮筐 25 英尺的激烈跳投到开放的轻松上篮不等。这就是为什么我们选择了自由投篮而不是投篮来与拉普拉斯概率曲线进行比较，并确定是否存在“热手”这种东西。自由投篮是在一个主要受控的环境中尝试的，而投篮则经常在混乱的情况下尝试。

话虽如此，我们接下来调用基础 R 的as.Date()函数，将 ft 变量date从字符字符串转换为日期类别。当格式等于%Y-%m-%d（如这里所示）或%Y/%m/%d 时，as.Date()函数特别简单。然后，我们调用也来自基础 R 的class()函数，以返回并确认转换后的类别：

ft$date <- as.Date(ft$date, "%Y-%m-%d")
class(ft$date)
## [1] "Date"

接下来，我们调用基础 R 的as.factor()函数三次，将剩余的四个 ft 字符字符串中的三个转换为因子：

ft$event_type <- as.factor(ft$event_type)
ft$result <- as.factor(ft$result)
ft$type <- as.factor(ft$type)

最后，我们调用dplyr glimpse()函数，它返回我们数据的转置、但截断的视图。此外，glimpse()函数还返回 ft 的行和列计数以及每个存活变量的类别。因此，在单一快照中，我们可以公平地了解我们的数据处理操作的结果：

glimpse(ft)
## Rows: 51,722
## Columns: 6
## $ date       <date> 2019-10-22, 2019-10-22, 2019-10-22, 2019-10-22,...
## $ event_type <fct> free throw, free throw, free throw, free throw, ...
## $ player     <chr> "Kyle Lowry", "Kyle Lowry", "Pascal Siakam", "Pa...
## $ points     <dbl> 1, 0, 1, 1, 1, 1, 1, 1, 1, 2, 0, 1, 1, 0, 1, 1, ...
## $ result     <fct> made, missed, made, made, made, made, made, made...
## $ type       <fct> Free Throw 1 of 2, Free Throw 2 of 2, Free Throw...

接下来，我们将详细阐述拉普拉斯的连续性规则。

16.3 连续性和热手规则

如果投篮命中率至少大致遵循拉普拉斯概率曲线，当成功（s）等于试验（n）时，那么得出“热手”这种东西存在的结论可能是合理的。这广泛地表明，成功不可避免地导致进一步的成功，这意味着从统计学的角度来看，幂律是从一系列早期成功中演变而来，而不是立即回归到平均值。为了明确，幂律通过一个变量与另一个变量的幂的比例来描述数学关系；结果不是线性的，而是指数的。相比之下，回归到平均值是一种现象，其中极端结果被更温和的结果或同等极端的结果所跟随，这些结果相互抵消。

另一方面，我们必须接受这样一个事实，即世界上很大一部分是盲目无序的，因此不是整洁或可预测的，并避免混淆随机性和秩序、因果关系的陷阱。以一系列抛硬币为例，我们可以通过调用内置的sample()函数在 R 中模拟。sample()函数接受以下四个参数：

• x——包含要从中选择的元素的向量。因为我们是在抛两面硬币，所以我们分配一对整数来表示正面（0）和反面（1）。然后，这些整数被传递给基础 R 的c()函数作为参数，以形成向量。

• size——等于所需的抛硬币次数。因为我们可以用 10 次抛硬币同样容易地演示sample()函数，所以我们设置size等于10。

• prob—一个包含单次抛硬币出现正面或反面的概率的第二个向量。因为我们模拟的是公平硬币的抛掷，而不是加权硬币，所以prob必须因此包含0.5和0.5作为元素。

• replace—在带替换采样时等于TRUE，否则为FALSE。抛硬币意味着是独立的试验，其中每次抛掷有相等的机会产生正面或反面，无论之前的抛掷结果如何。这就是为什么我们必须带替换采样。（顺便说一句，只能产生两种结果之一的独立试验通常被称为伯努利试验或二项试验。）

sample()函数返回一系列 10 个值，每个值都将等于0或1。当然，每次调用sample()函数的结果都会不同；这里显示的是第一次调用sample()函数时返回的结果：

sample(x = c(0, 1), size = 10, prob = c(0.5, 0.5), replace = TRUE)
##  [1] 0 1 1 1 1 1 1 0 1 0

我们第一次模拟的抛硬币结果是正面，接下来的六次抛硬币结果是反面，最后三次中有两次结果是正面。我们的代码没有问题，sample()函数也没有缺陷——我们公正地模拟了 10 次抛硬币，其中正面和反面的概率是相等的。

概率并不等同于保证的结果，尤其是在小样本中。如果我们模拟 10,000 次抛硬币，我们不太可能得到 70%的正面；然而，我们同样不太可能得到正好 5,000 次正面和 5,000 次反面。

如果我们再次运行我们的代码，我们可能会得到相同的结果，因此我们两次抛硬币的结果在效果上会类似于幂律。我们可能会得到七个正面和三个反面，或者至少五个正面和五个反面，因此我们两次抛硬币的结果会显示出回归到平均值。

当然，我们的模拟硬币连续六次抛出反面并不意味着它变热了。每次抛硬币代表一个独立的试验，其中结果与过去或未来的事件没有联系。那么，NBA 球员罚球的情况呢？每次罚球也是一个独立的试验吗，还是因为一系列尝试的罚球实际上是相关事件，所以连续六次命中因此构成“手感热”？

换句话说，手感热是一种认知错觉，就像臭名昭著的蒙提霍尔问题吗？还是它是一个真实的现象？

蒙提霍尔问题

蒙提霍尔是电视游戏节目《让我们来交易》的原始主持人。参赛者经常被展示三个隐藏在三个关闭的门后的奖品，并被要求选择其中之一。其中一扇门后面是一辆车；其他两扇门后面是农场动物。你作为参赛者，选择了 1 号门。

蒙提·霍尔，他知道每扇门后面是什么，然后打开了编号为 3 的门，门后面是一只山羊。然后他问你是否想坚持选择编号为 1 的门，还是切换到编号为 2 的门。你可能会得出结论，这无关紧要——剩下两扇门，几率必须是一半。然而，实际上，通过切换到编号为 2 的门，你实际上将赢得汽车的机会翻倍。这是因为有 33.3%的概率汽车在编号为 1 的门后面，有 66.7%的概率汽车在另外两扇门中的一扇后面。而且因为蒙提·霍尔已经打开了编号为 3 的门，汽车在编号为 2 的门后面而不是编号为 1 的门后面的概率是两倍。切换门的参赛者大约有三分之二的时间赢得了汽车。

如果“手感热”是一个真实的现象，那么罚球命中率将大约遵循拉普拉斯概率曲线，其中试验次数（投篮）和成功次数（罚球命中）是相同的。现在让我们用 20 次成功和 20 次试验来具体展示拉普拉斯概率曲线的形状。

我们首先创建了一对向量，prior_successes和independent_trials，它们都包含 1 到 20 的整数作为元素。R 的基础seq()函数通过一个传递的参数生成另一个传递的参数的数字序列；默认情况下，R 按默认值递增序列。然后，我们通过将两个向量传递给 R 的基础data.frame()函数来创建一个数据框 df：

prior_successes <-seq(1, 20)
independent_trials <- seq(1, 20)

df <- data.frame(prior_successes, independent_trials)
print(df)
##    prior_successes independent_trials
## 1                1                  1
## 2                2                  2
## 3                3                  3
## 4                4                  4
## 5                5                  5
## 6                6                  6
## 7                7                  7
## 8                8                  8
## 9                9                  9
## 10              10                 10
## 11              11                 11
## 12              12                 12
## 13              13                 13
## 14              14                 14
## 15              15                 15
## 16              16                 16
## 17              17                 17
## 18              18                 18
## 19              19                 19
## 20              20                 20

接下来，我们通过管道操作符将 df 传递给dplyr mutate()函数来创建一个新变量。我们的新变量laplace等于拉普拉斯的后继法则公式，然后乘以 100 将小数转换为百分比：

df %>%
  mutate(laplace = (prior_successes + 1) / 
           (independent_trials + 2) * 100) -> df
print(df)
##    prior_successes independent_trials  laplace
## 1                1                  1 66.66667
## 2                2                  2 75.00000
## 3                3                  3 80.00000
## 4                4                  4 83.33333
## 5                5                  5 85.71429
## 6                6                  6 87.50000
## 7                7                  7 88.88889
## 8                8                  8 90.00000
## 9                9                  9 90.90909
## 10              10                 10 91.66667
## 11              11                 11 92.30769
## 12              12                 12 92.85714
## 13              13                 13 93.33333
## 14              14                 14 93.75000
## 15              15                 15 94.11765
## 16              16                 16 94.44444
## 17              17                 17 94.73684
## 18              18                 18 95.00000
## 19              19                 19 95.23810
## 20              20                 20 95.45455

当然，与阅读一排排数字相比，可视化结果总是更有效，你可以在图 16.1 中这样做：

• 因此，我们将我们的模拟数据传递给ggplot()函数，该函数来自ggplot2包。

• 我们的自变量是independent_trials，因变量是laplace。

• 我们的视觉化将是一个带有线条上层的点状图；因此，我们调用一对几何对象来绘制我们的图表，geom_line()和geom_point()。我们的线条宽度是默认宽度的 1.5 倍，点的大小是默认大小的三倍。

• scale_x_continuous()函数与seq()函数一起使用，使我们能够操纵 x 轴刻度，从而覆盖ggplot2的默认设置。我们的 x 轴将包含 20 个刻度，每次增加 1，而不是 5 个刻度每次增加 5。

图 16.1 当成功次数等于相对较小的独立试验次数时的拉普拉斯概率曲线

精确的 y 轴值对我们来说大多没有意义。我们只是对随着试验次数和成功次数的增加概率曲线的弧线感兴趣：

p1 <- ggplot(df, aes(x = independent_trials, y = laplace, group = 1)) + 
      geom_line(aes(y = laplace), color = "purple", size = 1.5) +
      geom_point(size = 3, color = "purple") +
      labs(title = "Laplace's Rule of Succession", 
           subtitle = "success leads to more success", 
           x = "Independent Trials",
           y = "Probability of Success") +
     scale_x_continuous(breaks = seq(0, 20)) +
     theme(plot.title = element_text(face = "bold")) 
print(p1)

随着独立试验（和成功）数量的增加，成功的概率以递减的速度增加，但它永远不会达到 100%。拉普拉斯的后继规则考虑到了不同结果的可能性，无论之前进行了多少次成功的试验。

让我们从检查球员特定的罚球命中率开始，按连续尝试和得分进行细分。然后我们将比较结果与我们的拉普拉斯概率曲线。

16.4 球员级别分析

我们为分析挑选了三名球员。他们三人都曾是 2019-20 赛季尝试罚球次数的领跑者；然而，他们各自成功尝试的百分比差异很大。因此，支持我们分析的大量观察结果分散在三位具有不同罚球技巧的球员身上。

16.4.1 第 3 位球员：扬尼斯·安特托昆博

我们将从扬尼斯·安特托昆博开始，他效力于密尔沃基雄鹿队的强力前锋位置。安特托昆博在 2019-20 赛季常规赛和季后赛中尝试了 707 次罚球（不包括技术罚球），根据www.basketball-reference.com的数据，成功 442 次，成功率达到了 62.5%。安特托昆博是 NBA 最优秀和得分能力最强的球员之一，但罚球并不是他的强项。

我们的第一步操作是调用filter()函数，对 ft 数据集进行子集化，其中变量player等于Giannis Antetokounmpo。最终结果是名为 giannis 的新数据集。

我们可以通过运行一对基础 R 函数来确认我们数据的完整性——或者至少用我们从www.basketball-reference.com获取的统计数据来证实它。dim()函数返回 giannis 的行和列计数；giannis 包含 707 条记录，这与他在常规赛和季后赛中尝试的罚球次数相匹配。sum()函数将变量 points 中包含的整数相加，其中0代表未命中的罚球，1代表命中的罚球；总和为 442，确实等于成功罚球次数：

ft %>%
  filter(player == "Giannis Antetokounmpo") -> giannis

dim(giannis)
## [1] 707   6
sum(giannis$points)
## [1] 442

然后我们将 giannis 数据集通过管道传递给dplyr group_by()和mutate()函数。从mutate()中，我们得到一个名为streak的新变量，而group_by()则按变量 date 对结果进行分组。

我们的新变量是通过从runner包中调用streak_run()函数得到的。dplyr-streak_run()中的lag()函数计算一系列连续元素，并告诉streak_run()在处理数据之前先从上一条记录中摄取变量 points。(dplyr包还包含一个lead()函数，它是lag()的相反操作；此外，还可以通过两条或更多记录来回顾或前瞻。)

我们按变量日期分割这些结果，因为如果存在所谓的“手感热”现象，它肯定只存在于单场比赛中，因此不会从一个游戏延续到下一个游戏。这种方法也使记录数保持在最低，因此符合拉普拉斯继起法则的最佳拟合。

我们的结果被转换为一个名为 giannis_final 的 tibble。基本的 R head() 函数返回前 10 个观察值：

giannis %>%
  group_by(date) %>%
  mutate(streak = streak_run(lag(points))) -> giannis_final

head(giannis_final, n = 10)
## # A tibble: 10 × 7
## # Groups:   date [1]
##    date       event_type player                points result            
##    <date>     <fct>      <chr>                  <dbl> <fct>
##  1 2019-10-24 free throw Giannis Antetokounmpo      0 missed 
##  2 2019-10-24 free throw Giannis Antetokounmpo      1 made   
##  3 2019-10-24 free throw Giannis Antetokounmpo      0 missed 
##  4 2019-10-24 free throw Giannis Antetokounmpo      0 missed 
##  5 2019-10-24 free throw Giannis Antetokounmpo      0 missed 
##  6 2019-10-24 free throw Giannis Antetokounmpo      1 made   
##  7 2019-10-24 free throw Giannis Antetokounmpo      1 made   
##  8 2019-10-24 free throw Giannis Antetokounmpo      1 made   
##  9 2019-10-24 free throw Giannis Antetokounmpo      1 made   
## 10 2019-10-24 free throw Giannis Antetokounmpo      1 made   
##    type              streak
##    <fct>              <int>
##  1 Free Throw 1 of 2      0
##  2 Free Throw 2 of 2      1
##  3 Free Throw 1 of 2      1
##  4 Free Throw 2 of 2      1
##  5 Free Throw 1 of 2      2
##  6 Free Throw 2 of 2      3
##  7 Free Throw 1 of 1      1
##  8 Free Throw 1 of 2      2
##  9 Free Throw 2 of 2      3
## 10 Free Throw 1 of 2      4

让我们浏览一下数据——至少是前几条记录——以进一步解释 streak_run() 函数是如何工作的：

• 当日期翻转时，变量 streak 总是等于 0；并且无论第一次尝试是命中还是未命中，它总是等于 1。

• 安特托昆博在 2019 年 10 月 24 日错过了他的第一次罚球尝试，然后命中了他的第二次尝试。因此，他的第三次尝试罚球时 streak 等于 1。因为安特托昆博错过了那次尝试，他的第四次罚球尝试时 streak 也等于 1。

• 最终，安特托昆博连续投中五个罚球；因此，对于每一次连续尝试，变量 streak 都会增加一。

然后，我们将 giannis_final 传递给 dplyr group_by() 和 slice() 函数，以有效地删除每个独特日期的第一个记录。连串在每场比赛结束时自动停止；因此，我们只对每个独特日期或游戏的第二次罚球尝试 onward 感兴趣：

giannis_final %>%
  group_by(date) %>%
  slice(-1) -> giannis_final

调用 dim() 函数返回新的 giannis_final 维度：

dim(giannis_final)
## [1] 635   7

由于移除了每个独特日期或游戏的第一个记录（再次强调，我们按日期分割记录，因为连串不会从一个游戏延续到下一个游戏，所以每个游戏的第一次罚球尝试是多余的），giannis_final 现在包含 635 条记录，比之前少了 72 条记录。这很合理，因为安特托昆博在 2019-20 赛季参加了 72 场常规赛和季后赛比赛。（注意，2019-20 NBA 赛季因 COVID-19 而缩短。）

我们还没有完成对 giannis_final 记录数的减少，因为在这个时候，我们正在跟踪命中和未命中的连串，但我们只关心在命中罚球之后的成功和未成功的罚球尝试。因此，在我们的下一块代码中，我们将 giannis_final 传递给 filter() 函数，以子集我们的数据，其中变量 points 的一个记录滞后等于 1。

然后，我们调用 dplyr group_by() 和 summarize() 函数来按变量 streak 计算命中和未命中的次数。我们的结果被转换为一个名为 giannis_tbl1 的 tibble：

giannis_final %>%
  filter(lag(points) == 1) %>%
  group_by(streak) %>%
  summarize(makes = sum(points == 1), 
            misses = sum(points == 0)) -> giannis_tbl1
print(giannis_tbl1)
## # A tibble: 12 × 3
##    streak makes misses
##     <int> <int>  <int>
##  1      1    74     46
##  2      2    63     30
##  3      3    41     16
##  4      4    27      8
##  5      5    14      7
##  6      6     6      4
##  7      7     3      1
##  8      8     3      0
##  9      9     2      0
## 10     10     1      1
## 11     11     1      0
## 12     12     1      0

最后，我们再次调用 mutate() 函数来创建一个新的变量，pct，它等于命中次数除以总罚球尝试次数。因此，变量 pct 代表了变量 streak 中每个整数值所对应的吉安尼斯·安特托昆博的罚球命中率：

giannis_tbl1 %>%
  mutate(pct = makes / (makes + misses) * 100) -> giannis_tbl2
print(giannis_tbl2)
## # A tibble: 12 × 4
##    streak makes misses   pct
##     <int> <int>  <int> <dbl>
##  1      1    74     46  61.7
##  2      2    63     30  67.7
##  3      3    41     16  71.9
##  4      4    27      8  77.1
##  5      5    14      7  66.7
##  6      6     6      4  60  
##  7      7     3      1  75  
##  8      8     3      0 100  
##  9      9     2      0 100  
## 10     10     1      1  50  
## 11     11     1      0 100  
## 12     12     1      0 100

这些结果随后通过 ggplot2 线形图进行可视化，每个 x 轴刻度上都有点叠加在线上（见图 16.2）：

p2 <- ggplot(giannis_tbl2, aes(x = streak, y = pct, group = 1)) + 
  geom_line(aes(y = pct), color = "steelblue", size = 1.5) +
  geom_point(size = 3, color = "steelblue") +
  labs(title = "Giannis Antetokounmpo", 
       subtitle = "Free Throw Percentage Following Consecutive Makes", 
       x = "Consecutive Makes (Streak)", 
       y = "Free Throw Shooting Percentage", 
       caption = "2019-20 regular season and postseason\n
              Antetokounmpo shot 62.5% from the line during
       the regular season and postseason combined") +
  scale_x_continuous(breaks = seq(0, 12, 1)) +
  theme(plot.title = element_text(face = "bold"))
print(p2) 

图 16.2 2019-20 赛季吉安尼斯·安特托昆博连续命中罚球的成功率

我们的图表与拉普拉斯概率曲线完全不相似，因此我们无法得出存在“热手”效应的结论。是的，当安特托昆博连续命中一到四个罚球时，他的罚球成功率确实提高了，但当他连续命中五个成功尝试时，罚球成功率下降到大约 67%，当他连续命中六个罚球时，又下降到 60%。而且，是的，当安特托昆博连续成功罚球尝试达到并超过八个时，他通常从罚球线投篮 100%，但那些数字的记录计数如此之低，以至于使得结果在统计学上没有意义。

然而，更重要的是，那些最后的结果忽略了即使是在公平概率下抛硬币也可能连续多次出现正面或反面的事实。我们之前模拟的抛硬币在 10 次抛掷中就出现了六次连续出现反面的情况。让我们看看在 700 次抛掷中我们可能会得到什么样的连击，这大约等于安特托昆博在 2019-20 赛季尝试的罚球次数。

我们再次调用 sample() 函数（再次强调，每次调用 sample() 时结果都会不同）：

• 由于我们现在模拟的是 700 次抛硬币，而不是仅仅 10 次，我们改变 sample() 函数的大小参数为 700。

• 我们的结果保存在一个名为 coin_flips 的数据框中，具体是一个名为 heads_tails 的列，其中 0 再次表示正面，1 表示反面。我们也可以认为 0 表示失手的罚球，而 1 表示成功的罚球。

• 然后，我们将 coin_flips 传递给 mutate() 函数，创建一个名为 streak 的变量，该变量等于连续出现正面和反面的累计数，这要归功于 runner 包中的 streak_run() 函数。

• 然后，我们通过调用 dplyr 的 filter() 函数来对 heads_tails 等于 1 的 coin_flips 进行子集化。

• 最后，我们调用基础 R 的 max() 函数，该函数返回变量 streak 的最大值。

我们不会费心打印所有或部分 coin_flips；我们只需在这里分享结果：

coin_flips <- sample(x = c(0, 1), size = 700, prob = c(0.5, 0.5), 
                     replace = TRUE)
coin_flips <- as.data.frame(coin_flips)
colnames(coin_flips) <- c("heads_tails")

coin_flips %>%
  mutate(streak = streak_run(heads_tails)) %>%
  filter(heads_tails == 1) -> coin_flips

max(coin_flips$streak)
## [1] 11

因此，在模拟了 700 次抛硬币之后，我们得到了最多 11 次连续出现反面的情况。这与安特托昆博的最佳连击相当，特别是考虑到我们模拟的是公平的、没有加权的抛硬币，其概率是 50/50。

16.4.2 第 3 名球员：朱利叶斯·兰德尔

我们的下一位球员是朱利叶斯·兰德尔，他是纽约尼克斯队的前锋和中锋。在 2019-20 赛季常规赛中（尼克斯队没有晋级季后赛），兰德尔尝试了 350 次罚球，不包括两次技术罚球；他命中了 257 次，占这些尝试的 73.4%。再次强调，这些统计数据是从www.basketball-reference.com获得的。

我们首先调用filter()函数，并子集 ft 数据集，其中变量player等于Julius Randle。随后的dim()和sum()函数调用确认我们的数据与篮球参考网站上的类似统计数据完全一致——dim()返回记录数，即尝试的罚球次数，而sum()通过变量points中的整数相加返回命中的罚球次数，其中0表示未命中，1表示命中：

ft %>%
  filter(player == "Julius Randle") -> randle

dim(randle)
## [1] 350   6
sum(randle$points)
## [1] 257

然后，我们创建了一个名为streak的变量，这个变量与之前的同名变量类似，按date变量分组。我们的结果被转换成一个新的对象，称为 randle_final。

我们通过调用head()函数获取 randle_final 返回的前 10 个观测值：

randle %>%
  group_by(date) %>%
  mutate(streak = streak_run(lag(points))) -> randle_final

head(randle_final, n = 10)
## # A tibble: 10 × 7
## # Groups:   date [2]
##    date       event_type player        points result 
##    <date>     <fct>      <chr>          <dbl> <fct>  
##  1 2019-10-23 free throw Julius Randle      1 made   
##  2 2019-10-23 free throw Julius Randle      0 missed 
##  3 2019-10-23 free throw Julius Randle      1 made   
##  4 2019-10-23 free throw Julius Randle      1 made   
##  5 2019-10-23 free throw Julius Randle      0 missed 
##  6 2019-10-23 free throw Julius Randle      1 made   
##  7 2019-10-25 free throw Julius Randle      0 missed 
##  8 2019-10-25 free throw Julius Randle      0 missed 
##  9 2019-10-25 free throw Julius Randle      1 made   
## 10 2019-10-25 free throw Julius Randle      1 made   
##    type              streak
##    <fct>              <int>
##  1 Free Throw 1 of 1      0
##  2 Free Throw 1 of 2      1
##  3 Free Throw 2 of 2      1
##  4 Free Throw 1 of 1      1
##  5 Free Throw 1 of 2      2
##  6 Free Throw 2 of 2      1
##  7 Free Throw 1 of 2      0
##  8 Free Throw 2 of 2      1
##  9 Free Throw 1 of 2      2
## 10 Free Throw 2 of 2      1

然后，我们通过管道操作符将 randle_final 传递给group_by()和slice()函数，删除每个唯一日期或比赛的第一个 randle_final 记录：

randle_final %>%
  group_by(date) %>%
  slice(-1) -> randle_final

这将 randle_final 的长度减少到 289 条记录：

dim(randle_final)
## [1] 289   7

再次调用filter()函数进一步减少 randle_final，这次通过子集变量points中一个记录的滞后等于1。然后将这些结果传递给group_by()和summarize()函数，对变量streak中的每个整数进行命中和未命中的计数。我们的汇总结果被转换成名为 randle_tbl1 的 tibble：

randle_final %>%
  filter(lag(points) == 1) %>%
  group_by(streak) %>%
  summarize(makes = sum(points == 1), 
            misses = sum(points == 0)) -> randle_tbl1
print(randle_tbl1)
## # A tibble: 8 × 3
##   streak makes misses
##    <int> <int>  <int>
## 1      1    39     10
## 2      2    35     24
## 3      3    18     10
## 4      4    10      5
## 5      5     5      3
## 6      6     2      1
## 7      7     2      0
## 8      8     1      0

然后将这个对象传递给mutate()函数，创建一个新的变量，等于 Randle 在连续命中次数中的罚球命中率：

randle_tbl1 %>%
  mutate(pct = makes / (makes + misses) * 100) -> randle_tbl2

print(randle_tbl2)
## # A tibble: 8 × 4
##   streak makes misses   pct
##    <int> <int>  <int> <dbl>
## 1      1    39     10  79.6
## 2      2    35     24  59.3
## 3      3    18     10  64.3
## 4      4    10      5  66.7
## 5      5     5      3  62.5
## 6      6     2      1  66.7
## 7      7     2      0 100  
## 8      8     1      0 100

最后，我们通过绘制来自我们刚刚创建的 randle_tbl2 tibble 的ggplot2线图来可视化朱利叶斯·兰德尔（Julius Randle）的罚球命中率（见图 16.3）：

p3 <- ggplot(randle_tbl2, aes(x = streak, y = pct, group = 1)) + 
  geom_line(aes(y = pct), color = "steelblue", size = 1.5) +
  geom_point(size = 3, color = "steelblue") +
  labs(title = "Julius Randle", 
       subtitle = "Free Throw Percentage Following Consecutive Makes", 
       x = "Consecutive Makes (Streak)", 
       y = "Free Throw Shooting Percentage", 
       caption = "2019-20 regular season and postseason\n
                  Randle shot 73.4% from the line during
       the regular season") +
  scale_x_continuous(breaks = seq(0, 8, 1)) +
  theme(plot.title = element_text(face = "bold")) 
print(p3)

图 16.3 2019-20 赛季连续命中后朱利叶斯·兰德尔的罚球命中率

在一次成功的罚球尝试之后，Randle 的罚球命中率接近 80%，但当他之前在两次到六次连续罚球命中之间时，命中率则低于 70%。再次强调，这与拉普拉斯概率曲线没有相似之处，所以我们再次没有看到任何“手感热”的证据。

16.4.3 第 3 位球员：詹姆斯·哈登

我们的第三位和最后一位球员是詹姆斯·哈登，他在 2019-20 赛季为休斯顿火箭队效力（他后来为其他三支球队效力过）。年复一年，哈登是 NBA 顶级得分手之一，这在很大程度上是因为他吸引了大量的投篮犯规，因此尝试了大量的罚球。在 2019-20 赛季，哈登尝试的罚球比任何其他球员都多出近 200 次。根据他的www.basketball-reference.com统计数据，哈登在常规赛和季后赛中尝试了 873 次罚球，不包括技术犯规罚球，命中了 754 次，即 86.4%。

我们将詹姆斯·哈登的数据处理操作系列压缩到一个代码块中：

ft %>%
  filter(player == "James Harden") -> harden

dim(harden)
## [1] 873   6
sum(harden$points)
## [1] 754

harden %>%
  group_by(date) %>%
  mutate(streak = streak_run(lag(points))) -> harden_final

head(harden_final, n = 10)
## # A tibble: 10 × 7
## # Groups:   date [1]
##    date       event_type player       points result 
##    <date>     <fct>      <chr>         <dbl> <fct>  
##  1 2019-10-24 free throw James Harden      1 made   
##  2 2019-10-24 free throw James Harden      1 made   
##  3 2019-10-24 free throw James Harden      1 made   
##  4 2019-10-24 free throw James Harden      1 made   
##  5 2019-10-24 free throw James Harden      1 made   
##  6 2019-10-24 free throw James Harden      1 made   
##  7 2019-10-24 free throw James Harden      1 made   
##  8 2019-10-24 free throw James Harden      1 made   
##  9 2019-10-24 free throw James Harden      1 made   
## 10 2019-10-24 free throw James Harden      1 made   
##    type              streak
##    <fct>              <int>
##  1 Free Throw 1 of 2      0
##  2 Free Throw 2 of 2      1
##  3 Free Throw 1 of 3      2
##  4 Free Throw 2 of 3      3
##  5 Free Throw 3 of 3      4
##  6 Free Throw 1 of 3      5
##  7 Free Throw 2 of 3      6
##  8 Free Throw 3 of 3      7
##  9 Free Throw 1 of 2      8
## 10 Free Throw 2 of 2      9

harden_final %>%
  group_by(date) %>%
  slice(-1) -> harden_final

dim(harden_final)
## [1] 793   7

harden_final %>%
  filter(lag(points) == 1) %>%
  group_by(streak) %>%
  summarize(makes = sum(points == 1), 
            misses = sum(points == 0)) -> harden_tbl1
print(harden_tbl1)
## # A tibble: 23 × 3
##    streak makes misses
##     <int> <int>  <int>
##  1      1    70     13
##  2      2   104     17
##  3      3    86     12
##  4      4    66     14
##  5      5    46      8
##  6      6    35      7
##  7      7    27      4
##  8      8    19      4
##  9      9    16      1
## 10     10    13      2
## # ... with 13 more rows

harden_tbl1 %>%
  mutate(pct = makes / (makes + misses) * 100) -> harden_tbl2
print(harden_tbl2)
## # A tibble: 23 × 4
##    streak makes misses   pct
##     <int> <int>  <int> <dbl>
##  1      1    70     13  84.3
##  2      2   104     17  86.0
##  3      3    86     12  87.8
##  4      4    66     14  82.5
##  5      5    46      8  85.2
##  6      6    35      7  83.3
##  7      7    27      4  87.1
##  8      8    19      4  82.6
##  9      9    16      1  94.1
## 10     10    13      2  86.7
## # ... with 13 more rows

在前面的代码块中，通过 tibble harden_tbl2 以表格格式表示变量streak中每个整数的哈登罚球命中率，在接下来的代码块中，通过图 16.4 中的另一个ggplot2折线图以图形格式表示：

p4 <- ggplot(harden_tbl2, aes(x = streak, y = pct, group = 1)) + 
  geom_line(aes(y = pct), color = "steelblue", size = 1.5) +
  geom_point(size = 3, color = "steelblue") +
  labs(title = "James Harden", 
       subtitle = "Free Throw Percentage Following Consecutive Makes", 
       x = "Consecutive Makes (Streak)", 
       y = "Free Throw Shooting Percentage", 
       caption = "2019-20 regular season and postseason\n
                  Harden shot 86.4% from the line during
       the regular season and postseason combined") +
  scale_x_continuous(breaks = seq(0, 23, 1)) +
  theme(plot.title = element_text(face = "bold")) 
print(p4)

图 16.4 2019-20 赛季詹姆斯·哈登连续命中后的罚球命中率

再次，我们只看到了随机性——没有拉普拉斯概率曲线，没有幂律，没有热手。然而，接下来，我们将揭示我们在开始时坦率地加入的剧情转折。

16.5 全联盟分析

我们最后通过一个单一的数据系列来绘制和分析整个 NBA。我们的数据处理操作再次被压缩到一个代码块中；这里没有新的内容，只是当需要时，我们按日期和球员分组数据操作：

ft %>%
  group_by(date, player) %>%
  mutate(streak = streak_run(lag(points))) -> ft_final

head(ft_final, n = 10)
## # A tibble: 10 × 7
## # Groups:   date, player [4]
##    <date>     <fct>      <chr>          <dbl> <fct>  
##  1 2019-10-22 free throw Kyle Lowry         1 made   
##  2 2019-10-22 free throw Kyle Lowry         0 missed 
##  3 2019-10-22 free throw Pascal Siakam      1 made   
##  4 2019-10-22 free throw Pascal Siakam      1 made   
##  5 2019-10-22 free throw Pascal Siakam      1 made   
##  6 2019-10-22 free throw Pascal Siakam      1 made   
##  7 2019-10-22 free throw Fred VanVleet      1 made   
##  8 2019-10-22 free throw Kyle Lowry         1 made   
##  9 2019-10-22 free throw Kyle Lowry         1 made   
## 10 2019-10-22 free throw Josh Hart          2 made   
##    <fct>              <int>
##  1 Free Throw 1 of 2      0
##  2 Free Throw 2 of 2      1
##  3 Free Throw 1 of 2      0
##  4 Free Throw 2 of 2      1
##  5 Free Throw 1 of 2      2
##  6 Free Throw 2 of 2      3
##  7 Free Throw 1 of 1      0
##  8 Free Throw 1 of 2      1
##  9 Free Throw 2 of 2      1
## 10 Free Throw 1 of 2      0

ft_final %>%
  group_by(date, player) %>%
  slice(-1) -> ft_final

ft_final %>% 
  filter(lag(points) == 1) %>%
  group_by(streak) %>%
  summarize(makes = sum(points == 1), 
            misses = sum(points == 0)) -> ft_tbl1
print(ft_tbl1)
## # A tibble: 23 × 3
##    streak makes misses
##     <int> <int>  <int>
##  1      1  3209    980
##  2      2  5285   1386
##  3      3  3257    774
##  4      4  1796    399
##  5      5  1110    225
##  6      6   645    130
##  7      7   404     68
##  8      8   245     42
##  9      9   151     21
## 10     10    90     13
## # ... with 13 more rows

ft_tbl1 %>%
  mutate(pct = makes / (makes + misses) * 100) -> ft_tbl2
print(ft_tbl2)
## # A tibble: 23 × 4
##    streak makes misses   pct
##     <int> <int>  <int> <dbl>
##  1      1  3209    980  76.6
##  2      2  5285   1386  79.2
##  3      3  3257    774  80.8
##  4      4  1796    399  81.8
##  5      5  1110    225  83.1
##  6      6   645    130  83.2
##  7      7   404     68  85.6
##  8      8   245     42  85.4
##  9      9   151     21  87.8
## 10     10    90     13  87.4
## # ... with 13 more rows

这导致了我们的最终可视化，另一个ggplot2折线图，显示了从罚球线出发的每个可能的连续命中连串的全联盟罚球命中率（见图 16.5）。请注意，安特托昆博、兰德尔和哈登的数据包括在这些结果中；事实上，任何在 2019-20 赛季常规赛或季后赛中至少尝试过一次罚球的球员都被纳入了这些结果。

图 16.5 2019-20 赛季全联盟连续命中后的罚球命中率。与我们在球员层面的结果不同，这些结果近似于拉普拉斯概率曲线。

然而，我们在最后一个图表中添加了一个非常酷的功能——我们在左上角插入了 p1，这样我们就可以方便地比较（不完美）全联盟的结果与（完美）拉普拉斯概率曲线。我们通过调用ggplot2 annotation_custom()函数来实现这一点。传递给annotation_custom()的第一个参数是ggplotGrob()函数，它从一个现有的图表生成一个ggplot2网格图形对象。剩余的四个参数确定了内嵌图的 x 和 y 坐标：

p5 <- ggplot(ft_tbl2, aes(x = streak, y = pct, group = 1)) + 
  geom_line(aes(y = pct), color = "steelblue", size = 1.5) +
  geom_point(size = 3, color = "steelblue") +
  labs(title = "Entire NBA", 
       subtitle = "Free Throw Percentage Following Consecutive Makes", 
       x = "Consecutive Makes (Streak)",
       y = "Free Throw Shooting Percentage", 
       caption = "2019-20 regular season and postseason") +
  scale_x_continuous(breaks = seq(0, 23, 1)) +
  theme(plot.title = element_text(face = "bold")) +
  annotation_custom(ggplotGrob(p1), xmin = 1, xmax = 11, 
                    ymin = 89, ymax = 101)
print(p5)

现在我们正在绘制数千个数据点而不是仅仅几百个，我们实际上得到了一个近似拉普拉斯概率曲线的视觉化。当然，它并不完美，但我们确实看到随着连续命中次数的增加，罚球命中率逐渐提高；我们甚至看到一系列以递减速率增加的情况，至少直到连续命中的罚球次数达到 9 次。然后我们看到当连续命中次数等于 11 次、15 次以及再次等于 18 次时出现回归；然而，总的来说，当先前命中的罚球次数增加时，我们看到的罚球命中率更高。因此，当我们从整体上审视 NBA 而不是几个选定的球员时，我们似乎看到了一种“手感热”的现象。然而，这次，将拉普拉斯概率曲线与“手感热”分开是有意义的。毕竟，尽管 NBA 整体的结果近似于拉普拉斯概率曲线，但“手感热”只适用于有限时间段内的单个球员水平。

在下一章中，我们将通过比较拉斯维加斯体育博彩公司发布的开盘赔率和最终得分，来调查是否存在群体智慧。

摘要

• 即使在大数据时代，小数据无处不在。拉普拉斯成功法则是在处理少量观察结果以及/或者当独立试验次数和成功次数相同时，作为传统概率公式的最佳替代方案。

• 当其他人可能看到（或希望）秩序时，强调（并接受）随机性的重要性是不够的。我们展示了模拟的硬币抛掷可能（或将会）包含连续出现正面或反面，以及现实生活中的事件，如罚球射击，实际上更像是随机且独立的硬币抛掷，而不是有序且可预测的过程。

• 因此，不，罚球命中率，至少在球员水平上，并不随着每一次后续成功而持续增加；命中和失误更像是硬币抛掷，而不是近似拉普拉斯概率曲线；存在其他人误认为是秩序和因果关系的随机性；而且，至少基于 2019-20 赛季和季后赛期间的罚球射击情况，NBA 中没有“手感热”。

• runner 包被介绍为一个“相对冷门”的包，这是真的。在 2022 年期间，它平均每月下载约 2,000 次。相反，ggplot2 在 2022 年全年每月下载量约为 3,000,000 次。但即便如此，runner 包仍然是 R 编程语言如何灵活和可扩展的一个很好的例子——无论你想要在 R 中做什么，都有很高的可能性，其他人已经完成了完全相同的任务并且发布了一个包来帮助你完成繁重的工作。

• 关于“手感热”的一个要点必须绝对明确，尤其是在考虑到这里呈现的不一致结果时：特定球员的结果比整个联赛的结果更有意义。这是因为“手感热”适用于在离散时间段内行动的个体，而不是在时间不同、空间不同的多个个体。因此，根据证据的平衡，我们最好的结论是，罚球射击更像抛硬币，而不是“手感热”现象。

• 同时，我们演示了如何仅用一行 R 代码来模拟抛硬币。这不必一定是公平的硬币。如果你想模拟一个有，比如说，70/30 的概率而不是 50/50 的事件，只需通过改变 sample() 函数的 probs 参数即可完成。

• 最后，我们展示了如何将一个 ggplot2 对象插入到另一个 ggplot2 对象中。这是一个当你想要比较一个新图表与“较老”的图表时，非常棒的数据可视化技术。

17 集体智慧

本章涵盖

• 自动化探索性数据分析

• 使用tableone包执行基线 EDA 任务

• 使用DataExplorer和SmartEDA包执行高级 EDA 操作

• 将新的功能和美学技术应用于ggplot2条形图

我们在这里的第一个目的是确定谁可能更聪明——是那些拥有高级数据科学学位的少数拉斯维加斯赔率分析师，他们使用非常复杂的算法来设定开盘赔率，而这些赔率涉及他们为赌场工作的数百万美元，还是那些有切身利益的数千名赌徒、专业人士和业余爱好者，他们随后押注他们辛苦赚来的钱，并在这一过程中影响收盘赔率。

例如，2018 年 10 月 17 日，孟菲斯灰熊队在印第安纳活塞队的主场进行了比赛。拉斯维加斯赔率分析师的开盘总分——即灰熊队和活塞队预计的总得分——为 209 分。然后投注者对通常被称为上下盘的投注进行了投注，直到投注线关闭。投注在上盘的资金来自认为灰熊队和活塞队将得分超过 209 分的赌徒；投注在下盘的资金来自认为两队总得分将少于 209 分的赌徒。无论谁赢，谁输，或最终差距是多少；唯一重要的是总得分是否大于或小于 209 分。

开盘总分旨在鼓励投注在上下盘的金额相等。当这种情况不是发生时，开盘总分随后会上升或下降——上升以鼓励更多的下盘投注，下降以鼓励更多的上盘投注。就灰熊队与活塞队的比赛而言，总分收盘价为 204.5（这也被称为收盘总分），这意味着大部分投注资金都投在了下盘，而不是上盘。

开盘点差——通常被称为开盘差分，或简称差分——是印第安纳-7，或孟菲斯+7。换句话说，同样的拉斯维加斯赔率分析师估计印第安纳将赢得七分（或者说孟菲斯将输掉七分）。因此，投注在活塞队上的钱来自认为活塞队将赢得并且赢得超过七分的赌徒；而投注在灰熊队上的钱来自认为灰熊队将输掉少于七分或可能直接赢得比赛的赌徒。

与上下盘类似，开盘差分旨在鼓励在两支球队上投注的金额相等——印第安纳队覆盖或孟菲斯队覆盖。并且与上下盘类似，差分随后会根据实际投注进行调整。就灰熊队与活塞队的比赛而言，差分收盘价为印第安纳-7.5，这意味着大部分投注资金（可能不会超过一半）都投在了活塞队赢得比赛并赢得超过七分。

比赛者队以 111-83 击败了灰熊队，这意味着收盘总比分和收盘盘口比分比开盘总比分和开盘盘口比分更接近最终结果。至少就这场比赛而言，赌徒们比博彩公司知道得更多。我们将检查 2018-19 赛季的每一场 NBA 比赛，看看这是否是规则还是规则的例外。

我们的第二个目的是介绍 R 使探索性数据分析（EDA）变得快速和简单的方法；我们将介绍并回顾三个自动化的 EDA 包，并讨论它们与更系统化的 EDA 方法的优缺点。我们将从加载我们的包开始。

17.1 加载包

我们将使用dplyr和tidyr函数的组合来整理我们的数据，并用ggplot2条形图和分面图来可视化我们的结果。否则，我们将通过三个自动化的 EDA 包——tableone、DataExplorer和SmartEDA——按顺序探索我们的数据，如下所示：

library(tidyverse)
library(tableone)
library(DataExplorer)
library(SmartEDA)

接下来，我们将导入我们的一个数据集。

17.2 导入数据

我们通过调用readr包中的read_csv()函数并传递一个名为 2018-2019 NBA_Box_Score_Team-Stats.csv 的文件来导入我们的数据，该文件是从www.bigdataball.com下载的，并随后存储在我们的默认工作目录中。我们的数据集，至少目前，被称为 oddsdf1：

oddsdf1 <- read_csv("018-2019_NBA_Box_Score_Team-Stats.csv")

然后，我们将 oddsdf1 传递给基础 R 的dim()函数以返回行和列计数：

dim(oddsdf1)
## [1] 2624   57

我们的数据集包含 2,624 条记录和 57 个变量，这既比我们分析所需的要多，又比我们需要的要少。换句话说，它包含不会影响我们分析的行和列，但（目前）它不包含我们将不得不自己推导的其他变量。因此，我们将运行几个数据整理操作，将我们的原始数据转换成一个对我们更有用的对象。

17.3 数据整理

我们首先通过减少数据的长度开始。oddsdf1 数据集包含 2018-19 NBA 常规赛（我们想要的）和 2019 季后赛（我们不想要的）的记录。因此，我们调用dplyr包中的filter()函数来对 oddsdf1 进行子集化，选择那些变量DATASET不等于 NBA 2019 Playoffs 的观测值（!=运算符表示不等于）：

oddsdf1 %>%
  filter(DATASET != "NBA 2019 Playoffs") -> oddsdf1

然后，我们减少数据宽度。尽管 oddsdf1 中的大部分数据很有趣，但对于我们的目的来说几乎不是必要的，所以我们调用dplyr的select()函数来对 oddsdf1 进行子集化，只保留我们绝对需要的少数变量：

oddsdf1 %>%
  select(GAME_ID, DATE, TEAM, VENUE, PTS, OPENING_SPREAD, OPENING_TOTAL,
         CLOSING_SPREAD, CLOSING_TOTAL) -> oddsdf1

我们保留的变量包括以下内容：

• GAME_ID——每个比赛的唯一和按时间顺序递增的标识符，使用日期和开始时间递增。

• DATE——每场比赛的日期，格式为 mm/dd/yy。现在这是一个字符字符串。

• TEAM——简化的队伍名称（例如，费城而不是费城 76 人，或波士顿而不是波士顿凯尔特人）；洛杉矶的两支队伍，洛杉矶快船队和洛杉矶湖人队，是例外。现在是一个字符串。

• VENUE——对于客队等于R，对于主队等于H。现在是一个字符串。

• PTS——等于每个参与队伍的总得分。现在它是数字，并将保持数字。

• OPENING_SPREAD——等于任何投注都已下注之前的预测点差。当点差为例如 4.5 时，弱队必须直接获胜或以 4 分或更少的差距输掉比赛才能覆盖；当点差为-4.5 时，强队必须以 5 分或更多的差距获胜才能覆盖。现在它是数字，并将保持数字。

• OPENING_TOTAL——等于参与队伍预测的总得分；也称为总分上下。赌徒们根据他们预期的总得分来下注总分上下。现在它是数字，并将保持数字。

• CLOSING_SPREAD——等于所有投注都已下注并且投注线已关闭后的预测点差。现在它是数字，并将保持数字。

• CLOSING_TOTAL——等于所有投注都已下注并且投注线已关闭后的预测总得分。现在它是数字，并将保持数字。

你可能已经发现，oddsdf1 实际上每场比赛包含两条记录。上面的记录属于客队，下面的记录属于主队。以下是具体信息：

• 变量GAME_ID和DATE对于每对记录都是相同的。2018-19 赛季常规赛的第一场比赛是费城 76 人对阵波士顿凯尔特人队。因此，GAME_ID等于21800001，DATE等于10/16/18对于前两条 oddsdf1 记录。

• 变量TEAM、VENUE和PTS对于客队和主队是唯一的。因此，最终得分反映在PTS下的两个值中。

• 变量OPENING_SPREAD和CLOSING_SPREAD是彼此的相反数。例如，如果OPENING_SPREAD或CLOSING_SPREAD对于客队等于4.5，那么对于主队就等于-4.5。

• 变量OPENING_TOTAL和CLOSING_TOTAL对于每对记录都是相同的。

然而，这不是我们想要的或需要的结构；我们的分析需要我们的数据集对于每场比赛只包含一条记录，而不是两条。因此，我们接下来的任务是将 oddsdf1 拆分为两个相等的部分，然后通过行将这两部分连接起来。

为了实现这一点，我们首先再次调用filter()函数，这次是为了对 oddsdf1 进行子集化，其中变量VENUE等于R；我们新的对象称为 roadodds：

oddsdf1 %>%
  filter(VENUE == "R") -> roadodds

然后，我们通过管道操作符将 roadodds 传递给rename()函数，以重命名每个变量。rename()函数要求将新变量名放在赋值运算符的左边，将旧变量名放在右边。例如，我们将PTS重命名为ptsR：

roadodds %>%
  rename(ID = GAME_ID, date = DATE, teamR = TEAM, venueR = VENUE,        
         ptsR = PTS, openspreadR = OPENING_SPREAD, 
         opentotal = OPENING_TOTAL, closespreadR = CLOSING_SPREAD,
         closetotal = CLOSING_TOTAL) -> roadodds

接下来，将变量VENUE等于H的剩余 oddsdf1 记录扔进一个新的对象中，称为 homeodds：

oddsdf1 %>%
  filter(VENUE == "H") -> homeodds

我们首先将 homeodds 子集化，使其仅包括变量TEAM、VENUE、PTS、OPENING_SPREAD和CLOSING_SPREAD。变量GAME_ID、DATE、OPENING_TOTAL和CLOSING_TOTAL在每个 oddsdf1 记录对中都是相同的，包含在 roadodds 中，因此不需要在 homeodds 中重复：

homeodds %>%
  select(TEAM, VENUE, PTS, OPENING_SPREAD, CLOSING_SPREAD) -> homeodds

然后将幸存下来的 homeodds 变量重命名，以区分它们与道路队伍等价物的变量：

homeodds %>%
  rename(teamH = TEAM, venueH = VENUE, ptsH = PTS,                
         openspreadH = OPENING_SPREAD, 
         closespreadH = CLOSING_SPREAD) -> homeodds

最后，我们通过调用基础 R 的cbind()函数创建一个新的对象，称为 oddsdf2，该函数通过行将 roadodds 和 homeodds 合并成一个单一的数据集：

oddsdf2 <- cbind(roadodds, homeodds)

接着，我们调用dim()函数——oddsdf2 包含 1,230 行和 14 列。一个 NBA 常规赛赛程，其中所有 30 支球队各打 82 场比赛，等于 1,230 场比赛，所以这是正确的：

dim(oddsdf2)
## [1] 1230   14

然后，我们调用基础 R 的as.factor()函数将 oddsdf2 中的五个字符字符串中的四个（除了变量date）转换为因子变量：

oddsdf2$teamR <- as.factor(oddsdf2$teamR)
oddsdf2$teamH <- as.factor(oddsdf2$teamH)
oddsdf2$venueR <- as.factor(oddsdf2$venueR)
oddsdf2$venueH <- as.factor(oddsdf2$venueH)

我们通过调用基础 R 的as.Date()函数将date从字符字符串转换为日期类。as.Date()函数的第二个参数是 R 保持当前 mm/dd/yy 格式的指令——目前是这样：

oddsdf2$date <- as.Date(oddsdf2$date, "%m/%d/%Y")

然后，我们通过将 oddsdf2 传递给dplyr mutate()函数创建一个新变量；我们的新变量称为month，是从变量date派生出来的。例如，当date等于10/27/18时，month等于October；同样，当date等于2/9/19时，month等于February：

oddsdf2 %>%
  mutate(month = format(date, "%B")) -> oddsdf2

2018-19 NBA 常规赛于 10 月 16 日开始，并于 4 月 10 日结束。因此，10 月是 2018-19 常规赛赛程的第一个月，11 月是第二个月，12 月是第三个月，依此类推。话虽如此，我们将 oddsdf2 传递给dplyr mutate()和case_when()函数——mutate()创建另一个新变量，而case_when()将条件值分配给单元格。当变量month等于October时，我们的新变量month2应该等于1；当month等于November时，month2应该改为2；以此类推。

然后，我们将新变量通过调用基础 R 的as.factor()函数转换为因子：

oddsdf2 %>%
  mutate(month2 = case_when(month == "October" ~ 1,
                            month == "November" ~ 2,
                            month == "December" ~ 3,
                            month == "January" ~ 4,
                            month == "February" ~ 5,
                            month == "March" ~ 6,
                            month == "April" ~ 7)) -> oddsdf2

oddsdf2$month2 <- as.factor(oddsdf2$month2)

接着，我们调用select()函数从 oddsdf2 中删除变量ID、date和month（注意变量名前的减号）：

oddsdf2 %>%
  select(-ID, -date, -month) -> oddsdf2

现在，让我们开始探索我们的数据，立即从tableone包开始。这个包被设计用来在一个表中返回连续和分类变量的摘要数据。

17.4 自动化探索性数据分析

探索性数据分析（EDA）是计算基本统计信息和创建视觉内容相结合，以对数据集进行初步了解并确定进一步分析的范畴。有几个 R 包允许我们自动化 EDA 任务，或者至少与手动和更系统化的 EDA 方法相比，用更少的代码创建更多内容（例如，参见第二章）。

我们将演示这三个包中的三个。第一个包被称为 tableone。

17.4.1 使用 tableone 进行基线 EDA

tableone 包的灵感来源于许多研究出版物中常见的典型 表 1，通常包括几行汇总统计信息；因此，tableone，正如你可能猜到的，只以表格格式返回结果，并且因此不会产生任何数据的视觉表示。

可能最简单直接的 EDA 任务就是总结整个数据集。使用 tableone，我们可以通过传递一个数据集，在这个例子中是 oddsdf2，到 CreateTableOne() 函数中来实现这一点。随后，当我们调用基本的 R print() 函数时（由于空间考虑，一些输出没有包括在内），我们得到一系列的汇总统计信息：

tableOne <- CreateTableOne(data = oddsdf2)
print(tableOne)
##                           
##                            Overall        
##   n                          1230         
##   teamR (%)                               
##      Atlanta                   41 (  3.3) 
##      Boston                    41 (  3.3) 
##      Brooklyn                  41 (  3.3) 

##      Toronto                   41 (  3.3) 
##      Utah                      41 (  3.3) 
##      Washington                41 (  3.3) 
##   venueR = R (%)             1230 (100.0) 
##   ptsR (mean (SD))         109.85 (12.48) 
##   openspreadR (mean (SD))    2.49 (6.45)  
##   opentotal (mean (SD))    221.64 (8.62)  
##   closespreadR (mean (SD))   2.62 (6.59)  
##   closetotal (mean (SD))   221.69 (8.79)  
##   teamH (%)                               
##      Atlanta                   41 (  3.3) 
##      Boston                    41 (  3.3) 
##      Brooklyn                  41 (  3.3) 

##      Toronto                   41 (  3.3) 
##      Utah                      41 (  3.3) 
##      Washington                41 (  3.3) 
##   venueH = H (%)             1230 (100.0) 
##   ptsH (mean (SD))         112.57 (12.68) 
##   openspreadH (mean (SD))   -2.49 (6.45)  
##   closespreadH (mean (SD))  -2.62 (6.59)  
##   month2 (%)                              
##      1                        110 (  8.9) 
##      2                        219 ( 17.8) 
##      3                        219 ( 17.8) 
##      4                        221 ( 18.0) 
##      5                        158 ( 12.8) 
##      6                        224 ( 18.2) 
##      7                         79 (  6.4)

因此，我们只需运行单个 tableone 函数就能得到以下信息：

• oddsdf2 数据集包含 1,230 条记录。

• 所有 30 支球队在 2018-19 赛季中进行了 41 场客场比赛和 41 场主场比赛。

• 因此，每支球队在所有 2018-19 赛季比赛中作为客场球队的比例为 3.3%，另外 3.3% 的比赛作为主队。

• 那一年，客场球队平均每场比赛得分为 109.85 分，而主队平均每场比赛得分为 112.57 分。

• 得分分布的离散程度，由变量 ptsR 和 ptsH 中的标准差（SD）表示，客场和主队之间大致相同。这意味着在 2018-19 赛季的比赛中，大约三分之二的情况下，客场球队得分大约为 110 加减 13 分，而主队得分大约为 113 加减 13 分。

• 开盘差值和尤其是收盘差值准确地代表了客场和主队之间每场比赛平均得分差。

• 平均来看，收盘差值略大于开盘差值；主队比客场队更受青睐。

• 平均来看，开盘和收盘之间的移动几乎为零；但这可能不是比赛间变化的准确反映。

• 最后，我们得到了按月份划分的常规赛比赛次数的细分。去掉十月份和四月份的部分月份以及二月份，因为当然，二月只有 28 天，并且由于全明星赛而进一步缩短，常规赛赛程似乎均匀分布。

summary() 函数返回更多细节。连续变量的汇总统计量，包括均值、中位数、最小值、最大值以及第一和第三四分位数，总是首先返回，然后是 oddsdf2 分类变量的观测计数。

但首先，我们通过将 scipen = 999 参数传递给基础 R 的 options() 函数来禁用科学记数法（再次提醒，由于空间考虑，一些结果未包括在内）：

options(scipen = 999)
summary(tableOne)
## 
##      ### Summary of continuous variables ###
## 
## strata: Overall
##                 n miss p.miss mean sd median p25 p75 min max skew kurt
## ptsR         1230    0      0  110 12    110 101 118  68 168  0.1  0.2
## openspreadR  1230    0      0    2  6      3  -2   8 -16  18 -0.2 -0.6
## opentotal    1230    0      0  222  9    222 216 228 196 243 -0.2 -0.4
## closespreadR 1230    0      0    3  7      4  -2   8 -17  18 -0.2 -0.7
## closetotal   1230    0      0  222  9    222 216 228 194 244 -0.1 -0.3
## ptsH         1230    0      0  113 13    112 104 121  77 161  0.2  0.1
## openspreadH  1230    0      0   -2  6     -3  -8   2 -18  16  0.2 -0.6
## closespreadH 1230    0      0   -3  7     -4  -8   2 -18  17  0.2 -0.7
## 
## ======================================================================
## 
##      ### Summary of categorical variables ### 
## 
## strata: Overall
##     var    n miss p.miss         level freq percent cum.percent
##   teamR 1230    0    0.0       Atlanta   41     3.3         3.3
##                                 Boston   41     3.3         6.7
##                               Brooklyn   41     3.3        10.0

##                                Toronto   41     3.3        93.3
##                                   Utah   41     3.3        96.7
##                             Washington   41     3.3       100.0
##                                                                
##  venueR 1230    0    0.0             R 1230   100.0       100.0
##                                                                
##   teamH 1230    0    0.0       Atlanta   41     3.3         3.3
##                                 Boston   41     3.3         6.7
##                               Brooklyn   41     3.3        10.0

##                                Toronto   41     3.3        93.3
##                                   Utah   41     3.3        96.7
##                             Washington   41     3.3       100.0
##                                                                
##  venueH 1230    0    0.0             H 1230   100.0       100.0
##                                                                
##  month2 1230    0    0.0             1  110     8.9         8.9
##                                      2  219    17.8        26.7
##                                      3  219    17.8        44.6
##                                      4  221    18.0        62.5
##                                      5  158    12.8        75.4
##                                      6  224    18.2        93.6
##                                      7   79     6.4       100.0
## 

summary() 函数在 oddsdf2 的分类变量方面没有返回任何新的有趣内容，但它确实为我们的一些连续变量提供了一些额外的见解。例如，我们得到了每个变量的偏度（skew）和峰度（kurt）。偏度表示从正态分布或高斯分布的扭曲程度；因此，它衡量数据分布中的不对称性。当为负时，分布是负偏或左偏；当为正时，分布是正偏或右偏；当等于 0 时，分布实际上是对称的。因此，偏度可以补充甚至取代 Shapiro-Wilk 测试，其中任何大于 2 或小于 -2 的结果都视为非正态分布。

另一方面，峰度是衡量分布中尾部长度或不是那么长的度量。当等于或接近 0 时，分布是正态的；当为负时，分布有瘦尾；当为正时，分布有胖尾。

接下来，我们将绘制一些相同的分布，作为更广泛练习的一部分，以通过另一个名为 DataExplorer 的自动化 EDA 包进一步探索我们的数据。

17.4.2 使用 DataExplorer 进行盈亏 EDA

我们进一步 EDA 的范围，至少目前，将围绕开盘和收盘总点数，或盈亏；我们将把开盘和收盘点差保存为后续 EDA 练习，使用另一个包。话虽如此，我们将通过子集化 oddsdf2 创建一个新的数据集 oddsdf3，添加五个新的 oddsdf3 变量，然后介绍 DataExplorer 包的功能，以了解更多关于我们的数据。

数据整理

我们通过将 oddsdf2 传递给 dplyr select() 函数并对 oddsdf2 的 13 个变量中的 9 个进行子集化来创建 oddsdf3：

oddsdf2 %>%
  select(teamR, venueR, ptsR, opentotal, closetotal, teamH, venueH,
         ptsH, month2) -> oddsdf3

然后，我们着手创建新的变量。其中第一个，ptsT，是客场和主队每场比赛的总得分；因此，我们将 oddsdf3 传递给 dplyr mutate() 函数，并将变量 ptsR 和 ptsH 求和等于 ptsT：

oddsdf3 %>%
  mutate(ptsT = ptsR + ptsH) -> oddsdf3

我们的第二个变量 diff_ptsT_opentotal 是变量 ptsT 和 opentotal 之间的绝对差值。abs() 函数是一个基础 R 函数，它保持正数不变，并将负数转换为正数：

oddsdf3 %>%
  mutate(diff_ptsT_opentotal = abs(ptsT - opentotal)) -> oddsdf3

我们的第三个变量 diff_ptsT_closetotal 是变量 ptsT 和 closetotal 之间的绝对差值：

oddsdf3 %>%
  mutate(diff_ptsT_closetotal = abs(ptsT - closetotal)) -> oddsdf3

我们的第四个变量要求我们将 mutate() 函数与 case_when() 函数结合使用。当 closetotal 大于 opentotal 时，我们的新变量 totalmove 应等于 up；当 closetotal 小于 opentotal 时，totalmove 应等于 down；当 closetotal 等于 opentotal 时，totalmove 应等于 same。然后，我们调用 as.factor() 函数将 totalmove 转换为因子变量；毕竟，它只能假设三个潜在值中的一个：

oddsdf3 %>%
  mutate(totalmove = case_when(closetotal > opentotal ~ "up",
                               closetotal < opentotal ~ "down",
                               closetotal == opentotal ~ "same")) -> oddsdf3

oddsdf3$totalmove <- as.factor(oddsdf3$totalmove)

我们的第五个变量 versusPTS 也需要 mutate() 与 case_when() 结合使用。当 diff_ptsT_opentotal 大于 diff_ptsT_closetotal，或者当总得分与开盘总得分之间的绝对差值大于总得分与收盘总得分之间的绝对差值时，versusPTS 应等于 closetotal。当相反的条件成立时，versusPTS 应该等于 opentotal。当 diff_ptsT_opentotal 与 diff_ptsT_closetotal 之间没有差异时，新的变量 versusPTS 应等于 same。然后，我们再次通过调用 as.factor() 函数将 versusPTS 转换为因子变量：

oddsdf3 %>%
  mutate(versusPTS = 
           case_when(diff_ptsT_opentotal > 
                     diff_ptsT_closetotal ~ "closetotal",
                     diff_ptsT_closetotal > 
                     diff_ptsT_opentotal ~ "opentotal",
                     diff_ptsT_opentotal == 
                     diff_ptsT_closetotal ~ "same")) -> oddsdf3

oddsdf3$versusPTS <- factor(oddsdf3$versusPTS)

由于所有这些处理，oddsdf3 变量不一定按逻辑顺序从左到右排序。在 R 中重新排列变量顺序的一种方法就是简单地调用 select() 函数。我们不会指示 select() 对我们的数据进行子集化，而是将 所有 的 oddsdf3 变量——实际上，它们的当前位置编号——传递给 select() 函数，通过这样做，R 将根据变量作为参数传递的顺序重新排列变量。

从基础 R 调用 head() 函数返回前六条记录：

oddsdf3 %>%
  select(9, 1, 2, 3, 6, 7, 8, 10, 4, 5, 11, 12, 13, 14) -> oddsdf3
head(oddsdf3)
##   month2         teamR venueR ptsR        teamH 
## 1      1  Philadelphia      R   87       Boston      
## 2      1 Oklahoma City      R  100 Golden State      
## 3      1     Milwaukee      R  113    Charlotte      
## 4      1      Brooklyn      R  100      Detroit      
## 5      1       Memphis      R   83      Indiana      
## 6      1         Miami      R  101      Orlando      
##   venueH ptsH ptsT opentotal closetotal diff_ptsT_opentotal
## 1      H  105  192     208.5      211.5                16.5            
## 2      H  108  208     223.5      220.5                15.5            
## 3      H  112  225     217.0      222.0                 8.0            
## 4      H  103  203     212.0      213.0                 9.0            
## 5      H  111  194     209.0      204.5                15.0            
## 6      H  104  205     210.5      208.0                 5.5            
##   diff_ptsT_closetotal totalmove  versusPTS
## 1                 19.5        up  opentotal
## 2                 12.5      down closetotal
## 3                  3.0        up closetotal
## 4                 10.0        up  opentotal
## 5                 10.5      down closetotal
## 6                  3.0      down closetotal

我们现在有一个数据集，我们可以用它轻松地比较和对比开盘和收盘总得分与总得分。

创建数据概要报告

现在让我们介绍 DataExplorer 包。我们之前建议，最全面的 EDA 活动——总结整个数据集——可能也是最基础的。通过将 oddsdf3 数据集传递给 DataExplorer create_report() 函数，我们实际上得到了一个综合的数据概要报告，形式为一个交互式 HTML 文件（见图 17.1）。create_report() 函数自动运行许多 DataExplorer EDA 函数，并将结果堆叠，不是在 RStudio 控制台中，而是在一个可以保存和共享的独立报告中：

create_report(oddsdf3)

图 17.1 由 DataExplorer 包中的简单函数通过传递数据集作为唯一参数创建的数据概要报告的屏幕截图

如果说 酷 是指轻松的风格，那么 DataExplorer 包绝对是一个引人注目的选择。虽然我们确实以更少的代码（即更多的内容，大部分是视觉的，更少的代码，因此需要更少的时间和精力）创造了更多内容，但其中一些内容（其中大部分我们即将分享）实际上并没有增加任何价值——这就是权衡。你是在压力下向老板展示一些内容，即使这些内容既有相关的也有不那么相关的吗？或者你和你老板是否更倾向于一种更精确的方法？

考虑第二章中的 EDA。这需要大量的脑力劳动和大量的代码，但每个图表都传达了一个相关的信息。没有一点噪音。这里的信息是，手动和自动 EDA 方法都有其优缺点；根据项目和缓解因素，你将不得不决定哪种最适合你。

现在我们来探索从数据概览报告中获得的内容。

基本统计信息

数据概览报告首先显示一些基本统计信息的图形表示：我们的数据集在分类变量和连续变量之间的分布情况以及可能存在的缺失数据量。我们可以通过将 oddsdf3 传递给 plot_intro() 函数来生成这种可视化（见图 17.2）：

plot_intro(oddsdf3)

图 17.2 DataExplorer 包中数据集的基本统计信息的图形显示

注意，只有 create_report() 会发布独立的报告；当你运行 plot_intro() 等单独的命令，这些命令通常打包在 create_report() 函数中时，结果会在 RStudio 中显示。

我们也可以通过将 oddsdf3 传递给 introduce() 函数来以表格格式获取相同信息：

introduce(oddsdf3)
##   rows columns discrete_columns continuous_columns all_missing_columns
## 1 1230      14                7                  7                   0
##   total_missing_values complete_rows total_observations memory_usage
## 1                    0          1230              17220       114856

在 14 个 oddsdf3 变量中，有一半是连续的，另一半是分类的（或离散的）。此外，我们没有缺失数据。

数据结构

获取数据集结构的图形表示有两种方式——基本上，是 dplyr glimpse() 函数的视觉替代。一种方式是调用 plot_str() 函数（见图 17.3）：

plot_str(oddsdf3)

图 17.3 数据集结构的视觉表示。基本的 R str() 函数和 dplyr glimpse() 函数都返回类似的信息，但不是以图形格式。

第二种方式是再次调用 plot_str()，但添加 type = "r" 参数，这告诉 R 以径向网络的形式绘制数据结构（见图 17.4）：

plot_str(oddsdf3, type = "r")

图 17.4 以径向网络的形式展示了相同的数据结构。这两种视图都是通过 DataExplorer 包实现的。

无论哪种方式，我们都可以看到例如 month2 是一个有七个级别的因子变量，而 closetotal 是七个连续（或数值）变量之一。

缺失数据概览

通过之前运行 plot_intro() 和 introduce() 函数，我们已经知道 oddsdf3 不包含任何缺失数据。但如果情况相反，那么这些函数都不会告诉我们关于数据集中不可用（NAs）或不完整观测的任何具体信息。但 plot_missing() 函数返回一个可视化，显示每个变量的缺失值概览（见图 17.5）：

plot_missing(oddsdf3)

图 17.5 DataExplorer 绘制的提供缺失值概览的图

单变量分布

使用 DataExplorer 有三种方法来绘制连续数据的分布。当我们运行 create_report() 函数时，DataExplorer 会自动检测哪些变量是连续的，然后为每个变量返回直方图和分位数-分位数（QQ）图。此外，我们还可以选择告诉 DataExplorer 在直方图或 QQ 图之外或与之一起打印密度图。

plot_histogram() 函数返回一个直方图矩阵，显示我们每个连续变量的频率分布（见图 17.6）。默认情况下，DataExplorer 通常按变量名字母顺序返回绘图：

plot_histogram(oddsdf3)

图 17.6 DataExplorer 包的直方图矩阵

我们的一些连续变量似乎呈正态分布，或者至少足够接近，但变量 diff_ptsT_closetotal 和 diff_ptsT_opentotal 明显是右偏斜的。

plot_qq() 函数返回一个 QQ 图矩阵（见图 17.7）。当数据呈正态分布，或者至少足够接近假设高斯分布时，点将落在 QQ 图的对角线上或非常接近对角线；否则，我们会在 QQ 图的一侧或两侧观察到偏离对角线的点，有时偏离程度很大（例如，参见 diff_ptsT_closetotal 和 diff_ptsT_opentotal）：

plot_qq(oddsdf3)

图 17.7 DataExplorer 包的 QQ 图矩阵

最后，plot_density() 函数返回一系列密度图（见图 17.8）。

plot_density(oddsdf3)

图 17.8 DataExplorer 包的密度图矩阵

默认情况下，数据概览报告会调用plot_histogram()、plot_qq()和plot_density()函数，因此对于同一变量返回三个类似的可视化系列，所以我们得到了三个关于频率分布的视角，而通常一个就足够了。尽管如此，许多统计测试，例如线性回归（见第五章），假设数值数据是正态分布的，因此首先理解频率分布是绝对关键的。

相关性分析

当我们调用DataExplorer plot_correlation()函数时，我们得到一个相关矩阵，或热图，其中包含计算出的相关系数作为数据标签（见图 17.9）。默认情况下，create_report()函数会将相关热图添加到数据概览报告中，包括连续和分类变量。通过将type = "c"作为第二个参数添加，我们手动将结果限制为仅包含 oddsdf3 连续变量：

plot_correlation(oddsdf3, type = "c")

图 17.9 来自DataExplorer包的相关矩阵或热图；默认情况下，相关热图包括所有变量，无论是连续的还是分类的。在这里，我们已将结果限制为仅包含 oddsdf3 连续变量。

plot_correlation()函数特别令人满意的是，DataExplorer会自动忽略任何缺失值，然后仍然生成热图。请注意，closetotal与ptsR、ptsH和ptsT之间的相关系数（略微）高于opentotal与这三个相同变量的相关系数。

分类变量分析

最后，让我们转换一下思路，告诉DataExplorer提供一些关于 oddsdf3 分类变量的可视化洞察。通过调用create_report()函数生成的数据概览报告自动包含每个分类变量的条形图，作为可视化频率或计数的手段。我们可以通过将 oddsdf3 数据集传递给plot_bar()函数来复制这种自动化（见图 17.10）：

plot_bar(oddsdf3)p

图 17.10 DataExplorer为每个 oddsdf3 分类变量生成的条形图

但是，正如你所见，其中一些图表毫无意义，当然，如果不是自动化，这些图表根本就不会生成。然而，在筛选掉噪音之后，有几个有趣的发现：

• 在我们的数据集中，开盘总价比收盘总价更高的频率几乎与收盘总价比开盘总价更高的频率相同。否则，它们在大约 1,230 场比赛中有大约 100 次是相同的。

• 对于我们的目的来说，收盘总分数（在投注线关闭时的总分上下）与总得分之间的差距通常小于开盘总分数（在投注线开盘时的总分上下）与总得分之间的差距。这表明收盘总分数（受赌徒影响）比开盘总分数（由赔率制定者和他们的算法生成）更频繁地表现更好。

还可以通过按离散变量分组创建一系列条形图。在下面的代码行中，我们通过变量month2创建了六个堆叠条形图（见图 17.11）：

plot_bar(oddsdf3, by = "month2") 

图 17.11 另一系列DataExplorer条形图，但这些由于按 oddsdf3 变量month2分组而堆叠

对totalmove和versusPTS堆叠条形图的仔细观察表明，这两个变量的因素水平之间存在或跨月度的性能差异。

除了我们故意将其排除在范围之外的成分分析之外，我们几乎演示了几乎所有的DataExplorer函数；在这个过程中，我们获得了对数据的洞察，并为进一步分析建立了一个范围。我们将很快进行这项额外分析，但在此期间，我们将借助另一个自动化的 EDA 包来探索开盘和收盘点差。

17.4.3 使用 SmartEDA 进行点差 EDA

我们的新范围将围绕开盘和收盘点差以及它们与最终得分的比较。我们首先从 oddsdf2 创建一个新的数据集子集，添加一些派生变量，然后使用名为SmartEDA的包来探索数据。

数据整理

通过调用dplyr select()函数，我们选取了 oddsdf2 数据集的子集，并将结果传递给一个新的数据集，称为 oddsdf4：

oddsdf2 %>%
  select(teamR, venueR, ptsR, openspreadR, closespreadR, teamH, 
         venueH, ptsH, openspreadH, closespreadH, month2) -> oddsdf4

然后，我们着手创建新的变量，并将它们逐一附加到 oddsdf4 上。其中第一个，称为margin，是一个连续变量，等于ptsR和ptsH之间的差值，或者说是客场和主队得分之间的差值：

oddsdf4 %>%
  mutate(margin = ptsR - ptsH) -> oddsdf4

我们的第二个新变量diff_margin_openspreadH等于变量margin和openspreadH之间的绝对差值：

oddsdf4 %>%
  mutate(diff_margin_openspreadH = abs(margin - openspreadH)) -> oddsdf4

我们的第三个变量diff_margin_closespreadH等于变量margin和closespreadH之间的绝对差值：

oddsdf4 %>%
  mutate(diff_margin_closespreadH = abs(margin - closespreadH)) -> oddsdf4

我们的第四个也是最后一个变量spreadmove再次要求我们同时调用mutate()函数和case_when()函数。当closespreadH的绝对值大于openspreadH的绝对值时，spreadmove应等于up；从主队的角度来看，当收盘价差值的绝对值大于开盘价差值的绝对值（例如，从 6 变为 7 或从-6 变为-7）时，spreadmove应等于up。当条件相反时，spreadmove应改为等于down。当开盘价差和收盘价差的绝对值没有差异时，spreadmove应等于same。因为spreadmove应该是一个分类变量，所以我们调用as.factor()函数使其成为那样：

oddsdf4 %>%
  mutate(spreadmove = case_when(abs(closespreadH) > 
                                abs(openspreadH) ~ "up",
                                abs(closespreadH) < 
                                abs(openspreadH) ~ "down",
                                abs(closespreadH) == 
                                abs(openspreadH) ~ "same")) -> oddsdf4

oddsdf4$spreadmove <- factor(oddsdf4$spreadmove)

我们随后调用select()函数来重新排列 oddsdf4 变量，使其更有逻辑性。随后调用head()函数返回前六个 oddsdf4 记录：

oddsdf4 %>%
  select(11, 1, 2, 3, 6, 7, 8, 4, 5, 9, 10, 12, 13, 14, 15) -> oddsdf4

head(oddsdf4)
##   month2         teamR venueR ptsR        teamH venueH ptsH openspreadR
## 1      1  Philadelphia      R   87       Boston      H  105         5.0
## 2      1 Oklahoma City      R  100 Golden State      H  108        11.5
## 3      1     Milwaukee      R  113    Charlotte      H  112        -1.5
## 4      1      Brooklyn      R  100      Detroit      H  103         4.5
## 5      1       Memphis      R   83      Indiana      H  111         7.0
## 6      1         Miami      R  101      Orlando      H  104        -2.0
##   closespreadR openspreadH closespreadH margin diff_margin_openspreadH
## 1          4.5        -5.0         -4.5    -18                    13.0
## 2         12.0       -11.5        -12.0     -8                     3.5
## 3         -3.0         1.5          3.0      1                     0.5
## 4          6.0        -4.5         -6.0     -3                     1.5
## 5          7.5        -7.0         -7.5    -28                    21.0
## 6         -2.5         2.0          2.5     -3                     5.0
##   diff_margin_closespreadH spreadmove
## 1                     13.5       down
## 2                      4.0         up
## 3                      2.0         up
## 4                      3.0         up
## 5                     20.5         up
## 6                      5.5         up

创建 EDA 报告

SmartEDA包是tableone和DataExplorer的某种结合，因为它以表格和图形两种格式返回结果。但综合考虑，SmartEDA更类似于DataExplorer；一个原因是我们像使用DataExplorer一样，也可以创建一个交互式的 HTML 报告，该报告会自动将其他SmartEDA EDA 函数聚合到一个函数中。

然而，你会很快注意到，SmartEDA函数并不像它们的DataExplorer等价函数那样直观或简单。此外，许多这些相同的函数在手动运行时，最好首先拆分你的数据集或让SmartEDA输出一个随机样本；我们不需要使用DataExplorer包，甚至tableone包也不需要这样做。

不论如何，我们通过向ExpReport()函数（参见图 17.12）传递两个必填参数，即 oddsdf4 数据集和输出文件名，来获取SmartEDA HTML 报告。这需要几秒钟的时间来运行：

ExpReport(oddsdf4, op_file = "oddsdf4.xhtml")

图 17.12 SmartEDA包的交互式 HTML EDA 报告的顶部

数据概述

SmartEDA聚合以下功能，并将输出捆绑在我们刚刚创建的独立 HTML 文件中。否则，当我们向ExpData()函数传递 oddsdf4 和type = 1参数时，SmartEDA会以表格的形式返回我们数据的高级概述。我们得到维度、每个类的变量数量以及 RStudio 中发布的关于缺失案例的信息：

ExpData(oddsdf4, type = 1)
##                                           Descriptions     Value
## 1                                   Sample size (nrow)      1230
## 2                              No. of variables (ncol)        15
## 3                    No. of numeric/interger variables         9
## 4                              No. of factor variables         6
## 5                                No. of text variables         0
## 6                             No. of logical variables         0
## 7                          No. of identifier variables         0
## 8                                No. of date variables         0
## 9             No. of zero variance variables (uniform)         2
## 10               %. of variables having complete cases 100% (15)
## 11   %. of variables having >0% and <50% missing cases    0% (0)
## 12 %. of variables having >=50% and <90% missing cases    0% (0)
## 13          %. of variables having >=90% missing cases    0% (0)

当我们向ExpData()函数传递type = 2参数时，SmartEDA返回我们数据的结构，即 oddsdf4 变量名、它们的类型、行数以及更多关于缺失数据的信息（当然，没有缺失数据）：

ExpData(oddsdf4, type = 2)
##    Index            Variable_Name Variable_Type Sample_n Missing_Count
## 1      1                   month2        factor     1230             0
## 2      2                    teamR        factor     1230             0
## 3      3                   venueR        factor     1230             0
## 4      4                     ptsR       numeric     1230             0
## 5      5                    teamH        factor     1230             0
## 6      6                   venueH        factor     1230             0
## 7      7                     ptsH       numeric     1230             0
## 8      8              openspreadR       numeric     1230             0
## 9      9             closespreadR       numeric     1230             0
## 10    10              openspreadH       numeric     1230             0
## 11    11             closespreadH       numeric     1230             0
## 12    12                   margin       numeric     1230             0
## 13    13  diff_margin_openspreadH       numeric     1230             0
## 14    14 diff_margin_closespreadH       numeric     1230             0
## 15    15               spreadmove        factor     1230             0
##    Per_of_Missing No_of_distinct_values
## 1               0                     7
## 2               0                    30
## 3               0                     1
## 4               0                    74
## 5               0                    30
## 6               0                     1
## 7               0                    71
## 8               0                    63
## 9               0                    63
## 10              0                    63
## 11              0                    63
## 12              0                    81
## 13              0                    82
## 14              0                    79
## 15              0                     3

连续变量摘要

通过调用 ExpNumStat() 函数，我们可以得到 oddsdf4 连续变量的摘要。通过添加 Outlier = TRUE 参数，我们指示 SmartEDA 返回除了默认获取的其他度量之外的数据的较低枢纽、较高枢纽和异常值数量。较低枢纽（LB.25%）是数据下半部分的中位数，包括中位数本身；较高枢纽（UB.75%）是数据上半部分的中位数，包括中位数本身；我们通常将这些称为下四分位数和上四分位数。此外，通过添加 round = 2 作为第二个参数，我们告诉 SmartEDA 只返回小数点后两位的所有结果。

这里还有更多内容需要解析，但让我们来看看 nNeg、nZero 和 nPos 度量——这些分别代表每个变量等于负数、零或正数的记录数量。变量 openspreadH 和 closespreadH 在 1,230 条 oddsdf4 记录中几乎三分之二的情况下等于负数，这意味着在 2018-19 NBA 常规赛季的比赛中，主队几乎在 66% 的情况下开盘或收盘作为热门。现在来看看这些相同的度量与派生变量 margin 的关系，margin 等于 ptsR 减去 ptsH：margin 只有 729 次为负，对应大约 59% 的记录。这与我们在第九章中学到的非常吻合——主队赢得大约 58% 到 59% 的所有常规赛季比赛：

ExpNumStat(oddsdf4, Outlier = TRUE, round = 2)
##                      Vname Group   TN nNeg nZero nPos NegInf PosInf
## 6             closespreadH   All 1230  804     1  425      0      0
## 4             closespreadR   All 1230  425     1  804      0      0
## 9 diff_margin_closespreadH   All 1230    0    22 1208      0      0
## 8  diff_margin_openspreadH   All 1230    0    20 1210      0      0
## 7                   margin   All 1230  729     0  501      0      0
## 5              openspreadH   All 1230  790    30  410      0      0
## 3              openspreadR   All 1230  410    30  790      0      0
## 2                     ptsH   All 1230    0     0 1230      0      0
## 1                     ptsR   All 1230    0     0 1230      0      0
##   NA_Value Per_of_Missing      sum   min   max   mean median    SD
## 6        0              0  -3222.5 -18.5  17.0  -2.62   -3.5  6.59
## 4        0              0   3222.5 -17.0  18.5   2.62    3.5  6.59
## 9        0              0  12201.5   0.0  55.0   9.92    8.0  8.12
## 8        0              0  12365.0   0.0  53.5  10.05    8.0  8.22
## 7        0              0  -3351.0 -50.0  56.0  -2.72   -4.0 14.41
## 5        0              0  -3066.0 -18.5  16.0  -2.49   -3.0  6.45
## 3        0              0   3066.0 -16.0  18.5   2.49    3.0  6.45
## 2        0              0 138462.0  77.0 161.0 112.57  112.0 12.68
## 1        0              0 135111.0  68.0 168.0 109.85  110.0 12.48
##      CV  IQR Skewness Kurtosis LB.25% UB.75% nOutliers
## 6 -2.52 10.0     0.20    -0.74 -22.50  17.50         0
## 4  2.52 10.0    -0.20    -0.74 -17.50  22.50         0
## 9  0.82  9.5     1.35     2.26 -10.25  27.75        49
## 8  0.82 10.0     1.37     2.32 -11.00  29.00        40
## 7 -5.29 19.0     0.06     0.23 -40.50  35.50        11
## 5 -2.59  9.5     0.18    -0.63 -21.75  16.25         0
## 3  2.59  9.5    -0.18    -0.63 -16.25  21.75         0
## 2  0.11 17.0     0.17     0.10  78.50 146.50        12
## 1  0.11 17.0     0.14     0.24  75.50 143.50        13

连续变量的分布

大部分剩余的 SmartEDA 内容是视觉的。调用 ExpOutQQ() 函数会返回所有连续变量的 QQ 图（见图 17.13）：

ExpOutQQ(oddsdf4, Page = c(2, 2), sample = 4)

图 17.13 SmartEDA 包的四个随机样本 QQ 图

发现 DataExplorer 包，以及现在的 SmartEDA 包，首先提供 QQ 图来图形化表示连续数据的分布，这非常有趣；毕竟，虽然 QQ 图在运行回归诊断时通常会返回，但在 EDA 中却很少被提及。在这里，我们指导 SmartEDA 返回四个随机样本的图，并将它们排列成一个 2 × 2 矩阵。再次强调，当绘制的数据落在 QQ 图的对角线上时，这些数据是正态分布的；如果不是，数据则存在某种偏斜。

然后，我们调用 ExpNumViz() 函数来获取四个随机样本的密度图，也排列成一个 2 × 2 矩阵（见图 17.14）：

ExpNumViz(oddsdf4, Page = c(2,2), sample = 4)

图 17.14 SmartEDA 包的四个随机样本密度图

恰好SmartEDA为变量openspreadH和diff_margin_closespreadH返回了 QQ 图和密度图；openspreadH是正态分布的，而diff_margin_closespreadH则不是。注意它们各自的密度图中的概率分布，并将这些与它们相应的 QQ 图进行比较。此外，这些密度图的一个优点是SmartEDA会打印出偏度和峰度的数值。当数据是正态分布的，就像变量openspreadH那样，偏度和峰度都会接近于 0 的某个数值；相反，当数据是其他形式的偏斜，就像变量diff_margin_closespreadH那样，偏度和峰度将分别等于远离 0 的正负数值。实际上，偏度和峰度是正负的，这取决于数据是如何偏斜的；当正偏斜时，这些度量值是正的，而当负偏斜时，这两个度量值都是负的。

最后，再次调用ExpNumVix``()函数，这次通过额外的参数传递了scatter = TRUE，返回了一个由四个散点图组成的 2 × 2 矩阵的随机样本（见图 17.15）：

ExpNumViz(oddsdf4, Page = c(2,2), scatter = TRUE, sample = 4)p

图 17.15 SmartEDA包中的四个随机散点图的样本

不幸的是，使用SmartEDA无法创建相关矩阵；因此，可视化成对连续变量之间关系的方法只能是创建一系列散点图。我们之前通过调用ExpReport()函数创建的输出文件实际上包含了 36 个散点图。

分类型变量分析

这就是我们的连续数据的全部内容。至于我们的分类型变量，我们首先调用ExpTable()函数，该函数以表格格式返回month2和spreadmove的基本统计数据。真正令人高兴的是ExpTable()按因素水平分解我们的分类型数据，并为每个因素水平提供汇总。有趣的是，开盘点差价有 52%的时间增加，只有 32%的时间减少（其余时间几乎以相同的价格开盘，占 16%）：

ExpCTable(oddsdf4)
##      Variable Valid Frequency Percent CumPercent
## 1      month2     1       110    8.94       8.94
## 2      month2     2       219   17.80      26.74
## 3      month2     3       219   17.80      44.54
## 4      month2     4       221   17.97      62.51
## 5      month2     5       158   12.85      75.36
## 6      month2     6       224   18.21      93.57
## 7      month2     7        79    6.42      99.99
## 8      month2 TOTAL      1230      NA         NA
## 9  spreadmove  down       397   32.28      32.28
## 10 spreadmove  same       194   15.77      48.05
## 11 spreadmove    up       639   51.95     100.00
## 12 spreadmove TOTAL      1230      NA         NA

最后，我们对每个分类型变量进行了两次子集划分，然后调用ExpCatViz()函数。我们得到了一对柱状图，这些柱状图以图形方式表示了之前通过调用ExpTable()函数返回的数据（见图 17.16）：

select(oddsdf4, month2) -> temp1
ExpCatViz(temp1, Page = c(1, 1))

select(oddsdf4, spreadmove) -> temp2
ExpCatViz(temp2, Page = c(1, 1))

图 17.16 在左侧，柱状图显示了按因素水平显示的month2频率，而在右侧，柱状图显示了按因素水平显示的spreadmove频率。

记住，EDA 的目的是对数据集进行初步了解——它不是一切和结束。接下来，我们将把所有这些内容整合在一起。

17.5 结果

无论我们随后如何切割和切片数据，收盘总价比开盘总价表现更好，收盘点差也优于开盘点差——至少就 2018-19 赛季而言。也就是说，收盘总价和收盘点差比开盘总价和开盘点差更接近比赛结果。这表明大众——至少是那些关注 NBA 并愿意冒险的人——在拉斯维加斯赔率专家的预测之上增加了价值。我们将首先分享胜负彩的结果。

17.5.1 胜负彩

使用DataExplorer包进行的 EDA 练习提供了一些有趣的见解，并为我们提供了一个良好的前进基础。其中一个条形图显示，变量versusPTS等于closetotal的频率高于等于opentotal，尽管没有提供计数。换句话说，在 2018-19 NBA 常规赛中，似乎有更多比赛的收盘胜负彩与总分的差异小于开盘胜负彩与总分的差异。

绘制开盘总价和收盘总价与总分的对比图

在下面的代码块中，我们首先将 oddsdf3 数据集传递给dplyr summarize()函数——SUM1等于diff_ptsT_opentotal大于diff_ptsT_closetotal的实例数量，SUM2等于相反条件成立的实例数量，而SUM3等于diff_ptsT_opentotal和diff_ptsT_closetotal相同的实例数量。

这些结果随后传递给tidyr pivot_longer()函数，该函数以牺牲列计数为代价增加行计数。在此过程中创建了两个新变量，sum和total；SUM1、SUM2和SUM3随后在sum中转换为因子，其值放置在total的单元格中。所有这些最终得到一个可以投入绘图和分析的对象。最终结果是名为 tblA 的 tibble。

oddsdf3 %>%
  summarize(SUM1 = sum(diff_ptsT_opentotal > diff_ptsT_closetotal),
            SUM2 = sum(diff_ptsT_closetotal > diff_ptsT_opentotal),
            SUM3 = sum(diff_ptsT_opentotal == diff_ptsT_closetotal)) %>%
  pivot_longer(cols = c("SUM1", "SUM2", "SUM3"),
             names_to = "sum",
             values_to = "total") -> tblA

然后我们调用ggplot2 ggplot()和geom_bar()函数，用条形图可视化 tblA（见图 17.17）：

• 我们的自变量是sum，因变量是total。通过添加fill参数，我们告诉 R 根据变量sum对条形图进行颜色编码，而不是以灰度打印。

• 通过将stat参数设置为"identity"传递给geom_bar()函数，我们指示 R 将条形图的高度映射到之前提供给ggplot美学的 y 轴变量。

• 为条形图添加与 y 轴变量相关的标签总是一个很好的增强；在这里，geom_text()函数将 y 轴总价放置在条形图上方，并以粗体字体打印。如果我们更喜欢将标签放置在条形图内部，我们只需将vjust参数（即垂直调整）修改为正数。

• 在柱状图上方添加标签通常需要从美学角度出发，通过调用ylim()函数并指定起始和结束点来延长 y 轴的长度。

• 通过调用scale_x_discrete()函数，我们将SUM1、SUM2和SUM3替换为更具描述性的标签，从而避免了使用图例占用空间的需求。

图 17.17 一个柱状图显示，收盘总点数相对于开盘总点数超出了大约 10%。

所有这些都在以下代码块中综合起来：

p1 <- ggplot(tblA, aes(x = sum, y = total, fill = sum)) + 
  geom_bar(stat = "identity") +
  geom_text(aes(label = total), vjust = -0.2, fontface = "bold") +
  labs(title = 
         "Opening Total and Closing Total Performance vs. Combined Points", 
       subtitle = "Closing Total performed ~10% better than Opening Total",
       caption = "2018-19 Regular Season",
       x = "",
       y = "Counts") +
  ylim(0, 625) +
  theme(plot.title = element_text(face = "bold")) +
  scale_x_discrete(labels = c("SUM1" = "closetotal\nBEAT\nopentotal",
                              "SUM2" = "opentotal\nBEAT\nclosetotal",
                              "SUM3" = "closetotal\nEQUALED\nopentotal")) +
  theme(legend.position = "none") 
print(p1) 

结果表明，收盘总点数比开盘总点数高出大约 10%。

按变动

下一个代码块是对生成 tblA 的dplyr和tidyr代码的复制——除了我们插入dplyr group_by()函数来按变量totalmove中的每个因素分组结果，并添加filter()函数来排除diff_ptsT_opentotal等于diff_ptsT_closetotal的 100 个实例。然后我们的结果被转换为一个名为 tblB 的 tibble：

oddsdf3 %>%
  group_by(totalmove) %>%
  summarize(SUM1 = sum(diff_ptsT_closetotal > diff_ptsT_opentotal),
            SUM2 = sum(diff_ptsT_opentotal > diff_ptsT_closetotal),
            SUM3 = sum(diff_ptsT_opentotal == diff_ptsT_closetotal)) %>%
  pivot_longer(cols = c("SUM1", "SUM2", "SUM3"),
             names_to = "sum",
             values_to = "total") %>%
filter(total > 100) -> tblB

在我们的下一个图表中，我们调用ggplot2 facet_wrap()函数为变量totalmove中的每个剩余因素创建一个面板。然后 R 在每一个面板内创建一个类似的柱状图（见图 17.18）：

p2 <- ggplot(tblB, aes(x = sum, y = total, fill = sum))+
  geom_bar(stat = "identity") +
  facet_wrap(~totalmove) +
  geom_text(aes(label = total), vjust = -0.2, fontface = "bold") +
  labs(title = 
         "Opening Total and Closing Total Performance by O/U Movement", 
       subtitle = 
         "Closing Total performed ~10% better than Opening Total",
       caption = "2018-19 Regular Season",
       x = "",
       y = "Counts") +
  ylim(0, 325) +
  theme(plot.title = element_text(face = "bold")) +
  scale_x_discrete(labels = c("SUM1" = "opentotal\nBEAT\nclosetotal",
                              "SUM2" = "closetotal\nBEAT\nopentotal")) +
  theme(legend.position = "none") 
print(p2)

图 17.18 一个分解面板图，展示了开盘总点数与收盘总点数相对于变量totalmove中的因素的点数对比。结果是，收盘总点数比开盘总点数高出大约 10%，无论开盘总点数随后是上升还是下降。

开盘总点数在收盘前是上升还是下降在很大程度上并不重要。结果是，收盘总点数比开盘总点数高出 10%，无论随后的变动如何。

按月份

接下来，我们将 oddsdf3 传递给group_by()和summarize()函数，按变量month2中的每个因素计算diff_ptsT_opentotal小于diff_ptsT_closetotal和diff_ptsT_closetotal小于diff_ptsT_opentotal的实例数量。然后这些结果传递给pivot_longer()函数，以便我们为每个月份得到SUM1和SUM2的结果。我们的最终结果反映在一个名为 tblC 的 tibble 中：

oddsdf3 %>%
  group_by(month2) %>%
  summarize(SUM1 = sum(diff_ptsT_opentotal < diff_ptsT_closetotal),
            SUM2 = sum(diff_ptsT_closetotal < diff_ptsT_opentotal)) %>%
  pivot_longer(cols = c("SUM1", "SUM2"),
             names_to = "sum",
             values_to = "total") -> tblC

因此，我们的下一个ggplot2可视化是一个分组柱状图，每个月份我们得到两个结果，或者说两个柱状图（见图 17.19）。geom_bar() position = "dodge"参数将每对柱状图并排放置并连接它们。

图 17.19 按月份的开盘总点数与收盘总点数的性能对比。2018-19 NBA 常规赛于 10 月开始，并于次年的 4 月结束。

为了防止我们的标签跨越每对条形，我们必须将position_dodge()函数添加到geom_text()函数中。通过指定宽度等于 0.9，标签被居中放置在条形上方；即使从 0.9 到 1 的微小调整也会使标签固定在中心左侧。

通过调用scale_x_discrete()函数，我们能够将每个month2因子映射到实际的月份，因此1等于十月，2等于十一月，以此类推。而且因为我们的 x 轴标签与变量month2相关联，而不是与变量sum相关联，所以需要在图表下方放置一个图例：

p3 <-ggplot(tblC, aes(x = month2, y = total, 
                      fill = factor(sum, levels = c("SUM1", "SUM2")))) + 
  geom_bar(position = "dodge", stat = "identity") +
  geom_text(aes(label = total), position = position_dodge(width = 0.9), 
            vjust = -0.2, fontface = "bold") +
  labs(title = 
         "Month-over-Month Opening Total and Closing Total Performance", 
       subtitle = "Closing Total beat Opening Total in 4 of 7 Months",
       caption = "2018-19 Regular Season",
       x = "Month",
       y = "Counts") +
  ylim(0, 120) +
  scale_fill_discrete(name = "", 
                      labels = c("Opening Total", "Closing Total")) +
  scale_x_discrete(labels = c("1" = "October", "2" = "November",
                              "3" = "December", "4" = "January", 
                              "5" = "February", "6" = "March", 
                              "7" = "April")) +
  theme(legend.position = "bottom") +
  theme(plot.title = element_text(face = "bold")) 
print(p3)

在七个月中有四个月的收盘总方差超过了开盘总方差。然而，最引人入胜，也许是最重要的结果来自 2018 年 10 月和 11 月。在这两个常规赛的第一个月，由于观察数据相对较少，收盘总方差显著超过了开盘总方差。

绘制开盘总方差和收盘总方差与综合点数的关系图

现在我们对开盘总和与收盘总和之间的平均方差以及对抗队伍之间的综合点数总和感兴趣。我们将 oddsdf3 传递给summarize()函数，该函数计算diff_ptsT_opentotal和diff_ptsT_closetotal的平均值。然后将初始结果传递给pivot_longer()函数，将AVG1和AVG2转换为名为avg的新变量中的因子，并将它们的值放置在另一个名为value的新变量中。最终结果被转换为名为 tblD 的 tibble：

oddsdf3 %>%
    summarize(AVG1 = mean(diff_ptsT_opentotal),
              AVG2 = mean(diff_ptsT_closetotal)) %>%
    pivot_longer(cols = c("AVG1", "AVG2"),
             names_to = "avg",
             values_to = "value") -> tblD

我们接下来的可视化是一个非常简单的条形图，显示了开盘总方差和收盘总方差与总得分（见图 17.20）。

图 17.20 开盘总和与收盘总和以及对抗队伍所得分综合点数之间的平均方差

而不是调用geom_bar()函数并传递stat = "identity"参数，我们只是调用geom_col()函数。通过在geom_text()函数内插入基础 R 的round()函数，我们的标签保证只包含小数点后两位数字：

p4 <- ggplot(tblD, aes(x = avg, y = value, fill = avg)) + 
  geom_col() +
  geom_text(aes(label = round(value, 2)), vjust = -0.2,
            fontface = "bold") +
  labs(title = 
         "Variances: Opening and Closing Totals vs. Combined Points",
       subtitle = "Closing Total performed ~2% better than Opening Total",
       caption = "2018-19 Regular Season",
       x = "",
       y = "Average Variance from Combined Points") +
  ylim(0, 16) +
  theme(plot.title = element_text(face = "bold")) +
  scale_x_discrete(labels = c("AVG1" = "opentotal\nversus\nptsT",
                              "AVG2" = "closetotal\nversus\nptsT")) +
  theme(legend.position = "none") 
print(p4)

方差显然非常相似，但收盘总方差实际上确实比开盘总方差高出约 2%。

通过移动

然后，我们根据开盘总和在收盘前是上升还是下降来分解这些相同的结果；因此，我们将group_by()函数插入到我们的dplyr和tidyr代码的副本中，按变量totalmove中的每个因子分组结果。然后，我们调用filter()函数将最终结果限制在totalmove不等于same的地方。随后我们得到一个名为 tblE 的 tibble：

oddsdf3 %>%
  group_by(totalmove) %>%
  summarize(AVG1 = mean(diff_ptsT_opentotal),
            AVG2 = mean(diff_ptsT_closetotal)) %>%
  pivot_longer(cols = c("AVG1", "AVG2"),
             names_to = "avg",
             values_to = "value") %>%
filter(totalmove != "same") -> tblE

我们接下来的可视化是一个面图（见图 17.21），它为totalmove变量中剩余的每个因素包含一个面板。再次，我们将geom_bar()函数替换为geom_col()函数。此外，我们还修改了美学参数vjust，从-0.2改为1.5，这使得标签位于柱状图的顶部下方。因此，就不再需要调用ylim()函数来扩展 y 轴的长度：

p5 <- ggplot(tblE, aes(x = avg, y = value, fill = avg)) +
  geom_col() +
  facet_wrap(~totalmove) +
  geom_text(aes(label = round(value, 2)), vjust = 1.5,
            fontface = "bold") +
  labs(title = 
         "Opening Total and Closing Total Performance by O/U Movement", 
       subtitle = 
         "Closing Total performed ~2% better than Opening Total",
       caption = "2018-19 Regular Season",
       x = "",
       y = "Average Variance from Combined Points") +
  theme(plot.title = element_text(face = "bold")) +
  scale_x_discrete(labels = c("AVG1" = "opentotal",
                              "AVG2" = "closetotal")) +
  theme(legend.position = "none") 
print(p5)

图 17.21 开盘和收盘总点数以及对方球队得分总和的平均方差，按totalmove变量中剩余的每个因素分开

无论开盘总点数在收盘前是上升还是下降，方差再次非常相似。尽管如此，收盘总点数在 2%的幅度上优于开盘总点数。

按月份

最后，我们将按月份绘制这些方差。因此，我们将 oddsdf3 数据集传递给group_by()和summarize()函数，以计算month2变量中每个因素的diff_ptsT_opentotal和diff_ptsT_closetotal平均值。随后调用pivot_longer()函数，将AVG1和AVG2从变量转换为新变量avg中的因素，并将它们的值放置在另一个新变量value中。我们的结果被转换为一个名为 tblF 的 tibble：

oddsdf3 %>%
  group_by(month2) %>%
  summarize(AVG1 = mean(diff_ptsT_opentotal),
            AVG2 = mean(diff_ptsT_closetotal)) %>%
  pivot_longer(cols = c("AVG1", "AVG2"),
             names_to = "avg",
             values_to = "value") -> tblF

我们对上个月月度图表进行了一些美学上的调整（见图 17.22）。这次，我们不是将position参数设置为"dodge"传递给geom_bar()函数，而是传递position_dodge()，并指定宽度为0.5，这实际上使得一个系列柱状图的一半宽度被另一个系列柱状图所遮挡。因此，我们随后将标签四舍五入到最接近的整数；否则，标签通常会混合在一起，难以辨认。为了将这些相同的标签居中放置在柱状图上方，我们也在geom_text()函数中添加了position_dodge()函数；然而，这次我们指定的宽度也等于0.5，而不是之前的0.9：

p6 <-ggplot(tblF, aes(x = month2, y = value, 
                      fill = factor(avg, levels = c("AVG1", "AVG2")))) + 
  geom_bar(position = position_dodge(width = 0.5), stat = "identity") +
  geom_text(aes(label = round(value, 0)), 
            position = position_dodge(width = 0.5), vjust = -0.2, 
            fontface = "bold") +
  labs(title = 
         "Month-over-Month Opening Total and Closing Total Performance", 
       subtitle = 
         "Closing Total beat or equaled Opening Total in 7 of 7 Months",
       caption = "2018-19 Regular Season",
       x = "Month",
       y = "Average Variance from Combined Points") +
  ylim(0,18) +
  scale_fill_discrete(name = "", labels = c("Opening Total", 
                                            "Closing Total")) +
  scale_x_discrete(labels = c("1" = "October", "2" = "November",
                              "3" = "December", "4" = "January", 
                              "5" = "February", "6" = "March",          
                              "7" = "April")) +
  theme(legend.position = "bottom") +
  theme(plot.title = element_text(face = "bold")) 
print(p6)

图 17.22 开盘和收盘总点数以及得分总和的月度平均方差。柱状图上方的标签已四舍五入到最接近的整数。

如果根据四舍五入的方差来看，2018-19 NBA 常规赛的七个月中，收盘总点数在所有七个月都击败或至少等于开盘总点数。如果我们根据相同结果的视觉表示来看，那么在七个月中有五个月收盘总点数优于开盘总点数。最显著的、有利于收盘总点数的方差出现在 2018 年 10 月和 11 月，当时相对较少的比赛已经进行，因此只有少数几个观察值可供分析。

现在，我们将旋转并报告开盘和收盘点数差异的表现。

17.5.2 点差

为了最小化重复代码的展示（尽管变量进行了交换），我们将通过打印 tibbles 并避免任何进一步的视觉呈现来展示我们的结果。我们将从计算收盘价比开盘价更接近最终利润率的次数、开盘价更接近最终利润率的次数以及收盘价和开盘价相同的次数开始。以下代码块与之前生成 tblA 的dplyr和tidyr代码匹配；在这里，我们将结果转换为名为 tblG 的 tibble：

oddsdf4 %>%
  summarize(SUM1 = sum(diff_margin_openspreadH > 
                         diff_margin_closespreadH),
            SUM2 = sum(diff_margin_closespreadH >
                         diff_margin_openspreadH),
            SUM3 = sum(diff_margin_openspreadH == 
                         diff_margin_closespreadH)) %>%
  pivot_longer(cols = c("SUM1", "SUM2", "SUM3"),
               names_to = "sum",
               values_to = "total") -> tblG
print(tblG)
## # A tibble: 3 × 2
##   sum   total
##   <chr> <int>
## 1 SUM1    553
## 2 SUM2    493
## 3 SUM3    184

收盘总价比开盘总价高出约 11%（等于SUM2的倒数除以SUM1）。

接下来，我们根据开盘价随后是上升还是下降来分解这些相同的成果；我们的最终结果不包括变量spreadmove等于same或变量sum等于SUM3的情况。以下生成名为 tblH 的 tibble 的代码行与生成 tblB 的代码相似：

oddsdf4 %>%
  group_by(spreadmove) %>%
  summarize(SUM1 = sum(diff_margin_closespreadH > 
                         diff_margin_openspreadH),
            SUM2 = sum(diff_margin_openspreadH > 
                         diff_margin_closespreadH),
            SUM3 = sum(diff_margin_openspreadH == 
                         diff_margin_closespreadH)) %>%
  pivot_longer(cols = c("SUM1", "SUM2", "SUM3"),
               names_to = "sum",
               values_to = "total") %>%
  filter(spreadmove != "same", sum != "SUM3") -> tblH
print(tblH)
## # A tibble: 4 × 3
##   spreadmove sum   total
##   <fct>      <chr> <int>
## 1 down       SUM1    185
## 2 down       SUM2    212
## 3 up         SUM1    303
## 4 up         SUM2    331

尽管开盘价在收盘前可能上升或下降，但收盘价的表现始终优于开盘价，但结果会因spreadmove因素水平的不同而有所变化。当开盘价下降时，收盘价比开盘价高出约 13%；当开盘价上升时，收盘价比开盘价高出约 8%。

然后，我们计算了开盘价和收盘价与最终利润率之间的表现，按变量month2中的每个因素进行。以下生成名为 tblI 的代码块与 tblC 代码非常匹配：

oddsdf4 %>%
  group_by(month2) %>%
  summarize(SUM1 = sum(diff_margin_openspreadH < 
                         diff_margin_closespreadH),
            SUM2 = sum(diff_margin_closespreadH < 
                         diff_margin_openspreadH)) %>%
  pivot_longer(cols = c("SUM1", "SUM2"),
               names_to = "sum",
               values_to = "total") -> tblI
print(tblI)
## # A tibble: 14 × 3
##    month2 sum   total
##    <fct>  <chr> <int>
##  1 1      SUM1     52
##  2 1      SUM2     43
##  3 2      SUM1     85
##  4 2      SUM2     90
##  5 3      SUM1     75
##  6 3      SUM2    110
##  7 4      SUM1     95
##  8 4      SUM2     94
##  9 5      SUM1     70
## 10 5      SUM2     71
## 11 6      SUM1     87
## 12 6      SUM2    108
## 13 7      SUM1     29
## 14 7      SUM2     37

在七个月中有五个月，收盘价的表现优于开盘价——包括 2018-19 NBA 常规赛前三个月中的两个月，以及令人好奇的最后三个月。

接下来，我们计算开盘价和收盘价与最终利润率之间的平均方差，并将结果转换为名为 tblJ 的 tibble（参见 tblD 代码以进行比较）：

oddsdf4 %>%
  summarize(AVG1 = mean(diff_margin_openspreadH),
            AVG2 = mean(diff_margin_closespreadH)) %>%
  pivot_longer(cols = c("AVG1", "AVG2"),
             names_to = "avg",
             values_to = "value") -> tblJ
print(tblJ)
## # A tibble: 2 × 2
##   avg   value
##   <chr> <dbl>
## 1 AVG1  10.1 
## 2 AVG2   9.92

收盘价比开盘价高出约 2%。

然后，我们根据开盘价是上升还是下降来计算这些相同的方差。我们的结果被推送到一个名为 tblK 的 tibble 中，不包括变量spreadmove等于same的情况（参见 tblE 代码以进行对比）：

oddsdf4 %>%
  group_by(spreadmove) %>%
  summarize(AVG1 = mean(diff_margin_openspreadH),
            AVG2 = mean(diff_margin_closespreadH)) %>%
  pivot_longer(cols = c("AVG1", "AVG2"),
             names_to = "avg",
             values_to = "value") %>%
  filter(spreadmove != "same") -> tblK
print(tblK)
## # A tibble: 4 × 3
##   spreadmove avg   value
##   <fct>      <chr> <dbl>
## 1 down       AVG1  10.8 
## 2 down       AVG2  10.6 
## 3 up         AVG1   9.79
## 4 up         AVG2   9.68

不论开盘价在收盘前是上升还是下降，收盘价的表现与开盘价的表现大致相当。

最后，我们计算了月度开盘和收盘表现与最终利润率之间的对比（参见 tblF 代码以进行对比）：

oddsdf4 %>%
  group_by(month2) %>%
  summarize(AVG1 = mean(diff_margin_openspreadH),
            AVG2 = mean(diff_margin_closespreadH)) %>%
  pivot_longer(cols = c("AVG1", "AVG2"),
             names_to = "avg",
             values_to = "value") -> tblL
print(tblL)
## # A tibble: 14 × 3
##    month2 avg   value
##    <fct>  <chr> <dbl>
##  1 1      AVG1   9.92
##  2 1      AVG2   9.98
##  3 2      AVG1  10.4 
##  4 2      AVG2  10.3 
##  5 3      AVG1  10.4 
##  6 3      AVG2  10.1 
##  7 4      AVG1   9.79
##  8 4      AVG2   9.75
##  9 5      AVG1   9.46
## 10 5      AVG2   9.33
## 11 6      AVG1  10.2 
## 12 6      AVG2   9.96
## 13 7      AVG1   9.80
## 14 7      AVG2   9.66

在 2018-19 NBA 常规赛的每个月份，除了（令人好奇的是）第一个月，收盘价的表现都优于开盘价。

虽然这些差异——不仅限于开盘和收盘差价，还包括开盘和收盘总金额——可能看起来很小，但它们绝不是无关紧要的。在赌博界，小的差异通常对赌场和赌徒都有重大的财务影响。在最终分析中，仅基于 2018-19 赛季的数据，受赌徒影响的收盘总金额和收盘差价，往往比拉斯维加斯博彩公司设定的开盘总金额和开盘差价更接近比赛结束的结果。此外，“赌徒的价值增加”在 2018-19 赛季早期更为普遍，当时可供工作的历史数据不多，而后期则较少。因此，相对缺乏训练数据似乎对博彩公司的影响比对赌徒集体智慧的影响更大。

在下一章中，我们将探讨 NBA 在 1983-84 赛季和 1984-85 赛季之间实施的薪资上限可能如何影响了赛季内和赛季间的平衡。我们将介绍几个用于量化 1985 年前后平衡的统计指标，以确定薪资上限是否真的像联盟所说的那样改善了平衡。

摘要

• 自动 EDA 的优点是你可以用更少的资源生产更多，也就是说，用更少的代码行生成更多内容。这也允许你专注于运行统计测试、开发预测模型、创建无监督算法等等。

• 自动 EDA 的缺点是，你可能不会得到最佳的内容返回；也就是说，你可能会得到一些无关紧要的结果，而不会得到其他应该重要的结果。

• 手动或系统的 EDA 方法迫使你思考你的数据，并在过程中提供巨大的学习机会。自动 EDA 类似于全球定位系统——你将到达预定的目的地，但你可能不知道你是如何到达那里的。

• 当涉及到自动或手动时，不一定是非此即彼；自动和手动 EDA 的某种组合可能对许多项目来说是一个很好的解决方案。此外，你可以挑选和选择你想要手动运行的 tableone、DataExplorer 和/或 SmartEDA 函数，以补充基础 R 和 tidyverse 函数。

• 关于自动 EDA 以及特别演示的三个包，还有一个观点：尽管 tableone、DataExplorer 和 SmartEDA 无疑是三个最受欢迎的自动 EDA 包，但这并不一定意味着它们已经得到了充分的审查。SmartEDA 的手动功能最多有些古怪，最坏的情况是存在错误。DataExplorer 输出相对精致和详尽的表格和图形结果组合，可以保存为独立文件并共享；因此，它是这三个自动 EDA 包中最好的。

• 我们的研究结果一致表明，结算总账和结算赔率比开盘总账和开盘赔率更接近最终结果。赌徒们增加了价值，尤其是在赛季早期，那时可供建立开盘赔率的比赛或结果相对较少。

• 因此，智慧存在于人群中；独立操作且对游戏有投入的人群比数量多得多的专家更聪明的观点可能非常正确。

18 种统计离散度方法

本章涵盖

• 统计离散度度量

• 方差法

• 标准差法

• 范围法

• 均值绝对偏差法

• 中值绝对偏差法

• 计算客户流失率

• 创建金字塔图

我们在这里的主要目的是介绍几种统计离散度的方法。也称为统计变异性或分散度，统计离散度是衡量连续数据向量围绕中间值分散或散布的程度。仅仅知道平均值或中位数是不够的；了解计算统计离散度的方法对于真正理解数值数据至关重要，这在评估风险和衡量一致性和波动性方面具有实际意义。

这是我们所处的背景：在 1983-84 赛季和 1984-85 赛季之间，NBA 引入了薪资帽。这意味着球队每年在球员薪资上的支出是有限的，有一些允许的例外。（薪资帽仍然有效，并按通货膨胀、阵容规模增加和其他因素进行调整。）根据 NBA 的权力机构，薪资帽的所谓正当理由——或者更直白地说，限制球员收入的原因——是为了创造公平性，使球队拥有大致相当的人才，这将导致结果更不可预测。联盟说服了球员及其工会，认为公平性对联盟的财务健康和长期可持续性是有益的；球员（以及所有人，包括球迷）将受益于一个由薪资帽驱动的永恒公平性条件所支持的财务和其它方面安全的 NBA。

为了明确起见，我们现在讨论的是季节内公平性，即在整个赛季中，联盟中常规赛季胜利的离散度，在薪资帽之后应该小于在薪资帽之前的离散度。

在 1984-85 赛季之前，NBA 真的存在季节内公平性问题吗？如果是这样，薪资帽是否有效地解决了这个问题？我们的计划是通过逐步展示几种离散度的统计度量，计算按赛季分组的常规赛季胜利向量，并在薪资帽前后绘制结果来回答这些问题。

然而，也存在季节间公平性，即 NBA 最佳球队的年度更替率，在薪资帽之后应该大于在薪资帽之前。

薪资上限是否增加了联赛顶级球队的年度转会率，或者没有？因此，我们的次要目的是评估薪资上限对赛季间公平性的影响，如果有任何影响；我们将展示一种计算流动性的方法，并绘制薪资上限前后的年度对比图。当所有事情都结束时，我们希望验证薪资上限对赛季内和赛季间公平性的影响，或者对那些影响产生怀疑。剧透一下：我们将产生怀疑。

我们将首先加载一个包，以超越基本的 R 并实现这些目标。

18.1 加载包

我们将使用dplyr和tidyr函数处理我们的数据，并使用ggplot2函数可视化我们的赛季内和赛季间结果。我们第一次也是唯一一次调用library()函数加载了tidyverse包的宇宙；否则，基本的 R 函数将非常适合我们：

library(tidyverse)

我们将在下一部分导入我们的两个数据集。

18.2 导入数据

我们的两个数据集的第一个包含了从www.basketball-reference.com爬取的年度真实美元薪资上限数据，以及按通货膨胀调整后的 2021 美元薪资，使用www.usinflationcalculator.com的工具进行调整。而我们之前导入的类似文件覆盖了 2000 年到 2017 年的 NBA 赛季，这个文件——salary_cap2.csv，等于一个名为 cap 的对象——覆盖了 1985 年到 2021 年的赛季。

我们的两个数据集的第二个——team_records.csv（从 Kaggle 下载），等于一个名为 records 的对象——包含了 1961 年到 2018 年常规赛期间每个 NBA 球队的年度胜负记录。

我们通过两次调用readr的read_csv()函数导入两个数据集并将它们保存在我们的默认工作目录中：

cap <- read_csv("salary_cap2.csv")

records <- read_csv("team_records.csv")

关于这两个数据集的更多信息将在下一部分介绍。

18.3 探索和整理数据

我们之前使用时间序列图表可视化了 NBA 薪资上限数据，这里是真实和调整后的数据；这里，我们将使用所谓的金字塔图来可视化。金字塔图，有时也称为三角形图，在显示层次数据时是一个极好的选择，无论是正立还是倒置。

我们选择的可视化意味着我们首先必须整理薪资数据集。金字塔图在某种程度上类似于堆叠条形图——它显示两个或多个分类变量的数值——然后旋转了 90 度；金字塔或三角形效果是通过将每个条形的“一半”从 0 开始并朝相反方向绘制来创建的。这意味着我们必须将真实或调整后的美元转换为负数，所以我们将通过将每个单元格乘以-1 来简单地转换真实美元为负数。

调用基本 R 的head()函数然后返回 cap 中的前六个观测值：

cap$real <- cap$real * -1

head(cap)
##    season       real  adjusted
## 1 2020-21 -109140000 109140000
## 2 2019-20 -109140000 114267422
## 3 2018-19 -101869000 107970613
## 4 2017-18  -99093000 106931428
## 5 2016-17  -94143000 101015531
## 6 2015-16  -70000000  76710179

然后，我们将 cap 传递给 tidyr pivot_longer() 函数；原来的 real 和 adjusted 列成为名为 type 的新列中的因子，它们的值落在另一个名为 cap 的新列中。这些变化反映在名为 new_cap 的 tibble 中。对 head() 函数的另一个调用揭示了这一操作的后果：

cap %>%
  pivot_longer(cols = c("real", "adjusted"),
               names_to = "type",
               values_to = "cap") -> new_cap

head(new_cap)
## # A tibble: 6 × 3
##   season  type            cap
##   <chr>   <chr>         <dbl>
## 1 2020-21 real     -109140000
## 2 2020-21 adjusted  109140000
## 3 2019-20 real     -109140000
## 4 2019-20 adjusted  114267422
## 5 2018-19 real     -101869000
## 6 2018-19 adjusted  107970613

接下来，我们定义金字塔图表的断点和标签。断点是通过调用基础 R 的 seq() 函数并传递三个参数来定义的，这三个参数代表 y 轴的最小值和最大值以及刻度如何增加。标签是通过调用基础 R 的 paste0() 函数来定义的，该函数缩放刻度并将值与一个大写字母 M 连接起来；因此，一个如 120000000 的数字被转换为 120M：

breaks <- seq(-120000000, 120000000, 10000000)
labels <- paste0(as.character(c(seq(120, 0, -10), seq(10, 120, 10))), "M")

现在，这里是即将到来的 ggplot2 金字塔图表的细节（见图 18.1）：

• 我们通过调用 ggplot() 函数初始化绘图；new_cap 是我们的数据源，变量 season 是我们的 x 轴变量，变量 cap 是我们的 y 轴变量。fill 参数为图表中的 type 变量内的两个因子建立颜色方案；scale_fill_discrete() 函数告诉 R 创建一个指向同一内容的图例。默认情况下，图例被部署在 ggplot2 图表的右侧，但它们几乎可以放置在任何你喜欢的位置；在这里，我们决定将图例放置在图的底部。

• geom_col() 函数是告诉 R 绘制条形图的一种方式（记住，金字塔图表，至少在某些方面，类似于条形图）。当将 stat = "identity" 参数传递给 geom_bar() 函数时，geom_col() 函数等于 geom_bar() 函数。否则，我们希望 R 将条形绘制在默认宽度的 60%处。

• scale_y_continuous() 函数插入我们事先建立的断点和标签。

• coord_flip() 函数将我们的图表旋转 90 度，包括 x 轴和 y 轴，从而生成一个倒置的金字塔图表（倒置是因为 x 轴从上到下是按时间顺序反向堆叠的）。

图 18.1 显示了 1984-85 赛季至 2020-21 赛季 NBA 薪资上限的年度增长，包括实际和通货膨胀调整后的美元。

下面是我们金字塔图表的 ggplot2 代码块：

p1 <- ggplot(new_cap, aes(x = season, y = cap, fill = type)) +   
  geom_col(width = .6) +
  scale_y_continuous(breaks = breaks,   
                     labels = labels) + 
  coord_flip() +  
  labs(title = "NBA Salary Cap History: 1984-85 to 2020-21",
       x = "Season", 
       y = "Real or Adjusted Cap",
       caption = "salary cap was introduced prior to the 1984-85 season") +
  scale_fill_discrete(name = "", 
                      labels = c("Adjusted Dollars", "Real Dollars")) +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  theme(legend.position = "bottom")
print(p1)

再次强调，当你想要或需要可视化一个顺序或层次结构时，金字塔图表是理想的。例如，你可能会选择创建一个金字塔图表来显示按国家划分的销售情况，左侧是单位，右侧是（缩放后的）美元；显示按性别和年龄组的人口计数；或者表示每个到期阶段的单位之间的信用卡违约率。

现在，让我们从薪资数据集转向记录数据集。我们以两种方式减少记录的维度：首先是通过调用dplyr select()函数，仅选择我们绝对需要的少数变量来子集记录，其次是通过调用dplyr filter()函数，将记录减少到仅包括满足给定标准的观察值：

records %>%
  select(Season, Lg, Team, W, L) -> records

records %>%
  filter(Lg == "NBA" & Season > "1969-70" & Season < "1998-99") -> records

然后，我们调用dplyr glimpse()函数来返回记录维度以及数据的截断和转置视图：

glimpse(records)
## Rows: 650
## Columns: 5
## $ Season <chr> "1997-98", "1996-97", "1995-96", "1994-95", "1993-94", "...
## $ Lg     <chr> "NBA", "NBA", "NBA", "NBA", "NBA", "NBA", "NBA", "NBA", ...
## $ Team   <chr> "Boston Celtics", "Boston Celtics", "Boston Celtics", "B...
## $ W      <dbl> 36, 15, 33, 35, 32, 48, 51, 56, 52, 42, 57, 59, 67, 63, ...
## $ L      <dbl> 46, 67, 49, 47, 50, 34, 31, 26, 30, 40, 25, 23, 15, 19, ...

下面是记录数据现在的样子：

• 赛季——现在等于从1970-71到1997-98的最小值和最大值。因此，我们有 14 个赛季的数据在薪资上限之前，以及 14 个赛季的数据在薪资上限之后，这足以比较和对比在 1984-85 赛季之前和之后引入薪资上限之前和之后的结果。

• 联盟——现在等于所有剩余观察值中的NBA，但最初等于NBA或ABA。ABA，即美国篮球协会，是一个竞争对手职业联赛，早在 1976 年就倒闭了。由于我们的薪资上限分析仅适用于 NBA，我们过滤掉了所有 ABA 观察值。

• 球队——这等于完整的 NBA 球队名称（例如，底特律活塞，休斯顿火箭）。一个星号表示该队有资格参加季后赛。

• W——这等于在 82 场比赛安排中的常规赛胜场数。

• L——这等于常规赛的失利次数。胜场（W）加上失利（L）等于每个剩余记录的 82 场。

现在我们已经对数据有了很好的了解，让我们继续分析。我们将从赛季内公平性开始，展示我们如何通过不同的统计分散度度量来量化在薪资上限前后的情况。

18.4 统计分散度和赛季内公平性

统计分散度度量了围绕中心值的数值数据的分布或分布情况；换句话说，分散度度量描述了数据的可变性。随着可变性的增加，分散度也会增加。如果薪资上限实际上改善了赛季内公平性，那么我们应该在 1984-85 赛季之前看到比之后更高的分散度数字。

如果你是一个低风险投资者，正在考虑购买一只股票而不是另一只，那么计算两只股票价格随时间变化的分散度可能很明智，然后投资于分散度值较低的股票。作为另一个例子，你可能是一位人力资源经理，想要了解在调整薪资区间时同一行业薪酬的分散情况。你也可能正在为旅行做准备，想要在决定携带什么和多少行李之前计算目的地的温度分散情况。在这些场景中，仅仅计算平均值或中位数至多是不够的，在最坏的情况下是误导的。

要理解 NBA 的跨赛季公平性——在存在薪资上限之前和之后——我们需要计算常规赛胜利的年度分散度，并将这些值随时间绘制出来，这正是我们即将要做的事情。

我们的目的是介绍五种常见的统计分散度度量，计算记录数据集中每年或每个赛季的结果，将结果绘制在ggplot2折线图中，并将回归线插入我们的可视化中，以确定薪资上限前后跨赛季公平性的趋势。您将了解更多关于分散度和如何在 R 中计算这些度量的信息；同时，我们将确定 NBA 在 1984 年设立薪资上限时，是否确实存在跨赛季公平性问题，以及薪资上限是否产生了积极的影响。

在我们介绍方差方法之前，请注意，以下每种方法都有其自身的优缺点。考虑多个统计分散度度量以全面了解数据的分布是值得的。

18.4.1 方差方法

方差衡量每个数据点与组平均值的平均平方偏差；因此，方差考虑了各个数据点与单个平均值之间的差异。它是通过将每个数据点与平均值之间的平方差相加，然后除以记录数来计算的。在 R 中，我们只需调用基础 R 的var()函数。因此，方差方法考虑了所有数据点，但它可能对数据中的任何异常值较为敏感。

在下面的代码块中，我们将记录数据集传递给dplyr包中的group_by()和summarize()函数，以计算每个赛季的常规赛胜利的联赛方差。常规赛胜利的年度方差由名为v_wins的变量在名为 var_records 的 tibble 中表示。head()和tail()函数返回 var_records 中的前三个和最后三个观测值：

records %>%
  group_by(Season) %>%
  summarize(v_wins = var(W)) -> var_records

head(var_records, n = 3)
## # A tibble: 3 × 2
##   Season  v_wins
##   <chr>    <dbl>
## 1 1970-71   143.
## 2 1971-72   235.
## 3 1972-73   264.

tail(var_records, n = 3)
## # A tibble: 3 × 2
##   Season  v_wins
##   <chr>    <dbl>
## 1 1995-96   197.
## 2 1996-97   245.
## 3 1997-98   241.

这些结果随后被绘制在ggplot2折线图中（见图 18.2）：

• 我们刚刚创建的 tibble，var_records，是我们的数据源。一个变量Season是 x 轴变量，另一个变量v_wins是 y 轴变量。

• geom_line()函数绘制了一条宽度为默认ggplot2宽度一半的线。geom_point()函数将数据点叠加到线上，这些数据点的尺寸是默认尺寸的五倍。

• ylim()函数根据传递的参数绘制 y 轴的值。

• geom_smooth()函数被调用两次，从 1970-71 赛季到 1983-84 赛季，以及从 1984-85 赛季到 1997-98 赛季绘制回归线。

• annotate()函数被调用两次，添加了轻柔但独立的彩色块，以便容易地区分薪资上限前和薪资上限后的时代。因此，彩色块对应于我们的回归线的长度。

• 第二次调用theme()函数将 x 轴刻度倾斜到 45 度角。

图 18.2 基于方差法的常规赛胜利年度间分散情况

我们后续的折线图将使用这种相同的基本语法创建：

p2 <- ggplot(var_records, aes(x = Season, y = v_wins, group = 1)) + 
  geom_line(aes(y = v_wins), color = "black", size = .5) + 
  geom_point(size = 5, color = "dodgerblue") +
  labs(title = "Year-over-Year Variance in Regular Season Wins",
       subtitle = "1970-98",
       x = "Season", 
       y = "Variance",
       caption = "salary cap was introduced prior to the 1984-85 season") +
  ylim(0, 300) +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = var_records[as.character(var_records$Season) < 
                                   "1984-85",]) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = var_records[as.character(var_records$Season) > 
                                   "1983-84",]) +
  annotate("rect", xmin = "1970-71", xmax = "1983-84",
           ymin = 0, ymax = 300, alpha = 0.1, fill = "orange") +
  annotate("rect", xmin = "1984-85", xmax = "1997-98",
           ymin = 0, ymax = 300, alpha = 0.1, fill = "green")
print(p2)

基于方差法，1970-71 赛季到 1983-84 赛季期间，赛季内的公平性实际上呈下降趋势，然后在薪资上限时代又呈上升趋势。从联盟的立场来看，NBA 可能通过只考虑 1979-80 赛季到 1982-83 赛季，来缩减其历史视角，在这段时间里，常规赛胜利的分散程度高于前九年中的七年。即便如此，至少根据这种分析，薪资上限显然没有对赛季内的公平性产生积极影响。

18.4.2 标准差法

方差法的另一个缺点是它通常（包括在这个案例中）产生的分散值难以理解。相比之下，标准差法的优点是它仅仅是方差的平方根；在 R 中，标准差是通过在var()函数前加上基础 R 的sqrt()函数或调用基础 R 的sd()函数来计算的。

在下面的代码块中，我们再次将 records 传递给group_by()和summarize()函数，以计算常规赛胜利的年度间标准差。结果被转换为名为 sd_records 的 tibble。再次，head()和tail()函数返回前三和后三的观测值：

records %>%
  group_by(Season) %>%
  summarize(sd_wins = sd(W)) -> sd_records

head(sd_records, n = 3)
## # A tibble: 3 × 2
##   Season  sd_wins
##   <chr>     <dbl>
## 1 1970-71    12.0
## 2 1971-72    15.3
## 3 1972-73    16.2

tail(sd_records, n = 3)
## # A tibble: 3 × 2
##   Season  sd_wins
##   <chr>     <dbl>
## 1 1995-96    14.0
## 2 1996-97    15.7
## 3 1997-98    15.5

然后，我们将 sd_records 传递给ggplot()函数，并创建一个与第一个折线图外观和感觉相同的第二个折线图（见图 18.3）：

p3 <- ggplot(sd_records, aes(x = Season, y = sd_wins, group = 1)) + 
  geom_line(aes(y = sd_wins), color = "black", size = .5) + 
  geom_point(size = 5, color = "dodgerblue") +
  labs(title = "Year-over-Year Standard Deviation in Regular Season Wins",
       subtitle = "1970-98",
       x = "Season", 
       y = "Standard Deviation",
       caption = "salary cap was introduced prior to the 1984-85 season") +
  ylim(0, 20) +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = sd_records[as.character(sd_records$Season) < 
                                  "1984-85",]) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = sd_records[as.character(sd_records$Season) > 
                                  "1983-84",]) +
  annotate("rect", xmin = "1970-71", xmax = "1983-84",
           ymin = 0, ymax = 20, alpha = 0.1, fill = "orange") +
  annotate("rect", xmin = "1984-85", xmax = "1997-98",
           ymin = 0, ymax = 20, alpha = 0.1, fill = "green")
print(p3)

图 18.3 基于标准差法的常规赛胜利年度间分散情况

由于标准差是从方差派生出来的，因此这些结果与我们的先前结果相匹配并不令人惊讶——除了标准差法返回的分散度量是我们都能轻松相关联的事实。如果变量wins假设了一个正态分布，或者高斯分布——它确实如此——那么我们就可以推断，在 1976-77 赛季，大约三分之二的 NBA 球队赢得了 33 到 49 场常规赛（等于加减 8 场胜利，1976-77 年胜利的大约标准差，从平均数 41 开始）。我们还可以推断，在 1996-97 赛季，三分之二的球队赢得了 25 到 57 场常规赛。这表明分散程度显著增加，因此公平性减少。

18.4.3 范围法

范围法无疑是简单且直接的分散统计方法；然而，因为它只考虑最极端的值，而不是像方差和标准差方法那样考虑每一个数据点，所以它对异常值特别敏感，且不考虑整个分布。它等于数据集中最高值和最低值之间的差。在 R 中，我们通过调用基础 R 的max()和min()函数来获取这些值，然后通过从后者减去前者来得到范围。group_by()和summarize()函数否则指示 R 按变量Season中的每个因子计算范围，并将结果推送到名为r_wins的变量和一个名为 r_records 的 tibble 中。head()和tail()函数给我们提供了对结果的一瞥：

records %>%
  group_by(Season) %>%
  summarize(r_wins = max(W) - min(W)) -> r_records

head(r_records, n = 3)
## # A tibble: 3 × 2
##   Season  r_wins
##   <chr>    <int>
## 1 1970-71     51
## 2 1971-72     51
## 3 1972-73     59

tail(r_records, n = 3)
## # A tibble: 3 × 2
##   Season  r_wins
##   <chr>    <int>
## 1 1995-96     57
## 2 1996-97     55
## 3 1997-98     51

另一条ggplot2线形图可视化了相同的内容（见图 18.4）：

p4 <- ggplot(r_records, aes(x = Season, y = r_wins, group = 1)) + 
  geom_line(aes(y = r_wins), color = "black", size = .5) + 
  geom_point(size = 5, color = "dodgerblue") +
  labs(title = "Year-over-Year Range in Regular Season Wins",
       subtitle = "1970-98",
       x = "Season", 
       y = "Range",
       caption = "salary cap was introduced prior to the 1984-85 season") +
  ylim(0, 60) +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = r_records[as.character(r_records$Season) < 
                                 "1984-85",]) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = r_records[as.character(r_records$Season) > 
                                 "1983-84",]) +
  annotate("rect", xmin = "1970-71", xmax = "1983-84",
    ymin = 0, ymax = 60, alpha = 0.1, fill = "orange") +
  annotate("rect", xmin = "1984-85", xmax = "1997-98",
    ymin = 0, ymax = 60, alpha = 0.1, fill = "green")
print(p4)

图 18.4 基于范围法的常规赛季胜利的年度分散情况

即使按照范围法，NBA 的赛季内“公平性”问题在薪酬上限之前的 14 个赛季中逐步改善（尽管在每个随后的赛季中从 1978-79 赛季到 1982-83 赛季都有所增加）。从这个衡量标准来看，薪酬上限对进一步促进赛季内公平性没有产生积极影响；事实上，从 1984-85 赛季到 1997-98 赛季的每个赛季，常规赛胜利的分散程度都超过了 1983-84 赛季，这是薪酬上限时代 NBA 的最后赛季。

18.4.4 均值绝对偏差法

如果范围法是这里要展示的最简单、最直接的分散统计方法，那么均值和中位数偏差法（参见第 18.4.5 节）无疑是最复杂的（但只是在相对意义上，而不是在绝对意义上）。这两种方法对异常值比其他方法更不敏感。

我们需要两个步骤来计算基于均值偏差法的年度常规赛胜利的年度分散情况。首先，我们将 records 数据集传递给dplyr group_by()和mutate()函数；从mutate()中，我们创建了一个名为mad_wins的新变量，它等于胜利与胜利均值的差的绝对值，从group_by()中，我们计算了 records 中每个赛季的mad_wins。结果被转换为一个名为 mad_records 的 tibble。head()和tail()函数返回了前三个和最后三个 mad_records 观测值：

records %>%
  group_by(Season) %>%
  mutate(mad_wins = abs(W - mean(W))) -> mad_records

head(mad_records, n = 3)
## # A tibble: 3 × 6
## # Groups:   Season [3]
##   Season  Lg    Team               W     L mad_wins
##   <chr>   <chr> <chr>          <int> <int>    <dbl>
## 1 1997-98 NBA   Boston Celtics    36    46        5
## 2 1996-97 NBA   Boston Celtics    15    67       26
## 3 1995-96 NBA   Boston Celtics    33    49        8

tail(mad_records, n = 3)
## # A tibble: 3 × 6
## # Groups:   Season [3]
##   Season  Lg    Team                    W     L mad_wins
##   <chr>   <chr> <chr>               <int> <int>    <dbl>
## 1 1997-98 NBA   Vancouver Grizzlies    19    63       22
## 2 1996-97 NBA   Vancouver Grizzlies    14    68       27
## 3 1995-96 NBA   Vancouver Grizzlies    15    67       26

然后，我们将 mad_records 而不是 records 传递给group_by()和summarize()函数。在这里，我们正在计算变量mad_wins的总和，并将其除以变量wins大于 0 的观测值的总和。当然，因为每个 NBA 球队都有超过 0 的常规赛胜利，所以除数因此等于总观测计数。这正是关键——条件是这样的，我们以与group_by()和summarize()一起工作的方式得到n。

通过连续调用 head() 和 tail() 函数，打印出名为 mad_records2 的新 tibble 的前三个和最后三个观测值：

mad_records %>%
  group_by(Season) %>%
  summarize(mad_wins2 = sum(mad_wins) / sum(W > 0)) -> mad_records2

head(mad_records2, n = 3)
## # A tibble: 3 × 2
##   Season  mad_wins2
##   <chr>       <dbl>
## 1 1970-71      8.71
## 2 1971-72     13.2 
## 3 1972-73     13.3

tail(mad_records2, n = 3)
## # A tibble: 3 × 2
##   Season  mad_wins2
##   <chr>       <dbl>
## 1 1995-96      11.1
## 2 1996-97      13.2
## 3 1997-98      12.6

我们随后使用另一个 ggplot2 线形图来展示我们的结果（见图 18.5）：

p5 <- ggplot(mad_records2, aes(x = Season, y = mad_wins2, group = 1)) + 
  geom_line(aes(y = mad_wins2), color = "black", size = .5) + 
  geom_point(size = 5, color = "dodgerblue") +
  labs(title = 
         "Year-over-Year Mean Absolute Deviation in Regular Season Wins",
       subtitle = "1970-98",
       x = "Season", 
       y = "Mean Absolute Deviation",
       caption = "salary cap was introduced prior to the 1984-85 season") +
  ylim(0, 14) +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = mad_records2[as.character(mad_records2$Season) < 
                                    "1984-85",]) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = mad_records2[as.character(mad_records2$Season) > "1983-
              ➥ 84",]) +
  annotate("rect", xmin = "1970-71", xmax = "1983-84",
           ymin = 0, ymax = 14, alpha = 0.1, fill = "orange") +
  annotate("rect", xmin = "1984-85", xmax = "1997-98",
           ymin = 0, ymax = 14, alpha = 0.1, fill = "green")
print(p5)

图 18.5 基于平均值绝对偏差方法的常规赛胜场年际分散

尽管我们使用了不同的衡量方法和手段，但我们得到了相同的结果。看起来 NBA 在引入薪资上限之前的年份并没有内部赛季平衡性问题，或者如果有，通过这种方法和其他方法，问题基本上是自行解决的。也许更重要的是，根据这种方法和其他方法，薪资上限对提高内部赛季平衡性没有任何作用，至少在薪资上限时代的最初 14 个赛季是这样的。

18.4.5 中值绝对偏差方法

结果表明，年度常规赛平均胜场和中值胜场的年际差异并不重要。换句话说，中值绝对偏差方法——用中值替换了平均值——产生的结果几乎与来自平均值绝对偏差方法的结果相同。考虑到我们处理的是正态分布的数据，这并不令人惊讶。

从以下代码块中，我们得到以下内容——（1）一个名为 mdad_records 的 tibble，它等于 records 加上一个名为 mdad_wins 的新变量，该变量等于年度胜场与中值胜场的绝对差值；（2）另一个名为 mdad_records2 的 tibble，它包含以 mdad_wins 变量的形式呈现的中值绝对偏差方法结果；（3）第五个 ggplot2 线形图，用于展示结果（见图 18.6）：

records %>%
  group_by(Season) %>%
  mutate(mdad_wins = abs(W - median(W))) -> mdad_records

head(mdad_records, n = 3)
## # A tibble: 3 × 6
## # Groups:   Season [3]
##   Season  Lg    Team               W     L mdad_wins
##   <chr>   <chr> <chr>          <int> <int>     <dbl>
## 1 1997-98 NBA   Boston Celtics    36    46         7
## 2 1996-97 NBA   Boston Celtics    15    67        25
## 3 1995-96 NBA   Boston Celtics    33    49         8

tail(mdad_records, n = 3)
## # A tibble: 3 × 6
## # Groups:   Season [3]
##   Season  Lg    Team                    W     L mdad_wins
##   <chr>   <chr> <chr>               <int> <int>     <dbl>
## 1 1997-98 NBA   Vancouver Grizzlies    19    63        24
## 2 1996-97 NBA   Vancouver Grizzlies    14    68        26
## 3 1995-96 NBA   Vancouver Grizzlies    15    67        26

mdad_records %>%
  group_by(Season) %>%
  summarize(mdad_wins2 = sum(mdad_wins) / sum(W > 0)) -> mdad_records2

head(mdad_records2, n = 3)
## # A tibble: 3 × 2
##   Season  mdad_wins2
##   <chr>        <dbl>
## 1 1970-71       8.65
## 2 1971-72      13   
## 3 1972-73      13.2

tail(mdad_records2, n = 3)
## # A tibble: 3 × 2
##   Season  mdad_wins2
##   <chr>        <dbl>
## 1 1995-96       11.1
## 2 1996-97       13.1
## 3 1997-98       12.4

p6 <- ggplot(mdad_records2, aes(x = Season, y = mdad_wins2, group = 1)) + 
  geom_line(aes(y = mdad_wins2), color = "black", size = .5) + 
  geom_point(size = 5, color = "dodgerblue") +
  labs(title = 
         "Year-over-Year Median Absolute Deviation in Regular Season Wins",
       subtitle = "1970-98",
       x = "Season", 
       y = "Median Absolute Deviation",
       caption = "salary cap was introduced prior to the 1984-85 season") +
  ylim(0, 14) +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = mdad_records2[as.character(mdad_records2$Season) < 
                                     "1984-85",]) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = mdad_records2[as.character(mdad_records2$Season) >
                                     "1983-84",]) +
  annotate("rect", xmin = "1970-71", xmax = "1983-84",
    ymin = 0, ymax = 14, alpha = 0.1, fill = "orange") +
  annotate("rect", xmin = "1984-85", xmax = "1997-98",
    ymin = 0, ymax = 14, alpha = 0.1, fill = "green")
print(p6)

图 18.6 基于中值绝对偏差方法的常规赛胜场年际分散

几乎 40 年后，我们无法知道 NBA 如何得出它存在内部赛季平衡性问题的结论。然而，我们知道的是——无论 NBA 在薪资上限引入之前的赛季中存在什么样的内部赛季平衡性问题，这个问题（如果可以称之为问题的话）正在自行消散，至少根据这里展示的统计分散性衡量标准。此外，基于这些相同的衡量标准，薪资上限对减少联赛常规赛胜场年际分散没有任何影响；相反，分散性在薪资上限时代的最初 14 个赛季实际上呈上升趋势。

在下一节中，我们将计算联赛前八名球队的年度流失率——即，在上一赛季结束时不在前八的球队数量——作为检验跨赛季平衡性的方法。

18.5 流失率和跨赛季平衡性

因此，在 1984-85 赛季开始前，NBA 对球员薪资实施上限时，并不一定存在赛季内的公平性问题，即使存在，薪资上限也远未解决任何问题。但关于跨赛季的公平性问题又如何呢？

我们的目的在于探索 NBA 顶级球队在薪资上限前后年度流失情况，以确定球员薪资上限是否可能触发了联赛顶级球队更高的年度流失率。我们将按赛季排名常规赛胜场，根据排名将 NBA 分为两组，计算年度流失率，并在最终的ggplot2折线图中绘制：

18.5.1 数据整理

在我们能够分析和可视化任何结果之前，我们还需要进行一些数据整理操作。我们的首要任务是创建一个记录数据集的精确副本，我们将称之为churn：

records -> churn

你可能还记得，如果Team变量中的记录符合季后赛资格，则记录中的单元格末尾会有一个星号。我们需要移除这些星号，因为从现在开始，我们不希望 R 认为波士顿凯尔特人*与波士顿凯尔特人不同。

因此，我们调用基本的 R gsub()函数，该函数将替换字符串中的所有匹配模式，并用我们想要的或需要的任何内容替换。gsub()函数接受以下三个参数：（1）要匹配的字符串，（2）替换字符串，（3）要更改的对象和字符串。

在以下代码中，第一个参数指示 R 移除任何特殊字符，包括星号；第二个参数为空白，因为我们不想要或需要替换字符串；第三个参数是我们想要更改的对象和字符串：

churn$Team <- gsub('[^[:alnum:] ]', '', churn$Team) 

我们然后将流失数据集传递给group_by()和mutate()函数，创建一个名为rank的新变量，该变量是从原始变量W派生出来的。在每个流失赛季中，常规赛胜场最多的球队应获得 1 级排名，下一个最佳球队应获得 2 级排名，依此类推。因此，最佳球队应获得较低数字的排名，而最差的球队应获得较高数字的排名——这就是我们代码中变量W前面减号的原因。此外，来自同一赛季常规赛胜场总数相同的球队应获得相同的排名，因此我们使用ties.method参数将并列元素分配给平均值和相同排名：

churn %>%
  group_by(Season) %>%
  mutate(rank = rank(-W, ties.method = "average")) -> churn

接下来，我们再次调用mutate()函数，这次与ifele()函数结合使用，创建另一个派生变量，称为topTeam。如果变量rank大于8，则topTeam应等于0；如果不等于，则topTeam应改为等于1。换句话说，我们正在将前八名球队与其他 NBA 球队分开：

churn %>%
  mutate(topTeam = ifelse(rank > 8, 0, 1)) -> churn

然后，我们将churn传递给arrange()函数，首先按Team变量排序数据，然后按降序排序Season变量。我们再次调用mutate()函数来创建另一个派生变量topTeam2，它等于下一记录中的topTeam。例如，如果topTeam对于 1996-97 亚特兰大鹰队等于1，那么topTeam2对于 1997-98 亚特兰大鹰队也应该等于1。dplyr lead()函数指示 R 通过复制下一记录中的topTeam值来填充topTeam2，这就是为什么n等于1的原因；如果我们想用前一个topTeam值来填充topTeam2，我们就会调用dplyr lag()函数而不是lead()。这个操作是按Team变量分组的，因为例如，我们不希望亚特兰大鹰队从巴尔的摩子弹队提取结果：

churn %>%
  arrange(Team, desc(Season)) %>%
  group_by(Team) %>%
  mutate(topTeam2 = lead(topTeam, n = 1)) -> churn

head(churn, n = 30)
## # A tibble: 30 × 8
## # Groups:   Team [2]
##    Season  Lg    Team              W     L  rank topTeam topTeam2
##    <chr>   <chr> <chr>         <int> <int> <dbl>   <dbl>    <dbl>
##  1 1997-98 NBA   Atlanta Hawks    50    32  10         0        1
##  2 1996-97 NBA   Atlanta Hawks    56    26   7.5       1        0
##  3 1995-96 NBA   Atlanta Hawks    46    36  11.5       0        0
##  4 1994-95 NBA   Atlanta Hawks    42    40  14         0        1
##  5 1993-94 NBA   Atlanta Hawks    57    25   3.5       1        0
##  6 1992-93 NBA   Atlanta Hawks    43    39  12.5       0        0
##  7 1991-92 NBA   Atlanta Hawks    38    44  17.5       0        0
##  8 1990-91 NBA   Atlanta Hawks    43    39  13         0        0
##  9 1989-90 NBA   Atlanta Hawks    41    41  17         0        1
## 10 1988-89 NBA   Atlanta Hawks    52    30   5.5       1        1

因此，在Season变量等于 1970-71 的情况下，topTeam2变量包含不可用（NA）。我们不希望数据中存在 NA，所以接下来我们调用基础 R 中的na.omit()函数来删除包含 NA 的churn中的每一个观测值：

na.omit(churn) -> churn

现在我们已经准备好计算churn并可视化年度结果。

18.5.2 计算 和 可视化 churn

对于提供基于订阅服务的公司（例如，移动运营商、有线电视提供商、软件即服务供应商）来说，churn是一个特别关键的指标，因为客户可以无惩罚地选择退出。因此，公司开发churn模型——通常是决策树（见第五章）或逻辑回归（见第十四章）——以识别高风险客户，确定使他们成为高风险的因素（例如，年龄、性别、使用情况、合同长度），并制定细致的保留策略。其他公司开发类似模型以减少员工流失。

所以首先，churn几乎总是件坏事，无论是从财务上还是其他方面。其次，它通常是通过将失去的客户数量（但这也可能是失去的员工）除以某个先前定义的时间段（通常是月度、季度或年度）开始时的客户数量，然后将商乘以 100 来计算的。当情况相对流动时，这完全合理。

让我们现在考虑 NBA 以及所谓的薪资上限背后的动机。NBA 顶端的churn——即通过衡量联赛最佳八支球队的一年周转率来衡量的跨赛季churn——不仅是一件好事，而且可能是确保联赛长期可行性的必要事情。此外，由于我们的情况是固定的，而不是通过将数字插入正常公式来衡量churn，我们将通过仅仅计算上一赛季结束时不在前八的球队数量来计算churn。

我们首先将流动数据集传递给group_by()和count()函数，以统计我们数据中每个赛季topTeam中的值超过topTeam2中的值的记录数。换句话说，我们正在计算topTeam等于1且topTeam2等于0的记录数。我们的结果被转换为一个名为churn_tbl的 tibble。然后，我们调用head()函数来返回前六个churn_tbl记录：

churn %>%
  group_by(Season) %>%
  count(topTeam > topTeam2) -> churn_tbl

head(churn_tbl)
## # A tibble: 6 × 3
## # Groups:   Season [3]
##   Season  `topTeam > topTeam2`     n
##   <chr>   <lgl>                <int>
## 1 1971-72 FALSE                   14
## 2 1971-72 TRUE                     1
## 3 1972-73 FALSE                   14
## 4 1972-73 TRUE                     2
## 5 1973-74 FALSE                   15
## 6 1973-74 TRUE                     1

由于我们指示 R 执行逻辑运算，我们得到了条件等于TRUE和FALSE的年度计数。我们不需要也不需要任何逻辑条件等于FALSE的记录；下一块代码中的前两行提取了churn_tbl中的偶数行。

第一行代码创建了一个虚拟指示器，将每一行分解为偶数或奇数。seq_len()函数是一个基础 R 函数，它从 1 开始创建一个序列，在这个例子中，结束于 54，这等于churn_tbl行的数量；%%运算符是取模运算符，当churn_tbl行数除以 2 时，返回 1 或 0。第二行代码随后提取偶数行，或者row_odd等于 0 的行。

然后，我们调用select()函数来对Season和n变量进行子集化churn_tbl；print()函数打印出每个churn_tbl记录：

row_odd <- seq_len(nrow(churn_tbl)) %% 2 
churn_tbl[row_odd == 0, ] -> churn_tbl
churn_tbl %>%
  select(Season, n) -> churn_tbl
print(churn_tbl)
## # A tibble: 27 × 2
## # Groups:   Season [27]
##    Season      n
##    <chr>   <int>
##  1 1971-72     1
##  2 1972-73     2
##  3 1973-74     1
##  4 1974-75     4
##  5 1975-76     3
##  6 1976-77     3
##  7 1977-78     3
##  8 1978-79     3
##  9 1979-80     3
## 10 1980-81     2
## # ... with 17 more rows

接下来，我们使用另一个ggplot2折线图可视化结果，该图显示了薪资上限前后年度流动率的变化（见图 18.7）：

p7 <- ggplot(churn_tbl, aes(x = Season, y = n, group = 1)) + 
  geom_line(aes(y = n), color = "black", size = .5) + 
  geom_point(size = 5, color = "orange") +
  labs(title = "Year-over-Year Churn in the NBA's Top 8",
       subtitle = "1971-98",
       x = "Season", 
       y = "Number of New Top 8 Teams from Prior Season",
       caption = "salary cap was introduced prior to the 1984-85 season") +
  ylim(0, 6) +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = churn_tbl[as.character(churn_tbl$Season) <
                                 "1984-85",]) +
  geom_smooth(method = lm, color = "red", se = FALSE, 
              data = churn_tbl[as.character(churn_tbl$Season) > 
                                 "1983-84",]) +
  annotate("rect", xmin = "1971-72", xmax = "1983-84",
    ymin = 0, ymax = 6, alpha = 0.1, fill = "blue") +
  annotate("rect", xmin = "1984-85", xmax = "1997-98",
    ymin = 0, ymax = 6, alpha = 0.1, fill = "green") 
print(p7)

图 18.7 在常规赛中获胜的 NBA 前八名球队中，那些在上个赛季不是前八名的球队。再次强调，我们的图表通过彩色块分割，以表示薪资上限前后的情况。

显然，薪资上限对赛季间的公平性也没有影响，至少基于我们选择的方法来衡量它。我们的目的是测试 NBA 的薪资上限是否实现了其声明的目标，即通过多种分散度的衡量来引入赛季内的公平性，并通过衡量流动率来引入赛季间的公平性。虽然薪资上限确实带来了其他好处（毫无疑问，它有助于控制整体支出，从而提高利润），但实现公平性并不是其中之一。

在下一章中，我们将介绍数据标准化技术，并将其应用于获取对 NBA 得分王的不同历史视角。

摘要

• 统计分散度有许多衡量标准；我们只是展示了可能最流行或最常见的五种。

• 有内置函数可以计算这些衡量标准中的一些，例如方差和标准差；当 R 没有函数时，编写算术代码几乎不成问题。

• 在所展示的五个统计离散度度量方法——方差、标准差、极差、平均绝对偏差和中位数绝对偏差中，标准差方法可能在全面性、易用性和识别度之间取得了最佳平衡。

• 然而，正如之前所述，通常应用多种方法来更好地理解你的数据是有益的。

• 根据我们的分析，薪资上限对赛季内或赛季间的公平性几乎没有影响。

19 数据标准化

本章涵盖

• 数据标准化方法

• Z 分数法

• 标准差法

• 中心化方法

• 范围法

• 为数据框着色并突出观察结果

• 比较数据集

在一场 NBA 比赛中，球员得到 50 分或以上的情况并不常见。实际上，在 2021-22 赛季的常规赛（1,230 场比赛）中，这种情况只发生了 12 次。NBA 历史上得分最高的五位球员——仍在比赛的勒布朗·詹姆斯、卡里姆·阿卜杜尔-贾巴尔、卡尔·马龙、科比·布莱恩特和迈克尔·乔丹——在他们总共 93 个赛季中，至少在常规赛比赛中得到 50 分的有 73 次。

但在 1961-62 赛季，当时为费城勇士队效力的威尔特·张伯伦平均每场比赛得到 50 分；然后他在下一年平均每场比赛得到近 45 分。自那以后，没有球员接近这些数据。六十年后，我们仍然对张伯伦的得分能力感到惊讶。然而，许多人忽略了规则变化和比赛风格转变经常改变比赛节奏的事实。在 1961-62 赛季，球队每场比赛尝试大约 110 次投篮，即投篮，以及每场比赛大约 25 次罚球；当尼尔·约翰斯顿在 1952-53 赛季带领 NBA 得分时，平均“只有”每场比赛 22.3 分，当时球队每场比赛只尝试 70 次投篮和 20 次罚球。如今，球队每场比赛尝试大约 85 次投篮，并尝试大约 20 次罚球。更多的投篮尝试意味着更多的得分；更少的投篮尝试意味着更少的得分。

你可能已经意识到，那么，查默林 1961-62 赛季的得分平均数与约翰斯顿 1952-53 赛季的得分平均数之间的差异实际上可能比原始数据所暗示的要小。我们有时会标准化数据——也就是说，我们将一个变量从其原始格式转换为简单和统一的尺度——以控制时代变化、季节性影响和其他外部因素。以汽油价格为例；如果不考虑通货膨胀，直接比较今天一加仑汽油的成本与 1980 年相同汽油的成本，既不公平也不准确。作为另一个例子，考虑一个收款代理；在许多客户不愿意或无法偿还债务的 11 月或 12 月评估代理的表现，与许多拖欠客户收到退税并因此有可支配收入的 3 月或 4 月相比，这显然是不公平的。

我们在这里的目的在于演示在包含年度得分王的 NBA 数据集上使用不同的标准化技术，并针对原始数据可视化结果。通过将每场比赛得分从其原始格式转换为标准等价物，我们消除了规则变化、比赛风格转变和其他外部因素的影响，这些因素在许多代人的过程中影响了基本统计数据。根据方法的不同，我们假设我们可能会看到与过去几十年报道的非常不同的结果。

让我们回到我们的收集代理，简要讨论为什么标准化如此重要，需要理解和欣赏。与同年 3 月和 4 月相比，节假日期间的原始业绩数字可能会让代理采取纠正措施。但标准化的业绩数字可能否则会显示代理的收集效率完全符合季节性的起伏。标准化数据不仅可能提供新的视角，还可能使最佳行动成为可能。

我们将首先加载我们需要的唯一包。

19.1 加载一个包

我们将使用readr来加载数据，使用dplyr函数来整理和获取数据，并仅使用ggplot2函数来可视化；因此，tidyverse包的宇宙将足够使用：

library(tidyverse)

否则，我们剩余的繁重工作将通过一系列简单的算术运算来标准化我们的数据。接下来，我们将导入我们的数据集并简要探索其内容。

19.2 导入和查看数据

我们的数据集是一个从 Kaggle 下载的.csv 文件，其中包含从www.basketball-reference.com抓取的数据；它具体包含了球员统计数据，包括比赛场次和总得分，涵盖了 1949-50 赛季至 2016-17 赛季的每一届 NBA 赛季。不久之后，我们将对数据进行裁剪，使得 1998-99 赛季成为最大赛季——因此我们留下了 50 个赛季的数据，对于我们的目的来说仍然相当充足。它已经被保存在我们的默认工作目录中，文件名为 season_stats.csv。

我们调用readr read_csv()函数来导入 season_stats.csv 文件，并在过程中创建一个名为 dat1 的数据集：

dat1 <- read_csv("seasons_stats.csv")

然后，我们调用基础 R 的dim()函数来返回 dat1 的维度：

dim(dat1)
## [1] 24624    53

我们的数据集包含 24,624 行和 53 列。

从现在开始，我们只需要 dat1 中的 53 个变量中的 6 个；因此，我们接下来调用dplyr包中的select()函数来对 dat1 进行子集化，基于这六个变量。此外，由于空间考虑多于其他任何原因，我们将分析限制在拥有数据的头 50 个赛季。然后，我们调用dplyr filter()函数来对 dat1 进行子集化，其中变量Year（现在是数值型）小于或等于1999：

dat1 %>%
  select(Year, Player, Pos, Tm, G, PTS) -> dat1

dat1 %>%
  filter(Year <= 1999) -> dat1

glimpse() 函数，同样来自 dplyr，打印出 dat1 的转置和截断快照。我们在之前调用 select() 和 filter() 之后，也得到了新的行数和列数：

glimpse(dat1)
## Rows: 14,420
## Columns: 6
## $ Year   <dbl> 1950, 1950, 1950, 1950, 1950, 1950, 1950, 1950, 195...
## $ Player <chr> "Curly Armstrong", "Cliff Barker", "Leo Barnhorst",...
## $ Pos    <chr> "G-F", "SG", "SF", "F", "F", "F", "G", "G-F", "F-C"...
## $ Tm     <chr> "FTW", "INO", "CHS", "TOT", "DNN", "NYK", "INO", "T...
## $ G      <dbl> 63, 49, 67, 15, 13, 2, 60, 3, 65, 36, 29, 57, 60, 5...
## $ PTS    <dbl> 458, 279, 438, 63, 59, 4, 895, 10, 661, 382, 279, 2...

以下是我们的六个存活变量的分解：

• Year—相当于赛季，例如，1975 年相当于 1974-75 赛季；最小值为 1950 年（1950-51 赛季），最大值为 1999 年（1998-99 赛季）。现在这是一个整数，但它将被转换为因子变量。

• Player—球员的全名，以名-姓格式。球员名字旁边的星号表示他是名人堂成员。现在和将来都将是一个字符字符串。

• Pos—球员的位置或位置，例如，G 等于后卫，F 等于前锋，G-F 等于后卫-前锋。现在这是一个整数，但它将被转换为因子。

• Tm—球员的队伍，以缩写格式表示，例如，BOS 等于波士顿凯尔特人队。这是一个字符字符串，但它将被转换为因子。

• G—任何球员在任何一年常规赛中所打的比赛数。现在这是一个整数，并将保持为整数。

• PTS—任何球员在任何一年常规赛中所得的总分。这是一个将保持为整数的另一个整数。

在我们创建标准化变量和分析结果之前，我们的数据需要进一步整理。

19.3 数据整理

我们的第一项任务现在相当平凡——通过三次调用基础 R 的 as.factor() 函数，将 Year、Pos 和 Tm 变量从字符字符串转换为因子：

dat1$Year <- as.factor(dat1$Year)
dat1$Pos <- as.factor(dat1$Pos)
dat1$Tm <- as.factor(dat1$Tm)

然而，我们的第二项任务并不那么简单。我们的数据集包含由于赛季中期的交易和其他交易导致的重复记录，这些交易使得一些球员在同一个 NBA 赛季为两支或更多球队效力。这些记录必须以某种方式处理，以不损害我们标准化方程的完整性。

19.3.1 处理重复记录

我们数据集最显著的挑战是它包含每个独特的年份、球员和队伍组合的一个记录。所以，比如说，在 1949-50 赛季为两支球队效力的球员实际上在 dat1 中占据了三个记录——他效力的两支球队各一个记录，以及一个额外的记录，该记录汇总了他的统计数据，其中变量 Tm 等于 TOT（可能是 TOTAL 的缩写）。

话虽如此，我们接下来调用 dplyr 包中的 distinct() 函数，对 dat1 中的每个独特的或不同的 Year/Player/Pos 组合进行子集化；然后，结果被转换成一个新的数据集，称为 test1。然后，我们调用 dim() 函数来返回记录数；test1 包含 12,239 条记录，比 dat1 少 2,181 个观测值：

dat1 %>%
  distinct(Year, Player, Pos) -> test1
dim(test1)
## [1] 12239     3

换个说法，这意味着 dat1 包含 2,181 条记录（不是唯一的球员）其中变量 Tm 等于 TOT 或重复的 Year/Player/Pos 组合，否则会汇总到变量 Tm 等于 TOT 的记录中。

我们随后编写一小段 dplyr 代码来从 dat1 中提取变量 Tm 等于 TOT 的记录计数。我们通过管道操作符将 dat1 传递给 filter() 函数，然后将结果传递给 tally() 函数，该函数返回 Tm 等于 TOT 的 dat1 观察值的数量：

dat1 %>%
  filter(Tm == "TOT") %>%
  tally()
##      n
## 1 1172

因此，dat1 中有 1,172 名球员在至少一个 NBA 赛季中更换过球队 期间。

让我们看看一个例子。Ed Bartels 是一名 6-5 的前锋，他在北卡罗来纳州立大学接受过大学篮球训练。在 1950 年，他为丹佛掘金队出场 13 场，得到 59 分，以及为纽约尼克斯队出场 2 场，得到 4 分。因此，他 1950 年的总生产力是 15 场比赛和 63 分。

我们再次调用 filter() 函数来对 dat1 进行子集化，其中变量 Year 等于 1950 且变量 Player 等于 Ed Bartels；我们的结果被转换成一个新的数据集，称为 test2。基本的 R print() 函数返回结果：

dat1 %>%
  filter(Year == 1950, Player == "Ed Bartels") -> test2
print(test2)
##   Year     Player Pos  Tm  G PTS
## 1 1950 Ed Bartels   F TOT 15  63
## 2 1950 Ed Bartels   F DNN 13  59
## 3 1950 Ed Bartels   F NYK  2   4

我们不希望我们的数据中包含超过一个记录，每个唯一的 Year/Player/Pos 组合。因此，我们将删除所有 Tm 等于 TOT 的 dat1 观察值，然后对每个幸存记录的变量游戏 (G) 和得分 (PTS) 进行汇总。这看起来可能有些反直觉；然而，这个步骤序列从执行角度来看比保留 Tm 等于 TOT 的观察值然后删除其下两个或更多观察值的替代方案更容易。

因此，我们再次调用 filter() 函数来对 dat1 进行子集化，其中 Tm 不等于 TOT（注意使用 != 操作符）。dim() 函数返回行和列计数：

dat1 %>%
  filter(Tm != "TOT") -> dat1
dim(dat1)
## [1] 13248     6

我们的数据集现在包含 13,248 条记录，这等于原始记录数 14,420 减去在中途更换球队的 1,172 名球员。

然后，我们将 dat1 传递给 dplyr group_by() 和 summarize() 函数，以对每个 Year/Player/Pos 组合汇总游戏和得分。对于大多数 dat1 记录，此操作将没有影响；然而，当我们有重复的 Year/Player/Pos 组合时，group_by() 和 summarize() 函数实际上将两个或更多记录的统计数据合并为一条记录。这些结果被转换成一个名为 dat2 的 tibble。之后，我们调用 dim() 函数来获取 dat2 的维度：

dat1 %>%
  group_by(Year, Player, Pos) %>%
  summarize(G = sum(G), PTS = sum(PTS)) -> dat2
dim(dat2)
## [1] 12136     5

注意，我们已经丢失了变量 Tm；dat1 包含六个列，而 dat2 只有五个列。我们指示 R 对 dat1 的六个变量中的两个进行分组，并按剩余四个变量中的三个进行分组；因此，我们没有向 R 提供关于 Tm 的任何指令。这是可以的，因为从现在开始，我们不需要 Tm 来驱动任何进一步的数据整理操作或支持我们的分析。

现在，让我们再进行几项测试。首先，我们再次调用 filter() 函数，对 dat2 进行子集化，变量 Year 等于 1950，变量 Player 等于 Ed Bartels。我们的结果被转换成一个新的数据集，称为 test3，然后打印出来：

dat2 %>%
  filter(Year == 1950, Player == "Ed Bartels") -> test3
print(test3)
## # A tibble: 1 × 5
## # Groups:   Year, Player [1]
##   Year  Player     Pos       G   PTS
##   <fct> <chr>      <fct> <int> <int>
## 1 1950  Ed Bartels F        15    63

这个 dat2 记录类似于 dat1 的等效记录，其中 dat1 中的变量 Tm 等于 TOT；当然，dat2 中不包含名为 Tm 的变量，但更重要的是，变量 G 和 PTS 完美匹配。

其次，让我们确认那些在整个赛季中从未更换球队的球员的记录，例如乔治·米坎，他在球队位于明尼阿波利斯时为湖人队打中锋，没有受到影响（稍后会有更多关于米坎的介绍）。在这个过程中，我们将展示我们尚未介绍的两个操作。

看看下面代码块中的最后一行——colorDF 是一个包，可以为返回的数据框或 tibble 添加颜色，而 highlight() 函数在在线查看时将注意力吸引到满足给定条件的一个或多个记录上。我们之前没有通过调用 library() 函数来加载 colorDF 包；相反，我们通过在两个名称之间用一对冒号分隔来同时加载 colorDF 包并调用 highlight() 函数。highlight() 函数接受一个类似于数据框的对象作为第一个参数（test4，由前面的 dplyr 代码创建）和一个条件作为第二个参数（test4 中的变量 Year 等于 1962）。

注意，在执行此操作之前必须首先安装 colorDF。尽管在前面加载你的包仍然是一个好习惯，但当你调用跨包的函数时（highlight() 不是其中之一），这是一个非常有价值的技巧。如果你没有在同一行代码中将包和函数名称组合起来，R 会感到困惑。

dat2 %>%
  group_by(Year) %>%
  filter(Player == 'George Mikan*') -> test4
colorDF::highlight(test4, test4$Year == 1950)
## # Tibble (class tbl_df) 6 x 6:
## # Groups: Year [6]
##  │Year │Player       │Pos  │Tm   │G    │PTS  
## 1│1950 │George Mikan*│C    │MNL  │   68│ 1865
## 2│1951 │George Mikan*│C    │MNL  │   68│ 1932
## 3│1952 │George Mikan*│C    │MNL  │   64│ 1523
## 4│1953 │George Mikan*│C    │MNL  │   70│ 1442
## 5│1954 │George Mikan*│C    │MNL  │   72│ 1306
## 6│1956 │George Mikan*│C    │MNL  │   37│  390

然后，我们将 dat2 而不是 dat1 传递给一个类似的代码块，从而允许我们比较输出结果：

dat2 %>%
  group_by(Year) %>%
  filter(Player == 'George Mikan*') -> test5
colorDF::highlight(test5, test5$Year == 1950)
## # Tibble (class tbl_df) 5 x 6:
## # Groups: Year [6]
##  │Year │Player       │Pos  │G    │PTS  
## 1│1950 │George Mikan*│C    │   68│ 1865
## 2│1951 │George Mikan*│C    │   68│ 1932
## 3│1952 │George Mikan*│C    │   64│ 1523
## 4│1953 │George Mikan*│C    │   70│ 1442
## 5│1954 │George Mikan*│C    │   72│ 1306
## 6│1956 │George Mikan*│C    │   37│  390

除了 test4 包含名为 Tm 的变量而 test5 不包含之外——毕竟，test4 是从 dat1 衍生的，而 test5 是从 dat2 衍生的——输出结果相似。arsenal 包中的 comparedf() 函数接受两个数据集作为参数，比较这两个数据集，并返回发现摘要。当你需要比较两个维度远大于 test4 或 test5 的对象时，这特别有用：

arsenal::comparedf(test4, test5)
## Compare Object
## 
## Function Call: 
## arsenal::comparedf(x = test4, y = test5)
## 
## Shared: 5 non-by variables and 6 observations.
## Not shared: 1 variables and 0 observations.
## 
## Differences found in 0/5 variables compared.
## 0 variables compared have non-identical attributes.

我们数据整理的第三和最后一项任务——至少目前是这样——是创建一个新变量，然后从我们的工作数据集中删除多余的数据（行和列）。我们将在下一部分这样做。

19.3.2 最终修剪

在继续前进之前，由于我们的分析将针对每场比赛的得分点数，而不是总得分点数，我们调用dplyr mutate()函数创建一个名为PPG的新变量，该变量等于被除数PTS与除数G的商。来自基础 R 的format()函数将PPG限制为只包含小数点后一位数字。虽然我们通常将结果四舍五入或格式化为包含小数点后两位数字，但 NBA 历史上记录每场比赛的得分和其他指标时，只包含小数点后一位数字。head()函数返回前六条记录：

dat2 %>%
  mutate(PPG = format(PTS/G, digits = 1, nsmall = 1)) -> dat2
head(dat2)
## # A tibble: 6 × 6
## # Groups:   Year, Player [6]
##   Year  Player        Pos       G   PTS PPG  
##   <fct> <chr>         <fct> <int> <int> <chr>
## 1 1950  Al Cervi*     PG       56   573 10.2 
## 2 1950  Al Guokas     F-G      57   214 3.8  
## 3 1950  Al Miksis     C         8    27 3.4  
## 4 1950  Alex Groza    C        64  1496 23.4 
## 5 1950  Alex Hannum*  PF       64   482 7.5  
## 6 1950  Andrew Levane F-G      60   332 5.5

我们的数据集包含许多边缘球员的记录；如前所述，这些球员是板凳末端的球员，很可能在 NBA 担任兼职合同球员。总的来说，因此应该从我们的数据集中删除他们，以排除他们从我们的分析中。一个快速简单的方法是再次调用filter()函数，将 dat2 缩减为只包含每场比赛平均至少得两分的球员或至少参加了四分之一比赛的球员。如果一个球员未能每场比赛平均至少投中一个篮筐（篮筐相当于一次有效投篮，至少值两分）或在 80 场或 82 场常规赛安排中参加了超过 20 场比赛，那么很难将他标记为边缘球员：

dat2 %>%
  filter(PPG >= 2 & G >= 20) -> dat2
dim(dat2)
## [1] 6390    6

这些标准显著缩短了我们的数据长度——dat2 之前包含 12,136 条记录，现在只包含 6,390 个观测值。

到目前为止，我们不再需要变量Pos、G和PTS；因此，我们接下来调用dplyr包中的select()函数，对 dat2 进行子集化，选择变量Year、Player和PPG：

dat2 %>%
  select(Year, Player, PPG) -> dat2

最后，我们通过调用基础 R 的as.numeric()函数将派生变量PPG从字符字符串转换为数值：

dat2$PPG <- as.numeric(dat2$PPG)

在下一节中，我们将创建一个ggplot2条形图，可视化 NBA 主要得分手每年每场比赛的平均得分，展示不同的标准化数值向量的方法，并在标准化数据上创建类似条形图，以便我们可以比较和对比不同方法的结果以及与原始数据。

19.4 标准化数据

毫无疑问，我们中的大多数人已经使用数据来挑战那些在数据不可用或分析师无法挖掘时持续多年的先前的假设。标准化数据让我们在数据实际上已经存储、挖掘和包装供公众消费了很长时间后，敢于采取不同的视角。

我们首先通过创建一个名为 Year_Player 的新变量来对 dat2 数据集进行一次改进，这个变量简单地是现有变量 Year 和 Player 的拼接，这是通过内置的 paste0() 函数实现的。paste0() 函数将 Year 作为第一个参数，插入一个空格，然后将 Player 作为第二个参数。因此，当 Year 等于 1999 而 Player 等于 Will Perdue 时，我们新的变量 Year_Player 等于 1999 Will Perdue。基础 R 的 head() 和 tail() 函数返回前三个和最后三个观测值：

dat2$Year_Player <- paste0(as.character(dat2$Year)," ", 
                           as.character(dat2$Player))

head(dat2, n = 3)
## # A tibble: 3 × 4
## # Groups:   Year, Player [3]
##   Year  Player         PPG Year_Player      
##   <fct> <chr>        <dbl> <chr>            
## 1 1950  Al Guokas      3.8 1950 Al Guokas   
## 2 1950  Alex Groza    23.4 1950 Alex Groza  
## 3 1950  Alex Hannum*   7.5 1950 Alex Hannum*

tail(dat2, n = 3)
## # A tibble: 3 × 4
## # Groups:   Year, Player [3]
##   Year  Player           PPG Year_Player        
##   <fct> <chr>          <dbl> <chr>              
## 1 1999  Walt Williams    9.3 1999 Walt Williams 
## 2 1999  Walter McCarty   5.7 1999 Walter McCarty
## 3 1999  Will Perdue      2.4 1999 Will Perdue

我们的意图是使用 Year_Player 而不是 Year 或 Player 作为我们即将到来的 ggplot2 条形图的 x 轴变量——这样我们就可以显示和拟合这两个变量，而无需在两者之间做出选择。这将提高我们视觉内容的可读性和美观性。

然后，我们将 dat2 传递给 dplyr group_by() 和 slice() 函数——slice() 函数从 dat2 中提取每一年变量 PPG（每场比赛得分）为最大值的观测值。毕竟，我们的意图是仅显示每年的每场比赛得分领先者；因此，我们需要一个恰好满足这一要求的数据源。结果随后被转换为一个名为 dat3 的 tibble：

dat2 %>%
  group_by(Year) %>%
  slice(which.max(PPG)) -> dat3

接下来，我们创建我们的第一个 ggplot2 条形图，其中 dat3 是数据源，Year_Player 是我们的 x 轴变量，而 PPG 是我们的 y 轴变量（见图 19.1）。因此，我们正在可视化 1949-50 赛季至 1998-99 赛季之间每年 NBA 得分领先者及其每场比赛平均得分；这是我们后续结果将进行比较和对比的原始数据基线：

p1 <- ggplot(dat3, aes(x = Year_Player, y = PPG)) + 
  geom_bar(stat = "identity", color = "dodgerblue", fill = "dodgerblue") +
  geom_text(aes(label = PPG), 
            position = position_dodge(width = 0.8), vjust = -0.3,
            fontface = "bold", size = 2) +
  labs(title = "Leading Scorer (PPG) by Year", 
       subtitle = "1950 to 1999", 
       caption = "* Hall of Fame member",
       x = "Year and Leading Scorer",
       y = "Points per Game") +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 90)) 
print(p1)

图 19.1 1949-50 赛季至 1998-99 赛季每年 NBA 得分领先者及其每场比赛平均得分

威尔特·张伯伦在 1961-62 赛季每场比赛 50.4 分和在 1962-63 赛季的平均 44.8 分显然非常突出。接下来，我们将演示各种标准化技术，并将结果与我们刚刚显示的年度原始数值进行比较。如果我们的原始假设是正确的，那么以下方法之一应该会返回非常不同的结果。

19.4.1 z 分数法

z 分数法可能是最常见或最受欢迎的数据标准化方法。它表示原始数值高于或低于总体平均值的多少个标准差。z 分数是通过从原始数值中减去总体平均值，然后将差值除以标准差来计算的。

在下一块代码中，我们将 dat2 传递给 group_by() 和 mutate() 函数，以计算每个 dat2 记录的 z 分数，其中人口按变量 Year 分段。例如，乔治·米坎 1950 年的 PPG z 分数是从与威尔特·张伯伦 1962 年 z 分数不同的均值和标准差计算得出的。结果被放入一个名为 dat4a 的 tibble 中。head() 和 tail() 函数分别返回前三条和最后三条记录：

dat2 %>%
  group_by(Year) %>%
  mutate(z_ppg = round((PPG - mean(PPG)) / sd(PPG), digits = 1)) -> dat4a

head(dat4a, n = 3)
## # A tibble: 3 × 5
## # Groups:   Year [1]
##   Year  Player         PPG Year_Player       z_ppg
##   <fct> <chr>        <dbl> <chr>             <dbl>
## 1 1950  Al Guokas      3.8 1950 Al Guokas     -0.8
## 2 1950  Alex Groza    23.4 1950 Alex Groza     5.6
## 3 1950  Alex Hannum*   7.5 1950 Alex Hannum*   0.4

tail(dat4a, n = 3)
## # A tibble: 3 × 5
## # Groups:   Year [1]
##   Year  Player           PPG Year_Player         z_ppg
##   <fct> <chr>          <dbl> <chr>               <dbl>
## 1 1999  Walt Williams    9.3 1999 Walt Williams    0.5
## 2 1999  Walter McCarty   5.7 1999 Walter McCarty  -0.2
## 3 1999  Will Perdue      2.4 1999 Will Perdue     -0.9

在 1950 年，每场比赛平均得 3.8 分低于 1950 年均值的 0.8 个标准差，而每场比赛 23.4 分高于 1950 年均值的 5.6 个标准差。

验证我们刚刚创建的变量 z_ppg 的完整性的方法既快又简单——实际上，有两种既快又简单的方法。z 分数的向量应该具有均值为 0 和方差为 1；然后我们调用基础 R 的 mean() 和 var() 函数来检查这些：

mean(dat4a$z_ppg)
## [1] 0.0002503912

var(dat4a$z_ppg)
## [1] 0.9933541

当进行四舍五入时，z_ppg 的均值实际上等于 0，而 z_ppg 的方差，作为离散度的度量，等于标准差的平方，等于 1。我们不应该期望均值恰好等于 0 或方差恰好等于 1，简单的理由是我们通过变量 Year 中的每个因子创建了 z_ppg，而不是整体创建。

然后，我们将 dat4a 传递给 group_by() 和 slice() 函数，将变量 Year 中每个因子的最大 z_ppg 转换为名为 dat4b 的 tibble：

dat4a %>%
  group_by(Year) %>%
  slice(which.max(z_ppg)) -> dat4b

与 summarize() 函数相比，slice() 函数的优点在于 slice() 会提取每个适用记录的每个变量；如果我们调用 summarize() 函数，dat4b 将只包含变量 z_ppg 和 Year。然后我们将 dat4b 投入第二个 ggplot2 条形图，其中 Year_Player 再次是我们的 x 轴变量，而 z_ppg（而不是 PPG）是我们的 y 轴变量（见图 19.2）：

p2 <- ggplot(dat4b, aes(x = Year_Player, y = z_ppg)) + 
  geom_bar(stat = "identity", color = "darkorange", fill = "darkorange") +
  geom_text(aes(label = z_ppg), 
            position = position_dodge(width = 0.8), vjust = -0.3,
            fontface = "bold", size = 2) +
  labs(title = "Leading Scorer (Z-Score) by Year", 
       subtitle = "1950 to 1999", 
       caption = "* Hall of Fame member",
       x = "Year and Leading Scorer",
       y = "Z-Score (standard deviations from mean)") +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 90)) 
print(p2)

图 19.2 1949-50 赛季至 1998-99 赛季 NBA 年度得分领先者和他们每场比赛平均得分的 z 分数

这些结果对历史每场比赛平均分提供了全新的视角。威尔特·张伯伦在 1961-62 赛季每场比赛平均 50.4 分，相对于该年的均值“仅”高出 4.1 个标准差。同时，乔治·米坎 1950 年每场比赛平均 27.4 分，几乎比均值高出 7 个标准差。

19.4.2 标准差方法

标准化数据的另一种方法是标准差方法。与 z 分数方法从原始数据中减去总体均值然后除以标准差不同，标准差方法排除了均值，只是将原始数据除以标准差。

我们将 dat2 传递给dplyr group_by()和mutate()函数，通过变量Year中的每个因素来计算标准差方法，并将结果保存在一个名为sd_ppg的新变量中。我们得到一个新的 tibble，名为 dat5a，当然，它等于 dat2 加上变量sd_ppg。通过调用head()和tail()函数，我们可以查看 dat5a 中的前三条和最后三条记录：

dat2 %>%
  group_by(Year) %>%
  mutate(sd_ppg = round((PPG / sd(PPG)), digits = 1)) -> dat5a

head(dat5a, n = 3)
## # A tibble: 3 × 5
## # Groups:   Year [1]
##   Year  Player         PPG Year_Player       sd_ppg
##   <fct> <chr>        <dbl> <chr>              <dbl>
## 1 1950  Al Guokas      3.8 1950 Al Guokas       1.2
## 2 1950  Alex Groza    23.4 1950 Alex Groza      7.5
## 3 1950  Alex Hannum*   7.5 1950 Alex Hannum*    2.4

tail(dat5a, n = 3)
## # A tibble: 3 × 5
## # Groups:   Year [1]
##   Year  Player           PPG Year_Player         sd_ppg
##   <fct> <chr>          <dbl> <chr>                <dbl>
## 1 1999  Walt Williams    9.3 1999 Walt Williams     2  
## 2 1999  Walter McCarty   5.7 1999 Walter McCarty    1.2
## 3 1999  Will Perdue      2.4 1999 Will Perdue       0.5

sd_ppg的方差，就像z_ppg的方差一样，等于1：

var(dat5a$sd_ppg)
## [1] 1.018061

然后，我们将刚刚创建的 tibble，dat5a，传递给dplyr group_by()和slice()函数。这两个函数结合使用，有效地将 dat5a 减少到只包含每年变量sd_ppg为最大值的单条记录。这些结果被转换成另一个名为 dat5b 的 tibble：

dat5a %>%
  group_by(Year) %>%
  slice(which.max(sd_ppg)) -> dat5b

我们的结果随后通过一个ggplot2条形图进行可视化，其中 dat5b 是我们的数据源，Year_Player再次是我们的 x 轴变量，而 sd_ppg 是我们的 y 轴变量（见图 19.3）：

p3 <- ggplot(dat5b, aes(x = Year_Player, y = sd_ppg)) + 
  geom_bar(stat = "identity", color = "salmon3", fill = "salmon3") +
  geom_text(aes(label = sd_ppg), 
            position = position_dodge(width = 0.8), vjust = -0.3,
            fontface = "bold", size = 2) +
  labs(title = "Leading Scorer (Standard Deviation Method) by Year", 
       subtitle = "1950 to 1999", caption = "* Hall of Fame member",
       x = "Year and Leading Scorer",
       y = "PPG / Standard Deviation") +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 90)) 
print(p3)

图 19.3 基于标准差方法，1949-50 赛季至 1998-99 赛季每年 NBA 得分领先者和他们每场比赛的平均得分

这些结果看起来与我们之前的结果非常相似，这表明每场比赛平均得分（它影响 z 分数方法但不影响标准差方法）基本上是中性的，或者是不相关的。当这些结果与其他原始数据进行比较时，乔治·米坎（George Mikan）的 1950 赛季再次突出。尼尔·约翰斯顿（Neal Johnston）的 1954 赛季也突出，而艾伦·艾弗森（Allen Iverson）在费城 76 人队（Philadelphia 76ers）的 1998-99 赛季是过去 45 个 NBA 赛季中最显著的异常值。

19.4.3 中心化方法

中心化方法简单地从原始数据中减去某个常数——例如最小值或最大值，但通常是平均值。我们将减去每年的平均值，但如果我们对每场比赛平均得分的先验假设是正确的——它是中性的——那么我们的结果应该因此类似于原始数据。

首先，我们将 dat2 传递给group_by()和summarize()函数来计算每场比赛的平均得分。然后，这些结果被转换成一个名为 dat6a 的 tibble。我们通过调用head()和tail()函数来获取 dat6a 的前三条和最后三条记录：

dat2 %>%
  group_by(Year) %>%
  summarize(mean = round(mean(PPG), digits = 1)) -> dat6a

head(dat6a, n = 3)
## # A tibble: 3 × 2
##   Year   mean
##   <fct> <dbl>
## 1 1950    6.1
## 2 1951    6.6
## 3 1952    7.1

tail(dat6a, n = 3)
## # A tibble: 3 × 2
##   Year   mean
##   <fct> <dbl>
## 1 1997    7.2
## 2 1998    6.7
## 3 1999    6.8

第二，我们调用dplyr包中的left_join()函数，通过变量Year将 dat3 和 dat6a 合并或连接起来，这是这两个 tibble 共有的一个变量。而 dat3 有 68 × 4 的维度，dat6a 有 68 × 2 的维度，dat6b 有 68 × 5 的维度。head()和tail()函数返回 dat6b 的前三条和最后三条观测值：

left_join(dat3, dat6a, by = "Year") -> dat6b

head(dat6b, n = 3)
## # A tibble: 3 × 5
## # Groups:   Year [3]
##   Year  Player          PPG Year_Player         mean
##   <fct> <chr>         <dbl> <chr>              <dbl>
## 1 1950  George Mikan*  27.4 1950 George Mikan*   6.1
## 2 1951  George Mikan*  28.4 1951 George Mikan*   6.6
## 3 1952  Paul Arizin*   25.4 1952 Paul Arizin*    7.1

tail(dat6b, n = 3)
## # A tibble: 3 × 5
## # Groups:   Year [3]
##   Year  Player            PPG Year_Player           mean
##   <fct> <chr>           <dbl> <chr>                <dbl>
## 1 1997  Michael Jordan*  29.6 1997 Michael Jordan*   7.2
## 2 1998  Michael Jordan*  28.7 1998 Michael Jordan*   6.7
## 3 1999  Allen Iverson*   26.8 1999 Allen Iverson*    6.8

现在我们有一个单一的对象，其中包含了每年的最高 PPG 和每年的平均人口数。

第三，我们将 dat6b 传递给mutate()函数，创建一个名为c_ppg的新 dat6b 变量，该变量等于PPG减去平均值。现在你知道为什么我们刚刚执行了左连接——我们需要这两个变量在同一对象中派生c_ppg。为了继续提供对这些步骤的可见性，我们再次调用head()和tail()函数，在它们之间返回六个记录：

dat6b %>%
  mutate(c_ppg = PPG - mean) -> dat6b

head(dat6b, n = 3)
## # A tibble: 3 × 6
## # Groups:   Year [3]
##   Year  Player          PPG Year_Player         mean c_ppg
##   <fct> <chr>         <dbl> <chr>              <dbl> <dbl>
## 1 1950  George Mikan*  27.4 1950 George Mikan*   6.1  21.3
## 2 1951  George Mikan*  28.4 1951 George Mikan*   6.6  21.8
## 3 1952  Paul Arizin*   25.4 1952 Paul Arizin*    7.1  18.3

tail(dat6b, n = 3)
## # A tibble: 3 × 6
## # Groups:   Year [3]
##   Year  Player            PPG Year_Player           mean c_ppg
##   <fct> <chr>           <dbl> <chr>                <dbl> <dbl>
## 1 1997  Michael Jordan*  29.6 1997 Michael Jordan*   7.2  22.4
## 2 1998  Michael Jordan*  28.7 1998 Michael Jordan*   6.7  22  
## 3 1999  Allen Iverson*   26.8 1999 Allen Iverson*    6.8  20

第四，我们创建另一个ggplot2条形图，作为可视化结果的一种方式（见图 19.4）；dat6b 是我们的数据源，Year_Player沿着 x 轴运行，c_ppg沿着 y 轴运行：

p4 <- ggplot(dat6b, aes(x = Year_Player, y = c_ppg)) + 
  geom_bar(stat = "identity", color = "aquamarine4", 
           fill = "aquamarine4") +
  geom_text(aes(label = c_ppg), 
            position = position_dodge(width = 0.8), vjust = -0.3,
            fontface = "bold", size = 2) +
  labs(title = "Leading Scorer (Centering Method) by Year", 
       subtitle = "1950 to 2017", 
       caption = "* Hall of Fame member",
       x = "Year and Leading Scorer",
       y = "PPG - Annual Mean") +
  theme(plot.title = element_text(face = "bold")) +
  theme(axis.text.x = element_text(angle = 90)) 
print(p4)

图 19.4 1949-50 赛季至 1998-99 赛季 NBA 年度得分领先者和他们每场比赛平均得分的年度比较，基于中心化方法

这些结果几乎与原始数字相同，这并不令人惊讶。是的，附加在条形图顶部的总数当然比原始数字少，这是因为我们从PPG变量中减去了每年每场比赛得分的年度平均值。然而，更重要的是，年度间的比较与原始数据完全匹配。

19.4.4 范围法

在这个第四和最后的方法中，我们将原始数字除以年度范围，该范围等于Year中每个因子的每场比赛平均得分最大值减去最小值。

因此，我们将 dat2 传递给group_by()和mutate()函数，从而创建一个名为r_ppg的新变量，该变量等于PPG除以最大PPG减去最小PPG。然后，通过调用head()和tail()函数，我们获取了我们刚刚创建的 tibble（dat7a）中的前三个和最后三个记录：

dat2 %>%
  group_by(Year) %>%
  mutate(r_ppg = round((PPG) / (max(PPG) - min(PPG)), digits = 1)) -> dat7a

head(dat7a, n = 3)
## # A tibble: 3 × 5
## # Groups:   Year [1]
##   Year  Player         PPG Year_Player       r_ppg
##   <fct> <chr>        <dbl> <chr>             <dbl>
## 1 1950  Al Guokas      3.8 1950 Al Guokas      0.2
## 2 1950  Alex Groza    23.4 1950 Alex Groza     0.9
## 3 1950  Alex Hannum*   7.5 1950 Alex Hannum*   0.3

tail(dat7a, n = 3)
## # A tibble: 3 × 5
## # Groups:   Year [1]
##   Year  Player           PPG Year_Player         r_ppg
##   <fct> <chr>          <dbl> <chr>               <dbl>
## 1 1999  Walt Williams    9.3 1999 Walt Williams    0.4
## 2 1999  Walter McCarty   5.7 1999 Walter McCarty   0.2
## 3 1999  Will Perdue      2.4 1999 Will Perdue      0.1

接下来，我们切割一个名为 dat7b 的 tibble，它只包含那些记录，每个Year因子一个，其中我们派生的变量r_ppg是最大的。结果发现，对于每个 dat7b 记录，r_ppg都等于1.1。与其创建一个（相当不起眼的）条形图，我们不如展示前 10 个和最后 10 个结果：

dat7b %>%
  group_by(Year) %>%
  slice(which.max(r_ppg)) -> dat7b

head(dat7b, n = 10)
## # A tibble: 10 × 5
## # Groups:   Year [10]
##    Year  Player            PPG Year_Player          r_ppg
##    <fct> <chr>           <dbl> <chr>                <dbl>
##  1 1950  George Mikan*    27.4 1950 George Mikan*     1.1
##  2 1951  George Mikan*    28.4 1951 George Mikan*     1.1
##  3 1952  Paul Arizin*     25.4 1952 Paul Arizin*      1.1
##  4 1953  Neil Johnston*   22.3 1953 Neil Johnston*    1.1
##  5 1954  Neil Johnston*   24.4 1954 Neil Johnston*    1.1
##  6 1955  Neil Johnston*   22.7 1955 Neil Johnston*    1.1
##  7 1956  Bob Pettit*      25.7 1956 Bob Pettit*       1.1
##  8 1957  Bob Pettit*      24.7 1957 Bob Pettit*       1.1
##  9 1958  George Yardley*  27.8 1958 George Yardley*   1.1
## 10 1959  Bob Pettit*      29.2 1959 Bob Pettit*       1.1

tail(dat7b, n = 10)
## # A tibble: 10 × 5
## # Groups:   Year [10]
##    Year  Player              PPG Year_Player            r_ppg
##    <fct> <chr>             <dbl> <chr>                  <dbl>
##  1 1990  Michael Jordan*    33.6 1990 Michael Jordan*     1.1
##  2 1991  Michael Jordan*    31.5 1991 Michael Jordan*     1.1
##  3 1992  Michael Jordan*    30.1 1992 Michael Jordan*     1.1
##  4 1993  Michael Jordan*    32.6 1993 Michael Jordan*     1.1
##  5 1994  David Robinson*    29.8 1994 David Robinson*     1.1
##  6 1995  Shaquille O'Neal*  29.3 1995 Shaquille O'Neal*   1.1
##  7 1996  Michael Jordan*    30.4 1996 Michael Jordan*     1.1
##  8 1997  Michael Jordan*    29.6 1997 Michael Jordan*     1.1
##  9 1998  Michael Jordan*    28.7 1998 Michael Jordan*     1.1
## 10 1999  Allen Iverson*     26.8 1999 Allen Iverson*      1.1

虽然我们已经展示了四种标准化单个变量的方法，但有时有必要对两个或更多变量进行标准化，这些变量的原始数字在完全不同的尺度上。这是因为我们不想让一个变量，比如交易金额，其范围在数百甚至数千美元之间，在客户细分或其他类似分析中比另一个变量，比如交易次数，通常在个位数和两位数之间，有更大的权重。与跨越数十年的单个变量（如PPG）相比，范围法在标准化两个或更多变量时更有意义。

回到我们的分析，我们展示了标准化有可能以与我们通常习惯截然不同的方式呈现数据，因此挑战我们重新思考先前的惯例。几乎每个人都还在谈论威尔特·张伯伦，但几乎没有人关注乔治·米坎的成就。根据我们在这里展示的内容，这应该肯定会有所改变。

我们下一章和最后一章是对前 19 章的总结。

摘要

• 标准化是一个关键统计概念，当你有一个单一的连续变量，如每场比赛的平均得分，跨越长时间跨度时，了解并应用它是非常重要的。因此，由于外部因素的变化，原始数据在不同时间有不同的“含义”。想想通货膨胀以及为什么我们要将旧美元转换为当前美元。

• 当你拥有两个或更多连续变量，且原始数据处于非常不同的尺度时，为了防止其中一个变量产生不适当的影响，将变量转换为类似尺度——使用类似方法——然后将数据的标准版本纳入分析是很重要的。

• 我们展示了四种数据标准化方法，因为没有一种适合所有情况的数据标准化解决方案。这些方法中哪一个可能最适合你的用例主要取决于你的数据和你是标准化单个变量还是多个变量。测试不同的方法并不要仅仅依赖于一个预定义的方法是良好的实践。

• 我们还展示了如何给数据框对象添加颜色，甚至突出满足逻辑标准的记录。这些是值得了解的好技巧，可能有助于你的实时分析工作，或者当你打算直接将（尽管是粗略的）R 输出注入到 PowerPoint 演示文稿、RMarkdown 文件或其他文档类型时。

• 我们介绍了并演示了一些不同的数据处理技巧——使用 slice() 提取满足特定标准的观测值，使用 distinct() 从数据集中选择唯一或不同的记录，使用 comparedf() 比较两个对象并获取差异报告，以及使用 paste0() 连接字符串。

• 我们还演示了如何最好地调用跨包的函数。而不是分别加载这些包并调用它们的函数，实际上最好是在同一行代码中加载包并调用相应的函数。随着每年 R 函数和包数量的增加，实际上可能需要更多应用这种技术。

20 完成工作

在这些最后几页中，我们的目的是概述第二章至第十九章的结果，并回顾我们在过程中使用的技术。我们不会逐章进行，从而重复相同的旅程顺序，而是将我们的发现整合到九个“学习领域”中，这些领域进一步按包、应用技术和章节参考细分。例如，在第五章和第十四章之间，我们开发了四种类型的模型——线性回归、回归树、方差分析（ANOVA）和逻辑回归——使用基础 R 和包装函数的混合；因此，建模是我们九个学习领域之一。一旦我们到达第 20.4 节，我们将回顾哪些模型在哪里以及为了什么目的被应用。

以下学习领域按它们将呈现的顺序列出：

• 聚类分析 (20.1)

• 显著性测试 (20.2)

• 效应量测试 (20.3)

• 模型 (20.4)

• 运筹学 (20.5)

• 概率 (20.6)

• 统计分散 (20.7)

• 标准化 (20.8)

• 概率统计和可视化 (20.9)

此外，我们创建了一系列桑基图（见第三章），每个学习领域一个，这些图显示了学习领域、包和基础 R 函数、技术和章节编号之间的关系。因此，这些最终可视化是相同汇聚点的视觉快照。

20.1 聚类分析

聚类分析是一种无监督学习方法和多元分析技术，它根据对象的相似性将对象（例如，汽车、社区、几乎任何东西）分类到多个组或簇中。一家百货连锁店可能会根据人口统计数据和以前的购买记录来细分其客户，目的是随后根据簇来制定定制营销策略。毫无疑问，最常见或最受欢迎的聚类算法是层次聚类和 K-means 聚类。我们在第三章和第十一章分别介绍了这两种聚类技术。

我们开始这次旅程时，提出了一个论点，即摆烂是一种完全合乎逻辑（尽管令人厌恶）的策略，对于计划通过业余选秀重建阵容的处境不佳的 NBA 球队来说。这是因为联赛奖励其最差的球队以几个首轮选秀权，而选择未来超级巨星——那种可以扭转球队命运的球员——的唯一可能方式是在选秀中或接近最顶端进行选择。我们通过开发一系列基础 R 函数的层次聚类来结束我们的论点。

更重要的是，我们基于按第一轮选秀号码分组的第一轮选秀到 2000 年至 2009 年 NBA 选秀的平均职业生涯胜利份额创建了一个距离矩阵。层次聚类开始时，将每个对象或观察值视为其自己的簇。然后它通过每次合并两个相似的簇进行迭代，直到所有簇（在我们的案例中是 30 个，或每个首轮选秀一个簇）合并成一个。最终结果是树状图，或倒置的树，它在 x 轴上显示原始簇，在 y 轴上显示距离矩阵的结果。

在 R 中创建树状图特别好的是，我们有选项在图上绘制K个透明的框来进一步区分簇。我们将K设置为 2，看看 R 是否会绘制一个透明的框围绕选秀 1 到 5 的选秀，另一个框围绕 6 到 30 的选秀，从而返回与我们之前分析相似的结果。果然，这正是 R 为我们做的。

在第十章和第十一章中，我们探讨了球队薪资与常规赛胜利、季后赛出场和冠军之间的关系——得出结论，除了少数例外，球队薪资通常是球队轨迹的领先指标。我们以 K-means 聚类分析结束我们的分析。

K-means 聚类与层次聚类至少有两点不同——（1）我们必须提前告诉 R 要创建多少个簇，并且（2）我们根据两个或更多连续变量得到K个簇，为了绘图目的，这些变量会自动为我们标准化或缩放。我们在 2000 年至 2017 个赛季之间绘制了调整后的薪资和常规赛胜利。

我们首先演示了两种计算最佳簇数（与随机生成K）的方法，使用factoextra包中的函数。簇内平方和法，有时被称为肘部法，因为它建议在（不精确的）随后 scree 图弯曲的位置有一个最佳簇数，返回六个簇；轮廓法返回两个簇。

我们决定折中一下，并指示 R 将结果分割成四个集群。K-means 聚类通过（可能）几个迭代步骤来处理数字，直到数据与它们各自的质心或集群的中心位置之间的总平方和最小化，当然，不违反对K预定的要求。我们结果中最令人着迷的部分可能是 R 将纽约尼克斯队降级到了它自己的集群，该队的工资水平比联赛平均水平高出三个标准差以上，而常规赛的胜利次数比平均水平低一个标准差以上。与此同时，圣安东尼奥马刺队，在 2000 年至 2017 年之间赢得的常规赛比赛比任何其他工资水平低于平均水平的球队都要多，与 10 个其他球队聚类在一起。结果是通过基础 R 功能返回的，然后通过factoextra包进行可视化。

一般的无监督学习方法，特别是聚类分析，返回的结果比线性回归或 t 检验等更为主观。我们在第十一章进一步演示了，当我们对K应用不同的值时，结果可以并且会显著变化；因此，随着K的增加，聚类分析，尤其是 K-means 的个性特征会加剧。当K等于 2 时，看似具有相似轮廓并因此值得在类似营销活动中接受的一对客户，当K等于 3 或更多时，可能会被划分到不同的集群中。尽管如此，聚类分析是探索数据和评估群体的一种基本技术，也是应用不同治疗手段的关键推动者，这些手段通常比一揽子策略带来更好的回报。

我们的第一张桑基图——实际上，所有随后的桑基图——都应该从左到右阅读（见图 20.1）。最左边的节点是适用的学习区域；下一个节点或一系列节点代表被调用的包和/或内置函数；下一组节点代表应用的技术；最右边的节点组是章节引用。因此，层次聚类仅使用基础 R 函数开发，而我们的 K-means 聚类则是结合了基础 R 和factoextra函数开发的。层次聚类在第三章中进行了演示，K-means 聚类在第十一章中进行了演示。（顺便说一下，节点组之间连接线或链接的宽度没有任何意义。）

图 20.1 层次聚类在第三章中被展示为支持“摆烂”策略的最终证据；K-means 聚类在第十一章中被展示为基于各队工资和常规赛胜利的组合来划分类似队伍的方法。我们的层次聚类完全使用基础 R 函数开发和可视化；相反，我们的 K-means 聚类主要使用内置函数开发，但通过factoextra包进行可视化。

20.2 显著性检验

任何显著性检验——无论是 t 检验、独立性的卡方检验、相关性检验还是 F 检验——都应该围绕一个零假设（H[0]）及其对立面，备择假设（H[1]）。我们始终从零假设开始；也就是说，我们假设进入时任何方差都是由于偶然。然后我们运行一个显著性检验，告诉我们是拒绝零假设还是未能拒绝它。通过拒绝零假设，因此我们接受备择假设。

假设有两组类似的不良客户，他们接受了不同的催收处理。显著性检验告诉我们性能差异是由于偶然还是应该归因于处理方式的差异。如果前者，我们未能拒绝零假设；如果后者，我们拒绝零假设。如果结果是显著的，那么将获胜的处理方式应用于所有客户就变得有意义。

显著性检验的 p 值告诉我们是否拒绝零假设。我们一致地应用了一个预定义的 5%阈值，这是最常见的——当返回的 p 值大于 5%时，我们未能拒绝我们的零假设，而当它小于 5%时，我们拒绝那个零假设并接受备择假设。显著性阈值有时设定得非常低，如 1%，有时设定得非常高，如 10%。这意味着显著性检验本质上返回一个二元结果；也就是说，基于应用的意义阈值，观察到的方差要么是不重要的，要么是重要的。

请记住，显著性检验的结果，尤其是独立性的 t 检验和卡方检验，是基于方差以及数据的大小。如果你被要求设计一个测试和控制（有时被称为冠军/挑战者），你应该将测试和控制群体分开，并相应地确定测试的持续时间。

在第七章中，我们探讨了 NBA 中普遍存在的主场优势，至少部分可能归因于裁判的偏见。当然，裁判不会影响投篮是否命中或失误，或者哪个队伍夺回篮板球，但他们负责吹罚——或者不吹罚——个人犯规，这通常是酌情处理的。个人犯规的吹罚通常会导致对方队伍获得罚球机会——以及更多的分数。但从更广泛的角度来看，它们可以打乱换人模式，从而影响比赛的流畅性。

访问队伍比主场队伍受到更多的个人犯规吹罚，因此，主场队伍尝试的罚球次数比访问队伍多，至少根据 2018-19 赛季和 2019-20 赛季的数据来看是这样。然而，原始数据并不能告诉我们这些差异仅仅是由于偶然，还是背后有某种含义。这正是显著性检验的作用所在。

当我们想要比较两组——而且只有两组——的均值，并且我们有连续数据可供工作时，t 检验是一种适当的显著性或假设检验。我们的零假设，或初始假设，是两组的均值基本上是相等的；因此，我们需要一个非常低的 p 值来拒绝均值在统计上相等的零假设，并接受备择假设，即任何差异的根源不是偶然。在第七章中，我们进行了八次 t 检验；虽然原始数据始终偏向主场队伍——甚至在比赛在中立场地进行时，被指定为主场队伍的队伍——但我们的测试在记录数量大的情况下返回了统计上显著的结果，在其他情况下则没有显著结果。包括 t 检验在内的显著性检验通常从基本的 R 函数中运行，但在第七章中，我们还从ggpubr包中运行了 t 检验，这使得我们能够自动将结果插入到ggplot2箱线图中。

然后，在第十二章和第十三章中，我们发现 1991 年至 2018 年间获得冠军的队伍，其薪资分布和赢分分布比其他队伍更加不平等；同样，获胜队伍——不仅是指后来赢得联赛冠军的队伍，还包括常规赛胜率超过.500 的队伍——其薪资分布和赢分分布比输掉比赛的队伍更加不平等。我们进行了额外的 t 检验，以确定组间基尼系数均值差异是否具有统计显著性；每次 t 检验都返回了低于.05 显著性阈值的 p 值。用通俗的话说，薪资分布和赢分分布是决定胜负的关键因素，也是赢得冠军的关键。

相关性检验是另一种在连续数据上运行的显著性检验。我们在第十章运行了我们的第一个相关性检验，以确定至少在 2000 年至 2017 赛季之间，球队薪资和常规赛胜利之间是否存在统计学上显著的关联或关系。我们的零假设是它们之间没有关联，但我们的相关性检验返回的 p 值低于.05，因此我们拒绝了零假设，并得出结论，实际上薪资和胜利之间存在有意义的关系。

在第十四章，我们运行了另外两个相关性检验——第一个是胜利和允许得分之间的关系，第二个是胜利和得分之间的关系。我们的变量首先进行了缩放，以减轻时间的影响。你可能还记得，在第十四章中，我们的目的是衡量防守和进攻对胜利的相对影响。如果正如传统思维多年来所暗示的那样，防守比进攻更重要，那么我们的两个相关性检验应该返回非常不同的结果。然而，它们并没有——我们的两个测试返回了统计学上显著且相同的结果，这表明防守和进攻对胜利的影响是相等的。相关性检验是从基本的 R 功能运行的。

稍微转换一下话题，我们在第九章进行了一种不同类型的显著性检验，即独立性卡方检验。在这一章中，我们根据前一天休息日的不同排列组合，探讨了主队和客队之间的胜负情况。由于在第九章我们处理的是分类数据而非连续数据，因此使用卡方检验而不是 t 检验（或者当然也不是相关性检验）是更合适的显著性检验方法。

然而，我们还是从零假设开始，然后根据测试的 p 值拒绝或未能拒绝该零假设。我们最终拒绝了零假设，因此得出结论，休息日的排列组合对胜负有影响。我们的独立性卡方检验是从基本的 R 函数运行的，然后我们以两种方式可视化了结果，一次是从gtools包，另一次是从vcd包。

最后，我们在第十三章从基本的 R 函数运行了一个 F 检验，以帮助我们决定从三个相互竞争的效果量检验中接受哪些结果（参见第 20.3 节）。与 t 检验和卡方检验一样，我们的起点是零假设，终点是小于或等于.05 的 p 值。我们的第二个桑基图（见图 20.2）从视觉上总结了显著性检验的学习领域。

图 20.2 显著性检验从零假设开始，该假设随后根据 p 值和 5%的阈值被拒绝或未被拒绝。进行哪种显著性检验取决于数据（通常，但并非总是，是连续数据还是分类数据）。显著性检验通常从基本的 R 函数运行，并且结果通常通过包装函数进行可视化。

20.3 效果量检验

与显著性统计测试返回的 p 值告诉我们，通常在 5% 的阈值下，观察结果和预期结果之间的方差是否在统计上显著不同，效应量测试告诉我们这种相同的方差有多大或有多小。关于效应量测试的以下内容需要考虑：

• 效应量测试应该补充或补充显著性统计测试，而不是取代它们。我们不会根据效应量测试拒绝或未能拒绝零假设。

• 与其他统计测试一样，选择正确的效应量测试取决于数据。Cohen’s d、Hedges’ g 和 Glass’s delta 效应量测试是对连续数据进行运行的，因此它们补充了 t 测试。另一方面，Cramer’s V 效应量测试是对分类数据进行运行的，因此它补充了独立性卡方测试。

• Cohen’s d 是连续数据的最受欢迎的效应量测试。我们在第 7、12 和 13 章中运行了 Cohen’s d 测试，并且只在第十三章中运行了 Hedges’ g 和 Glass’s delta 测试。

• 我们的 Cohen’s d 测试是在第 7、12 和 13 章中从 effsize 包中运行的，并且在第十三章中只从 effectsize 包中再次运行。因此，我们的 Hedges’ g 和 Glass’s delta 测试只从 effectsize 包中运行。

• Cramer’s V 是分类数据的首选效应量测试。我们在第九章中两次运行了 Cramer’s V 效应量测试，一次来自 questionr 包，另一次来自 rcompanion 包。

• 显著性统计测试和效应量测试的结果可能并不总是吻合。例如，返回 p 值远低于 5% 阈值的 t 测试不一定转化为大的效应量；相反，返回 p 值高于 5% 的 t 测试或其他显著性测试实际上可能等同于大的效应量。再次强调，显著性测试考虑记录数，而效应量测试不考虑。

• 通常，当定量结果等于 0.2 或更少时，效应量被认为是小的；当结果在 0.5 或附近时，效应量被认为是中等的；当结果等于或高于 0.8 时，效应量被认为是大的。

我们接下来的桑基图（见图 20.3）展示了这些非常相同的关联。

图 20.3 效果量测试应该补充或补充，而不是取代，显著性测试。Cohens’ d、Hedges’ g 和 Glass’s delta 是作为 t 检验（数据连续）的补充运行的效果量测试；Cramer’s V 是作为独立性卡方检验（数据为分类而非连续）的补充运行的效果量测试。Cohens’ d 测试，连续数据的最受欢迎的效果量测试，在第 7、12 和 13 章以及第十三章的effectsize包中运行；Hedges’ g 和 Glass’s delta 测试仅在第十三章的effectsize包中运行。Cramer’s V 在第九章运行了两次，一次来自questionr包，一次来自rcompanion包。

在第七章中，我们通过量化客场和主队之间的个人犯规和罚球尝试次数，然后测试和测量方差，探讨了游戏官员可能偏向主队的可能性。无论前期的 t 检验结果如何，我们的 Cohens’ d 检验——其中计算组均值和标准差，而忽略记录计数——返回了可忽略的效果量。我们测试了 2018-19 赛季常规赛和季后赛以及 2019-20 赛季常规赛，包括和疫情前后的情况。

在第十二章中，我们使用涵盖 28 个 NBA 赛季的数据集，探讨了薪资不平等与胜利之间的关系。我们发现，常规赛胜率较高的球队比胜率较低的球队薪资分布更不平等；我们还发现，冠军球队比其他联盟球队的薪资分布更不平等。然后我们运行了两个 Cohens’ d 效果量测试来衡量薪资分布差异——在两种情况下，Cohens’ d 都返回了中等效果量。

在第十三章中，我们分析了球队之间的胜利份额分布（作为薪资不平等的一种替代）与胜利之间的关系。随后我们了解到，胜利份额分布不均等的球队是那些赢得更多常规赛比赛和冠军的球队。我们利用第十三章的机会，通过引入另一个包来进一步展示效果量测试，这使我们能够除了 Cohens’ d 测试外，还运行 Hedges’ g 和 Glass’s delta 效果量测试。这些其他测试的结果与我们的最终 Cohens’ d 测试相同，尽管在效果量计算方式上存在微小差异。无论方法如何，无论测试如何，效果量都相对较小。

至于我们第九章的 Cramer’s V 测试，我们旨在衡量休息与胜利与失败之间的效果量，我们的结果表明，至少基于 2012-13 赛季和 2017-18 赛季之间的常规赛比赛，休息对比赛结果有轻微到中等的影响。

20.4 模型

在 2016-17 赛季的常规赛季中，NBA 开始测量努力统计数据——例如封盖、干扰和捡回松散球等。我们在第五章中着手调查这些努力统计数据中，如果有的话，哪些在胜负大局中至关重要。

我们的起点是多重线性回归，其中常规赛季的胜利（一个连续变量）被回归到 NBA 的努力统计数据（其他连续变量）上，这之前包括以下详尽的数据探索和数据整理工作：

• 通过为每个变量绘制箱线图来识别异常值，并在存在异常值的情况下，通过增加其值以等于所谓的最小值或减少其值以等于最大值来消除它们——因为异常值可能会不成比例地偏模型结果。将值“封顶”的过程称为 winsorization。

• 通过绘制密度图和运行 Shapiro-Wilk 测试来检查正态分布，并在适用的情况下，移除具有非正态分布的变量作为候选预测因子——因为线性回归假设，甚至要求变量采用高斯分布。当 Shapiro-Wilk 测试返回的 p 值高于 0.05 时，我们假设正态性。

• 创建一个矩阵，显示每对剩余变量之间的相关性，并返回相同变量的相关系数——因为我们想确定那些最有希望作为预测因子的变量。

此外，我们在模型开发过程中遵循其他最佳实践，包括以下内容：

• 将数据分割成互斥的子集以进行开发和预测。

• 检查预测因子之间的多重共线性。

• 运行诊断。

• 配合第二个或竞争性模型，并比较我们的两个回归以获得数据的最佳拟合。

我们的最佳多重线性回归解释了常规赛季胜利中不到 20%的方差（总方差与 R2 相关，或者更好的是，调整 R2 统计量）；然而，我们的意图并不是解释胜利，而是隔离那些真正影响胜利的努力统计数据，并量化它们的总效应。来自挡拆的得分、防守端的传球干扰和捡回的松散球对常规赛季胜利的方差有统计学意义上的影响；也就是说，我们最佳回归的这三个变量的 p 值小于.05。

而线性回归绘制一条直线但斜线，以最小化其与数据之间的距离，回归树——通常被称为决策树回归——通过一系列的 if-else 语句在数据上绘制一条锯齿线。然后我们拟合一个回归树，看看不同类型的模型是否会返回相似或不同的结果。

此外，虽然线性模型的结果以表格格式返回（除了诊断信息外），但基于树的模型的结果仅以图形格式返回。我们得到一个倒置的树，其中最重要的预测变量和分割点位于树的“顶部”，而其余的预测变量和分割点位于“底部”。结果证明，我们的回归树将来自屏幕的得分、偏转和失球回收这三个变量隔离出来，认为它们对常规赛胜利的影响最大。

线性回归是从基础 R 语言中发展而来的。我们通过使用car包来检查多重共线性，并调用broom包中的函数——它是tidyverse包集合的一部分，以返回我们结果的一个子集。我们的回归树是由tree包开发的（尽管 R 提供了其他包装好的替代方案），并通过基础 R 进行可视化。

我们在第十四章中回到建模，作为我们努力建立或反驳“防守比进攻更重要”这一观点的一部分，使用的数据集涵盖了 2007 年至 2018 赛季。方差分析（ANOVA）需要一个连续的或定量的因变量和一个至少分为三个数据系列的分类预测变量。我们分别测试了常规赛胜利的标准化转换与允许的得分和得分的标准化转换；如果防守比进攻更重要，那么我们的第一个模型应该比第二个模型更好地解释胜利。然而，两个模型返回了相同的结果。ANOVA 使用基础 R 进行拟合。

逻辑回归需要一个二元因变量和一个或多个（通常是）连续的自变量。我们分别对等于0的因变量进行了回归，这些因变量代表未能晋级季后赛的球队，以及等于1的因变量，代表成功晋级季后赛的球队，这些因变量与我们投入 ANOVA 中的相同。再次强调，如果防守实际上比进攻更重要，那么我们的第一个逻辑回归应该更好地解释或预测球队是否晋级季后赛。事实上，我们的第一个回归模型比第二个模型更强，但差异微乎其微。总体而言，我们得出的最公平的结论是，防守和进攻对常规赛胜利以及球队是否晋级季后赛的影响大致相等。

逻辑回归也是从基础 R 语言中发展而来的；然而，我们随后调用了一系列包装好的函数来获取我们的结果。这些细节反映在下面的桑基图中（见图 20.4）。

图 20.4 在第五章中，我们开发了线性回归和回归树模型来隔离可能对胜负有统计学意义的 hustle 统计数据。从这两种模型类型中，我们发现来自挡拆得分的得分、防守端的传球干扰和捡回的 loose balls 比其他类似统计数据更重要，并且实际上确实对胜负有贡献。在第十四章中，我们开发了方差分析和逻辑回归模型来建立防守是否比进攻更重要，前者是常规赛的胜负，后者是季后赛的资格。我们的模型返回了具有统计学意义的成果，但并不明确和不可否认的是防守比进攻更重要。

20.5 运筹学

与之前的学习领域不同，运筹学包含了一个技术的大熔炉。再次，我们在第二章和第三章中为选择通过业余选秀重建的球队提出了“摆烂”的论点。然而，其他球队可以选择并通过自由球员收购来重建阵容。在第四章中，我们展示了虚构的 NBA 球队如何通过设置约束优化问题来优化他们的自由球员收购，并消除猜测。约束优化是一种运筹学技术，通过遵守一个或多个硬约束来最大化或最小化某个函数。我们的虚构球队寻求在其自由球员收购中最大化预期的赢分，同时遵守以下约束：

• 必须收购恰好五名自由球员。

• 每位自由球员必须担任一个独特的位置。

• 年薪不得超过 9000 万美元；薪资可以在五名自由球员之间以任何方式分配，但他们的累计年薪必须等于或低于 9000 万美元。

• 在签约时，五名自由球员的平均年龄不得超过 30 岁；每个自由球员没有年龄限制，但平均年龄必须等于或低于 30 岁。

重量级的工作来自 lpSolve 包——要最大化或最小化的函数必须是线性和连续的（赢分——检查）并且约束也必须是线性和连续的（精确的自由球员收购数量——检查，按位置精确的收购数量——检查，每年最大薪资分配——检查，签约时的最大平均年龄——检查）。从 24 名可用球员的短名单中，我们的约束优化问题返回了五名自由球员的收购名单：一名控球后卫，一名得分后卫，一名中锋，一名大前锋和一名小前锋，他们的年薪总额为 8950 万美元，平均年龄为 28.4 岁。

任何其他解决方案都会低于最佳方案，或者需要违反一个或多个硬约束。我们的约束优化问题可以通过简单地更换要最大化或最小化的函数以及更换约束来轻松地重新定位。

到我们到达第八章时，我们已经有效地从“前办公室”分析过渡到了“比赛”分析。在这里，我们探讨了当球队有 24 秒时间尝试投篮并避免失误时，最优停止规则适用得如何。最优停止也被称为 37%规则的原因是——理论上，NBA 球队应该在分配时间的头 37%内传球和运球，而不是投篮，然后选择第一个与先前投篮机会相比更有利的投篮。同样，如果你是面试你组织中的空缺职位的招聘经理，你应该自动淘汰前 37%的候选人，然后雇佣第一个与先前候选人相比更有利的申请人。最优停止专注于在几种替代方案中返回最高概率的最佳结果，同时避免浪费的努力——当没有第二次机会时。

我们的分析表明，最优停止的原则对密尔沃基雄鹿队和夏洛特黄蜂队适用得相当好，但对亚特兰大老鹰队则不一定适用；进一步的分析还表明，持续的或来回的回归均值比最优停止规则更为重要。然而，最优停止的精神对整个联赛适用得非常好；得分和投篮命中率都随着比赛时间的推移而急剧下降。在整个分析过程中，我们使用了tidyverse宇宙包中的函数以及janitor包中的函数的组合。

在第九章中，在我们探讨休息对胜负的影响之前，我们首先需要解决一个非常基本的问题：关于对抗主队和客队之间的先前休息日，我们是处理组合还是排列？最终，我们的意图是按每一种可能的先前休息日组合来统计和绘制结果，但由于组合和排列不是同义的，因此它们的计算方式不同，我们首先正确地确定哪一个是哪一个是至关重要的。

简而言之，我们处理的是排列问题，因为顺序很重要。（实际上，你的组合锁应该实际上被称为排列锁。）对于任何特定的比赛，主队可能在休息两天后进行比赛，而客队可能只在休息一天后进行比赛，这当然与主队休息一天而客队休息两天的情况不同。实际上，我们实际上处理的是带替换的排列，而不是不带替换的排列，因为主队和客队可能有相同数量的先前休息日，而且他们经常是这样。从gtools包中，我们计算了我们需要考虑的排列数量，然后提供了指令给 R 来打印实际的排列。

在第十五章中，我们探讨了林迪效应、右偏概率分布、非线性与 80-20 规则之间的相似性。我们的具体兴趣在于衡量 1946 年至 2020 年之间 NBA 各球队的比赛中获胜的比赛分布——是否可能有 20%的联赛球队占有了 80%的所有比赛和获胜？

没有创建帕累托图，就无法进行 80-20 分析。帕累托图是一种组合条形图和折线图，具有主要和次要 y 轴。条形长度可以代表单位频率，但也可以代表时间、金钱或其他成本函数的单位；它们通常垂直排列，必须绝对按降序排列，并回溯到主要 y 轴。线代表按百分比测量的累积频率，并回溯到次要 y 轴。目的是可视化，比如说，可以用多少更少的修复来解决多少问题。

帕累托图基本上是一种质量控制工具，它以视觉方式表示通常非线性，有时甚至像 80-20 那样极端的原因和效果。因此，我们使用了一对质量控制包来绘制两个帕累托图。其中第一个，来自ggQC包，显示了每个 NBA 球队每场比赛的数量，使用ggplot2美学，而第二个图表，来自qcc包，显示了每个球队的获胜比赛数量。帕累托图清楚地显示了非线性效果，但不是 80-20 的程度。

我们接下来的桑基图（见图 20.5）可视化了运筹学学习领域。

图 20.5 运筹学学习领域包含了一系列技术。在第四章中，我们展示了如何通过建立一个约束优化问题，一支 NBA 球队在自由球员市场上能够以最少的投入获得最大的回报；在第八章中，我们测试了最优停止规则，即通常所说的 37%规则，与 24 秒投篮钟的匹配效果；在第九章中，我们考察了排列与组合（在计算主队和客队之间前几天的休息日的排列之前）；在第十五章中，我们展示了 80-20 规则，通常称为帕累托原理，并可视化地展示了它如何适用于所有 NBA 球队的比赛中获胜的比赛。

20.6 概率

让我们再次回顾第三章，讨论一下期望值分析——这是一种将竞争结果乘以其概率，然后将它们的乘积相加以得到期望值的技巧。我们计算了前五顺位选秀权的期望值以及任何其他第一轮选秀权的期望值，预计 R 将返回非常不同的结果。

2000 年至 2009 年 NBA 选秀的第一轮选择被分配了五种状态之一，或职业生涯结果，根据他们随后的胜利份额；例如，如果一个首轮选秀球员随后获得了超过 100 个职业生涯胜利份额，则他被指定为超级巨星。然后，我们计算了每种职业生涯结果的概率，根据球员是否为前五名选择进行划分。在选秀中或在接近前五名选择时获得未来超级巨星的概率为 24%；在其他任何位置选择时，概率仅为 1%。

然后，我们计算了每个结果的平均胜利份额，再次根据球员是否为前五名选择进行划分。被选中为前五名的未来超级巨星平均获得了 127 个职业生涯胜利份额；被选中为前五名以下的前景超级巨星平均获得了 111 个职业生涯胜利份额。

预期值是通过将概率乘以中值胜利份额然后总计乘积来得到的。前五名选秀的预期值为 57.53 个胜利份额，而任何其他首轮选秀的预期值仅为 21.21 个胜利份额。这是获得长期首发球员与仅仅是一名边缘球员之间的区别——并进一步解释了为什么通过任何必要手段进入选秀榜首是完美的选择。我们调用了一组基础 R 和dplyr函数来获取这些结果，如我们下一个桑基图的上半部分所示（见图 20.6）。

图 20.6 第三章中的预期值分析清楚地表明，并非所有首轮 NBA 选秀球员都是相同的；球队应该根据他们从哪里选秀而有非常不同的期望。然后，在第十六章中，我们试图确定罚球投篮是否类似于拉普拉斯概率曲线，其中成功促进更多成功，或者它是否看起来更随机；我们最终得出结论，后者更符合。

在第十六章中，我们研究了罚球投篮——特别是成功的罚球尝试的连串——以确定这种投篮连串是否更类似于拉普拉斯概率曲线或硬币的翻转。如果“手感热”是一种真实现象，那么球员的连续罚球百分比——他下一次尝试成功的概率——应该随着每一次成功的投篮而增加。另一方面，如果球员按连续命中次数绘制的罚球百分比没有遵循拉普拉斯概率曲线，或者至少接近，那么我们应该摒弃“手感热”现象，并得出结论，罚球投篮更随机。

我们首先检查了三名球员的罚球命中率，这三位球员在 2019-20 赛季的罚球尝试中均位于领先者行列：Giannis Antetokounmpo（大约 63%的罚球命中率），Julius Randle（73%），和 James Harden（86%）。使用runner包，我们统计了成功罚球的连击次数，然后计算了连续命中每个整数的投篮命中率。最终，罚球命中率看起来是随机的。为了证明这一点，我们模拟了 700 次抛硬币（Antetokounmpo 在 2019-20 赛季尝试了 700 多次罚球）；我们的模拟返回的连击（反面）与 Antetokounmpo 的罚球百分比非常相似。

但然后，我们绘制了整个 NBA 的罚球命中率，并得到了非常不同的结果。通过将每个球员分组到一个单独的计算系列中，我们得到的罚球命中率，当绘制时，看起来比我们的球员级分析更像是拉普拉斯概率曲线。然而，我们的主要收获是，球员特定的结果比联赛范围内的结果更有意义，因为“手感”如果存在，是针对在离散时间段内进行单个球员的表现，而不是针对在不同时间和不同空间进行的不同球员的表现。

20.7 统计离散度

我们在第十二章和第十三章中使用了基尼系数，使用了ineq包（参见 20.2 节和 20.3 节），但实际上，我们最认真地考虑统计离散度措施是在第十八章。NBA 在 1984-85 赛季开始前引入了球员薪资上限，表面上是为了在整个联盟中创造或至少改善平等性。我们着手测量薪资上限前的赛季内平等性，以确定 NBA 在 1984 年之前是否真的存在需要采取纠正行动的平等性问题，以及薪资上限后的赛季内平等性，以确定薪资上限当时是否改善了情况。以下方法被应用：

• 方差法—等于将数据集中每个值与同一数据集中所有值的平均值之间的差值平方，然后除以观测值的数量

• 标准差法—等于方差的平方根

• 范围法—等于数据集中最高值和最低值之间的差

• 平均绝对偏差法—等于每个数据点与同一数据集中平均值之间的聚合绝对差值，除以记录数

• 中值绝对偏差法—等于每个数据点与同一数据集中中位数之间的聚合绝对差值，除以记录数

关于方差和标准差方法，我们调用了基础 R 函数；至于范围、平均绝对偏差和中位数绝对偏差方法，我们编写了也现成的算术运算。在考虑全面性、易用性和识别度时，标准差方法在所有测试方法中取得了最佳平衡。然而，没有一种统计分散度的通用度量标准；所有方法都应被应用，以获得对数据的最佳理解。我们的下一个桑基图（见图 20.7）捕捉了使用了哪些方法和在哪里使用。

图 20.7 我们在第十二章和第十三章中使用了基尼系数，并表明在薪资和赢分分布不均的球队，根据这一衡量标准，比其他球队更成功。然后在第十八章中展示了五个统计分散度的指标，以量化 NBA 在薪资上限前后的赛季内公平性。根据所有五个分散度指标，1970-71 赛季到 1983-84 赛季之间赛季内的公平性实际上有所改善，然后在 1984-85 赛季到 1997-98 赛季之间恶化。整个过程中使用了基础 R 函数。

我们的分析未能确定 NBA 在当年声称存在公平性问题时的想法。我们清楚地表明，通过相同的五个指标，薪资上限并没有产生预期的（或至少是声明的）效果。

20.8 标准化

我们在第十一章和第十四章中使用了 z 分数——z 分数告诉我们原始值相对于总体平均值的距离——但在第十九章中，我们更有目的地使用了 z 分数和其他数据标准化技术（见图 20.8）。

图 20.8 虽然我们在第十一章和第十四章中使用了 z 分数，但直到第十九章，我们才给予它们，连同其他标准化技术，充分的重视。在第十九章中，我们将每场比赛的历史平均得分标准化，以减轻规则变化和比赛风格转变的影响，在这个过程中，对过去提供了一个新的视角。

回到 1961-62 赛季，伟大的威尔特·张伯伦平均每场比赛得到 50.4 分，然后在 1962-63 赛季，他平均每场比赛得到 44.8 分。（张伯伦实际上在 1960 年至 1966 年连续七个赛季中领导 NBA 得分。）在此之前或之后，没有其他球员甚至平均每场比赛得到 40 分。

查尔斯·巴克利绝对是一位独一无二的球员，然而我们对他的得分能力的持续钦佩却忽略了这样一个事实：规则变化和比赛风格的变化已经影响了从 NBA 第一个赛季到现在的比赛节奏。在巴克利在 20 世纪 60 年代的统治之前和之后，球队尝试的投篮和罚球次数都减少了；因此，在 20 世纪 40 年代和 50 年代以及从 20 世纪 70 年代开始，得分都减少了。

我们通过标准化原始数据来控制时间上的变化；因此，我们通过将年度得分领袖与当时联盟的平均得分进行比较，而不是跨越几十年的时间跨度，对每场比赛的平均得分（或几乎所有其他事物）提出了新的视角。使用基本的 R 函数，我们测试了以下四种方法：

• Z 分数法—等于原始数据减去总体均值，然后除以标准差

• 标准差法—等于原始数据除以标准差

• 中心化法—等于原始数据减去均值

• 范围法—等于原始数据除以最大值和最小值之间的差

Z 分数法和标准差法从传统角度来看，返回了非常不同的外观和结果。根据这两种方法，乔治·米坎在 1950 年可能非常有可能在那一年的 1999 年之间拥有联盟的最佳得分平均分。米坎 1950 年的得分平均分比联盟均值高出 6.8 个标准差；相比之下，查尔斯·巴克利在十多年后的 50.4 平均得分仅比联盟均值高出 3.7 个标准差。标准差法在米坎和巴克利之间返回了更大的差异。换句话说，米坎在他那个时代比巴克利在他那个时代表现得更好。

20.9 概率统计和可视化

我们最后一个学习领域，概率统计和可视化，是一种包罗万象的东西。这是因为前几章在某种程度上都包含了一些汇总（或描述性）统计，辅以各种可视化。为了避免与先前学习领域有任何重复，因此我们的范围被限制在以下内容：

• 第十七章中介绍过的自动化（探索性数据分析）EDA 包—tableone、DataExplorer和SmartEDA。

• 那些特别详尽或没有必然补充一个或多个统计技术的手动 EDA 练习。例如，第二章几乎完全是最佳 EDA 实践的演示；第五章展示了如何最好地探索数据集（然后根据需要对其进行整理）以准备拟合线性回归；尽管我们在第十章介绍了相关性测试，但我们否则仅依赖于计算汇总统计和绘图。

当然，所有这些都使我们的范围具有一定的主观性，但并不亚于我们的其他学习领域。我们接下来的最后一张桑基图（见图 20.9）提供了一个即将讨论的视觉快照。

图 20.9 我们在每一章都计算了总结性或描述性统计量，然后通过展示各种绘图技术来可视化这些统计量。然而，第 2、5、6、10 和 14 章中的手动 EDA 练习，以及第十七章中的自动化 EDA 演示，比其他章节的努力更为详尽。

在第十七章中，我们的目的是研究开盘总额与收盘总额，以及开盘点数差与收盘点数差。在调查过程中，我们介绍并演示了三个自动化的 EDA 包，这些包随后提供了第一个迹象，即受成千上万的赌徒冒险投入自己的收入影响的收盘总额和收盘点数差，通常比由拉斯维加斯赌场雇佣的少数赔率分析师和数据科学家建立的开盘总额和开盘点数差更准确。

下面是具体细节：

• 我们调用tableone包来建立我们的数据集基线，并以表格格式返回结果。

• 我们随后转向DataExplorer包，以深入了解开盘和收盘总额（也称为开盘和收盘上下波动），该包以表格和视觉格式返回了结果组合。

• 最后，当我们需要初步了解开盘和收盘点数差时，我们展示了SmartEDA包。

DataExplorer和SmartEDA包特别令人愉快的是，它们将我们随后手动演示的多个 EDA 命令聚合到一个单一操作中，然后将结果输出到一个独立的 HTML 文件。

然而，总的来说，如果我们只能选择其中之一，我们更喜欢手动 EDA 而不是自动化 EDA，因为手动 EDA 可以更好地控制内容，并且需要更多的脑力。在第二章中，我们计算了基本统计量，然后创建了一系列可视化——一个直方图、一个相关矩阵以及几个箱线图、条形图和分面图，以最好地理解我们的数据与职业生涯胜利份额之间的关联。

在第五章中，我们绘制了箱线图，覆盖散点图和直方图，以帮助我们识别（然后移除）数据中的异常值；密度图帮助我们确定我们的变量是否呈正态分布；以及一个相关矩阵来隔离最佳候选预测因子，为即将到来的线性模型做准备（也参见 20.4 节）。

在第六章中，我们完全依赖基本的数据分析和数据可视化技术来表明，比赛通常不是在第四季度赢得的，正如几十年来传统思维所暗示的那样，但实际上，比赛往往是在第三季度赢得的。

在第十章中，我们创建了相关性图（并计算了相关系数）来显示球队薪资和常规赛胜利之间存在正相关；按三个赛季结束分类进行分组的点图，以显示薪资最高的球队赢得冠军并通常有资格参加季后赛，而薪资最低的球队通常无法进入季后赛；以及棒棒糖图，作为条形图的替代品，它显示了薪资和赛季结束处置之间的更明确关联，尤其是在 2006 赛季之后。

在第十四章中，我们使用了多种 EDA 技术，甚至在运行统计测试之前就得到了结果，这表明防守和进攻在赢得比赛和冠军方面贡献几乎相等，而不是防守比进攻更重要。

最后，这让我们回到了第一章，特别是这本书的预期工作方式。从一开始，我们的目标就是通过 R 编程语言提供一种不同——但更有效、更有趣——的学习统计方法。尽管有数百个网站和几本书详细介绍了如何总结数据或创建ggplot2条形图或拟合线性回归，但没有一本书解释如何将非常不同、看似无关的技术结合起来，并提供可操作见解。没有数据总结项目、数据可视化项目或线性回归项目，但每个现实世界中的项目都需要你具有预见性和谨慎地逻辑和顺序地应用这些以及其他技术的组合。例如，你的数据首先必须被总结——也许还需要进行转置和整理——以精确的格式使用，然后作为固定图表的来源或运行合适的统计测试。

最有说服力的方式是将你的结果可视化，如果可能的话。我们的可视化旨在一方面保持低调，另一方面始终保持专业水准。创建能够让你的读者轻松得出至少两个或三个关键结论的图表，比用美学来眩惑他们要重要得多。我们展示了如何创建大量可视化，其中许多——如树状图、桑基图、金字塔图、分面图、克利夫兰点图和洛伦兹曲线，仅举几例——都属于非主流。我们的意图并不是要与众不同，而是要展示这些以及其他类型的可视化有合适的时间和空间。

最后，虽然你很可能不在分析篮球统计数据这一行，但希望使用 NBA 数据集让学习过程比我们导入打包的数据集或使用模拟数据更加引人入胜。尽管 NBA 数据集有共同的主题，但我们展示的每一项技术都可以完全转移到你的工作中——无论是专业、学术还是其他方面。甚至我们提出的概念，例如从约束优化到最优停止，再到 80-20 法则，几乎在任何一个领域都有无限的应用场景。

现在，让它成为现实吧！

附录：更多 ggplot2 可视化

本附录包含相关性图、点图和棒棒糖图，涵盖了 2002 年至 2017 年的 NBA 赛季——总共增加了 48 个可视化（这也是为什么我们将内容放在这里而不是第十章中的原因）。这些可视化背后的代码没有包括在这里，因为它与第十章中包含的涵盖 2000 年和 2001 赛季的相关性图、点图和棒棒糖图的代码没有实质性区别。否则，图表是按照可视化类型排列，然后按时间顺序排列。