Learning R---SMOTE

knitr::opts_chunk$set(echo = TRUE)

AIM

使用rmarkdown编辑~
主要目标学习SMOTE算法，并且利用DMwR实现该算法，用以处理类不平衡问题。

简介

该函数使用SMOTE算法处理类不平衡问题。简而言之，这个函数能够生成SMOTE算法处理之后的数据。或者，它也可以在新生成的数据集建立二分类模型，并且返回最终的模型。

函数使用方式

Code

SMOTE(form, data, perc.over = 200, k = 5, perc.under = 200,learner = NULL, ...)

参数说明

1 . form 公式，用以描述预测问题
2 . data 原始不平衡数据集
3 . perc.over 过采样比例p1=perc.over/100，一个少数类样本生成p1·n1+n1个样本
4 . 默认值为5，k 生成少数类新样本时，所采用的邻居数。即knn中的k
5 . perc.under 欠采样比例 如果p2=perc.under/100,那么生成p1·n1·p2个新样本。貌似是可重复抽样
6 . learner 默认为NULL，参数值可以是一个字符串，表示一个函数，应用于新数据集
7 . … 指定learner的一些别的参数
8 . 若配置数据集1:1，保证perc.over/100 + 1 =perc.over/100 *perv.under/100即可

Details

类不平衡问题会对许多机器学习算法产生影响。该问题的特征为每一类所占的比例不均匀。SMOTE(Chawla et. al. 2002)是解决这一问题的好方法。SMOTE的大体思想为：利用少数类样本的近邻人为的生成新样本(少数类的)。此外，多数类样本也可以使用欠采样，使得数据集更加平衡。
参数perc.over和perc.under控制过采样、欠采样的数量。perc.over 通常大于100，每一个少数类样本都会产生perc.over/100个新样本。如果perc.over小于100，则按照给定比例(perc.over/100)随机产生样本。
参数perc.under决定多数类样本最终随机抽取到新数据集的比例(perc.over/100)
举个栗子：如果少数类样本生成200个新样本，并且perc.under值为100，那么多数类样本中也会精确地抽取200个样本，组成最终的数据集。而如果perc.under值大于100，则会从多数类中抽取更多样本，样本数为少数类新生成的样本数。
参数k决定新样本产生的方式，每一个少数类的样本都会产生新样本，产生新样本的数量有perc.over决定。这些新样本由每个老样本的k个近邻产生。参数k决定邻居的数量。
该函数还可以对新样本集建立分类模型。通过参数learner确定分类模型的名称，也可以添加该模型函数的其他参数。如果参数learner的值不是NULL，那么该函数返回的值是学习模型，而不是新的平衡数据集。模型的参数第一个参数是预测公式，第二个参数是训练集。

Value

SMOTE函数由参数learner是否为NULL，返回两种不同类型的结果。learner为NULL返回新产生的数据集，否则返回指定的分类模型。

Examples

## A small example with a data set created artificially from the IRIS## datadata(iris)data <- iris[, c(1, 2, 5)]data$Species <- factor(ifelse(data$Species == "setosa","rare","common"))## checking the class distribution of this artificial data settable(data$Species)## 少数类为common，共100个样本；多数类为rare，共50个样本。## now using SMOTE to create a more "balanced problem"## 参数说明：## perc.over 过采样600/100,6倍，则少数类样本生成6*50=300个新样本，加上原来的50个样本共计350个样本## perc.under 欠采样100/100，1倍，从多数类中抽取300*1个新样本library(DMwR)newData <- SMOTE(Species ~ ., data, perc.over = 600,perc.under = 100)table(newData$Species)## Checking visually the created data## Not run:par(mfrow = c(1, 2))plot(data[, 1], data[, 2], pch = 19 + as.integer(data[, 3]),main = "Original Data")plot(newData[, 1], newData[, 2], pch = 19 + as.integer(newData[,3]),main = "SMOTE'd Data")## End(Not run)## Now an example where we obtain a model with the "balanced" dataclassTree <- SMOTE(Species ~ ., data, perc.over = 600,perc.under = 100,learner='rpartXse',se=0.5)## check the resulting classification treeclassTree## The tree with the unbalanced data set would berpartXse(Species ~ .,data,se=0.5)

源码

