![](/img/trans.png)
[英]looping the which() function over a list of dataframes with lapply
[英]Looping apply function over list of dataframes
我浏览了各个带有类似问题(有些链接)的“溢出”页面,但没有发现任何似乎可以帮助完成此复杂任务的内容。
我的工作区中有一系列数据框,我想在所有这些框上循环使用相同的功能(rollmean或该功能的某些版本),然后将结果保存到新的数据框中。
我写了几行代码来生成所有数据帧的列表和一个for循环,该循环应在每个数据帧上迭代一条apply语句; 但是,在尝试完成我希望实现的所有功能时遇到了问题(下面包含了我的代码和一些示例数据):
1)我想将rollmean
函数限制在除第一列(或前几列)以外的所有列上,以使列'info'不会被平均。 我还想将此列添加回输出数据框中。
2)我想将输出另存为新的数据框(具有唯一的名称)。 我不在乎是将其保存到工作区中还是以xlsx格式导出,因为我已经编写了批量导入代码。
3)理想情况下,我希望所得的数据帧与输入的观察数相同,其中rollmean
收缩您的数据。 我也不想让它们成为NA,所以我不想使用fill = NA
这可以通过编写一个新函数来完成,在rollmean
传递type = "partial"
(尽管在我的计算机上我的数据仍会缩小1)或通过在nth + 2项上开始滚动均值并将非平均的nth和nth + 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
我告诫此实现充其量只是一点点天真,需要加以修复。 确保您了解选择"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)] <- 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
dfnames
下面是全局环境env
中的数据帧的名称-我们将其命名为env
,以防您以后要更改它们的位置。 请注意, ls
具有pattern=
参数,并且如果数据帧名称具有不同的模式,则可以使用dfnames <- ls(pattern=whatever)
代替适合的正则表达式。
现在定义make_new
,它使用新的均值函数mean3
调用rollapplyr
,如果输入向量的长度小于3,均值函数将返回其输入的最后一个值, mean3
返回均值。 然后遍历使用名称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的第一个版本的替代方法是以下第二个版本。 在第二个版本,而不是定义mean3
我们使用的只是普通的mean
,但指定宽度的矢量 w
在rollapplyr
这样w
等于C(1,1,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)
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.