R语言tidyverse数据处理建模案例

管道%>%

左连接left_join()

筛选行 filter(条件)

行排序arrange()

选择列select()

修改(计算)列mutate()

分组汇总group_by()、%>%、summarise() 计数：count()

数据处理案例：

企业上游业务量：

企业上游年均业务量:X1=12×企业上游交易总次数企业数据的月份数X_1 = 12 \times \frac{企业上游交易总次数}{企业数据的月份数}X1=12×企业数据的月份数企业上游交易总次数
企业上游业务量年平均变化率：
KaTeX parse error: Undefined control sequence: \notag at position 88: …数}{企业上游k月交易次数} \̲n̲o̲t̲a̲g̲ ̲

第jjj个企业上游业务量用X1jX_{1j}X1j表示，相应的企业上游业务量变化率用X1j’(j=1,2,⋯,123)X_{1j}^{’}(j=1,2,\cdots,123)X1j’(j=1,2,⋯,123)表示.

企业下游业务量：

企业上游年均业务量:X2=12×企业下游交易总次数企业数据的月份数X_2 = 12 \times \frac{企业下游交易总次数}{企业数据的月份数}X2=12×企业数据的月份数企业下游交易总次数
企业下游业务量年平均变化率：
KaTeX parse error: Undefined control sequence: \notag at position 88: …数}{企业下游k月交易次数} \̲n̲o̲t̲a̲g̲ ̲

第jjj个企业下游业务量用X2jX_{2j}X2j表示，相应的企业上游业务量变化率用X2j’(j=1,2,⋯,123)X_{2j}^{’}(j=1,2,\cdots,123)X2j’(j=1,2,⋯,123)表示.

企业毛利润：

企业年均毛利润X3=12×企业总收益−企业直接总成本企业数据的月份数X_3 = 12 \times \frac{企业总收益 - 企业直接总成本}{企业数据的月份数}X3=12×企业数据的月份数企业总收益−企业直接总成本
企业的年均毛利润变化率:

KaTeX parse error: Undefined control sequence: \notag at position 90: …毛利润}{企业k月的毛利润} \̲n̲o̲t̲a̲g̲ ̲

第jjj个企业下游业务量用X3jX_{3j}X3j表示，相应的企业上游业务量变化率用X3j’(j=1,2,⋯,123)X_{3j}^{’}(j=1,2,\cdots,123)X3j’(j=1,2,⋯,123)表示.

数据处理：

对上游业务量X1jX_{1j}X1j，下游业务量X2jX_{2j}X2j和毛利润率X3jX_{3j}X3j做标准化处理，即
Xij∗=Xij−X‾iσi,i=1,2,3;j=1,2,⋯,123X_{ij}^{*}= \frac{X_{ij}-\overline{X}_{i}}{\sigma_i},i=1,2,3; j= 1,2,\cdots,123 Xij∗=σiXij−Xi,i=1,2,3;j=1,2,⋯,123
企业信贷风险的因素分析

