R语言笔记Day1 (缺失值的处理—tidyr包+mice包)

1、tidyr包主要涉及:

    1. 缺失值的简单补齐
    1. 长形表变宽形表与宽形表变长形表
    1. 列分割与列合并

1.1 缺失值的简单补齐

> library(tidyr) 
> library(dplyr)
> # 创建含有缺失值的数据框示例
> x <- c(1,2,7,8,NA,10,22,NA,15)
> y <- c("a",NA,"b",NA,"b","a","a","b","a")
> df <- data.frame(x = x,y = y)
> df
   x    y
1  1    a
2  2 <NA>
3  7    b
4  8 <NA>
5 NA    b
6 10    a
7 22    a
8 NA    b
9 15    a

小技巧

  • 缺失-数字:用均值或中位数替换缺失值;
  • 缺失-字符串:用众数替换缺失值。
接下来

#第一步,计算x的均值和中位数(对缺失值比较敏感)
> x_mean <- mean(df$x, na.rm = TRUE)#TRUE表示去除NA
> x_mean
[1] 9.285714
> x_median <- median(df$x, na.rm = TRUE)
> x_median
[1] 8

#第二步,计算y的众数
> df$y
[1] a    <NA> b    <NA> b    a    a    b    a   
Levels: a b
> table(df$y)
a b 
4 3 
> which.max(table(df$y))
a 
1 
> df$y[which.max(table(df$y))]
[1] a
Levels: a b
> y_mode <- as.character(df$y[which.max(table(df$y))])#众数是字符a
> y_mode
[1] "a"
#如果不是字符串,是整数型变量和因子型变量
#整数型变量,即列表元素个数最多的位置
#a <- which.max(table(df$y)) 
#因子型变量(具体可见table()求每个因子水平的频数)
#a1 <- df$y[which.max(table(df$y))] 

#第三步,#替换数据框df中x和y的缺失值
> df$y
[1] a    <NA> b    <NA> b    a    a    b    a   
Levels: a b
> table(df$y)

a b 
4 3 
> which.max(table(df$y))
a 
1 
> df$y[which.max(table(df$y))]
[1] a
Levels: a b
> y_mode <- as.character(df$y[which.max(table(df$y))])
> y_mode
[1] "a"
> df2 <- replace_na(data = df, replace = list(x = x_mean, y = y_mode))
> df2
          x y
1  1.000000 a
2  2.000000 a
3  7.000000 b
4  8.000000 a
5  9.285714 b
6 10.000000 a
7 22.000000 a
8  9.285714 b
9 15.000000 a

1.2 长形表-变宽形表中的缺失值

  • 简单的说,长形表就是一个观测对象可由多行组成,而宽形表则是一个观测仅由一行组成

举例说明

  • 1)长转宽
####新建 长形表
> name <- c('A','A','A','B','B')
> product <- c('P1','P2','P3','P1','P4')
> price <- c(100,130,55,100,78)
> df_long <- data.frame(name = name, product = product, price = price)
> df_long
  name product price
1    A      P1   100
2    A      P2   130
3    A      P3    55
4    B      P1   100
5    B      P4    78

函数长转宽
spread(data, key, value, fill = NA, convert = FALSE, drop = TRUE)

data:为需要转换的长形表
key:需要将变量值拓展为字段的变量
value:需要分散的值
fill:对于缺失值,可将fill的值赋值给被转型后的缺失值

> df_long_expand <- spread(data = df_long, key = product, value = price)                      
> df_long_expand
  name  P1  P2 P3 P4
1    A 100 130 55 NA
2    B 100  NA NA 78
> df_long_expand2 <- spread(data = df_long, key = product, value = price, fill = 0) 
#被转型后的数据框中存在缺失值,如果想给缺失值传递一个指定值的话,就需要fill参数的作用。                    
> df_long_expand2
  name  P1  P2 P3 P4
1    A 100 130 55  0
2    B 100   0  0 78
  • 2)宽转长
