R语言 数据抽样（数据失衡处理、sample随机抽样、数据等比抽样、交叉验证抽样）

关注微信公共号：小程在线

关注CSDN博客：程志伟的博客

详细内容为 《R语言游戏数据分析与挖掘》第五章学习笔记

数据抽样包括：

1.数据类不平衡问题解决

2.随机抽样

3.数据等比例抽样（用于多分类）

4.用于交叉验证的样本抽取

 

5.1.2类失衡处理方法

在R中，DMwR包中的SMOTE()函数可以实现SMOTE方法。

perc.over=500表示对原始数据集中的每个少数样本，都生成5个新的少数样本；

perc.under=80表示从原始数据集中选择的多数类的样本是新生的数据集中少数样本的80%。

> hyper <-read.csv('http://archive.ics.uci.edu/ml/machine-learning-databases/thyroid-disease/hypothyroid.data',
+                  header=F)
> names <- read.csv('http://archive.ics.uci.edu/ml/machine-learning-databases/thyroid-disease/hypothyroid.names', 
+                   header=F, sep='\t')[[1]]
> names <- gsub(pattern =":|[.]", replacement="", x = names)
> colnames(hyper)<-names
> colnames(hyper)
 [1] "hypothyroid, negative"     "age"                      
 [3] "sex"                       "on_thyroxine"             
 [5] "query_on_thyroxine"        "on_antithyroid_medication"
 [7] "thyroid_surgery"           "query_hypothyroid"        
 [9] "query_hyperthyroid"        "pregnant"                 
[11] "sick"                      "tumor"                    
[13] "lithium"                   "goitre"                   
[15] "TSH_measured"              "TSH"                      
[17] "T3_measured"               "T3"                       
[19] "TT4_measured"              "TT4"                      
[21] "T4U_measured"              "T4U"                      
[23] "FTI_measured"              "FTI"                      
[25] "TBG_measured"              "TBG"                      
> # 我们将第一列的列名从 hypothyroid, negative改成target，并将该列中的因子negative变成0，其他值变成1
> colnames(hyper)[1]<-"target"
> colnames(hyper)
 [1] "target"                    "age"                      
 [3] "sex"                       "on_thyroxine"             
 [5] "query_on_thyroxine"        "on_antithyroid_medication"
 [7] "thyroid_surgery"           "query_hypothyroid"        
 [9] "query_hyperthyroid"        "pregnant"                 
[11] "sick"                      "tumor"                    
[13] "lithium"                   "goitre"                   
[15] "TSH_measured"              "TSH"                      
[17] "T3_measured"               "T3"                       
[19] "TT4_measured"              "TT4"                      
[21] "T4U_measured"              "T4U"                      
[23] "FTI_measured"              "FTI"                      
[25] "TBG_measured"              "TBG"                      
> hyper$target<-ifelse(hyper$target=="negative",0,1)
> # 检查下0、1的结果
> table(hyper$target)

   0    1 
3012  151 
> prop.table(table(hyper$target))

         0          1 
0.95226051 0.04773949 

数据集存在严重额失衡数据。

 

# 利用SMOTE对类失衡问题进行处理
> # 将变量target变成因子型
> hyper$target <- as.factor(hyper$target)
> # 加载DMwR包
> if(!require(DMwR)) install.packages("DMwR")
载入需要的程辑包：DMwR
载入需要的程辑包：lattice
载入需要的程辑包：grid
Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 
Warning message:
程辑包‘DMwR’是用R版本3.6.3 来建造的 

# 进行类失衡处理
# perc.over=100:表示少数样本数=151+151*100%=302
# perc.under=200:表示多数样本数(新增少数样本数*200%=151*200%=302)
> hyper_new <- SMOTE(target~.,hyper,perc.over = 100,perc.under = 200)
> # 查看处理后变量target的0、1个数
> table(hyper_new$target)

  0   1 
302 302 

# perc.over=200:表示少数样本数=151+151*200%=453
# perc.under=300:表示多数样本数(新增少数样本数*300%=151*200%*300%=906)
> hyper_new1 <- SMOTE(target~.,hyper,perc.over = 200,perc.under = 300)
> # 查看处理后变量target的0、1个数
> table(hyper_new1$target)

  0   1 
906 453 
> # 对活跃用户是否付费数据进行研究
> # 导入数据
> user <- read.csv("H:\\程志伟\\R语言游戏数据分析与挖掘\\Game_DataMining_With_R-master\\data\\第5章\\活跃用户是否付费数据.csv",header=T)
> # 查看变量名
> colnames(user)
[1] "用户id"                  "是否付费"               
[3] "注册至今距离天数"        "最后一周登陆天数"       
[5] "最后一周登陆次数"        "最后一周0.8点登陆次数"  
[7] "最后一周8.18点登陆次数"  "最后一周18.24点登陆次数"
> # 查看是否付费的类别占比(0:非付费，1:付费)
> prop.table(table(user$是否付费))

        0         1 
