R 缺失值處理

data(iris)
set.seed(1234)
library(missForest)
iris.miss <- prodNA(iris)
summary(iris.miss)

# Sepal.Length    Sepal.Width     Petal.Length    Petal.Width          Species  
# Min.   :4.300   Min.   :2.000   Min.   :1.000   Min.   :0.100   setosa    :41  
# 1st Qu.:5.100   1st Qu.:2.800   1st Qu.:1.600   1st Qu.:0.300   versicolor:45  
# Median :5.700   Median :3.000   Median :4.400   Median :1.300   virginica :45  
# Mean   :5.787   Mean   :3.059   Mean   :3.822   Mean   :1.182   NA's      :19  
#  3rd Qu.:6.400   3rd Qu.:3.300   3rd Qu.:5.100   3rd Qu.:1.800                  
#  Max.   :7.900   Max.   :4.400   Max.   :6.900   Max.   :2.500                  
#  NA's   :12      NA's   :16      NA's   :12      NA's   :16     
#查閱缺少值在40%以上(不含)數(shù)據(jù)所在行的行號(hào)
library(DMwR)
manyNAs(iris.miss,0.4)

#缺失值統(tǒng)計(jì)1
library(mice)
par(mar=c(0,0,0,0))
md.pattern(iris.miss,rotate.names=T)

#缺失值統(tǒng)計(jì)2
library(VIM)
aggr(iris.miss,prop=F,numbers=T,cex.axis=0.8)
缺失值統(tǒng)計(jì)1

缺失值統(tǒng)計(jì)2

處理方法:常規(guī)方法