(1)信誉评级量化(D级"一票否决")
第 j (j=1,2,3,…)企业的信誉评级指标: X0j={5，信誉评级为 A 级，3，信誉评级为 B 级，1，信誉评级为 C 级，0，信誉评级为 D 级. \text{第 j }(j=1,2,3,\dots) \text{ 企业的信誉评级指标: }X_{0j} =\begin{cases} 5， \text{ 信誉评级为 A 级，}\\ 3， \text{ 信誉评级为 B 级，}\\ 1，\text{ 信誉评级为 C 级，}\\ 0，\text{ 信誉评级为 D 级. }\\ \end{cases} 第 j (j=1,2,3,…) 企业的信誉评级指标: X0j=⎩⎪⎪⎪⎨⎪⎪⎪⎧5，信誉评级为 A 级，3，信誉评级为 B 级，1，信誉评级为 C 级，0，信誉评级为 D 级.
(2)是否有违约量化(违约"一票否决")
第 j (j=1,2,3,…)企业的信誉评级指标: Y0j={1，企业无违约，0，企业有违约. \text{第 j }(j=1,2,3,\dots) \text{ 企业的信誉评级指标: }Y_{0j} =\begin{cases} 1，\text{ 企业无违约，}\\ 0，\text{ 企业有违约. }\\ \end{cases} 第 j (j=1,2,3,…) 企业的信誉评级指标: Y0j={1，企业无违约，0，企业有违约.
企业信贷风险的量化模型

(1)企业的实力指标

综合实力指标为三项实力指标的动态加权求和：
S=λ1(X1′)X1+λ2(X2′)X2+λ3(X3′)X3S = \lambda_1(X_1^{'})X_1 + \lambda_2(X_2^{'})X_2 + \lambda_3(X_3^{'})X_3 S=λ1(X1′)X1+λ2(X2′)X2+λ3(X3′)X3
动态加权函数取偏大的S型分布：
λi(Xi′)={2−e−3∣Xi′∣,Xi′⩾0e−3∣Xi′∣,Xi′<0(i=1,2,3)\lambda_{i}(X_{i}^{'})=\begin{cases} 2-e^{-3|X_i^{'}|}&,X_i^{'} \geqslant 0\\ e^{-3|X_i^{'}|}&,X_i^{'} < 0 \end{cases} \quad(i= 1,2,3) λi(Xi′)={2−e−3∣Xi′∣e−3∣Xi′∣,Xi′⩾0,Xi′<0(i=1,2,3)
各企业的综合实力指标值：
Sj=λ1(X1j′)X1j+λ2(X2j′)X2j+λ3(X3j′)X3j(j=1,2,…,123)S_j = \lambda_1(X_{1j}^{'})X_{1j} + \lambda_2(X_{2j}^{'})X_{2j} + \lambda_3(X_{3j}^{'})X_{3j} \quad (j = 1,2,\ldots,123) Sj=λ1(X1j′)X1j+λ2(X2j′)X2j+λ3(X3j′)X3j(j=1,2,…,123)
X1′X_1^{'}X1′对应程序中的dfdX1，以此类推.

(2) 企业信誉度指标

企业的信誉度指标由信誉评级和是否有违约构成，即
Cj=X0jY0j(j=1,2,…,123)C_j = X_{0j}Y_{0j}\quad(j = 1,2,\dots,123) Cj=X0jY0j(j=1,2,…,123)

(3) 企业实力+信誉指标

企业的信贷风险由企业的综合实力和信誉指标决定，而且银行对信誉评级为D和有违约记录的企业“一票否决”，则企业的实力+信誉指标：
SCj=CjSj(j=1,2,⋯,123)S_{Cj}=C_jS_j \quad (j=1,2,\cdots,123) SCj=CjSj(j=1,2,⋯,123)
(4) 企业的信贷风险指标

企业的实力和信誉决定了信贷风险，信贷风险与实力+信贷指标不应该是线性关系，不难说明呈S型曲线的关系。

利用生物学中常用的SigmoidSigmoidSigmoid函数:
SCj′={11+e−SCj,当SCj≠0时,0,当SCj=0时(j=1,2,,⋯,123).S_{Cj}{'}=\begin{cases} \frac{1}{1+e^{-S_{Cj}}}&,当 S_{Cj}\ne 0 时,\\ 0&,当S_{Cj}=0时\\ \end{cases} \quad(j=1,2,,\cdots,123). SCj′={1+e−SCj10,当SCj=0时,,当SCj=0时(j=1,2,,⋯,123).
则每个企业的信贷风险指标值：
Rj=1−SCj′∈[0,1](j=1,2,⋯,123)R_j= 1 - S_{Cj}^{'} \in [0,1] \quad(j=1,2,\cdots,123) Rj=1−SCj′∈[0,1](j=1,2,⋯,123)
根据各企业信贷风险值R进行分类，不妨分为四类.事实上，企业的实力+信誉值越高，风险值越低，贷款违约的可能性越小，贷款利率就应越低.

各企业信贷风险的等级分类

信贷风险值	等级分级	企业数	各信誉评级分布
[0,0.2)	1级	63	A级26，B级20，C级20
[0.2,0.5]	2级	6	B级1，C级5
(0.5,1)	3级	27	A级1，B级16，C级10
1	4级	27	B级1，C级2，D级24

代码：

library(tidyverse)
library(readxl)
library(writexl)
library(tsibble) ##使用year、month函数##读取数据
info <- read_xlsx("data/附件1：123家有信贷记录企业的相关数据.xlsx", sheet = 1)
input <- read_xlsx("data/附件1：123家有信贷记录企业的相关数据.xlsx", sheet = 2)
output <- read_xlsx("data/附件1：123家有信贷记录企业的相关数据.xlsx", sheet = 3)##统计发票状态
input %>%count(发票状态)output %>%count(发票状态)## 开票日期列转化成日期型，删除作废发票
input <- input %>%mutate(开票日期 = yearmonth(开票日期)) %>%filter(发票状态 == "有效发票")
inputoutput <- output %>%mutate(开票日期 = yearmonth(开票日期)) %>%filter(发票状态 == "有效发票")
output## 特征工程：构建新特征# 企业上游业务量
dfX1 <- input %>%group_by(企业代号) %>%summarise(X1 = 12 * n() / n_distinct(开票日期))# 企业上游业务量年均变化率 dx1,注意E104总共只有一笔交易dfdX1 <- input %>%group_by(企业代号, 开票日期) %>%summarise(交易量 = n()) %>%mutate(月变化 = 交易量 - lag(交易量),月变化率 = 月变化 / lag(交易量)) %>%summarise(dX1 = 12 * mean(月变化率, na.rm = T))# 企业下游业务量
dfX2 <- output %>%group_by(企业代号) %>%summarise(X2 = 12 * n() / n_distinct(开票日期))# 企业上游业务量年均变化率 dx2dfdX2 <- output %>%group_by(企业代号, 开票日期) %>%summarise(交易量 = n()) %>%mutate(月变化 = 交易量 - lag(交易量),月变化率 = 月变化 / lag(交易量)) %>%summarise(dX2 = 12 * mean(月变化率, na.rm = T))# 企业年均毛利润X3
costs <- input %>%group_by(企业代号) %>%summarise(月份数 = n_distinct(开票日期), 总成本 = sum(金额))sales <- output %>%group_by(企业代号) %>%summarise(总收益 = sum(金额))dfX3 <- costs %>%left_join(sales, by = "企业代号") %>%mutate(X3 = 12 * (总收益 - 总成本) / 月份数) %>%select(-c(月份数, 总成本, 总收益))# 企业年均毛利润变化率dX3
costs_mon <- input %>%group_by(企业代号, 开票日期) %>%summarise(月成本 = sum(金额))sales_mon <- output %>%group_by(企业代号, 开票日期) %>%summarise(月收益 = sum(金额))dfdX3 <- costs_mon %>%left_join(sales_mon, by = c("企业代号", "开票日期")) %>%mutate(月利润 = 月收益 - 月成本) %>%drop_na(月利润) %>%mutate(月变化率 = (月利润 - lag(月利润)) / lag(月利润)) %>%summarise(dX3 = 12 * mean(月变化率, na.rm = T))## 将各个新特征合并到一个表中
df <- list(dfX1, dfdX1, dfX2, dfdX2, dfX3, dfdX3) %>%reduce(left_join, by = "企业代号")write_xlsx(df, "data/企业信贷指标数据.xlsx")## 用各列的均值插补缺失值
df <- df %>%mutate(across(where(is.numeric), ~ ifelse(is.nan(.x), NA, .x)),across(where(is.numeric), ~ naniar::impute_mean(.x)))## 标准化处理
#注：用于数据相差很大时,可以避免归一化"大数吃小数"
df <- df %>%mutate(across(starts_with("X"), ~ (.x - mean(.x)) / sd(.x)))
df## 企业实力指标：动态加权
# 注意，只有相互独立的指标才可以线性相加
SType = function(x) {ifelse(x >= 0, 2 - exp(-3 * abs(x)), exp(-3 * abs(x)))
}ggplot() +xlim(-1, 1) +geom_function(fun = SType)df <- df %>%mutate(S = SType(dX1) * X1 + SType(dX2) * X2 + SType(dX3) * dX3)
df## 企业信誉度指标
rating <- info %>%mutate(X0 = case_when(信誉评级 == "A" ~ 5,信誉评级 == "B" ~ 3,信誉评级 == "C" ~ 1,信誉评级 == "D" ~ 0,),Y0 = ifelse(是否违约 == "是", 0, 1),C = X0 * Y0) %>%select(企业代号, 信誉评级, C)
rating## 企业实力 + 信誉综合指标
scores <- rating %>%left_join(df, by = "企业代号") %>%mutate(Sc = C * S)
scores
summary(scores$Sc)##企业信贷风险指标
Sigmoid = function(x) {ifelse(x != 0, 1 / (1 + exp(-x)), 0)
}ggplot() +xlim(-8, 8) +geom_function(fun = Sigmoid)scores <- scores %>%mutate(R = 1 - Sigmoid(Sc))
scores## 散点图
scores %>%mutate(企业代号 = parse_number(企业代号)) %>%ggplot(aes(企业代号, R)) +geom_point()
final <- scores %>%select(企业代号, 信誉评级, R) %>%mutate(等级分级 = case_when(R < 0.2 ~ "1级",R <= 0.5 ~ "2级",R < 1 ~ "3级",R == 1 ~ "4级"))
## 统计分组频数
final %>%count(等级分级)
final %>%count(等级分级, 信誉评级) %>%pivot_wider(names_from = 信誉评级, values_from = n)## 机器学习模型
df <- df %>%left_join(info, by = "企业代号") %>%rename(default = 是否违约, Rank = 信誉评级) %>%mutate(default = factor(default), Rank = factor(Rank))library(mlr3verse) #此包不支持中文变量名,字符型变量需要变为因子## 创建分类任务
task <- as_task_classif(df[-c(1, 8:9)], target = "Rank")## 选择学习器,并设置两个超参数：最大深度，最小分支节点
learner <- lrn("classif.ranger", num.trees = 200, min.node.size = 20)## 划分训练集,测试集
set.seed(123)
split <- partition(task, ratio = 0.8) #80%为训练集## 训练模型
learner$train(task, row_ids = split$train)## 模型预测
predictions <- learner$predict(task, row_ids = split$test)## 模型评估
predictions$confusion #混淆矩阵
predictions$score(msr("classif.acc")) #准确率#建议将信誉等级B和C合并变成一类

本文章内容为张敬信老师B站视频学习笔记

R语言tidyverse数据处理建模案例相关推荐

r语言提取列名_玩转数据处理120题之P1-P20（R语言tidyverse版本）
前言今天在微信公众号[早起Python],看到有篇文章叫做[玩转数据处理120题],最初来自[Pandas进阶修炼120题],作者刘早起开始是用pandas实现的,后来又加入了中山大学博士陈熹的R语 ...
[R语言基础]——数据处理实例
[R语言基础]--数据处理实例前言问题 Step1:建立数据框 Step2:计算综合得分 Step3:对学生进行评分 Step4:根据姓氏和名字排序完整代码前言之前我们已经学习了R对数据预处 ...
大数据分析R语言tidyverse数据清洗工具教程
凌乱的数据集无处不在.如果要分析数据,不可避免地需要清理数据.在大数据分析R语言tidyverse数据清洗工具教程中,我们将研究如何使用R和一些漂亮的tidyverse工具来做到这一点. 该tidyv ...
R语言cox回归模型案例（绘制列线图、校正曲线）：放疗是否会延长胰脏癌手术患者的生存时间
R语言cox回归模型案例(绘制列线图.校正曲线):放疗是否会延长胰脏癌手术患者的生存时间目录
R语言Logistic回归模型案例基于AER包的affair数据分析
R语言Logistic回归模型案例基于AER包的affair数据目录 R语言Logistic回归模型案例基于AER包的affair数据 #数据加载及目标变量二值化
R语言Logistic回归模型案例:低出生婴儿体重的影响因素分析（列线图、校准曲线）
R语言Logistic回归模型案例:低出生婴儿体重影响因素分析(列线图.校准曲线) 目录 R语言Logistic回归模型案例:低出生婴儿体重影响因素分析(列线图.校准曲线ÿ
R语言Logistic回归模型案例:分析吸烟、饮酒与食管癌的关系
R语言Logistic回归模型案例:分析吸烟.饮酒与食管癌的关系目录 R语言Logistic回归模型案例分析吸烟.饮酒与食管癌的关系 #样例数据
R语言Logistic逐步回归模型案例：分析与冠心病有关的危险因素
R语言Logistic逐步回归模型案例:分析与冠心病有关的危险因素目录 R语言Logistic逐步回归模型案例:分析与冠心病有关的危险因素
R语言泊松回归模型案例:基于AER包的affair数据分析
R语言泊松回归模型案例:基于AER包的affair数据分析目录 R语言泊松回归模型案例基于AER包的affair数据分析 #数据加载

R语言tidyverse数据处理建模案例

R语言tidyverse数据处理建模案例相关推荐

最新文章

热门文章