0.8589596 0.1410404 
> table(user$是否付费)

     0      1 
106176  17434 
> # 将是否付费变量转换成因子型
> user$是否付费 <- as.factor(user$是否付费)
> library(DMwR)
> # 对类失衡数据进行处理
> user_new <- SMOTE(是否付费~.,data=user,perc.over=100,perc.under=200)
> # 查看处理后的结果
> table(user_new$是否付费)

    0     1 
34868 34868 

 

5.1.3 数据随机抽样
> # sample小例子
> set.seed(1234)
> # 创建对象x，有1~10组成
> x <- seq(1,10);x
 [1]  1  2  3  4  5  6  7  8  9 10

 # 利用sample函数对x进行无放回抽样
> a <- sample(x,8,replace=FALSE);a
[1] 10  6  5  4  1  8  2  7

# 利用sample函数对x进行有放回抽样
> b <- sample(x,8,replace=TRUE);b
[1]  7  6 10  6  4  8  4  4
> # 当size大于x的长度
> (c <- sample(x,15,replace = F))
Error in sample.int(length(x), size, replace, prob) : 
  cannot take a sample larger than the population when 'replace = FALSE'
> (c <- sample(x,15,replace = T))
 [1]  5  8  4  8  3  4 10  5  2  8  4  3  7  9  3

> # 利用sample对活跃用户数据进行抽样
> # 导入数据
> #user <- read.csv("活跃用户是否付费数据.csv",T)
> # 查看数据user的行数
> nrow(user)
[1] 123610
 

# 利用sample函数对user数据进行无放回抽样
> set.seed(1234)
> # 提取下标集
> index <- sample(nrow(user),10000,replace=TRUE)
> # 将抽样数据赋予对象user_sample
> user_sample <- user[index,]
> # 查看user_sample的行数
> nrow(user_sample)
[1] 10000
> # 现在我们分别查看user与user_sample变量“是否付费”中0、1占比。
> round(prop.table(table(user$是否付费)),3)

    0     1 
0.859 0.141 
> round(prop.table(table(user_sample$是否付费)),3)

    0     1 
0.853 0.147 

 

# 以下代码实现抽样后的“是否付费”的0、1占比不变
> # 计算出“是否付费”中0的占比
> rate <- sum(user$是否付费==0)/nrow(user)
> # 提取未付费用户的下标子集
> d <- 1:nrow(user)
> index1 <- sample(d[user$是否付费==0],10000*rate)
> # 提取付费用户的下标子集
> index2 <- sample(d[user$是否付费==1],10000*(1-rate))
> # 将抽样数据赋予对象user_sample1
> user_sample1 <- user[c(index1,index2),]
> # 查看“是否付费”的0、1占比
> round(prop.table(table(user_sample1$是否付费)),3)

    0     1 
0.859 0.141 

 

5.1.4利用createDataPartition函数对数据进行等比抽样

createDataPartition（y,times=1,p=0.5,list=TRUE,groups=min(5,length(y))）

y：一个向量；

times:需要进行抽样的次数；

p:需要从数据中抽取的样本比例；

list：结果是否是list形式；

groups：如果输出变量为数值型数据，默认按分位数分组进行取样。

> library(caret)
载入需要的程辑包：ggplot2
Warning messages:
1: 程辑包‘caret’是用R版本3.6.2 来建造的 
2: 程辑包‘ggplot2’是用R版本3.6.2 来建造的 
> # 提取下标集
> splitindex <- createDataPartition(iris$Species,times=1,p=0.1,list=FALSE)
> splitindex
      Resample1
 [1,]         4
 [2,]        14
 [3,]        26
 [4,]        27
 [5,]        48
 [6,]        63
 [7,]        67
 [8,]        71
 [9,]        74
[10,]        97
[11,]       101
[12,]       105
[13,]       107
[14,]       109
[15,]       110
> # 提取符合子集
> sample <- iris[splitindex,]

# 查看Species变量中各类别的个数和占比
> table(sample$Species);

    setosa versicolor  virginica 
         5          5          5 
> prop.table(table(sample$Species))

    setosa versicolor  virginica 
 0.3333333  0.3333333  0.3333333 
> # 设置list为TRUE
> # 提取下标集
> splitindex1 <- createDataPartition(iris$Species,times=1,p=0.1,list=TRUE)
> # 查看下标集
> splitindex1
$Resample1
 [1]   6  10  13  27  38  56  64  97  98  99 113 128 143 145 149

> # 提取子集
> iris[splitindex1$Resample1,]
    Sepal.Length Sepal.Width Petal.Length Petal.Width    Species
