基于R语言的卡方分箱

在做风控策略分析时，我们经常要对某个变量进行离散化，查看不同阶段的好坏用户分布情况，好的离散化方法可以让我们找到比较好的策略分界点。
本片文章主要讲述卡方分箱

一、理论

基本思想：卡方分箱是依赖于 卡方检验的分箱方法，在统计指标上选择卡方统计量（chi-Square）进行判别。卡方分箱的基本思想是判断相邻的两个区间是否有分布差异，如果两个相邻的区间具有非常类似的分布，则这两个区间可以合并；否则，它们应当保持分开。基于卡方统计量的结果进行自下而上的合并，直到满足分箱的限制条件为止。

卡方分箱的实现步骤：

1. 预先设定一个卡方的阈值或者分箱个数的阈值。

在做分箱处理时可以使用两种限制条件：

• 分箱个数：限制最终的分箱个数结果，每次将样本中具有最小卡方值的区间与相邻的最小卡方区间进行合并，直到分箱个数达到限制条件为止。

• 卡方阈值：根据自由度和显著性水平得到对应的卡方阈值，如果分箱的各区间最小卡方值小于卡方阈值，则继续合并，直到最小卡方值超过设定阈值为止。

通过显著性水平和自由度计算出这个阈值，然后数据的卡方值与这个阈值进行比较，如果卡方值大于阈值，就可以推翻原假设(两个相邻区间的分布无差异);如果卡方值小于阈值，则不能推翻原假设(两个相邻区间的分布无差异),即可合并。

• 显著性水平，当置信度90%时显著性水平为10%，ChiMerge算法推荐使用置信度为0.90、0.95、0.99。

• 自由度，比分类数量小1。例如：有3类,自由度为2。

类别和属性独立时,有90%的可能性,计算得到的卡方值会小于4.6（在excel中用CHIINV(0.1,2)算出）。大于阈值4.6的卡方值就说明属性和类不是相互独立的，不能合并。如果阈值选的大,区间合并就会进行很多次,离散后的区间数量少、区间大。

2. 初始化：根据要离散化的数据对实例进行排序，每个实例属于一个区间

3. 合并区间：

1. 计算每一对相邻区间的卡方值

2. 将卡方值最小的一对区间合并（合并需要符合以下两个条件之一）

image.png

4.评估指标

分完箱之后需要评估，常用的评估手段是计算出WOE和IV值。对于WOE和IV值的含义，看 数据挖掘模型中的IV和WOE详解

分箱的注意点

对于连续型变量，

• 使用ChiMerge进行分箱(默认分成5个箱)

• 检查分箱后的bad rate单调性；倘若不满足，需要进行相邻两箱的合并，直到bad rate为止

• 上述过程是收敛的，因为当箱数为2时，bad rate自然单调

• 分箱必须覆盖所有训练样本外可能存在的值！

• 原始值很多时，为了减小时间的开销，通常选取较少(例如50个)初始切分点。但是要注意分布不均匀！

对于类别型变量，

• 当类别数较少时，原则上不需要分箱

• 当某个或者几个类别的bad rate为0时，需要和最小的非0 的bad rate的箱进行合并

• 当该变量可以完全区分目标变量时，需要认真检查该变量的合理性

要求分箱完之后：

（1）不超过5箱

（2）Bad Rate单调

（3）每箱同时包含好坏样本

（4）特殊值如－1，单独成一箱

连续型变量可直接分箱

类别型变量：

（a）当取值较多时，先用bad rate编码，再用连续型分箱的方式进行分箱

（b）当取值较少时：

（b1）如果每种类别同时包含好坏样本，无需分箱

（b2）如果有类别只包含好坏样本的一种，需要合并

二、代码

2.1 R包--discretization

discretization包，是一个用来做有监督离散化的工具集，主要用于卡方分箱算法，它提供了几种常用的离散化工具函数，可以按照自上而下或自下而上，实施离散化算法。

