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

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

# 導(dǎo)入無監(jiān)督分箱包——infotheo
library(infotheo)
# 分成幾個(gè)區(qū)域
nbins <- 3 

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

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

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

### 有監(jiān)督的數(shù)據(jù)離散化
library(discretization)# 有監(jiān)督分箱
# 使用ChiMerge算法基于卡方檢驗(yàn)進(jìn)行自下而上的合并
chi1 <- chiM(iris_train, alpha = 0.05) # alpha 為顯著性指標(biāo)
apply(chi1$Disc.data,2,table)
# 保存闕值
depreciation <- chi1$cutp[[2]]
## 其他有監(jiān)督分享算法
# 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)     # 使用熵準(zhǔn)則將最小描述長度作為停止規(guī)則來離散化
# d1 <- disc.Topdown(iris,method=1) # 該功能實(shí)現(xiàn)了三種自上而下的離散化算法（CAIM，CACC，Ameva）

# 分箱前數(shù)據(jù)準(zhǔn)備
library(smbinning) 
# 查看測(cè)試用例
head(smbsimdf1)

# 使用smbinning函數(shù)進(jìn)行分箱，df 為原始數(shù)據(jù)，y表示目標(biāo)標(biāo)簽，x表示需要分箱的標(biāo)簽result <- smbinning(df = smbsimdf1,y = "fgood",x = "cbs1") 
# 查看分箱結(jié)果的分布情況，不良率和證據(jù)權(quán)重
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 # 相關(guān)重要信息
result$ctree # 決策樹
result$cuts # 闕值
smbinning.sql(result) # 輸出相應(yīng)的sql語句

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

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