删除带R的所有列的异常值

我使用这些函数来删除异常值：

calcul.mad <- function(x) {
mad <- median(abs(x-median(x, na.rm=TRUE))) 
mad}

uper.interval <- function(x,y) {
up.inter <- median(x, na.rm=TRUE)+5*(y) 
up.inter}

lower.interval <- function(x,y) {
low.inter <- median(x, na.rm=TRUE)-5*(y)
low.inter}

functionData <- function(x,h,l) {
out <- ifelse(x > h, h, ifelse(x < l, l, x))
out}

---

calcul.mad您可以在数据帧上使用
apply

下面的代码将微调从5x更改为2x，因为正态分布的值不太可能与中值相距那么远

data_f <- data.frame(col1=rnorm(100,10,10), col2=rnorm(100,15,15), col3=rnorm(100,20,20))

calcul.mad <- function(x) {
mad <- median(abs(x-median(x, na.rm=TRUE))) 
mad}

uper.interval <- function(x,y) {
up.inter <- median(x, na.rm=TRUE)+2*(y) 
up.inter}

lower.interval <- function(x,y) {
low.inter <- median(x, na.rm=TRUE)-2*(y)
low.inter}

functionData <- function(x,h,l) {
out <- ifelse(x > h, h, ifelse(x < l, l, x))
out}


outlier.fun <- function(column1) {
  med_data <- median(column1, na.rm=TRUE)
  cal_mad <- calcul.mad(column1)
  up_data <- uper.interval(med_data, cal_mad)
  low_data <- lower.interval(med_data, cal_mad)
  column_without_outliers <- functionData(column1, up_data, low_data)

  return(column_without_outliers)
  }

data_f_noout <- apply(data_f, 2, outlier.fun)

summary(data_f)
summary(data_f_noout)

数据\u f您可以尝试从
dplyr
中对每个数据进行
汇总，并应用
中值
和
calcul.mad
。一旦我们得到它，我们就可以在重塑
Sum\u f1
之后计算
uper.interval
和
lower.interval
。然后，在获得所有值后应用
函数\u Data

library(dplyr)
Sum_f1 <- summarise_each(data_f,funs(median, calcul.mad))

n <-  2*ncol(data_f)

dl <- reshape(Sum_f1, idvar='id', direction='long', sep="_", 
                      varying=split(seq(n), as.numeric(gl(n,n/2,n))))


up_data <- mapply(uper.interval, dl[,2], dl[,3])
low_data <- mapply(lower.interval, dl[,2], dl[,3])
data_f1 <- data_f
data_f1[] <- Map(functionData, data_f, up_data, low_data)

库（dplyr）
Sum_f1您可以使用以下方法简化此过程

data_f <- data.frame(col1=rnorm(100,10,10), col2=rnorm(100,15,15), col3=rnorm(100,20,20))

library(tidyverse)

rmOutlier <- function(x){
                        low <- median(x, na.rm=TRUE)-5*(mad(x)) 
                       high <- median(x, na.rm=TRUE)+5*(mad(x))   
                       out <- if_else(x > high, NA,ifelse(x < low, low, x)) 
                       out }

data_f2 <- map_df(data_f, rmOutlier)

data\u f检查plyr包中的“colwise”功能；这可能会满足您的需要。您可以使用
apply
，而不必在使用
lappy
时强制返回到
data.frame
。两者都同样快：
apply（data\u f，2，outlier.fun）
出于好奇，我做了一些基准测试，比较了公认的
dplyr
方法和这个基本R方法。有趣的是，
dplyr
方法只快了7-10%。@treysp我只在
第一行使用了
dplyr
。其他代码只是calcul.mad（Id）中的
base R
错误：找不到函数“calcul.mad”
library(dplyr)
Sum_f1 <- summarise_each(data_f,funs(median, calcul.mad))

n <-  2*ncol(data_f)

dl <- reshape(Sum_f1, idvar='id', direction='long', sep="_", 
                      varying=split(seq(n), as.numeric(gl(n,n/2,n))))


up_data <- mapply(uper.interval, dl[,2], dl[,3])
low_data <- mapply(lower.interval, dl[,2], dl[,3])
data_f1 <- data_f
data_f1[] <- Map(functionData, data_f, up_data, low_data)

data_f <- data.frame(col1=rnorm(100,10,10), col2=rnorm(100,15,15), col3=rnorm(100,20,20))

library(tidyverse)

rmOutlier <- function(x){
                        low <- median(x, na.rm=TRUE)-5*(mad(x)) 
                       high <- median(x, na.rm=TRUE)+5*(mad(x))   
                       out <- if_else(x > high, NA,ifelse(x < low, low, x)) 
                       out }

data_f2 <- map_df(data_f, rmOutlier)