R語言數據預處理操作——離散化(分箱)

# 這裡我們使用的是鳶尾花數據集（iris）
data(iris)
head(iris)

library(dplyr)
library(sqldf)
# 為數據集增加序號列（id）
iris$id <- c(1:nrow(iris))
# 將鳶尾花數據集中70%的數據劃分為訓練集
iris_train <- sample_frac(iris, 0.7, replace = TRUE)
# 使用sql語句將剩下的30%花費為測試集
iris_test <- sqldf("
    select *
    from iris
    where id not in (
    select id
    from iris_train
    )
    ")
# 去除序號列（id）
iris_train <- iris_train[,-6]
iris_test <- iris_test[,-6]

# 導入無監督分箱包——infotheo
library(infotheo)
# 分成幾個區域
nbins <- 3 

### 等寬分箱的原理非常簡單，就是按照相同的間距將數據分成相應的等分
# 將連續型數據分成三份，並以1、2、3賦值
equal_width <- discretize(iris_train$Sepal.Width,"equalwidth",nbins)
### 查看分箱情況
# 查看各分類數量
table(equal_width)
# 用顏色表明是等寬分箱
plot(iris_train$Sepal.Width, col = equal_width$X)
### 保存每個等分切割點的值（闕值）
# 計算各個分類相應的切割點
width <- (max(iris_train$Sepal.Width)-min(iris_train$Sepal.Width))/nbins
# 保存闕值
depreciation <- width * c(1:nbins) + min(iris_train$Sepal.Width)

### 等頻分箱是將數據均勻的分成相應的等分（數量不一定是完全相同的）
# 將連續型數據分成三份，並以1、2、3賦值
equal_freq <- discretize(iris_train$Sepal.Width,"equalfreq",nbins)
### 查看分箱情況
# 查看各分類數量
table(equal_width)
# 用顏色表明是等頻分箱
plot(iris_train$Sepal.Width, col = equal_freq$X)
### 保存每個等分切割點的值（闕值）
data <- iris_train$Sepal.Width[order(iris_train$Sepal.Width)]
depreciation <- as.data.frame(table(equal_freq))$Freq

# kmeans分箱法，先給定中心數，將觀察點利用歐式距離計算與中心點的距離進行歸類，再重新計算中心點，直到中心點# 不再發生變化，以歸類的結果做為分箱的結果。
# 將連續型數據分成三份，並以1、2、3賦值
k_means <- kmeans(iris_train$Sepal.Width, nbins)
# 查看各分類數量
table(k_means$cluster)
# 查看實際分箱狀況
k_means$cluster
# 保存闕值
# rev() 的作用是倒置數據框
# 統一從左往右，從大到小
depreciation <- rev(k_means$centers)

### 有監督的數據離散化
library(discretization)# 有監督分箱
# 使用ChiMerge算法基於卡方檢驗進行自下而上的合並
chi1 <- chiM(iris_train, alpha = 0.05) # alpha 為顯著性指標
apply(chi1$Disc.data,2,table)
# 保存闕值
depreciation <- chi1$cutp[[2]]
## 其他有監督分享算法
# chi2 <- chi2(iris,alp=0.5,del=0.05) # chi2()算法
# chi3 <- modChi2(iris,alp=0.5)  # modChi2()算法
# chi4 <- extendChi2(iris,alp = 0.5) # extendChi2()算法
# m1 <- mdlp(iris)     # 使用熵準則將最小描述長度作為停止規則來離散化
# d1 <- disc.Topdown(iris,method=1) # 該功能實現瞭三種自上而下的離散化算法（CAIM，CACC，Ameva）

# 分箱前數據準備
library(smbinning) 
# 查看測試用例
head(smbsimdf1)

# 使用smbinning函數進行分箱，df 為原始數據，y表示目標標簽，x表示需要分箱的標簽result <- smbinning(df = smbsimdf1,y = "fgood",x = "cbs1") 
# 查看分箱結果的分佈情況，不良率和證據權重
par(mfrow=c(2,2))
boxplot(smbsimdf1$cbs1~smbsimdf1$fgood,horizontal=T, frame=F, col="lightgray",main="Distribution")
smbinning.plot(result,option="dist")
smbinning.plot(result,option="badrate")
smbinning.plot(result,option="WoE")

result$ivtable # 相關重要信息
result$ctree # 決策樹
result$cuts # 闕值
smbinning.sql(result) # 輸出相應的sql語句

# 使用訓練好的函數對數據進行分箱（訓練集和測試集都需要）
smbsimdf1 <- smbinning.gen(smbsimdf1, result, chrname = "gcbs1")
# 查看分箱情況
table(smbsimdf1$gcbs1)

### 對測試集進行分箱操作
# 使用之前保存的闕值
# 這裡之所以要前後加上Inf，是為瞭讓它的范圍能夠向正負無窮延伸
# (-Inf, a],[b, Inf)
break1<-c(-Inf,depreciation,Inf)
labels = c("差", "中", "良", "優")
# 第一個值是數據
# 第一個值是分箱的區間
# 第三個值是替換成的數
# ordered_result表示被替換成的數是否有前後順序
iris_test$Sepal.Width <- cut(iris_test$Sepal.Width,break1,labels,ordered_result = T)
iris_test$Sepal.Width