R语言学习：行去重、时间处理、棒棒糖图、快捷键、模型可解释性

专题介绍：R是一种广泛用于数据分析和统计计算的强大语言，于上世纪90年代开始发展起来。得益于全世界众多爱好者的无尽努力，大家继而开发出了一种基于R但优于R基本文本编辑器的R Studio（用户的界面体验更好）。也正是由于全世界越来越多的数据科学社区和用户对R包的慷慨贡献，让R语言在全球范围内越来越流行。其中一些R包，例如MASS，SparkR， ggplot2，使数据操作,可视化和计算功能越来越强大。R是用于统计分析、绘图的语言和操作环境。R是属于GNU系统的一个自由、免费、源代码开放的软件，它是一个用于统计计算和统计制图的优秀工具。R作为一种统计分析软件，是集统计分析与图形显示于一体的。它可以运行于UNIX、Windows和Macintosh的操作系统上，而且嵌入了一个非常方便实用的帮助系统，相比于其他统计分析软件，R的学术性开发比较早，适合生物学和医学等学术学科的科研人员使用。

2021年第34周。

这一周R语言学习，记录如下。

行去重操作

在一个实际数据项目，获取数据后，发现数据的行（样本）有重复，需要把重复行删除掉。

dplyr包distinct()函数，可以做行去重。

# dplyr包
library(dplyr)
data <- data.frame(Column1 = c('P1', 'P1', 'P2', 'P3', 'P1', 'P1', 'P3', 'P4', 'P2', 'P4'), 
                  Column2 = c(5, 5, 3, 5, 2, 3, 4, 7, 10, 14))
dim(data)
# 删除重复的行
# 使用distinct()函数
data1 <- data %>% distinct()
dim(data1)

时间处理操作

想知道，今日是属于这一年第几周，利用lubridate包的week函数。

# 计算今天属于第几周
library(lubridate)
paste0(Sys.Date(), 
       '是', 
       year(Sys.Date()),
       '第',
       formatC(week(Sys.Date()), flag = '0', width = 2),
       '周')

棒棒糖图

小时候，大家都吃过棒棒糖。

利用棒棒糖图，表示类别之间的对比关系，类似条形图，使用了线和点组合而成。

# 加载R包
library(pacman)
p_load(ggalt, tidyverse, tidyquant)

# 数据集
mpg
str(mpg)

# 数据准备
mpg_by_class_tbl <- mpg %>% 
  group_by(class) %>% 
  summarise(mean_hwy = mean(hwy, na.rm = TRUE)) %>% 
  mutate(class = fct_reorder(class, mean_hwy))

mpg_by_class_tbl  

# 数据可视化
g1 <- mpg_by_class_tbl %>% 
  ggplot(aes(x=mean_hwy, y=class)) +
  geom_lollipop(
    horizontal = TRUE,
    point.colour = 'dodgerblue',
    point.size = 10,
    color = '#2c3e50',
    size = 1
  )

g1

