R 在数据帧列表上循环应用函数

我已经浏览了各种带有类似问题的溢出页面（有些是链接的），但没有发现任何对这项复杂任务有帮助的东西

我的工作区中有一系列数据帧，我希望在所有数据帧上循环相同的函数（rollmean或该函数的某个版本），然后将结果保存到新的数据帧

我已经写了几行代码来生成所有数据帧的列表和一个for循环，该循环应该在每个数据帧上迭代apply语句；然而，我在尝试完成我希望实现的一切时遇到了问题（我的代码和一些示例数据包含在下面）：

1） 我想将

rollmean

函数限制为除第一列（或前几列）以外的所有列，以便不计算列“info”的平均值。我还想将此列添加回输出数据框

2） 我想将输出保存为新的数据帧（具有唯一的名称）。我不在乎它是保存到工作区还是作为xlsx导出，因为我已经编写了批导入代码

3） 理想情况下，我希望生成的数据帧与输入的观察数相同，其中as

rollmean

收缩数据。我也不想让它们变成NA，所以我不想使用

fill=NA

这可以通过编写一个新函数来实现，在

rollmean

中传递

type=“partial”

（尽管这仍然会将我手中的数据缩减1），或者在第n+2项上开始滚动平均值，并将非平均的第n项和第n+1项绑定到结果数据帧。无论如何都可以。 （详见图，图中说明了后者的外观）

我的代码只完成这些事情的一部分，我不能让for循环一起工作，但是如果我在单个数据帧上运行它们，就可以让部分工作

非常感谢您的任何意见，因为我没有想法。

#reproducible data frames 
a = as.data.frame(cbind(info = 1:10, matrix(rexp(200), 10)))
b = as.data.frame(cbind(info = 1:10, matrix(rexp(200), 10)))
c = as.data.frame(cbind(info = 1:10, matrix(rexp(200), 10)))
colnames(a) = c("info", 1:20)
colnames(b) = c("info", 1:20)
colnames(c) = c("info", 1:20)