6            5.4         3.9          1.7         0.4     setosa
10           4.9         3.1          1.5         0.1     setosa
13           4.8         3.0          1.4         0.1     setosa
27           5.0         3.4          1.6         0.4     setosa
38           4.9         3.6          1.4         0.1     setosa
56           5.7         2.8          4.5         1.3 versicolor
64           6.1         2.9          4.7         1.4 versicolor
97           5.7         2.9          4.2         1.3 versicolor
98           6.2         2.9          4.3         1.3 versicolor
99           5.1         2.5          3.0         1.1 versicolor
113          6.8         3.0          5.5         2.1  virginica
128          6.1         3.0          4.9         1.8  virginica
143          5.8         2.7          5.1         1.9  virginica
145          6.7         3.3          5.7         2.5  virginica
149          6.2         3.4          5.4         2.3  virginica

# 设置times=2
> splitindex2 <- createDataPartition(iris$Species,times=2,p=0.1,list=TRUE)
> splitindex2
$Resample1
 [1]  15  18  20  27  29  51  54  84  89  91 102 105 117 129 131

$Resample2
 [1]  18  19  22  29  49  55  58  70  76  84 108 113 119 124 133

 

# 对12万本周活跃用户的数据按照“是否付费”的比例随机抽取1万的活跃用户进行探索性分析
> # 导入数据
> #user <- read.csv("活跃用户是否付费数据.csv",T)
> # 将“是否付费”改为因子型变量
> user$是否付费 <- as.factor(user$是否付费)
> # 提取下标集
> ind <- createDataPartition(user$是否付费,p=10000/nrow(user),
+                            times=1,list=FALSE)
> # 查看子集中0、1占比
> prop.table(table(user[ind,'是否付费']))

        0         1 
0.8589141 0.1410859 
> # 利用sample函数对数据分区
> # 提取训练数据集的下标
> ind <- sample(nrow(user),0.7*nrow(user),replace=F)
> # 构建训练集数据
> traindata <- user[ind,]
> # 构建测试集数据
> testdata <- user[-ind,]
> # 查看“是否付费”的0、1占比
> prop.table(table(user$是否付费))

        0         1 
0.8589596 0.1410404 
> prop.table(table(traindata$是否付费))

        0         1 
0.8590382 0.1409618 
> prop.table(table(testdata$是否付费))

        0         1 
0.8587763 0.1412237 

 

# 利用createDataPartition函数按照”是否付费“等比例对数据进行分区
> library(caret)
> # 将”是否付费“变量转换成因子型
> user$是否付费 <- as.factor(user$是否付费)
> # 构建训练数据下标集
> idx <-  createDataPartition(user$是否付费,p=0.7,list=FALSE)
> # 构建训练数据集
> train <- user[idx,]
> # 构建测试数据集
> test <- user[-idx,]
> # 查看”是否付费“的0、1占比
> prop.table(table(user$是否付费))

        0         1 
0.8589596 0.1410404 
> prop.table(table(train$是否付费))

        0         1 
0.8589589 0.1410411 
> prop.table(table(test$是否付费))

        0         1 
0.8589612 0.1410388 

 

 

5.1.5 用于交叉验证的样本抽样
> # zz1为所有观测值的下标
> n <- nrow(user);zz1 <- 1:n
> # zz2为1:5的随机排列
> set.seed(1234)
> zz2 <- rep(1:5,ceiling(n/5))[1:n]
> zz2 <- sample(zz2,n)
> # 构建训练集及测试集
> for(i in 1:5){
+   m <- zz1[zz2==i]
+   train <- user[-m,]
+   test <- user[m,]
+   # 接下来就可以利用训练集建立模型，测试集验证模型，并计算5次MSE
+ }

 

利用createFoldsh函数构建五折交叉验证的训练集和测试集

createFoldsh（y,k=10,list=TRUE,returnTrain=FALSE）

y:要依据分类的变量；

k:交叉验证的样本，默认是10，每重的样本量为样本总量/10；

list:是否以列表或矩阵的形式存储，默认为FLASE；

returnTrain：是否返回抽样的真实值，默认返回样本的索引值。

> user$是否付费 <- as.factor(user$是否付费)
> index <- createFolds(user$是否付费,k=5,list=FALSE)
> prop.table(table(user[index==1,'是否付费']))

        0         1 
0.8589515 0.1410485 
> prop.table(table(user[index==2,'是否付费']))

        0         1 
0.8589863 0.1410137 
> prop.table(table(user[index==3,'是否付费']))

        0         1 
0.8589572 0.1410428 
> prop.table(table(user[index==4,'是否付费']))

        0         1 
0.8589515 0.1410485 
> prop.table(table(user[index==5,'是否付费']))

        0         1 
0.8589515 0.1410485