R语言台湾银行还款预测数据预处理距离判别（懒得再打一遍了，源文件再主页有）

本文链接：https://blog.csdn.net/carrymybaby/article/details/120984849

2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

1/15

第四次大作业

朱翔宇

要求：

1 、对数据进行统计分析，观察他们在分布情况，样本数据的特点 ;

2 、数据预处理：判断数据中是否存在空缺值、是否某些特征需要哑变量处理、是否需要将某些维数据进行归一

化 ;

3 、分别建立距离判别 ( 等方差和不等方差阵 ) 、线性判别和 Bayes 判别分析模型，计算各自的判别符合率，以判定

那种判别方法更恰当。

4 、针对 1 的分析，如果出现样本分布不均，思考如何优化 ?

第一步：读取数据

In [1]:



In [2]:



In [3]:



In [4]:



In [5]:



In [6]:



credit_data <- read.csv( 'C:/Users/HUAWEI/Desktop/第四次实验多元统计/default of credit card clients.

credit_data.new <- credit_data[,c( 'ID' , 'LIMIT_BAL' , 'AGE' , 'PAY_1' , 'PAY_2' , 'PAY_3' , 'PAY_4' , 'PAY_5' , 'PA

#SEX哑变量处理

credit_data.new $ SEX.man <- ifelse(credit_data $ SEX == '1' , 1 , 0 ) # SEX.man中1表示男性

credit_data.new $ SEX.women <- ifelse(credit_data $ SEX == '2' , 1 , 0 )

#EDUCATION的哑变量处理

credit_data.new $ EDUCATION.yanjiusheng <- ifelse(credit_data $ EDUCATION == '1' , 1 , 0 ) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

2/15

In [7]:



In [8]:



In [9]:



In [10]:



In [11]:



In [12]:



In [13]:



先知道了解各个字段的含义，进行人工分析。

性别、婚姻状况、教育水平都是需要进行哑变量处理的

A data.frame: 6 × 30

ID LIMIT_BAL

AGE PAY_1 PAY_2

PAY_3

PAY_4

PAY_5 PAY_6 BILL_AMT1 ... PAY

<int>

<int> <int>

<int>

<int> ...

20000

-1

-2

3913

...

120000

-1

2682

...

90000

29239

...

50000

46990

...

50000

-1

8617

...

50000

64400

...

credit_data.new $ EDUCATION.daxue <- ifelse(credit_data $ EDUCATION == '2' , 1 , 0 )

credit_data.new $ EDUCATION.gaozhong <- ifelse(credit_data $ EDUCATION == '3' , 1 , 0 )

credit_data.new $ EDUCATION.qita <- ifelse(credit_data $ EDUCATION == '4' , 1 , 0 )

#'MARRIAGE',的哑变量处理

credit_data.new $ MARRIAGE.jiele <- ifelse(credit_data $ MARRIAGE == '1' , 1 , 0 )

credit_data.new $ MARRIAGE.danshen <- ifelse(credit_data $ MARRIAGE == '2' , 1 , 0 )

head(credit_data.new) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

3/15

有些全都是 0 的 BILL_ 会影响判断，需要删除

ID ：每个客户的 ID

LIMIT_BAL 限额余额：以新台币为单位的信用证金额（包括个人和家庭 / 补充信用证）

SEX 性别：性别（ 1= 男性， 2= 女性）

EDUCATION 教育：（ 1= 研究生院， 2= 大学， 3= 高中， 4= 其他， 5= 未知， 6= 未知）

MARRIAGE 婚姻：婚姻状况（ 1= 已婚， 2= 单身， 3= 其他）

AGE 年龄：岁

Pay_0:2005 年 9 月还款情况（ -2= 无消费， -1= 全额支付， 0= 循环信用证的使用（仅支付最低金额）， 1= 一个月的

付款延迟， 2= 延迟付款两个月， …8= 八个月的付款延迟， 9= 九个月及以上的付款延迟）

Pay_2 ： 2005 年 8 月还款情况（规模同上）

Pay_3:2005 年 7 月还款情况（规模同上）

Pay_4 ： 2005 年 6 月还款情况（规模同上）

Pay_5:2005 年 5 月还款情况（规模同上）

Pay_6 ： 2005 年 4 月还款情况（规模同上）

BILL_AMT1 汇票金额 1:2005 年 9 月对账单金额（新台币）

BILL_AMT2 汇票金额 2 ： 2005 年 8 月对账单金额（新台币）

BILL_AMT3 汇票金额 3 ： 2005 年 7 月对账单金额（新台币）

BILL_AMT4 汇票金额 4 ： 2005 年 6 月对账单金额（新台币）

BILL_AMT5 汇票金额 5 ： 2005 年 5 月对账单金额（新台币）

BILL_AMT6 汇票金额 6 ： 2005 年 4 月对账单金额（新台币）

PAY_AMT1 支付金额 1:2005 年 9 月以前支付金额（新台币）

PAY_AMT2 支付金额 2 ： 2005 年 8 月以前支付金额（新台币）

PAY_AMT3 支付金额 3 ： 2005 年 7 月以前支付金额（新台币）

PAY_AMT4 支付金额 4 ： 2005 年 6 月以前支付金额（新台币）

PAY_AMT5 支付金额 5 ： 2005 年 5 月以前支付金额（新台币） 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

4/15

PAY_AMT6 支付金额 6 ： 2005 年 4 月以前支付金额（新台币）

是否逾期 default.payment.next.month: （ 1= 是， 0= 否）

----------------------------------------------------------------------------------------------------------------------

显示数据结构

In [14]:



ID 这一列并不影响预测，所以删了 , 留下了 y 和哑变量后的 28 个可能相关变量

'data.frame':

30000 obs. of 30 variables:

$ ID : int 1 2 3 4 5 6 7 8 9 10 ...

$ LIMIT_BAL : int 20000 120000 90000 50000 50000 50000 500000 100000 14

0000 20000 ...

$ AGE : int 24 26 34 37 57 37 29 23 28 35 ...

$ PAY_1 : int 2 -1 0 0 -1 0 0 0 0 -2 ...

$ PAY_2 : int 2 2 0 0 0 0 0 -1 0 -2 ...

$ PAY_3 : int -1 0 0 0 -1 0 0 -1 2 -2 ...

$ PAY_4 : int -1 0 0 0 0 0 0 0 0 -2 ...

$ PAY_5 : int -2 0 0 0 0 0 0 0 0 -1 ...

$ PAY_6 : int -2 2 0 0 0 0 0 -1 0 -1 ...

$ BILL_AMT1 : int 3913 2682 29239 46990 8617 64400 367965 11876 11285 0

...

$ BILL_AMT2 : int 3102 1725 14027 48233 5670 57069 412023 380 14096 0

...

$ BILL_AMT3 : int 689 2682 13559 49291 35835 57608 445007 601 12108 0

...

$ BILL_AMT4 : int 0 3272 14331 28314 20940 19394 542653 221 12211 0 ...

$ BILL_AMT5 : int 0 3455 14948 28959 19146 19619 483003 -159 11793 1300

7 ...

$ BILL_AMT6 : int 0 3261 15549 29547 19131 20024 473944 567 3719 13912

...

$ PAY_AMT1 : int 0 0 1518 2000 2000 2500 55000 380 3329 0 ...

$ PAY_AMT2 : int 689 1000 1500 2019 36681 1815 40000 601 0 0 ...

$ PAY_AMT3 : int 0 1000 1000 1200 10000 657 38000 0 432 0 ...

$ PAY_AMT4 : int 0 1000 1000 1100 9000 1000 20239 581 1000 13007 ...

$ PAY_AMT5 : int 0 0 1000 1069 689 1000 13750 1687 1000 1122 ...

$ PAY_AMT6 : int 0 2000 5000 1000 679 800 13770 1542 1000 0 ...

$ dpnm : int 1 1 0 0 0 0 0 0 0 0 ...

$ SEX.man : num 0 0 0 0 1 1 1 0 0 1 ...

$ SEX.women : num 1 1 1 1 0 0 0 1 1 0 ...

$ EDUCATION.yanjiusheng: num 0 0 0 0 0 1 1 0 0 0 ...

$ EDUCATION.daxue : num 1 1 1 1 1 0 0 1 0 0 ...

$ EDUCATION.gaozhong : num 0 0 0 0 0 0 0 0 1 1 ...

$ EDUCATION.qita : num 0 0 0 0 0 0 0 0 0 0 ...

$ MARRIAGE.jiele : num 1 0 0 1 1 0 0 0 1 0 ...

$ MARRIAGE.danshen : num 0 1 1 0 0 1 1 1 0 1 ...

str(credit_data.new) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

5/15

In [15]:



处理缺失值

In [16]:



In [17]:



A data.frame: 6 × 29

x10 ...

x20

x21

<int> <int> <int> <int> <int> <int> <int> <int>

<int>

<int> ... <int> <int> <dbl>

20000

-1

-2

3913

3102

...

120000

-1

2682

1725

...

2000

90000

0 29239

14027

...

5000

50000

0 46990 48233

...

1000

50000

-1

8617

5670

...

679

50000

0 64400 57069

...

800

载入程辑包：'mice'

The following object is masked from 'package:stats':

filter

The following objects are masked from 'package:base':

cbind, rbind

cr_data <- credit_data.new[, 2 : 30 ]

names(cr_data) <- c( 'x1' , 'x2' , 'x3' , 'x4' , 'x5' , 'x6' , 'x7' , 'x8' , 'x9' , 'x10' , 'x11' , 'x12' , 'x13' , 'x14' , 'x15'

head(cr_data)

library(lattice)

library(mice) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

6/15

In [18]:



从中发现并没有缺失值。。。。

从年龄角度分析，将 18 到 65 岁以外的数据删除

/\ /\

{ `---' }

{ O O }

==> V <== No need for mice. This data set is completely observed.

\ \|/ /

`-----'

A matrix: 2 × 30 of type dbl

x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 ... y x21 x22 x23 x24 x25 x26 x27 x28

30000

1 ... 1

1 0

... 0

0 0

md.pattern(cr_data) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

7/15

In [19]:



In [20]:



检查数据

boxplot(cr_data $ x2)

cr_data <- cr_data[cr_data $ x2 <= 65 & cr_data $ x2 >= 18 ,] 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

8/15

In [21]:



有些全都是 0 的 BILL_ 会影响判断，需要删除

In [22]:



建模分析

检验变量之间的相关性 , 如果变量之间具有强相关性 , 则会影响模型的准确性。

In [23]:



$stats

21 · 28 · 34 · 41 · 60

29914

$conf

33.8812419126171 · 34.1187580873829

$out

63 · 61 · 61 · 62 · 63 · 61 · 64 · 61 · 65 · 65 · 62 · 63 · 62 · 65 · 62 ·

63 · 64 · 64 · 63 · 65 · 64 · 63 · 61 · 61 · 63 · 62 · 62 · 61 · 64 · 62 ·

62 · 61 · 61 · 63 · 62 · 63 · 64 · 64 · 61 · 61 · 62 · 65 · 63 · 64 · 62 ·

62 · 61 · 65 · 65 · 61 · 63 · 64 · 61 · 62 · 61 · 61 · 61 · 63 · 62 · 62 ·

65 · 64 · 61 · 63 · 63 · 61 · 63 · 62 · 65 · 63 · 63 · 62 · 61 · 62 · 64 ·

61 · 62 · 61 · 61 · 62 · 64 · 65 · 64 · 62 · 65 · 62 · 64 · 63 · 61 · 62 ·

64 · 62 · 61 · 64 · 62 · 62 · 61 · 65 · 63 · 63 · 63 · 61 · 62 · 64 · 62 ·

61 · 65 · 61 · 63 · 61 · 61 · 61 · 62 · 64 · 62 · 61 · 64 · 62 · 64 · 61 ·

62 · 62 · 61 · 63 · 62 · 61 · 62 · 62 · 62 · 61 · 64 · 64 · 61 · 62 · 63 ·

65 · 61 · 61 · 63 · 61 · 64 · 64 · 64 · 65 · 63 · 64 · 65 · 65 · 62 · 64 ·

62 · 61 · 65 · 65 · 61 · 61 · 61 · 61 · 63 · 61 · 61 · 65 · 63 · 61 · 63 ·

61 · 65 · 61 · 63 · 62 · 64 · 62 · 62 · 65 · 62 · 63 · 64 · 61 · 65 · 64 ·

65 · 61 · 61 · 61 · 61 · 64

corrplot 0.90 loaded

boxplot.stats(cr_data $ x2)

cr_data <- cr_data[cr_data $ x9 != 0 & cr_data $ x10 != 0 & cr_data $ x11 != 0 & cr_data $ x12 != 0 & cr_d

library(corrplot) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

9/15

In [24]:



In [25]:



上图可知：变量之间的相关系数较小，不存在明显的多重共线问题，当然，有些颜色较深的是可以进行模型归一

化处理的

切分数据集

In [26]:



y 等于 1 为 2130 ，等于 0 为 13160 ，两者不平衡，于是我们对非平衡数据进行处理，调用 R 语言中 caret 包中的

createDataPartition 对数据进行超级采样

0 1

13160 2130

cor1 <- cor(cr_data)

corrplot(cor1,method = 'number' )

table(cr_data $ y) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

10/15

In [27]:



In [ ]:



切分数据集

In [28]:



In [29]:



In [30]:



In [31]:



In [32]:



In [33]:



载入需要的程辑包：ggplot2

The following objects are masked from traindata:

x1, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x2, x20, x21,

x22, x23, x24, x25, x26, x27, x28, x3, x4, x5, x6, x7, x8, x9, y

library(caret)

set.seed( 500 )

splitindex <- createDataPartition(cr_data $ y,times = 1 ,p = 0.5 , list = FALSE )

traindata <- cr_data[splitindex,]

testdata <- cr_data[ - splitindex,]

attach(traindata)

attach(testdata) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

11/15

In [34]:



In [35]:



由上面数据可知，两者分类后的结果是平衡的

进行建模分析

In [36]:



0 1

0.8579464 0.1420536

0 1

0.8634402 0.1365598

prop.table(table(traindata $ y))

prop.table(table(testdata $ y))

fit = glm(y ~ .,data = traindata,family = "binomial" ) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

12/15

In [37]:



从中可以看出， x1,x3,x4,x21,x5,x11,x23,x24 对响应变量 y 的贡献显著 , 尝试删除其他变量，然后进行判别

距离判别：

Call:

glm(formula = y ~ ., family = "binomial", data = traindata)

Deviance Residuals:

Min 1Q Median 3Q Max

-1.8988 -0.5781 -0.4833 -0.3105 2.9681

Coefficients: (1 not defined because of singularities)

Estimate Std. Error z value Pr(>|z|)

(Intercept) -2.499e+00 5.279e-01 -4.734 2.20e-06 ***

x1 -2.310e-06 3.808e-07 -6.065 1.32e-09 ***

x2 2.988e-04 4.317e-03 0.069 0.944814

x3 9.224e-01 5.385e-02 17.131 < 2e-16 ***

x4 -4.281e-01 9.306e-02 -4.600 4.22e-06 ***

x5 2.956e-01 9.131e-02 3.237 0.001208 **

x6 -2.316e-01 1.129e-01 -2.051 0.040290 *

x7 4.961e-02 1.280e-01 0.387 0.698387

x8 1.216e-01 1.064e-01 1.143 0.252935

x9 -1.139e-06 1.783e-06 -0.639 0.522996

x10 -1.028e-06 2.464e-06 -0.417 0.676480

x11 6.405e-06 2.271e-06 2.821 0.004788 **

x12 -1.227e-06 2.042e-06 -0.601 0.547888

x13 8.015e-07 2.402e-06 0.334 0.738605

x14 -2.999e-06 1.880e-06 -1.595 0.110791

x15 -7.576e-06 3.256e-06 -2.327 0.019967 *

x16 -3.531e-06 2.679e-06 -1.318 0.187472

x17 3.840e-06 2.137e-06 1.796 0.072419 .

x18 1.958e-06 2.606e-06 0.751 0.452353

x19 4.047e-06 2.521e-06 1.605 0.108470

x20 1.005e-06 1.878e-06 0.535 0.592554

x21 2.336e-01 7.073e-02 3.303 0.000957 ***

x22 NA NA NA NA

x23 1.166e+00 4.214e-01 2.767 0.005649 **

x24 1.114e+00 4.187e-01 2.660 0.007804 **

x25 1.092e+00 4.241e-01 2.575 0.010018 *

x26 -1.232e+01 2.445e+02 -0.050 0.959798

x27 -8.989e-02 2.785e-01 -0.323 0.746907

x28 -4.245e-01 2.821e-01 -1.505 0.132418

---

Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

(Dispersion parameter for binomial family taken to be 1)

Null deviance: 6248.6 on 7644 degrees of freedom

Residual deviance: 5637.2 on 7617 degrees of freedom

AIC: 5693.2

Number of Fisher Scoring iterations: 14

summary(fit) 2021/10/27

上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

13/15

距离判别：

In [38]:



In [39]:



In [40]:



In [41]:



In [42]:



距离判别的符合度约为 0.87

Fisher 判别

In [43]:



Call:

qda(y ~ x1 + x3 + x4 + x21)

Prior probabilities of groups:

0 1

0.8634402 0.1365598

Group means:

x1 x3 x4 x21

0 193341.9 -0.2493562 -0.26708075 0.3981215

1 144509.3 0.4252874 0.08045977 0.4377395

y 0 1

0 6304 297

1 693 351

0.870503597122302

library(MASS)

pd = qda(y ~ x1 + x3 + x4 + x21)

(tab = table (y,predict(pd) $ class))

sum(diag(prop.table(tab)))

lbl = lda(y ~ x1 + x3 + x4 + x21) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

14/15

In [44]:



In [45]:



In [46]:



Fisher 判别的符合度约为 0.8743

Bayes 判别

In [47]:



In [48]:



In [49]:



In [50]:



Bayes 判别的符合度约为 0.876

综上所述，贝叶斯判别的符合度更高，为 0.876

针对①的分析，如果出现样本分布不均，思考如何优化？

首先通过查阅资料，知道了样本的正负不均衡和模型学不好没有一定的联系。

0.874296926095487

0.875604970568999

zl = predict(lbl)

tab = table(y,predict(lbl) $ class)

sum(diag(prop.table(tab)))

lbl = lda(y ~ x1 + x3 + x4 + x21,prior = c( 13 , 7 ) / 20 )

zl = predict(lbl)

tab = table(y,predict(lbl) $ class)

sum(diag(prop.table(tab))) 2021/10/27 上午 1:10

Untitled48 - Jupyter Notebook

localhost:8888/notebooks/Desktop/Untitled48.ipynb#

15/15

1. 大数据集存在分布不均衡。整体数据规模大，小样本占比较小，但是小样本也覆盖了大部分或者全部特

征。

2. 小数据集存在分布不均衡。整体数据规模小，少数样本比例的分类数量也少，导致特征分布严重不均衡。

优化的方法有：扩大训练集、重新选择评价指标、重采样数据集、产生人工数据样本、尝试不同的分类算法、对

模型进行惩罚、尝试一个新的角度理解问题

针对这个数据集，发现 x1,x3,x4,x21 是对准确率影响最大的变量，也就是年龄、限额余额、性别，本次实验中，

对年龄做了处理，就是将 18 岁一下， 65 岁以上的人删除，这可以提高数据的可信度，若要继续优化，可以在 18 到

65 这个年龄段中均匀采样，得到的数据集再进行分析，其他两个变量也是一样，进行均匀抽样分析。

In [ ]:



R语言 台湾银行还款预测 数据预处理 距离判别（懒得再打一遍了，源文件再主页有）

R语言台湾银行还款预测数据预处理距离判别（懒得再打一遍了，源文件再主页有）