给定一个大数据集，如何使用 R 的 IQR 方法删除异常值

Question

我们获得了一个大型数据集，并要求我们使用 R 的 IQR 方法删除异常值。

数据有 53 列，其中 17 列是连续的，其余是分类的。您将如何使用 IQR 方法删除多列的异常值并更新数据框？

我在网上找到了这个函数，但它不考虑具有分类值的列。

sample_data <- data.frame(x=c(1, 2, 3, 4, 3, 2, 3, 4, 4, 5, 0),
                           y=c(4, 3, 5, 7, 8, 5, 9, 7, 6, 5, 0),
                           z=c(1, 3, 2, 9, 8, 7, 0, 8, 7, 2, 3))
print("Display original dataframe")
print(sample_data)

detect_outlier <- function(x) {
  
  # calculate first quantile
  Quantile1 <- quantile(x, probs=.25)
  
  # calculate third quantile
  Quantile3 <- quantile(x, probs=.75)
  
  # calculate inter quartile range
  IQR = Quantile3-Quantile1
  
  # return true or false
  x > Quantile3 + (IQR*1.5) | x < Quantile1 - (IQR*1.5)
}

# create remove outlier function
remove_outlier <- function(dataframe,
                           columns=names(dataframe)) {
  
  # for loop to traverse in columns vector
  for (col in columns) {
    
    # remove observation if it satisfies outlier function
    dataframe <- dataframe[!detect_outlier(dataframe[[col]]), ]
  }
  
  # return dataframe
  print("Remove outliers")
  print(dataframe)
}

remove_outlier(sample_data, c('x', 'y', 'z', 'w'))




########these are all my variables

'car.deliver.airport.num','car.deliver.hotel.num','car.deliver.train.station.num','car.displayed.turo.review.num',  'car.displayed.turo.review.num.past.12m','car.displayed.turo.review.num.past.18m','car.displayed.turo.review.num.past.6m','car.displayed.user.review.num','car.displayed.user.review.num.past.12m','car.displayed.user.review.num.past.18m','car.displayed.user.review.num.past.6m','car.extra.mile.fee','car.extra.num','car.extra.phone.mount','car.extra.portable.gps','car.extra.post.trip.cleaning','car.extra.prepaid.ev.recharge','car.extra.prepaid.refuel','car.extra.stroller','car.extra.unlimited.mileage','car.faq.num','car.instant.book','car.insurance','car.miles.included','car.photo.num','car.trip.price','host.car.num'



Original output
#Output after
#   x y z
#1  1 4 1
#2  2 3 3
#3  3 5 2
#4  4 7 9
#5  3 8 8
#6  2 5 7
#7  3 9 0
#8  4 7 8
#9  4 6 7
#10 5 5 2
#11 0 0 3

#Output after
#   x y z
#1  1 4 1
#2  2 3 3
#3  3 5 2
#4  4 7 9
#5  3 8 8
#6  2 5 7
#7  3 9 0
#8  4 7 8
#9  4 6 7
#10 5 5 2

我期望从原始数据框中删除异常值，仅适用于连续变量。

Answer 1

我们可以在

tidyverse

中轻松完成此操作，即循环

across

数字列 (

where(is.numeric)

) 和

replace

通过将

detect_outlier

应用于

NA

）来计算离群值。删除这些值会导致列之间的长度差异，然后只能将其保存为

list

，因为

data.frame/tibble

要求所有列具有相同的长度

library(dplyr)
sample_data %>% 
   mutate(across(where(is.numeric), ~ replace(.x, detect_outlier(.x), NA)))

Answer 2

首先仅选择数字列，这里是一个简单的示例：

DF <- data.frame(x=rnorm(10),y=sample(1:100,10),
                 z=factor(sample(LETTERS[1:2],10,replace=TRUE)))

select <- sapply(DF, is.numeric, simplify=TRUE) 

DF2 <- DF[, select, drop=FALSE] 

然后应用函数删除异常值...

Answer 3

首先我修改了你的函数，用 NA 替换异常值并允许修改 IQR 时间

detect_outlier <- function(x,iqtimes=1.5) {
  # calculate first quantile
  Quantile1 <- quantile(x, probs=.25, na.rm = T)
  # calculate third quantile
  Quantile3 <- quantile(x, probs=.75, na.rm = T)
  # calculate inter quartile range
  IQR = Quantile3-Quantile1
  # return true or false
  outiers <- x > Quantile3 + (IQR*iqtimes) | x < Quantile1 - (IQR*iqtimes)
  x[which(outiers)] <- NA
  return(x)
}

选择要处理的列（数字数据）

cols_to_clean <- names(sample_data )[sapply(sample_data , is.numeric)]

最后将函数应用到数据框。

data_clean<- sample_data %>%
  mutate(across(cols_to_clean , ~detect_outlier(.,iqtimes=1.5)))