#新建 宽形表
> name <- c('A','B','C')
> gender <- c('f','f','m')
> province <- c('JS','SH','HN')
> age <- c(18,22,19)
> df_wide <- data.frame(name = name, gender = gender, province = province, age = age)
> df_wide
  name gender province age
1    A      f       JS  18
2    B      f       SH  22
3    C      m       HN  19

实现宽转长
gather(data, key, value, …, na.rm = FALSE, convert = FALSE) 该函数实现宽转长

data:需要被转换的宽形表
key:将原数据框中的所有列赋给一个新变量key
value:将原数据框中的所有值赋给一个新变量value
…:可以指定哪些列聚到同一列中
na.rm:是否删除缺失值


 #默认将所有列存放到key中
> df_wide_gather <- gather(data = df_wide, key = variable,
+                          value = value)
> df_wide_gather
   variable value
1      name     A
2      name     B
3      name     C
4    gender     f
5    gender     f
6    gender     m
7  province    JS
8  province    SH
9  province    HN
10      age    18
11      age    22
12      age    19
 #指定需要被聚为一列的字段
> df_wide_gather2 <- gather(data = df_wide, key = variable, 
+                           value = value, gender, province)
> df_wide_gather2
  name age variable value
1    A  18   gender     f
2    B  22   gender     f
3    C  19   gender     m
4    A  18 province    JS
5    B  22 province    SH
6    C  19 province    HN
> 
> #df_wide_gather2的结果也可以写成
> df_wide_gather3 <- gather(data = df_wide, key = variable, 
+                           value = value, -name) #除name外,其他变量聚成一列
> df_wide_gather3
  name variable value
1    A   gender     f
2    B   gender     f
3    C   gender     m
4    A province    JS
5    B province    SH
6    C province    HN
7    A      age    18
8    B      age    22
9    C      age    19

1.3 列分割与列合并

  • 下面介绍——列分割

separate()函数可将一列拆分为多列,一般可用于日志数据或日期时间型数据的拆分,语法如下:
separate(data, col, into, sep = “分隔符”, remove = TRUE,
convert = FALSE, extra = “warn”, fill = “warn”, …)

data:为数据框
col:需要被拆分的列
into:新建的列名,为字符串向量
sep:被拆分列的分隔符
remove:是否删除被分割的列

> id <- c(1,2)
> datetime <- c(as.POSIXlt('2015-12-31 13:23:44'), as.POSIXlt('2016-01-28 21:14:12'))
> df <- data.frame(id = id, datetime = datetime)
> df
  id            datetime
1  1 2015-12-31 13:23:44
2  2 2016-01-28 21:14:12
  • 下面使用separate()函数将日期时间值分割为年、月、日、时、分、秒
> # 将日期时间数据切割为日期和时间两列
> separate1 <- df%>%separate(.,col = datetime,into = c("data","time"),
+                            sep = " ",remove = FALSE)
> separate1
  id            datetime       data     time
1  1 2015-12-31 13:23:44 2015-12-31 13:23:44
2  2 2016-01-28 21:14:12 2016-01-28 21:14:12
> # 将日期切割为年月日
> separate2 <- separate1 %>% separate(col = data,into = c("year","month","day"),
+                                     sep = "-",remove = FALSE)
> separate2
  id            datetime       data year month day     time
1  1 2015-12-31 13:23:44 2015-12-31 2015    12  31 13:23:44
2  2 2016-01-28 21:14:12 2016-01-28 2016    01  28 21:14:12
> # 将时间切割为时分秒
> separate3 <- separate2 %>% separate(col = time,into = c("hour","minute","second"),
+                                     sep = ":",remove = FALSE)
> separate3
  id            datetime       data year month day     time hour
1  1 2015-12-31 13:23:44 2015-12-31 2015    12  31 13:23:44   13
2  2 2016-01-28 21:14:12 2016-01-28 2016    01  28 21:14:12   21
  minute second
1     23     44
2     14     12
  • 下面介绍——列合并