项目主页： https://cran.r-project.org/web/packages/discretization/

提供了几个主要的离散化的工具函数：

• chiM，ChiM算法进行离散化

• chi2, Chi2算法进行离散化，在chiM的基础上进行优化

• mdlp，最小描述长度原理(MDLP)进行离散化

• modChi2，改进的Chi2方法离散数值属性

• disc.Topdown，自上而下的离散化

• extendChi2，扩展Chi2算法离散数值属性

chiM算法进行离散化（根据卡方阈值来设定合并停止条件)

ChiM()函数，使用ChiMerge算法基于卡方检验进行自下而上的合并。通过卡方检验判断相邻阈值的相对类频率，是否有明显不同，或者它们是否足够相似，从而合并为一个区间。
chiM(data,alpha)函数解读。
* 第一个参数data，是输入数据集，要求最后一列是分类属性。
* 第二个参数alpha，表示显著性水平。
* 自由度，通过数据计算获得是2，一共3个分类减去1。

image.png

2.2 自定义函数ChiMerge

#初始化划分
SplitData <- function(df,col,numOfSplit,special_attribute=NULL){
  library(dplyr)
  #当连续变量的初始取值集合太多时（>100）,我们先对其进行初步划分
  #:param df: 按照col排序后的数据集
  #:param col: 待分箱的变量
  #:param numOfSplit: 切分的组别数
  #:param special_attribute: 在切分数据集的时候，某些特殊值需要排除在外
  #:return: 在原数据集上增加一列，把原始细粒度的col重新划分成粗粒度的值，便于分箱中的合并处理
  df2 <- df
  if(length(special_attribute)>0){
    df2 <- filter(df,! col %in% special_attribute)
  }
  N <- dim(df2)[1] #行数
  n <- floor(N/numOfSplit) #每组样本数
  splitPointIndex <- seq(1,numOfSplit-1,1)*n #分割点的下标
  rawValues <- sort(df2[,col]) #对取值进行升序排序
  splitPoint <- rep(0,length(rawValues))
  for(i in splitPointIndex){
    splitPoint[i] <- rawValues[i]  #分割点的取值
  }
  splitPoint <- sort(unique(splitPoint)) #对取值进行升序排序
  if(splitPoint[1]==0){
    splitPoint<- splitPoint[-1]
  }
  return(splitPoint)
}

#计算每个值的好坏比率
BinBadRate <- function(df,col,target,grantRateIndicator=0){
  library(dplyr)
  #:param df:需要计算好坏比率的数据集
  #:param col:需要计算好坏比率的特征
  #:param target:好坏标签
  #:param grantRateIndicator:1返回总体的坏样本率，0不返回
  #:return:每箱的坏样本率以及总体的坏样本率(当grantRateIndicator=1时)
  #total <- df %>% group_by(col) %>% summarise(total=n())
  #bad <- df %>% group_by(col) %>% summarise(bad=sum(target))
  total <- data.frame(table(df[,col]))
  names(total) <- c(col,'total')
  bad <- data.frame(tapply(df[,target],df[,col],FUN = sum))
  bad$bad <- row.names(bad)
  names(bad) <- c('bad',col)
  regroup <- left_join(total,bad,by=col)
  #regroup$bad_rate  <- bad/total
  regroup <- mutate(regroup,bad_rate = bad/total)
  dicts <- regroup[,'bad_rate'] #每箱对应的坏样本率组成的向量
  names(dicts) <- regroup[,col]
  if(grantRateIndicator==0){
    return(list(dicts,regroup))
  }else{
    N =sum(regroup[,'total'])
    B = sum(regroup[,'bad'])
    overallRate = B*1.0/N
    return(list(dicts,regroup,overallRate))
  }
}