# SMOTE -------------------------------------------------------------------function (form, data, perc.over = 200, k = 5, perc.under = 200,           learner = NULL, ...) {  tgt <- which(names(data) == as.character(form[[2]])) ## 目标变量的索引,第几列  minCl <- levels(data[, tgt])[which.min(table(data[, tgt]))] ## 取出少数类名称  minExs <- which(data[, tgt] == minCl) ## 少数类的行索引  ## 如果目标变量不是最后一列,那么把目标变量换到最后一列~  ## 用写的这么麻烦吗？单独拉出来重新赋值不就行了  if (tgt < ncol(data)) {    cols <- 1:ncol(data) ## 存放列的向量1:n    cols[c(tgt, ncol(data))] <- cols[c(ncol(data), tgt)]    data <- data[, cols]  }  ## 少数类生成新样本的函数，没有找到详细的函数呀  ## 看看包里是不是有这个函数  newExs <- smote.exs(data[minExs, ], ncol(data), perc.over,                       k)  ## 再按照原数据集列的顺序调整回去  if (tgt < ncol(data)) {    newExs <- newExs[, cols]    data <- data[, cols]  }  ## 多数类可重复抽样，抽取样本数为perc.under/100*少数类新增的样本数  selMaj <- sample((1:NROW(data))[-minExs], as.integer((perc.under/100) *                                                          nrow(newExs)), replace = T)  ## 合并数据集  newdataset <- rbind(data[selMaj, ], data[minExs, ], newExs)  ## 如果learner参数为空，返回处理之后的数据集。否则调用指定的分类模型，返回模型结果  if (is.null(learner))     return(newdataset)  else do.call(learner, list(form, newdataset, ...))}# smote.exs ---------------------------------------------------------------newExs <- smote.exs(data[minExs, ], ncol(data), perc.over,k)## 参数 data少数类样本，tgt目标变量所在列，perc.over欠采样参数,k近邻数function (data, tgt, N, k){  nomatr <- c()  ## 生成一个空矩阵，行数是少数类的行数，列为原数据框列数-1  T <- matrix(nrow = dim(data)[1], ncol = dim(data)[2] - 1)  ## for循环是为了将少数类样本中的字符型或者因子型变量转换为数值型  ## 遍历每一个列，如果是因子型或者字符型，转换成数值型  ## nomatr 为因子or字符型变量所在的列  for (col in seq.int(dim(T)[2])){    if (class(data[, col]) %in%        c("factor", "character")) {      T[, col] <- as.integer(data[, col])      nomatr <- c(nomatr, col)    }    else      T[, col] <- data[, col]  }  ## 欠采样参数如果小于100,不重复简单随机抽样抽取as.integer((N / 100) * nT)个样本  if (N < 100) {    nT <- NROW(T)    idx <- sample(1:nT, as.integer((N / 100) * nT))    T <- T[idx,]    N <- 100  }  p <- dim(T)[2]  nT <- dim(T)[1]  ## 求每一列的值域，不包括目标变量列  ranges <- apply(T, 2, max) - apply(T, 2, min)  nexs <- as.integer(N / 100)  ## 生成新的矩阵，行数为 as.integer(N / 100)*nT,即perc.over/100 * 原来少数类样本的行数  ## 相当于每一个少数类样本新生成perc.over/100新样本  new <- matrix(nrow = nexs * nT, ncol = p)  ## 对每一个少数类样本进行操作  ## xd是标准化之后的矩阵。标准化方法为极差标准化  ## 但是不是减去均值，而是减去指定的矩阵行数据，最后除以极差  for (i in 1:nT) {    xd <- scale(T, T[i,], ranges)    ## 遍历所有字符串列,判断元素是否为0，返回TRUE or FALSE 覆盖原值    ## 矩阵元素平方，行求和，drop转换成向量    for (a in nomatr)      xd[, a] <- xd[, a] == 0    ## 不知道这个是干嘛的    dd <- drop(xd ^ 2 %*% rep(1, ncol(xd)))    ## 排序取最近    ## order函数有小到大返回相关数字的索引    ## 取出第2小-k+1个小的索引    kNNs <- order(dd)[2:(k + 1)]    ## nexs = as.integer(perc.over/100)    ## 每次随机抽取    for (n in 1:nexs) {      neig <- sample(1:k, 1)      ex <- vector(length = ncol(T))      ## 选取一个随机确定的邻居，得到邻居和该少数类样本的差      difs <- T[kNNs[neig],] - T[i,]      ## 构造出新样本，构造逻辑真奇怪，还要看下论文      new[(i - 1) * nexs + n,] <- T[i,] + runif(1) *        difs      for (a in nomatr)        new[(i - 1) * nexs + n, a] <- c(T[kNNs[neig],                                          a], T[i, a])[1 + round(runif(1), 0)]    }  }  newCases <- data.frame(new)  for (a in nomatr)    newCases[, a] <- factor(newCases[, a],                            levels = 1:nlevels(data[, a]),                            labels = levels(data[,                                                 a]))  newCases[, tgt] <- factor(rep(data[1, tgt], nrow(newCases)),                            levels = levels(data[, tgt]))  colnames(newCases) <- colnames(data)  newCases}

Ref

DMwR帮助文档