unite()函数与separate()函数相反,可将多列合并为一列,语法如下:

unite(data, col, …, sep = “_”, remove = TRUE)
data:为数据框
col:被组合的新列名称
…:指定哪些列需要被组合
sep:组合列之间的连接符,默认为下划线
remove:是否删除被组合的列

> #删除原来的日期时间列、日期列和时间列
> separate3 <- separate3[, -c(2,3,7)]
> separate3 
  id year month day hour minute second
1  1 2015    12  31   13     23     44
2  2 2016    01  28   21     14     12
> #将年月日合并为新字段日期
> unite1 <- unite(data = separate3, 'date', sep = '-', year, month, day)
> unite1
  id       date hour minute second
1  1 2015-12-31   13     23     44
2  2 2016-01-28   21     14     12

关于缺失值

首先了解一下处理缺失值的一般步骤:

  • 1)识别缺失值;

第一步对缺失值的识别是非常简单的,可以使用is.na()、is.nan()、和is.infinite()函数来鉴别数据集中是否存在缺失;

  • 2)检测导致缺失数据的原因;

第二步需要根据实际的场景业务去理解缺失的原因,如敏感数据导致用户不填或网络、机器故障导致数据断层等;

  • 3)删除包含缺失值的观测或用合理的值代替缺失值。

第三步是处理缺失的重要步骤,一般可以通过推理法、行删除法和多重插补法进行处理

下面具体来介绍

一、识别缺失值

  • 上面提到可以使用is.na()、is.nan()、和is.infinite()来鉴别数据集中是否存在缺失,但该方法返回的是所有向量或数据框中每一个元素是否为缺失值,显然数据量非常大的话该方法返回的结果就不太容易接受。


  • mice包中的md.pattern()函数来发现数据集中缺失值的模式。但该方法只能识别R中的NA和NaN为缺失值,而不能将-Inf和Inf视为缺失值,处理的办法可以用NA替代这些值。

> set.seed(1234)
> x1 <- runif(n = 1000, min = 1, max = 15) 
> x2 <- 100*rnorm(n = 1000) + 10 
> x3 <- rt(n = 1000, df = 3) 
> x4 <- rf(n = 1000, df1 = 2, df2 = 3) 
> y <- 2*x1 - 0.3*x2 + 0.6*x3 - 1.2*x4 + rnorm(1000) 
> nonemiss.df <- data.table(y = y, x1 = x1, x2 = x2, x3 = x3, x4 = x4)
> nonemiss.df
               y        x1           x2         x3        x4
   1: -25.642609  2.591848  108.4779968  1.5206970 1.6421182
   2:  52.469333  9.712192 -112.4737876  0.9541739 0.8233494
   3:  -5.777701  9.529846   80.9726218 -0.5763673 1.6377639
   4:  11.783031  9.727312   -0.9219993 -0.8390399 6.3839570
   5: -30.094348 13.052815  188.2607895  0.9603589 0.8097546
  ---                                                       
 996:  -2.531766  1.018322   13.9589562 -0.8615238 0.7856535
 997: -25.752777 11.743963  158.0990197 -2.1667088 0.4541599
 998:  -9.970456  5.479714   66.6660058 -1.1474349 0.1537334
 999: -28.987563 14.412180  188.9580359  0.8767898 1.0181988
1000: -29.245580  3.735566  121.4047851  3.3353688 3.0958502
 #随机将y,x3和x4列的某些观测设为缺失值 
