• R语言学习笔记之七


    摘要: 仅用于记录R语言学习过程:

    内容提要: 

    缺失值的识别与处理;

    异常值与重复值的处理

    正文:

    缺失值的识别与处理

    导读:

           > x <- c(1,2,3,NA,NA,4)

    > mean(x)

    [1] NA

    > sum(x)

    [1] NA

    > mean(x,na.rm = TRUE)

    [1] 2.5

    > sum(x,na.rm = TRUE)

    [1] 10

    > is.na(x)

    [1] FALSE FALSE FALSE  TRUE  TRUE FALSE

    > sum(is.na(x))

    [1] 2

    n  用[! ]去掉缺失值

    u  示例:

    > x[!is.na(x)]

    [1] 1 2 3 4

    > iris_na <- iris

    > for (i in 1:4) {

    +   iris_na[sample(1:nrow(iris),5),i] = NA

    + }

    >

    > sapply(iris_na[,1:4],function(x)sum(is.na(x)))

    我 是 中 国

     5  5  5  5

    > sapply(iris_na[,1:4],function(x)which(is.na(x))) #which返回的是位置

          我  是 中  国

    [1,]  10  11  6  28

    [2,]  60  52 21 108

    [3,]  92  54 32 111

    [4,] 108 113 79 124

    [5,] 144 136 83 135

    u  psych扩展包里describe()函数,用于描述数据集的基本统计值

    u  计算缺失值的比例:

    l  示例:

    > sapply(iris_na[,1:4],function(x)sum(is.na(x)/nrow(iris_na)))

            我         是         中         国

    0.03333333 0.03333333 0.03333333 0.03333333

    n  缺失值对于回归分析的影响

    u  示例:

    u  lm(Sepal.length~Sepal.Width,data = iris_na,na.action = na.omit) #在进行回归分析是也要去除缺失值,用na.action,但其默认也是na.action=na.omit

    n  缺失值得填补:一般采用中数和中位数,具体如下

    u  示例1:

    mean_value <- sapply(iris_na[,1:4],mean,na.rm = TRUE)

    for (i in 1:4) {

      iris_na[is.na(iris_na[,i],i)] = mean_value[i]

    }

    u  示例2:

    > cancer[sample(1:1000,90),2] <- NA   #生成缺失值

    > mean_value <- tapply(cancer$sur_days,list(cancer$type,cancer$treatment),mean,na.rm = TRUE)

    > mean_value     #求均值

             chemo     sugr

    colon 523.6489 539.9329

    liver 530.1656 576.6056

    lung  547.7427 553.1241

    > for (i in 1:3){

    +   for (j in 1:2){

    +     cancer$sur_days[is.na(cancer$sur_days) & cancer$type == rownames(mean_value)[i]

    +                     & cancer$treatment == colnames(mean_value)[j]] =mean_value[i,j]

    +   }

    + }     #填补缺失值

    > summary(cancer)

           id            sur_days         type     treatment 

    1.  Min.   :   1.0   Min.   : 100.0   colon:320   chemo:497 

     1st Qu.: 250.8   1st Qu.: 335.8   liver:330   sugr :503 

     Median : 500.5   Median : 547.7   lung :350             

     Mean   : 500.5   Mean   : 545.4                         

     3rd Qu.: 750.2   3rd Qu.: 738.5                         

    1.  Max.   :1000.0   Max.   :1000.0                       

    > describe(cancer)

               vars    n   mean     sd median trimmed    mad min  max range

    id            1 1000 500.50 288.82 500.50  500.50 370.65   1 1000   999

    sur_days      2 1000 545.45 247.96 547.74  544.41 300.23 100 1000   900

    type*         3 1000   2.03   0.82   2.00    2.04   1.48   1    3     2

    treatment*    4 1000   1.50   0.50   2.00    1.50   0.00   1    2     1

                skew kurtosis   se

    id          0.00    -1.20 9.13

    sur_days    0.03    -1.00 7.84

    type*      -0.06    -1.51 0.03

    treatment* -0.01    -2.00 0.02

    n  用R包对缺失值进行填补

    u  安装mlbench包

    l  示例:

    install.packages('mlbench')

    library(mlbench)

    data('BostonHousing')

    original_data <- BostonHousing

    set.seed(2018)

    BostonHousing[sample(1:nrow(BostonHousing),80),'rad'] <- NA  #在rad列生成缺失值

    BostonHousing[sample(1:nrow(BostonHousing),80),'ptratio'] <- NA   #在ptratio列生成缺失值

    u  安装mice包,利用里面的md.pattern()函数查看缺失值得模式。md.pattern(BostonHousing数据集名称) ,0代表缺失,1表示不缺失,最后一行表示缺失总数。

    u  安装Hmisc包,利用其中的impute()插补:参数设置:需要插补的对象,拟插补的参数

    n  示例:

    im_mean <- impute(BostonHousing$ptratio,mean)  #mean可以换成median或者固定的数字

    BostonHousing$ptratio <- NULL

    BostonHousing$im_mean <- im_mean

    u  用mice包(链式方程多元插值)进行缺失值填补,基本思想为利用一种模型,把缺失值的变量作为因变量,把其他不缺失的变量作为自变量进行回归分析,以预测缺失值

    n  示例:

    mice_mod <- mice(BostonHousing[,!names(BostonHousing)%in% 'medv'],method ='rf')     #rf 随机森林

    mice_output <- complete(mice_mod)   #complete函数,完整显示

    anyNA(mice_output)  #是否还有NA值

    FALSE

    n  示例2:查看预测的精度

    actuals <- original_data$rad[is.na(BostonHousing$rad)]  #查看原始值

    predicts <- mice_out[is.na(BostonHousing$rad),'rad']  #查看预测值

    mean(actuals != predicts)   #原始值不等于预测值的比例

    0.3  #预测精度为70%

    VIM包:可以对缺失值进行可视化;也可以对数据进行插补

    n  数据可视化:

    u  示例:

    md.pattern(airquality)

    aggr_plot <- aggr(airquality,col = c('red','green'),numbers = TRUE,sortVars = T,labels = names(airquality),cex.axis = 0.7,gap = 3)

    marginplot(airquality[1:2]

    n  用线性回归模型进行插补:

    n  示例:

    data(sleep)

    head(sleep)

      BodyWgt BrainWgt NonD Dream Sleep Span Gest Pred Exp Danger

    1 6654.000   5712.0   NA    NA   3.3 38.6  645    3   5      3

    2    1.000      6.6  6.3   2.0   8.3  4.5   42    3   1      3

    3    3.385     44.5   NA    NA  12.5 14.0   60    1   1      1

    4    0.920      5.7   NA    NA  16.5   NA   25    5   2      3

    5 2547.000   4603.0  2.1   1.8   3.9 69.0  624    3   5      4

    6   10.550    179.5  9.1   0.7   9.8 27.0  180    4   4      4

    sleepIm <- regressionImp(Sleep + Gest + Span + Dream + NonD ~ BodyWgt+BrainWgt,data = sleep)   # 第一个为缺失值变量,~后面为不包含缺失值的变量,data为数据集名,也可以再考虑family 参数,可选auto

    head(sleepIm)    #不含有缺失值了,TRUE代表该位置原来为缺失值。

    BodyWgt BrainWgt       NonD      Dream Sleep     Span Gest Pred Exp Danger

    1 6654.000   5712.0 -11.732867 -0.6897314   3.3 38.60000  645    3   5      3

    2    1.000      6.6   6.300000  2.0000000   8.3  4.50000   42    3   1      3

    3    3.385     44.5   8.987353  2.0132372  12.5 14.00000   60    1   1      1

    4    0.920      5.7   9.017324  2.0148478  16.5 15.50179   25    5   2      3

    5 2547.000   4603.0   2.100000  1.8000000   3.9 69.00000  624    3   5      4

    6   10.550    179.5   9.100000  0.7000000   9.8 27.00000  180    4   4      4

      Sleep_imp Gest_imp Span_imp Dream_imp NonD_imp

    1     FALSE    FALSE    FALSE      TRUE     TRUE

    2     FALSE    FALSE    FALSE     FALSE    FALSE

    3     FALSE    FALSE    FALSE      TRUE     TRUE

    4     FALSE    FALSE     TRUE      TRUE     TRUE

    5     FALSE    FALSE    FALSE     FALSE    FALSE

    6     FALSE    FALSE    FALSE     FALSE    FALSE

      异常值与重复值的处理

    n  异常值的处理:原则:根据数据的实际背景来判断

    u  一些基础值:

    > set.seed(2017)

    > mmhg <- sample(60:250,1000, replace = TRUE)

    > range(mmhg)

    [1]  60 250

    > min(mmhg)

    [1] 60

    > max(mmhg)

    [1] 250

    > quantile(mmhg)  #四分位数

        0%    25%    50%    75%   100%

     60.00 104.75 154.00 199.00 250.00

    > fivenum(mmhg)  #四分位数

    [1]  60.0 104.5 154.0 199.0 250.0

    u  自定义函数:

    > outlierKD <- function(dt,var){

    +   var_name <-eval(substitute(var),eval(dt))

    +   tot <- sum(!is.na(var_name))

    +   na1 <- sum(is.na(var_name))

    +   m1 <- mean(var_name,na.rm = T)

    +   par(mfrow = c(2,2),oma = c(0,0,3,0))

    +   boxplot(var_name,main ='With outliers')

    +   hist(var_name,main ='With outliers',xlab = NA,ylab = NA)

    +   outlier <- var_name[var_name >230]

    +   mo <- mean(outlier)

    +   var_name <- ifelse(var_name %in% outlier, NA, var_name)

    +   boxplot(var_name,main ='Without outliers')

    +   hist(var_name,main ='Without outliers',xlab = NA,ylab = NA)

    +   title('Outlier Check',outer = T)

    +   na2 <- sum(is.na(var_name))

    +   cat('Outliers identified:',na2 - na1,' ')

    +   cat('Propotion (%) of outliers:',round((na2 - na1)/ tot * 100,1),' ')

    +   cat('Mean of the outliers:',round(mo,2),' ')

    +   m2 <- mean(var_name,na.rm = T)

    +   cat('Mean without removing outliers:',round(m1,2),' ')

    +   cat('Mean if we remove outliers:',round(m2,2),' ')

    +   response <- readline(prompt = 'Do you want to remove outliers

    +                        and to replace with NA? [yes/no]:')

    +   if (response == 'y' | response == 'yes'){

    +     dt[as.character(substitute(var))] <- invisible(var_name)

    +     assign(as.character(as.list(match.call())$dt),dt,envir = .GlobalEnv)

    +     cat('Outliers successfully removed',' ')

    +     return(invisible(dt))

    +   } else{

    +     cat('Nothing changed',' ')

    +     return(invisible(var_name))

    +   }

    + }

    > set.seed(2017)

    > df <- data.frame(bp = c(sample(80:250,1000,replace = T),NA,390,100))

    > outlierKD(df,bp)

    Outliers identified: 126

    Propotion (%) of outliers: 12.6

    Mean of the outliers: NA

    Mean without removing outliers: 163.79

    Mean if we remove outliers: 152.71

    Do you want to remove outliers

                           and to replace with NA? [yes/no]:

     同时也会生成可视化的图。

    n  重复值的处理:

    u  unique()函数:返回值   针对向量

    > x<- c(1,2,3,4,5,1,2,3)

    > unique(x)

    [1] 1 2 3 4 5

    u  duplicated()函数:返回逻辑值T和F,可用于提取子集  针对向量

    > x<- c(1,2,3,4,5,1,2,3)

    > duplicated(x)

    [1] FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE  TRUE

    > x[duplicated(x)]  #如要返回非重复值,前面加!

    [1] 1 2 3

    u  anyDuplicated()函数:返回第一个重复值出现的位置   针对向量

    > anyDuplicated(x)

    [1] 6

    u  对数据框进行重复值的处理

    l  自己设置条件

    library(readxl)

    mydata <- read_excel('absolute path/filename.xlsx')

    mydata[!(duplicated(mydata$name)& duplicated(mydata$birthday)),]

    l  用函数实现:paste()函数:主要是对字符串进行操作

    library(readxl)

    mydata <- read_excel('absolute path/filename.xlsx')

    mydata$test <- paste(mydata$name,mydata$birthday)  # 把两个变量粘在一起

    newdata <- mydata[!duplicated(mydata$test),]

  • 相关阅读:
    php memcache分布式和要注意的问题
    PHP延迟静态绑定(本文属于转发)
    WebSocket实战
    HTML5本地存储(Local Storage) 的前世今生
    HTML5本地存储——IndexedDB
    HTML5 FileReader
    HTML5 FormData对象
    2017-2018-1 20155225 实验四 外设驱动程序设计
    2017-2018-1 20155225 《信息安全系统设计基础》第十一周学习总结
    Linux下的IPC机制
  • 原文地址:https://www.cnblogs.com/ppjs/p/9435775.html
Copyright © 2020-2023  润新知