#刪除缺少值所在行
iris.sub <- na.omit(iris.miss)
iris.sub <- iris.miss[complete.cases(iris.miss),]
nrow(iris.sub)
#平均值填補(bǔ)
iris1 <- iris.miss
library(Hmisc)
iris1$Sepal.Length <- impute(iris.miss$Sepal.Length,mean)
summary(abs(iris$Sepal.Length-iris1$Sepal.Length)/iris$Sepal.Length)
# Imputed Values:
#   
#   [1] 0.25803403 0.15739130 0.01915991 0.03550725 0.06661992 0.08143547 0.18493570 0.20726623 0.24844720 0.21797885
#  [11] 0.24844720 0.13627515
# 
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# 0.00000 0.00000 0.00000 0.01241 0.00000 0.25803 
regr.eval(iris$Sepal.Length,iris1$Sepal.Length)
# mae        mse       rmse       mape 
# 0.08269565 0.11525709 0.33949534 0.01240999 
#中位數(shù)填補(bǔ)
iris1$Sepal.Length <- impute(iris.miss$Sepal.Length,median)
summary(abs(iris$Sepal.Length-iris1$Sepal.Length)/iris$Sepal.Length)
# Imputed Values:
#   
#   [1] 0.23913043 0.14000000 0.03389831 0.05000000 0.08064516 0.09523810 0.19718310 0.21917808 0.25974026 0.22972973
#  [11] 0.25974026 0.14925373
# 
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
# 0.00000 0.00000 0.00000 0.01302 0.00000 0.25974
regr.eval(iris$Sepal.Length,iris1$Sepal.Length)
# mae        mse       rmse       mape 
# 0.08733333 0.12566667 0.35449495 0.01302491 
#使用缺失值前(后)的數(shù)據(jù)進(jìn)行填補(bǔ)
library(zoo)
iris1$Sepal.Length <- na.locf(iris.miss$Sepal.Length,fromLast = T)#fromLast = F
summary(abs(iris$Sepal.Length-iris1$Sepal.Length)/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.007691 0.000000 0.181818 
regr.eval(iris$Sepal.Length,iris1$Sepal.Length)
# mae         mse        rmse        mape 
# 0.051333333 0.047800000 0.218632111 0.007691407 
#眾數(shù)填補(bǔ)(有多個(gè)似嗤,也只取第一個(gè))
zs <- function(x){ return(as.numeric(names(sort(table(x),decreasing = T)[1])))}
iris1$Sepal.Length <- impute(iris.miss$Sepal.Length,zs)
summary(abs(iris$Sepal.Length-iris1$Sepal.Length)/iris$Sepal.Length)
# Imputed Values:
#   
#   [1] 0.08695652 0.00000000 0.15254237 0.16666667 0.19354839 0.20634921 0.29577465 0.31506849 0.35064935 0.32432432
#  [11] 0.35064935 0.25373134
# 
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# 0.00000 0.00000 0.00000 0.01798 0.00000 0.35065 
regr.eval(iris$Sepal.Length,iris1$Sepal.Length)
# mae        mse       rmse       mape 
# 0.12466667 0.25353333 0.50352094 0.01797507 
#隨機(jī)填補(bǔ)
set.seed(1234)
iris1$Sepal.Length <- impute(iris.miss$Sepal.Length,"random")
summary(abs(iris$Sepal.Length-iris1$Sepal.Length)/iris$Sepal.Length)
# Imputed Values:
#   
#   [1] 0.13043478 0.20000000 0.13559322 0.28333333 0.00000000 0.07936508 0.18309859 0.10958904 0.15584416 0.32432432
# [11] 0.18181818 0.13432836
# 
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# 0.00000 0.00000 0.00000 0.01278 0.00000 0.32432 
regr.eval(iris$Sepal.Length,iris1$Sepal.Length)
# mae        mse       rmse       mape 
# 0.08400000 0.11626667 0.34097898 0.01278486 

由mape(Mean absolute percentage error噩翠,平均絕對(duì)百分比誤差)可知锈津,以上的效果都不咋的暮顺,隨機(jī)填補(bǔ)的效果竟然處于第一等(和平均值一樣)乖篷,其他的都要更差勁

其他方法

#基于數(shù)據(jù)的中心趨勢(shì)(差勁)
iris1 <- centralImputation(iris.miss)
summary(abs(iris$Sepal.Length-iris1$Sepal.Length)/iris$Sepal.Length)
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# 0.00000 0.00000 0.00000 0.01302 0.00000 0.25974 
regr.eval(iris$Sepal.Length,iris1$Sepal.Length)
# mae        mse       rmse       mape 
# 0.08733333 0.12566667 0.35449495 0.01302491 
#KNN填補(bǔ)
library(DMwR)
iris1 <- knnImputation(iris.miss,k=5,scale = T,meth = "weighAvg")
summary(abs(iris$Sepal.Length-iris1$Sepal.Length)/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.004713 0.000000 0.135677 
regr.eval(iris$Sepal.Length,iris1$Sepal.Length)
# mae         mse        rmse        mape 
# 0.032537344 0.022380002 0.149599473 0.004713242 
#基于熱卡(hot-deck)插補(bǔ)法
library(hot.deck)
iris1 <- hot.deck(iris.miss)
summary(abs(iris$Sepal.Length-iris1$data[[1]][,1])/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.006674 0.000000 0.168831 
regr.eval(iris$Sepal.Length,iris1$data[[1]][,1])
# mae         mse        rmse        mape 
# 0.043333333 0.032466667 0.180185090 0.006674233 
#基于K-means聚類
library(ClustImpute)
res <- ClustImpute(iris.miss[,1:4],nr_cluster=3,seed_nr = 1234) 
summary(abs(iris$Sepal.Length-res$complete_data[,1])/iris$Sepal.Length)
# Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
# 0.00000 0.00000 0.00000 0.01298 0.00000 0.41558 
regr.eval(iris$Sepal.Length,res$complete_data[,1])
# mae        mse       rmse       mape 
# 0.09000000 0.16473333 0.40587354 0.01298464 
#隨機(jī)森林填補(bǔ)
library(missForest)
set.seed(1234)
iris1<- missForest(iris.miss,ntree = 100)
summary(abs(iris$Sepal.Length-iris1$ximp$Sepal.Length)/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.003736 0.000000 0.098378 
regr.eval(iris$Sepal.Length,iris1$ximp$Sepal.Length)
# mae         mse        rmse        mape 
# 0.024307178 0.010210473 0.101046885 0.003736354 
#多重插補(bǔ)
library(mice)
imputed.data <- mice(iris.miss,seed = 1234)
summary(imputed.data)
# imputed.data$imp$Sepal.Length#每個(gè)缺失值有五組插補(bǔ)值
iris1<- complete(imputed.data)
summary(abs(iris$Sepal.Length-iris3$ximp$Sepal.Length)/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.003736 0.000000 0.098378 
regr.eval(iris$Sepal.Length,iris1$Sepal.Length)
# mae         mse        rmse        mape 
# 0.034000000 0.022600000 0.150332964 0.005511659 
#基于逐步線性回歸
library(imputeR)
impdata <- impute(iris.miss[1:4], lmFun = "stepBothR")
summary(abs(iris$Sepal.Length-impdata$imp[,1])/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.004157 0.000000 0.113774 
regr.eval(iris$Sepal.Length,impdata$imp[,1])
# mae         mse        rmse        mape 
# 0.028266645 0.014647495 0.121026838 0.004156997 
#基于偏最小二乘法
impdata <- impute(iris.miss[1:4], lmFun = "plsR")
summary(abs(iris$Sepal.Length-impdata$imp[,1])/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.004602 0.000000 0.117457 
regr.eval(iris$Sepal.Length,impdata$imp[,1])
# mae         mse        rmse        mape
# 0.031493171 0.018252665 0.135102424 0.004601763
#基于lasso(ridge)回歸
impdata <- impute(iris.miss[1:4], lmFun = "lassoR")#也可以選擇ridgeR
summary(abs(iris$Sepal.Length-impdata$imp[,1])/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.004185 0.000000 0.113492 
regr.eval(iris$Sepal.Length,impdata$imp[,1])
# mae         mse        rmse        mape 
# 0.028470418 0.014835973 0.121803010 0.004184943 
#基于主成分回歸
impdata <- impute(iris.miss[1:4], lmFun = "pcrR")
summary(abs(iris$Sepal.Length-impdata$imp[,1])/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.004751 0.000000 0.122191 
regr.eval(iris$Sepal.Length,impdata$imp[,1])
# mae         mse        rmse        mape 
# 0.032481150 0.019359134 0.139137105 0.004751286 

#另一種基于SVD的主成分分析
library(missMDA)
nb <- estim_ncpPCA( iris.miss[1:4],ncp.max = 5)
imputed <- imputePCA(iris.miss[1:4],ncp=2)
summary(abs(iris$Sepal.Length-imputed$completeObs[,1])/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.003319 0.000000 0.145998 
regr.eval(iris$Sepal.Length,imputed$completeObs[,1])
# mae         mse        rmse        mape 
# 0.021932719 0.014370704 0.119877870 0.003319263 
#基于混合數(shù)據(jù)的因子分析
res.impute <- imputeFAMD(iris.miss,ncp=3)
summary(abs(iris$Sepal.Length-res.impute$completeObs$Sepal.Length)/iris$Sepal.Length)
# Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
# 0.000000 0.000000 0.000000 0.003186 0.000000 0.133000 
regr.eval(iris$Sepal.Length,res.impute$completeObs$Sepal.Length)
# mae         mse        rmse        mape 
# 0.021656096 0.015004907 0.122494517 0.003185862 

其他方法中响驴,除基于數(shù)據(jù)的中心趨勢(shì)和K-means聚類外,其他填補(bǔ)的效果都還不錯(cuò)撕蔼,尤其是隨機(jī)森林和SVD主成分以及基于混合數(shù)據(jù)的因子分析的算法豁鲤,錯(cuò)誤率低秽誊,效果相當(dāng)可以

最后編輯于
?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請(qǐng)聯(lián)系作者
  • 序言:七十年代末,一起剝皮案震驚了整個(gè)濱河市琳骡,隨后出現(xiàn)的幾起案子锅论,更是在濱河造成了極大的恐慌,老刑警劉巖日熬,帶你破解...
    沈念sama閱讀 206,013評(píng)論 6 481
  • 序言:濱河連續(xù)發(fā)生了三起死亡事件棍厌,死亡現(xiàn)場(chǎng)離奇詭異,居然都是意外死亡竖席,警方通過(guò)查閱死者的電腦和手機(jī)耘纱,發(fā)現(xiàn)死者居然都...
    沈念sama閱讀 88,205評(píng)論 2 382
  • 文/潘曉璐 我一進(jìn)店門(mén),熙熙樓的掌柜王于貴愁眉苦臉地迎上來(lái)毕荐,“玉大人束析,你說(shuō)我怎么就攤上這事≡餮牵” “怎么了员寇?”我有些...
    開(kāi)封第一講書(shū)人閱讀 152,370評(píng)論 0 342
  • 文/不壞的土叔 我叫張陵,是天一觀的道長(zhǎng)第美。 經(jīng)常有香客問(wèn)我蝶锋,道長(zhǎng),這世上最難降的妖魔是什么什往? 我笑而不...
    開(kāi)封第一講書(shū)人閱讀 55,168評(píng)論 1 278
  • 正文 為了忘掉前任扳缕,我火速辦了婚禮,結(jié)果婚禮上别威,老公的妹妹穿的比我還像新娘躯舔。我一直安慰自己,他們只是感情好省古,可當(dāng)我...
    茶點(diǎn)故事閱讀 64,153評(píng)論 5 371
  • 文/花漫 我一把揭開(kāi)白布粥庄。 她就那樣靜靜地躺著,像睡著了一般豺妓。 火紅的嫁衣襯著肌膚如雪惜互。 梳的紋絲不亂的頭發(fā)上,一...
    開(kāi)封第一講書(shū)人閱讀 48,954評(píng)論 1 283
  • 那天琳拭,我揣著相機(jī)與錄音载佳,去河邊找鬼。 笑死臀栈,一個(gè)胖子當(dāng)著我的面吹牛,可吹牛的內(nèi)容都是我干的挠乳。 我是一名探鬼主播权薯,決...
    沈念sama閱讀 38,271評(píng)論 3 399
  • 文/蒼蘭香墨 我猛地睜開(kāi)眼姑躲,長(zhǎng)吁一口氣:“原來(lái)是場(chǎng)噩夢(mèng)啊……” “哼!你這毒婦竟也來(lái)了盟蚣?” 一聲冷哼從身側(cè)響起黍析,我...
    開(kāi)封第一講書(shū)人閱讀 36,916評(píng)論 0 259
  • 序言:老撾萬(wàn)榮一對(duì)情侶失蹤,失蹤者是張志新(化名)和其女友劉穎屎开,沒(méi)想到半個(gè)月后阐枣,有當(dāng)?shù)厝嗽跇?shù)林里發(fā)現(xiàn)了一具尸體,經(jīng)...
    沈念sama閱讀 43,382評(píng)論 1 300
  • 正文 獨(dú)居荒郊野嶺守林人離奇死亡奄抽,尸身上長(zhǎng)有42處帶血的膿包…… 初始之章·張勛 以下內(nèi)容為張勛視角 年9月15日...
    茶點(diǎn)故事閱讀 35,877評(píng)論 2 323
  • 正文 我和宋清朗相戀三年蔼两,在試婚紗的時(shí)候發(fā)現(xiàn)自己被綠了拉宗。 大學(xué)時(shí)的朋友給我發(fā)了我未婚夫和他白月光在一起吃飯的照片算利。...
    茶點(diǎn)故事閱讀 37,989評(píng)論 1 333
  • 序言:一個(gè)原本活蹦亂跳的男人離奇死亡,死狀恐怖疾党,靈堂內(nèi)的尸體忽然破棺而出档泽,到底是詐尸還是另有隱情俊戳,我是刑警寧澤,帶...
    沈念sama閱讀 33,624評(píng)論 4 322
  • 正文 年R本政府宣布馆匿,位于F島的核電站抑胎,受9級(jí)特大地震影響,放射性物質(zhì)發(fā)生泄漏渐北。R本人自食惡果不足惜阿逃,卻給世界環(huán)境...
    茶點(diǎn)故事閱讀 39,209評(píng)論 3 307
  • 文/蒙蒙 一、第九天 我趴在偏房一處隱蔽的房頂上張望腔稀。 院中可真熱鬧盆昙,春花似錦、人聲如沸焊虏。這莊子的主人今日做“春日...
    開(kāi)封第一講書(shū)人閱讀 30,199評(píng)論 0 19
  • 文/蒼蘭香墨 我抬頭看了看天上的太陽(yáng)诵闭。三九已至炼团,卻和暖如春,著一層夾襖步出監(jiān)牢的瞬間疏尿,已是汗流浹背瘟芝。 一陣腳步聲響...
    開(kāi)封第一講書(shū)人閱讀 31,418評(píng)論 1 260
  • 我被黑心中介騙來(lái)泰國(guó)打工, 沒(méi)想到剛下飛機(jī)就差點(diǎn)兒被人妖公主榨干…… 1. 我叫王不留褥琐,地道東北人锌俱。 一個(gè)月前我還...
    沈念sama閱讀 45,401評(píng)論 2 352
  • 正文 我出身青樓,卻偏偏與公主長(zhǎng)得像敌呈,于是被迫代替她去往敵國(guó)和親贸宏。 傳聞我的和親對(duì)象是個(gè)殘疾皇子造寝,可洞房花燭夜當(dāng)晚...
    茶點(diǎn)故事閱讀 42,700評(píng)論 2 345

推薦閱讀更多精彩內(nèi)容

  • 本版塊打算分享一些數(shù)據(jù)分析過(guò)程中用到的數(shù)據(jù)清洗,統(tǒng)計(jì)分析吭练,建立簡(jiǎn)單模型等诫龙。 拿到數(shù)據(jù)后,在清楚了分析需求后鲫咽,別急著...
    生信補(bǔ)給站閱讀 2,329評(píng)論 0 4
  • 建議:不同場(chǎng)景下的數(shù)據(jù)缺失機(jī)制不同签赃,這需要工程師基于對(duì)業(yè)務(wù)選擇合適的填充方法。 如何判斷缺失值類型分尸?缺失值的分類按...
    堂堂正正的大號(hào)閱讀 8,088評(píng)論 0 2
  • 1. 刪除 主要有簡(jiǎn)單刪除法和權(quán)重法锦聊。簡(jiǎn)單刪除法是對(duì)缺失值進(jìn)行處理的最原始方法。 (1) 簡(jiǎn)單刪除法 此方法將存在...
    ZhangShiWen閱讀 1,607評(píng)論 0 2
  • 第一部分 分類 第一章 機(jī)器學(xué)習(xí)基礎(chǔ)(代碼) 熟悉Python即可寓落。 開(kāi)發(fā)機(jī)器學(xué)習(xí)應(yīng)用程序步驟收集數(shù)據(jù)制作網(wǎng)絡(luò)爬蟲(chóng)...
    除了學(xué)習(xí)什么都不gan閱讀 2,032評(píng)論 0 0
  • 文章作者:Tyan博客:noahsnail.com | CSDN | 簡(jiǎn)書(shū) 聲明:作者翻譯論文僅為學(xué)習(xí)括丁,如有侵權(quán)請(qǐng)...
    SnailTyan閱讀 9,023評(píng)論 0 16