> set.seed(1234)> 
> miss.df <- data.frame(y = y, x1 = x1, x2 = x2, x3 = x3, x4 = x4) 
> miss.df[sample(1:nrow(miss.df), 40),1] <- NA> 
> miss.df[sample(1:nrow(miss.df), 50),4] <- NA 
> miss.df[sample(1:nrow(miss.df), 60),5] <- NA
> nonemiss.df
               y        x1           x2         x3        x4
   1: -25.642609  2.591848  108.4779968  1.5206970 1.6421182
   2:  52.469333  9.712192 -112.4737876  0.9541739 0.8233494
   3:  -5.777701  9.529846   80.9726218 -0.5763673 1.6377639
   4:  11.783031  9.727312   -0.9219993 -0.8390399 6.3839570
   5: -30.094348 13.052815  188.2607895  0.9603589 0.8097546
  ---                                                       
 996:  -2.531766  1.018322   13.9589562 -0.8615238 0.7856535
 997: -25.752777 11.743963  158.0990197 -2.1667088 0.4541599
 998:  -9.970456  5.479714   66.6660058 -1.1474349 0.1537334
 999: -28.987563 14.412180  188.9580359  0.8767898 1.0181988
1000: -29.245580  3.735566  121.4047851  3.3353688 3.0958502
#用mice包中的md.pattern()函数探索缺失值的模式
> install.packages("mice")
> library(mice)
> md.pattern(miss.df)
    x1 x2  y x3 x4    
858  1  1  1  1  1   0
55   1  1  1  1  0   1
45   1  1  1  0  1   1
2    1  1  1  0  0   2
34   1  1  0  1  1   1
3    1  1  0  1  0   2
3    1  1  0  0  1   2
     0  0 40 50 60 150
Rplot.png

上面返回了数据集中缺失值的情况,0表示列中存在缺失值,1表示列中不存在缺失值。

  • 第一行描述数据集中没有缺失值的模式;
  • 从第二行至倒数第二行反映了某些列中会存在缺失值;
  • 第一列表示缺失值的观测数量(排除第一个值,即858);
  • 最后一列表示缺失值的变量个数;
  • 最后一行给出每个变量缺失值的个数。
  • 通过这张缺失值模式表能够清楚的发现哪些变量存在缺失值,而这些变量又包含了多少数量的缺失。还可以通过可视化的方法来探索数据集中存在缺失值的情况,本人比较喜欢使用VIM包中的aggr()函数
> install.packages("VIM")
> library(VIM)
> aggr(miss.df, prop = FALSE, numbers = TRUE)
Rplot01.png

二、缺失数据处理方法

  • 推理法

该方法根据变量间的数学或逻辑关系进行填补或恢复缺失值,如根据某几个变量间的关系来推断缺失值可能的值;根据姓名来推断缺失的性别或根据购买的产品特征推断用户可能所属的年龄段等。

  • 行删除法

数据集中含有一个或多个缺失值的任意一行都会被删除,一般假定缺失数据是完全随机产生的,且缺失的量仅仅是数据集中的一小部分,可以考虑使用该方法进行缺失值的处理。

  • 多重插补法

该方法是一种基于重复模拟的处理缺失值的方法,它将从一个含缺失值的数据集中生成一组完整的数据集,这些缺失值都是通过蒙特卡洛方法进行替补。替补方法有很多,如贝叶斯线性回归法、自助线性回归法、Logist回归法和线性判别分析法等。

关于多重插补法可以使用mice包中的mice()函数(有关该函数的详细说明可以查看R的帮助文档),该包实现多重插补法并将完整数据集应用到统计模型中的思路如下:

  • 1)mice()函数从一个含缺失值的数据框开始,返回一个包含多个完整数据集对象(默认可以模拟参数5个完整的数据集);
  • 2)with()函数可依次对每个完整数据集应用统计建模;
  • 3)pool()函数将with()生成的单独结果整合到一起。
