在R中按组移除异常值

Question

在我的数据集中，我必须分别为每个组删除异常值。 这是我的数据集

vpg=structure(list(customer = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 
1L, 1L, 1L, 2L, 2L, 2L, 2L), code = c(2L, 2L, 3L, 3L, 4L, 4L, 
5L, 5L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L), year = c(2017L, 2017L, 
2017L, 2017L, 2017L, 2017L, 2017L, 2017L, 2018L, 2018L, 2018L, 
2018L, 2018L, 2018L, 2018L, 2018L), stuff = c(10L, 20L, 30L, 
40L, 50L, 60L, 70L, 80L, 10L, 20L, 30L, 40L, 50L, 60L, 70L, 80L
), action = c(0L, 1L, 0L, 1L, 0L, 1L, 0L, 1L, 0L, 1L, 0L, 1L, 
0L, 1L, 0L, 1L)), .Names = c("customer", "code", "year", "stuff", 
"action"), class = "data.frame", row.names = c(NA, -16L))

我需要从“stuff”变量中删除离群值，但是要按照客户+代码+年份分组单独进行操作。

我找到了这个非常好用的函数。

remove_outliers <- function(x, na.rm = TRUE, ...) {
  qnt <- quantile(x, probs=c(.25, .75), na.rm = na.rm, ...)
  H <- 1.5 * IQR(x, na.rm = na.rm)
  y <- x
  y[x < (qnt[1] - H)] <- NA
  y[x > (qnt[2] + H)] <- NA
  y
}

new <- remove_outliers(vpg$stuff)
vpg=cbind(new,vpg)
View(vpg)

但是它适用于所有群体。 如何使用此功能删除每个组的异常值并获取清晰的数据集以进行下一步操作？ 请注意，在此数据集中，有一个名为“action”的变量（它取值为0和1）。它不是分组变量，但是必须仅删除“action”变量的零（0）类别的异常值。

- psysky

---

在你的例子中：是否有需要移除的异常值？ - jogo

@jogo，不，因为这只是一个简单的例子。 - psysky

Answer 1

以下是使用 data.table 的解决方案：

library("data.table")
setDT(vpg)
vpg[, new:=stuff][action==0, new:=remove_outliers(stuff), by=.(customer, code, year)]

- jogo

Answer 2

这里有一个使用 tidyverse 的选项

library(dplyr)
vpg %>%
  group_by_at(names(.)[1:3]) %>% 
  mutate(new = case_when(action == 0 ~ remove_outliers(stuff), TRUE ~ stuff))

- akrun

Answer 3

使用library(tidyverse)，您可以定义函数。

add_new_column <- function(df) {
  new <- remove_outliers(df$stuff)
  return(cbind(new,df))
}

然后对整个数据框进行分组应用：

vpg %>%
  group_by(customer, code, year) %>%
  nest() %>%
  mutate(data = map(data, my_function)) %>%
  unnest()

- Lilian Sanselme

Answer 4

尝试这个解决方案： 构建一个函数，将函数remove_outliers应用于按客户+代码+年份分类的数据。

f<-function(x,vpg)
{
  select<-paste0(vpg$customer,vpg$code,vpg$year)==x
  out<-suppressWarnings(cbind(vpg[select,c("customer","code","year")][1,],remove_outliers(vpg[select,"stuff"])))
  return(out)
}

遍历所有三元组客户+代码+年份。

uniq<-as.character(unique(paste0(vpg$customer,vpg$code,vpg$year)))
bind_rows(lapply(uniq,f,vpg=vpg))

- Terru_theTerror

---

可以不使用 bind_rows 完成这个操作吗？比如说使用基本函数？ - MRT

rbind是一种替代方法。 - Terru_theTerror

可以试一下吗？因为我收到了一个维度错误… - MRT