#identify all dataframes for looping rollmean
dflist = as.list(ls()[sapply(mget(ls(), .GlobalEnv), is.data.frame)]

#for loop to create rolling average and save as new dataframe
for (j in 1:length(dflist)){
  list = as.list(ls()[sapply(mget(ls(), .GlobalEnv), is.data.frame)])
  new.names = as.character(unique(list))
  smoothed = as.data.frame(
     apply(
        X = names(list), MARGIN = 1, FUN = rollmean, k = 3, align = 'right'))
  assign(new.names[i], smoothed)
}

我还尝试了嵌套应用方法，但无法让它调用rollmean/rollapply函数，因此我返回for循环，但如果有人能够使用嵌套应用程序实现这一点，我就失败了

图片是理想的输出：顶部是带有彩色框的单输入数据框，显示所有列的滚动平均值，在每个列上迭代；底部是理想的输出，颜色反映了上面每个彩色窗口的输出位置

---

要实现这一点，请先考虑一列，然后是一帧（这只是列列表），然后是帧列表

（我使用的数据位于答案的底部。）

一栏 如果您不喜欢减少

zoo:：rollmean

，请编写您自己的：

myrollmean <- function(x, k, ..., type=c("normal","rollin","keep"), na.rm=FALSE) {
  type <- match.arg(type)
  out <- zoo::rollmean(x, k, ...)
  aug <- c()
  if (type == "rollin") {
    # effectively:
    #   c(mean(x[1]), mean(x[1:2]), ..., mean(x[1:j]))
    # for the j=k-1 elements that precede the first from rollmean,
    # when it'll become something like:
    # c(mean(x[3:5]), mean(x[4:6]), ...)
    aug <- sapply(seq_len(k-1), function(i) mean(x[seq_len(i)], na.rm=na.rm))
  } else if (type == "keep") {
    aug <- x[seq_len(k-1)]
  }
  out <- c(aug, out)
  out
}

myrollmean(1:8, k=3) # "normal", default behavior
# [1] 2 3 4 5 6 7
myrollmean(1:8, k=3, type="rollin")
# [1] 1.0 1.5 2.0 3.0 4.0 5.0 6.0 7.0
myrollmean(1:8, k=3, type="keep")
# [1] 1 2 2 3 4 5 6 7

一个“框架” 简单使用

lappy

，省略第一列：

str(dflist[[1]][1:4, 1:3])
# 'data.frame': 4 obs. of  3 variables:
#  $ info: num  1 2 3 4
#  $ 1   : num  1.865 0.405 0.147 1.731
#  $ 2   : num  0.745 1.243 0.674 1.59
dflist[[1]][-1] <- lapply(dflist[[1]][-1], myrollmean, k=3, type="keep")
str(dflist[[1]][1:4, 1:3])
# 'data.frame': 4 obs. of  3 variables:
#  $ info: num  1 2 3 4
#  $ 1   : num  1.865 0.405 0.806 0.761
#  $ 2   : num  0.745 1.243 0.887 1.169

（同样，为了进行简单验证，请参见第一帧的

$1

行显示与上面“一列”示例的第二行相同的滚动平均值。）

附言：

---

• 如果您需要跳过的不仅仅是第一列，那么在外部

  lappy

  中，使用

  ldf[-（1:n）]下面
  dfnames
  是全局环境
  env
  中数据帧的名称——我们将其命名为
  env
  ，以防您以后想要更改它们的位置。请注意，
  ls
  有一个
  pattern=
  参数，如果数据帧名称有一个不同的模式，那么
  dfnames J Ross，两个答案中的任何一个都能回答您的问题吗？
  str(dflist[[1]][1:4, 1:3])
  # 'data.frame': 4 obs. of  3 variables:
  #  $ info: num  1 2 3 4
  #  $ 1   : num  1.865 0.405 0.147 1.731
  #  $ 2   : num  0.745 1.243 0.674 1.59
  dflist[[1]][-1] <- lapply(dflist[[1]][-1], myrollmean, k=3, type="keep")
  str(dflist[[1]][1:4, 1:3])
  # 'data.frame': 4 obs. of  3 variables:
  #  $ info: num  1 2 3 4
  #  $ 1   : num  1.865 0.405 0.806 0.761
  #  $ 2   : num  0.745 1.243 0.887 1.169
  
  dflist2 <- lapply(dflist, function(ldf) {
    ldf[-1] <- lapply(ldf[-1], myrollmean, k=3, type="keep")
    ldf
  })
  str(lapply(dflist2, function(a) a[1:4, 1:3]))
  # List of 3
  #  $ :'data.frame': 4 obs. of  3 variables:
  #   ..$ info: num [1:4] 1 2 3 4
  #   ..$ 1   : num [1:4] 1.865 0.405 0.806 0.761
  #   ..$ 2   : num [1:4] 0.745 1.243 0.887 1.169
  #  $ :'data.frame': 4 obs. of  3 variables:
  #   ..$ info: num [1:4] 1 2 3 4
  #   ..$ 1   : num [1:4] 0.271 3.611 2.36 3.095
  #   ..$ 2   : num [1:4] 0.127 0.722 0.346 0.73
  #  $ :'data.frame': 4 obs. of  3 variables:
  #   ..$ info: num [1:4] 1 2 3 4
  #   ..$ 1   : num [1:4] 1.278 0.346 1.202 0.822
  #   ..$ 2   : num [1:4] 0.341 1.296 1.244 1.528
  
  set.seed(2)
  a = as.data.frame(cbind(info = 1:10, matrix(rexp(200), 10)))
  b = as.data.frame(cbind(info = 1:10, matrix(rexp(200), 10)))
  c = as.data.frame(cbind(info = 1:10, matrix(rexp(200), 10)))
  colnames(a) = c("info", 1:20)
  colnames(b) = c("info", 1:20)
  colnames(c) = c("info", 1:20)
  dflist <- list(a,b,c)
  
  str(lapply(dflist, function(a) a[1:3, 1:4]))
  # List of 3
  #  $ :'data.frame': 3 obs. of  4 variables:
  #   ..$ info: num [1:3] 1 2 3
  #   ..$ 1   : num [1:3] 1.865 0.405 0.147
  #   ..$ 2   : num [1:3] 0.745 1.243 0.674
  #   ..$ 3   : num [1:3] 0.356 0.689 0.833
  #  $ :'data.frame': 3 obs. of  4 variables:
  #   ..$ info: num [1:3] 1 2 3
  #   ..$ 1   : num [1:3] 0.271 3.611 3.198
  #   ..$ 2   : num [1:3] 0.127 0.722 0.188
  #   ..$ 3   : num [1:3] 1.99 2.74 4.78
  #  $ :'data.frame': 3 obs. of  4 variables:
  #   ..$ info: num [1:3] 1 2 3
  #   ..$ 1   : num [1:3] 1.278 0.346 1.981
  #   ..$ 2   : num [1:3] 0.341 1.296 2.094
  #   ..$ 3   : num [1:3] 1.1159 3.05877 0.00506
  
  library(zoo)
  
  env <- .GlobalEnv
  dfnames <- Filter(function(x) is.data.frame(get(x, env)), ls(env))
  
  # make_new - first version
  mean3 <- function(x, k = 3) if (length(x) < k) tail(x, 1) else mean(x)
  make_new <- function(df) replace(df, -1, rollapplyr(df[-1], 3, mean3, partial = TRUE))
  
  for(nm in dfnames) env[[paste(nm, "new", sep = "_")]] <- make_new(get(nm, env))
  
  # make_new -- second version
  make_new <- function(df) {
    w <- replace(rep(3, nrow(df)), 1:2, 1)
    replace(df, -1, rollapplyr(df[-1], w, mean))
  }
  
  L <- mget(dfnames, env)
  L2 <- lapply(L, make_new)