> library(mice) 
> im <- mice(data = miss.df, m = 10, method = 'pmm')
 iter imp variable
  1   1  y  x3  x4
  1   2  y  x3  x4
  1   3  y  x3  x4
  1   4  y  x3  x4
  1   5  y  x3  x4
  1   6  y  x3  x4
  1   7  y  x3  x4
  1   8  y  x3  x4
  1   9  y  x3  x4
  1   10  y  x3  x4
  2   1  y  x3  x4
  2   2  y  x3  x4
  2   3  y  x3  x4
  2   4  y  x3  x4
  2   5  y  x3  x4
  2   6  y  x3  x4
  2   7  y  x3  x4
  2   8  y  x3  x4
  2   9  y  x3  x4
  2   10  y  x3  x4
  3   1  y  x3  x4
  3   2  y  x3  x4
  3   3  y  x3  x4
  3   4  y  x3  x4
  3   5  y  x3  x4
  3   6  y  x3  x4
  3   7  y  x3  x4
  3   8  y  x3  x4
  3   9  y  x3  x4
  3   10  y  x3  x4
  4   1  y  x3  x4
  4   2  y  x3  x4
  4   3  y  x3  x4
  4   4  y  x3  x4
  4   5  y  x3  x4
  4   6  y  x3  x4
  4   7  y  x3  x4
  4   8  y  x3  x4
  4   9  y  x3  x4
  4   10  y  x3  x4
  5   1  y  x3  x4
  5   2  y  x3  x4
  5   3  y  x3  x4
  5   4  y  x3  x4
  5   5  y  x3  x4
  5   6  y  x3  x4
  5   7  y  x3  x4
  5   8  y  x3  x4
  5   9  y  x3  x4
  5   10  y  x3  x4 
> fit <- with(data = im, expr = lm(y ~ x1 + x2 + x3 + x4))
> pooled <- pool(object = fit) 
> summary(pooled)
               estimate    std.error    statistic       df   p.value
(Intercept)  0.01683167 0.0726224265    0.2317696 841.7101 0.8167733
x1           2.00401462 0.0080438273  249.1369521 637.1336 0.0000000
x2          -0.30001081 0.0003660614 -819.5640613 229.3173 0.0000000
x3           0.61370389 0.0197867137   31.0159583 437.1691 0.0000000
x4          -1.20668892 0.0049298963 -244.7696376 532.9739 0.0000000
#以上,给出了线性模型在填补缺失值后的数据集的返回结果。
为了比较,同样将缺失数据集应用到线性模型中:
> lm.fit <- lm(y ~ x1 + x2 + x3 + x4, data = miss.df)
> summary(lm.fit)
Call:
lm(formula = y ~ x1 + x2 + x3 + x4, data = miss.df)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2114 -0.6782  0.0237  0.6604  3.5705 

Coefficients:
              Estimate Std. Error  t value Pr(>|t|)    
(Intercept)  0.0141706  0.0758362    0.187    0.852    
x1           2.0028833  0.0083552  239.718   <2e-16 ***
x2          -0.2999110  0.0003584 -836.905   <2e-16 ***
x3           0.6179078  0.0200083   30.883   <2e-16 ***
x4          -1.2042557  0.0051187 -235.265   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 0.9951 on 853 degrees of freedom
  (142 observations deleted due to missingness)
Multiple R-squared:  0.999, Adjusted R-squared:  0.999 
F-statistic: 2.111e+05 on 4 and 853 DF,  p-value: < 2.2e-16
  • 发现缺失数据集和多重插补数据集应用到线性回归后的参数估计基本一致,这主要是因为缺失值是完全随机产生的。如果缺失值不是随机产生的,且缺失比重比较大的话,就不适合使用行删除法,而强烈建议使用多重插补法。

  • 还有一种比较传统的方法是用均值或中位数来替换缺失值,如果缺失数据量比较大的话,该方法可能会低估标准差和曲解变量间的相关性,导致错误的统计检验和P值。

最后编辑于
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 213,047评论 6 492
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 90,807评论 3 386
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 158,501评论 0 348
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 56,839评论 1 285
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 65,951评论 6 386
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 50,117评论 1 291
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 39,188评论 3 412
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 37,929评论 0 268
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 44,372评论 1 303
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 36,679评论 2 327
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 38,837评论 1 341
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 34,536评论 4 335
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 40,168评论 3 317
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 30,886评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,129评论 1 267
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 46,665评论 2 362
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 43,739评论 2 351

推荐阅读更多精彩内容