循环应用函数于数据框列表

Question

我查看了许多类似的Overflow页面（有些是链接），但没有找到任何有助于这项复杂任务的东西。

我的工作空间中有一系列数据帧，我想循环执行相同的函数（rollmean或其某个版本）在它们所有中运行，然后将结果保存到新的数据帧中。

我编写了几行代码来生成所有数据帧的列表和一个for循环，该循环应迭代每个数据帧上的apply语句；但是，我在尝试实现我所希望实现的所有内容时遇到了问题（包括我的代码和一些示例数据如下）：

1）我想将rollmean函数限制为除第一列（或前几列）之外的所有列，以便不平均化'info'列。 我还想将这些列添加回输出数据框中。

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

3）理想情况下，我希望结果数据帧与输入具有相同数量的观测结果，而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)
}

我曾试过一个嵌套的apply方法，但无法调用rollmean/rollapply函数（类似于此处问题），所以我回到了for循环，但如果有人能够让这个嵌套应用程序工作，那就好了！

图片是理想的输出：顶部是单个输入数据框，其中着色框演示了所有列的滚动平均值，将迭代每一列；底部是理想的输出，颜色反映了上面每个着色窗口的输出位置。

- J Ross

---

J Ross，这两个答案中有一个回答了你的问题吗？ - r2evans

Answer 1

为了处理这个问题，可以先考虑一列数据，然后是一个框架（就是一列数据的列表），最后是一个框架的列表。

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

一列数据

如果你不喜欢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

我要提醒的是，这个实现方法最多只能算是有点天真，需要修正。当你选择除了"normal"之外的其他选项时，请确保你理解它正在做什么（这对你没有用，我只是默认使用正常的zoo::rollmean行为）。这个函数可以轻松地应用于其他zoo::roll*函数。

在数据的一列上：

rbind(
  dflist[[1]][,2],  # for comparison
  myrollmean(dflist[[1]][,2], k=3, type="keep")
)
#          [,1]      [,2]      [,3]      [,4]       [,5]      [,6]      [,7]     [,8]     [,9]     [,10]
# [1,] 1.865352 0.4047481 0.1466527 1.7307097 0.08952618 0.6668976 1.0743669 1.511629 1.314276 0.1565303
# [2,] 1.865352 0.4047481 0.8055844 0.7607035 0.65562952 0.8290445 0.6102636 1.084298 1.300091 0.9941452

一个“框架”

lapply 的简单用法，省略第一列：

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与上面“一个列”的示例中的第二行匹配。）

“框架”列表

（我将数据重置为修改之前的状态...请参见答案底部的“数据”代码。）

我们将前面的技术嵌套到另一个lapply中：

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

（同样地，为了进行简单的验证，请确保第一帧的 $ 1 行显示与上面“一个列”的示例的第二行相同的滚动均值。）

PS：

• 如果您需要跳过不止第一列，则在外部的lapply中使用ldf [-（1：n）]＆lt; - lapply（ ldf [-（1：n）]，myrollmean，k = 3，type =“keep”）代替以跳过前n列
• 如果要使用除zoo :: rollmean之外的窗口函数，则需要更改myrollmean的特殊情况，虽然这应该是很容易的，因为这个示例已经给出了说明。
• 我使用了一个虚构的 str（...）来缩短输出以在此处显示。您应该验证所有数据，以确保它在每个框架的整体中执行您期望的操作。

---

可再生数据

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

- r2evans

Answer 2

以下是需要翻译的内容：

下面dfnames是全局环境中数据框的名称 - 我们已经将其命名为env，以防您稍后想要更改它们的位置。请注意，ls有一个pattern=参数，如果数据框名称具有不同的模式，则可以使用dfnames <- ls(pattern=whatever)，其中whatever是合适的正则表达式。

现在定义make_new，它调用带有新均值函数mean3的rollapplyr，如果输入向量的长度小于3，则返回其输入的最后一个值，否则返回平均值。然后使用rollappyr和FUN=mean3以及partial=TRUE循环遍历这些名称。

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的另一种版本

与上面展示的第一个版本不同，第二个版本如下所示。在第二个版本中，我们使用普通的mean而不是定义mean3，但在rollapplyr中指定了一个宽度w的向量，使得w等于c(1, 1, 3, 3, ..., 3)。因此，它只对前两个输入组件的最后一个元素取平均值，并对其余元素的最后3个元素取平均值。请注意，现在我们明确指定宽度，因此不再需要指定partial=。

# 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))
}

注意

通常在编写R代码时，对一组对象进行操作时，应将这些对象存储在列表中，而不是让它们散落在全局环境中。我们可以像这样创建这样一个名为L的列表，然后使用lapply创建包含新版本的第二个列表L2。任何一个版本的make_new都可以在此处使用。

L <- mget(dfnames, env)
L2 <- lapply(L, make_new)

- G. Grothendieck