从数据框列表中按条件删除异常值

Question

我尝试创建一个函数，通过从数据框列表中的烹饪距离删除多个异常值。 目前有一些问题：

1. 我可以将第 1 部分表述为函数吗？我尝试了一些没有成功的方法。我想为 lm 使用几个不同的变量 - 所以如果我可以使用 colnumbers 和数据帧的正则表达式语法作为输入参数，那就太好了。

2. 第 2 部分 - 绘图的文件名不正确。它将列表中每个数据帧中的第一个观察值作为文件名。我该如何纠正这个问题？

3. 第 3 部分： 不创建没有异常值的数据框。打印消息后功能结束。我找不到我的错误。

data(iris)
iris.lst <- split(iris[, 1:2], iris$Species)
new_names <- c(paste0(unlist(levels(iris$Species)),"_data"))
for (i in 1:length(iris.lst)) {
  assign(new_names[i], iris.lst[[i]])
}

# Part 1: Then cooks distances
fit <- lapply(mget(ls(pattern = "_data")), 
       function(x) lm(x[,1] ~ x[,3], data = x))
cooksd <-lapply(fit,cooks.distance)

# Part 2: Plot each data frame with suspected outlier
plots <- function(x){
    jpeg(file=paste0(names(x),".jpeg")) # file names are numbers
    #par(mfrow=c(2,1))    
    plot(x, pch="*", cex=2, main="Influential cases by Cooks distance") #  plot cook's distance
    abline(h = 3*mean(x, na.rm=T), col="red") #  add cutoff line
    text(x=1:length(x)+1, y=x, labels=ifelse(x > 3*mean(x, na.rm=T),
                                                           names(x),""), col="red")
    dev.off()
}
myplots <- lapply(cooksd, plots)

# Part 3: give me new data frames without influential cases
show_influential_cases <- function(x){
    # invisible(cooksd[["n_OG"]] <- lapply(cooksd, length)
    influential <- lapply(x,function(x) names(x)[x > 3*mean(x, na.rm=T)])
    test <- as.data.frame(unlist(influential))[,1]
    test <- as.numeric(test)
}

tested <- show_influential_cases(result)
cleaned_data <- add_new[-tested,] # removing outliers by indexing

有人可以帮我改进我的代码吗？ 非常感谢， 纳丁

Answer 1

一般来说，在全局环境中创建多个数据框并不是一个好习惯。列表总是更好的选择，它们易于管理。

第 1 部分 -

您可以在一个lapply 函数中组合多个步骤。在第 1 部分中，我们将 lm 和 cooks.distance 函数一起应用到同一个 lapply 调用中。

master_data <- split(iris[, 1:2], iris$Species)

data <- lapply(master_data, function(x) {
  cooks.distance(lm(Sepal.Length ~ Sepal.Width, data = x))
})
new_names <- paste0(levels(iris$Species),"_data")
names(data) <- new_names

第 2 部分 -

lapply 无权访问列表名称，单独传递并使用Map 调用plots 函数。

plots <- function(x, y){
  jpeg(file=paste0(y,".jpeg")) 
  plot(x, pch="*", cex=2, main="Influential cases by Cooks distance")
  abline(h = 3*mean(x, na.rm=T), col="red") #  add cutoff line
  text(x=1:length(x)+1,y=x,labels=ifelse(x > 3*mean(x, na.rm=T),y,""), col="red")
  dev.off()
}
Map(plots, data, names(data))

第 3 部分 -

我不太清楚你想如何执行第 3 部分，但现在我分别显示异常值和数据。

remove_influential_cases <- function(x, y){
  inds <- x > 3*mean(x, na.rm=TRUE)
  y[!inds, ]
}

result <- Map(remove_influential_cases, data, master_data)