# 添加Label
g2 <- g1 + 
  geom_label(
    aes(label = str_glue("Vehicle Class: {toupper(class)}
                     mpg: {round(mean_hwy)}")),
    size = 3,
    hjust = 'outward',
    nudge_x = 2
  ) +
  expand_limits(x = 45) +
  labs(
    title = "Vehicle Flue Economy lollipop Plot",
    x = 'Fuel Economy (MPG)',
    y = 'Vehicle Class'
  ) +
  theme_tq() +
  theme(
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank(),
    panel.grid.major.y = element_blank(),
    axis.ticks = element_blank(),
    panel.border = element_blank()
  )
g2

可视化图形

参考资料：

https://www.r-bloggers.com/2021/08/ggalt-make-a-lollipop-plot-to-compare-categories-in-ggplot2/

快捷键

R语言代码常用快捷键

赋值符号 Ctrl+-

管道符号 Ctrl+Shift+M

注释操作 Ctrl+Shift+C

执行选择的 R代码 Ctrl+Enter

屏蔽警告信息和不采用科学计数法

写代码之前，用options()函数做参数设置。

options(warn = -1) # 不显示警告信息
options(scipen = 999) # 不采用科学计数法

tidyverse包学习

阅读书籍《R For Data Science》，选择性阅读。

依据数据科学工作流，结合实际数据任务和项目，学习和应用所需包和函数，提升数据处理的效率。

在线阅读网址：https://r4ds.had.co.nz/

数据可视化，用ggplot2包。

作图模版

类别型变量数据可视化

1）类别型-数值型

条形图或者盒箱图

2）类别型-类别型

mosaicplot图

# R包
library(ggplot2)
library(tidyquant)
# 数据准备
data <- data.frame(result = c('W', 'L', 'L', 'W', 'W', 'L', 'L', 'L', 'W', 'L'),
                   team = c('B', 'D', 'B', 'A', 'D', 'A', 'A', 'D', 'C', 'D'),
                   score = c(18, 38, 29, 28, 32, 55, 22, 48, 33, 12),
                   rebounds = c(15, 5, 9, 10, 15, 8, 9, 12, 11, 10))
head(data)

# 类别型-数值型
# 条形图
ggplot(data, aes(x=reorder(team, team, function(x)-length(x)))) +
  geom_bar(fill='red') +  
  labs(x='Team') + 
  theme_tq()

# 盒箱图
ggplot(data, aes(x=team, y=score)) +  
  geom_boxplot(fill='green') +
  theme_tq()

# 类别型-类别型
# 列联表
counts <- table(data$result, data$team)
counts
mosaicplot(counts, 
           xlab='Match Result', 
           ylab='Team',
           main='Wins by Team', 
           col='orange')

可视化效果

模型的可解释性

实际建模后，业务方或者服务方，很在意模型的可解释性。换而言之，从业务知识，模型是否可以解释。

我所在的金融科技行业，对于模型的解释性，尤为重要。因此我们常用逻辑回归模型和树模型，以及树+集成学习思想而衍生的模型。比如：gbdt，XGBoost， LightGBM，CatBoost等。

lime包对模型的可解释性提供便利。

# 加载R包
library(tidyquant)
library(readxl)
library(h2o)
library(lime)
library(tidyverse)

# 读入数据
hr_data_raw <- read_excel(path = "./raw_data/WA_Fn-UseC_-HR-Employee-Attrition.xlsx")

# 变量类型转换
# 变量要求数值性
# 把字符型变量转换为因子类型
hr_data <- hr_data_raw %>% 
  dplyr::mutate_if(is.character, as.factor) %>% 
  dplyr::select(Attrition, everything())

# 数据结构了解
glimpse(hr_data)

# 模型构建和评价
h2o.init()
h2o.no_progress() # 关闭运行结果的进度条

# 数据集划分
# 训练集-验证集-测试集
hr_data_h2o <- as.h2o(hr_data)
split_h2o <- h2o.splitFrame(hr_data_h2o,
                            c(0.7, 0.15),
                            seed = 1234)
train_h2o <- h2o.assign(split_h2o[[1]], 'train')
valid_h2o <- h2o.assign(split_h2o[[2]], 'valid')
test_h2o <- h2o.assign(split_h2o[[3]], 'test')

# 设置x和y
y <- "Attrition"
x <- setdiff(names(train_h2o), y)

# 运行自动化机器学习
automl_models_h2o <- h2o.automl(
  x = x, 
  y = y,
  training_frame    = train_h2o,
  leaderboard_frame = valid_h2o,
  max_runtime_secs  = 30
)

automl_leader <- automl_models_h2o@leader

# 预测
pred_h2o <- h2o.predict(object = automl_leader, newdata = test_h2o)

# 模型性能分析
test_performance <- test_h2o %>%
  tibble::as_tibble() %>%
  select(Attrition) %>%
  add_column(pred = as.vector(pred_h2o$predict)) %>%
  mutate_if(is.character, as.factor)
test_performance

# 混淆矩阵
confusion_matrix <- test_performance %>%
  table() 
confusion_matrix

# 性能指标
# Performance analysis
tn <- confusion_matrix[1]
tp <- confusion_matrix[4]
fp <- confusion_matrix[3]
fn <- confusion_matrix[2]

accuracy <- (tp + tn) / (tp + tn + fp + fn)
misclassification_rate <- 1 - accuracy
recall <- tp / (tp + fn)
precision <- tp / (tp + fp)
null_error_rate <- tn / (tp + tn + fp + fn)

tibble(
  accuracy,
  misclassification_rate,
  recall,
  precision,
  null_error_rate
) %>% 
  transpose() 

# 模型的可解释性
# 归因分析
# 模型效果很好，如何分析其中的原因

predict_model(x = automl_leader, newdata = as.data.frame(test_h2o[,-1]), type = 'raw') %>%
  tibble::as_tibble()

# 模型解释
explainer <- lime::lime(
  as.data.frame(train_h2o[,-1]), 
  model          = automl_leader, 
  bin_continuous = FALSE)

explanation <- lime::explain(
  as.data.frame(test_h2o[1:10,-1]), 
  explainer    = explainer, 
  n_labels     = 1, 
  n_features   = 4,
  kernel_width = 0.5)

plot_features(explanation) +
  labs(title = "HR Predictive Analytics: LIME Feature Importance Visualization",
       subtitle = "Hold Out (Test) Set, First 10 Cases Shown")