#计算卡方值
Chi2 <- function(df,total_col,bad_col){
  library(dplyr)
  df2 <- df
  # 求出df中，总体的坏样本率和好样本率
  badRate <- sum(df2[,bad_col])/sum(df2[,total_col])
  # 当全部样本只有好或者坏样本时，卡方值为0
  if(badRate %in% c(0,1)){
    return(0)
  }
  good=df2[,total_col]-df2[,bad_col]
  df2 <- cbind(df2,good)
  goodRate = sum(df2[,'good'])/ sum(df2[,total_col])
  # 期望坏（好）样本个数＝全部样本个数*平均坏（好）样本占比
  badExpected=df2[,total_col]*badRate
  goodExpected=df2[,total_col]*goodRate
  df2 <- cbind(df2,badExpected)
  df2 <- cbind(df2,goodExpected)
  badChi <- sum(((df2[,bad_col]-df2[,'badExpected'])^2)/df2[,'badExpected'])
  goodChi <- sum(((df2[,'good']-df2[,'goodExpected'])^2)/df2[,'goodExpected'])
  chi2 <- badChi+goodChi
  return(chi2)
}
AssignBin <- function(x,cutOffPoints,special_attribute=NULL){
  # :param x: 某个变量的某个取值
  # :param cutOffPoints:上述变量的分箱结果，用切分点表示
  # :param special_attribute:不参与分箱的特殊取值
  # :return:分箱后的对应的第几个箱，从0开始
  # for example, if cutOffPoints = c(10,20,30), if x = 7, return Bin 0. If x = 35, return Bin 3
  
  
  numBin = length(cutOffPoints)+1+length(special_attribute)
  if(x %in% special_attribute){
    i <-  which(special_attribute==x)
    return(paste('Bin',0-i))
  }
  if(x<= cutOffPoints[1]){
    return('Bin 0')
  }else if(x>cutOffPoints[length(cutOffPoints)]){
    return(paste("Bin",numBin-1))
  }else{
    for(i in seq(1,numBin-1)){
      if(cutOffPoints[i] < x & x<= cutOffPoints[i+1]){
        return(paste('Bin',i))
      }
    }
  }
}
AssignGroup <- function(x,bin){
  # '
  #   :param x:某个变量的某个取值
  #   :param bin:上述变量的分箱结果
  #   :return：x在分箱结果下的映射
  #  
  N = length(bin)
  if(x<=min(bin)){
    return(min(bin))
  }else if(x>max(bin)){
    return(10e10)
  }else{
    for(i in 1:N-1){
      if(bin[i]100）,我们先对其进行初步划分，切分的组别数
  #   :return ：分箱结果
  #   '''
  library(dplyr)
  colLevels=sort(unique(df[,col])) #升序排序变量值
  N_distinct = length(colLevels) #不同取值的个数
  if(N_distinct<=max_interval){ #如果原始变量的取值个数低于max_interval,不执行这个函数
    print(paste(col,'变量的取值个数低于设定的最大分箱数max_interval:',max_interval))
    return(colLevels[-length(colLevels)]) #去掉最后一个值
  }else{
    if(length(special_attribute)>=1){
      df1 <- filter(df,col %in% special_attribute)
      df2 <- filter(df,!col %in% special_attribute)
    }else{
      df2 <- df
    }
    
    N_distinct <- length(unique(df2[,col])) #该变量的不同取值个数
    
    
    #步骤一：通过col对数据集进行分组，求出每组的总样本数和坏样本数
    if(N_distinct>numOfSplit){
      split_x <- SplitData(df2,col,numOfSplit)
      #temp <- cut(df2[,col],breaks = split_x,include.lowest = TRUE)
      temp <- apply(df2[col],1,AssignGroup,split_x)
      df2 <- cbind(df2,temp)
    }else{
      temp <- df2[,col]
      df2 <- cbind(df2,temp)
      
    }
    #总体bad rate将被用来计算expected bad count
    ha <- BinBadRate(df2,'temp',target)
    regroup <- ha[[2]]
    binBadRate<- ha[[1]]
    #首先，每个单独的属性值将被分为单独的一组
    #对属性值进行排序，然后两两组别进行合并
    colLevels<- sort(unique(df2[,'temp']))
    
    groupIntervals <- list()
    for(i in 1:length(colLevels)){
      groupIntervals[i] <-list(colLevels[i])
    }
    
    # #步骤二，建立循环，不断合并最优的相邻的两个组别，直到：
    # #1.最终分裂出来的分箱数<=预设的最大分箱数
    # #2.每箱的占比不低于预设值(可选)
    # #3.每箱同时包含好坏样本
    # #如果有特殊属性，那么最终分裂出来的分箱数=预设的最大分箱数-特殊属性的个数
    split_intervals= max_interval-length(special_attribute)

    while(length(groupIntervals)>=split_intervals){ #终止条件
      #每次循环时，计算合并相邻组别后的卡方值。具有最小卡方值值的合并方案，是最优方案
      chisqList <- rep(100000000,length(groupIntervals)-1)
      for(k in 1:(length(groupIntervals)-1)){
        temp_group <- c(groupIntervals[[k]],groupIntervals[[k+1]])
        df2b <- filter(regroup, temp %in% temp_group)
        chisq = Chi2(df2b,'total','bad')
        chisqList[k] <- chisq
      }
      best_combined <- order(chisqList)[1] #找到最小值的位置
      #合并
      groupIntervals[[best_combined]] = c(groupIntervals[[best_combined]],groupIntervals[[best_combined+1]])
      # after combining two intervals, we need to remove one of them
      groupIntervals[[best_combined+1]] <- NULL
      
    }
    
    for(i in 1:length(groupIntervals)){
      groupIntervals[[i]]<- sort(groupIntervals[[i]])
    }
    
    cutOffPoints <- rep(0,length(groupIntervals)-1)
    for(i in 1:(length(groupIntervals)-1)){
      cutOffPoints[i] <- max(groupIntervals[[i]])
    }
    
    # 检查是否有箱没有好或者坏样本。如果有，需要跟相邻的箱进行合并，直到每箱同时包含好坏样本
    groupedvalues <-  apply(df2['temp'],1,AssignBin,cutOffPoints,special_attribute)
    temp_Bin<-groupedvalues
    df2 <- cbind(df2,temp_Bin)
    #返回（每箱坏样本率列表，和包含“列名、坏样本数、总样本数、坏样本率的数据框”）
    middle <- BinBadRate(df2,'temp_Bin',target)
    binBadRate <- middle[[1]]
    regroup <- middle[[2]]
    minBadRate <- min(binBadRate)
    maxBadRate <- max(binBadRate)
while(minBadRate ==0 || maxBadRate == 1){
   # 找出全部为好／坏样本的箱
   indexForBad01 <- filter(regroup,bad_rate %in% c(0,1))[,'temp_Bin']
   bin <- indexForBad01[1]
   return(bin)
   # 如果是最后一箱，则需要和上一个箱进行合并，也就意味着分裂点cutOffPoints中的最后一个需要移除
   if(bin==max(regroup[,'temp_Bin'])){
     cutOffPoints <- cutOffPoints[1:length(cutOffPoints)-1]
   }else if(bin == min(regroup[,'temp_Bin'])){
     # 如果是第一箱，则需要和下一个箱进行合并，也就意味着分裂点cutOffPoints中的第一个需要移除
     cutOffPoints[1] <- NULL
   }else{
     # 如果是中间的某一箱，则需要和前后中的一个箱进行合并，依据是较小的卡方值
     # 和前一箱进行合并，并且计算卡方值
     currentIndex <- which(regroup[,'temp_Bin']==bin)
     prevIndex <- regroup[,'temp_Bin'][currentIndex - 1]
     df3 <- filter(df2,temp_Bin %in% c(prevIndex,bin))
     middle <- BinBadRate(df3, 'temp_Bin', target)
     binBadRate <- middle[[1]]
     df2b <- middle[[2]]
     chisq1 = Chi2(df2b, 'total', 'bad')
     # 和后一箱进行合并，并且计算卡方值
     laterIndex <- regroup[,'temp_Bin'][currentIndex + 1]
     df3b <- filter(df2,temp_Bin %in% c(prevIndex,bin))
     middle <- BinBadRate(df3b, 'temp_Bin', target)
     binBadRate <- middle[[1]]
     df2b <- middle[[2]]
     chisq2 = Chi2(df2b, 'total', 'bad')
     if(chisq1 < chisq2){
       cutOffPoints[currentIndex - 1] <- NULL
     }else{cutOffPoints[currentIndex] <- NULL}
   }
   # 完成合并之后，需要再次计算新的分箱准则下，每箱是否同时包含好坏样本
   groupedvalues <- apply(df2['temp'],1,AssignBin,cutOffPoints,special_attribute)
   temp_Bin = groupedvalues
   df2 <- cbind(df2,temp_Bin)
   middle <- BinBadRate(df2, 'temp_Bin', target)
   binBadRate <- middle[[1]]
   regroup <- middle[[2]]
   minBadRate <- min(binBadRate)
   maxBadRate <- maxmax(binBadRate)
}


if(minBinPcnt > 0){
   groupedvalues <- apply(df2['temp'],1,AssignBin,cutOffPoints,special_attribute)
   temp_Bin = groupedvalues
   df2 <- cbind(df2,temp_Bin)
   valueCounts <- data.frame(table(groupedvalues))
   names(valueCounts)[2] <- 'temp'
   pcnt=valueCounts[,'temp']/sum(valueCounts[,'temp'])
   valueCounts <- cbind(valueCounts,pcnt)
   valueCounts <- arrange(valueCounts,Var1)
   minPcnt = min(valueCounts[,'pcnt'])
   while(minPcnt < minBinPcnt & len(cutOffPoints) > 2){
     # 找出占比最小的箱
     indexForMinPcnt = filter(valueCounts,valueCounts[,'pcnt'] == minPcnt)[,'var1'][1]
     # 如果占比最小的箱是最后一箱，则需要和上一个箱进行合并，也就意味着分裂点cutOffPoints中的最后一个需要移除
     if(indexForMinPcnt==max(valueCounts[,'var1'])){
       cutOffPoints[length(cutOffPoints)] <- NULL
     }else if(indexForMinPcnt==min(valueCounts[,'var1'])){
       # 如果占比最小的箱是第一箱，则需要和下一个箱进行合并，也就意味着分裂点cutOffPoints中的第一个需要移除
       cutOffPoints[1] <- NULL
     }else{
       # 如果占比最小的箱是中间的某一箱，则需要和前后中的一个箱进行合并，依据是较小的卡方值
       # 和前一箱进行合并，并且计算卡方值
       currentIndex <- which(valueCounts[,'pcnt']==indexForMinPcnt)
       prevIndex <- valueCounts[,'var1'][currentIndex-1]
       df3 <- filter(df2,var1 %in% c(prevIndex, indexForMinPcnt))
       middle <- BinBadRate(df3, 'temp_Bin', target)
       binBadRate <- middle[[1]]
       df2b <- middle[[2]]
       chisq1 = Chi2(df2b, 'total', 'bad')
       # 和后一箱进行合并，并且计算卡方值
       laterIndex <- valueCounts[,'var1'][currentIndex-1]
       df3b <- filter(df2,temp_Bin %in% c(laterIndex, indexForMinPcnt))
       middle <- BinBadRate(df3b, 'temp_Bin', target)
       binBadRate <- middle[[1]]
       df2b <- middle[[2]]
       chisq2 = Chi2(df2b, 'total', 'bad')
       if(chisq1

image.png

2. 3自定义并行化分箱函数

有时候数据量大的时候卡方分箱的计算大会导致运行速度慢，所以我们可以合理利用我们电脑的多核

image.png