如何解决在 R 中顺序迭代两个列表 准备数据创建函数测试功能
我有两个看起来像这样的 df
library(tidyverse)
iris <- iris%>% mutate_at((1:4),~.+2)
iris2 <- iris
names(iris2)<-sub(".","_",names(iris2),fixed = TRUE)
我的目标是减少 iris 中高于 iris2 中相应变量最大值的变量值，以匹配 iris2 中的最大值。>
max(iris$Sepal.Length)
[1] 9.9
max(iris2$Sepal_Length)
[1] 7.9
# i want every value of iris that is >= to max value of iris2 to be equal to the max value of iris 2.
# my function:
fixmax<- function(data,data2,var1,var2) {
data<- data %>%
mutate("{var1}" := ifelse(get(var1)>=max(data2[[var2]],na.rm = T),max(data2[[var2]],get(var1)))
return(data)
}
# apply my function to a variable
tst_iris <- fixmax(iris,iris2,"Sepal.Length","Sepal_Length")
max(tst_iris$Sepal.Length)
7.9 # it works!
我面临的挑战是我想顺序迭代我的函数超过两个变量列表——即Sepal.Length和Sepal_Length，{ {1}}与Sepal.Width 等
有人知道我该怎么做吗？
我尝试使用 Sepal_Width，但我做错了。
Map我的目标是获得一个 df (lst1 <- names(iris[,1:4])
lst2 <- names(iris2[,1:4])
final_iris<- Map(fixmax,iris,lst1,lst2)
)，其中每个变量都使用 final_iris 指定的标准进行了调整。
我知道我可以通过在每个变量上运行我的函数来做到这一点。
fixmax但在实际数据中，我必须运行此操作数十次，并且我希望能够按顺序循环我的函数。
有谁知道我如何在 final_iris <- iris
final_iris <- fixmax(final_iris,"Sepal_Length")
final_iris <- fixmax(final_iris,"Sepal.Width","Sepal_Width")
final_iris <- fixmax(final_iris,"Petal.Length","Petal_Length")
final_iris <- fixmax(final_iris,"Petal.Width","Petal_Width")
和 fixmax 上依次循环我的 lst1？
解决方法
您可以利用内置于 R 中的矢量化，而不是按名称显式迭代不同的数据集和列。如果数据帧具有相同的列/变量排序，则使用 mapply 或 purrr::map2 映射到两个数据帧的函数将逐列迭代，而无需指定列名。
给定两个输入数据框（df_small 和 df_big），步骤是：
- 计算
df_small中每列的最大值以创建df_small_max - 使用
pmin（或df_big，如果您喜欢df_small_max映射）
mapply由 reprex package (v2.0.0) 于 2021 年 7 月 31 日创建
,您的问题很可能与数据框本身就是列表这一事实有关。 Map() 期望非函数参数是相同长度的列表。任何比最长列表短的参数都被“回收”以匹配它的长度。
目前，您拥有：
final_iris<- Map(fixmax,iris,iris2,lst1,lst2)
这实际上相当于：
final_iris<- Map(fixmax,list(iris$Sepal.Length,iris$Sepal.Width,iris$Petal.Length,iris$Petal.Width,iris$Species),list(iris2$Sepal_Length,iris2$Sepal_Width,iris2$Petal_Length,iris2$Petal_Width,iris2$Species),lst2)
我怀疑您希望为每次调用 iris 提供 iris2 和 fixmax()。为了让 Map() 像这样回收它们，它们需要是单元素列表。这可能是您想要的：
final_iris<- Map(fixmax,list(iris),list(iris2),lst2)
要将数据框列表合并为一个数据框，请执行
do.call(rbind,final_iris)
这是你期待的吗？
my_a <- iris %>% mutate_at((1:4),~.+2)
iris2 <- iris
names(iris2)<-sub(".","_",names(iris2),fixed = TRUE)
my_var <- which(my_a$Sepal.Length >= max(iris2$Sepal_Length) & my_a$Sepal.Width >= max(iris2$Sepal_Width))
if (length(my_var)) {
my_a <- my_a[my_var,]
}
您的函数乍一看似乎令人费解且难以阅读。我们可以整理一下函数，使用快速函数为列中的每个值返回 max(x,max_val)
#function to correct max
adjust_max <- function(x,max_val) {
return(ifelse(x >= max_val,max_val,x))
}
最后，我们希望使用两个数据帧自动并按顺序应用它。我们将使用一个简单的 for 循环。附上设置问题的代码。
#libraries
library(tidyverse)
#set up fake data
iris_big <- iris%>% mutate_at((1:4),~.+2)
iris_small <- iris
names(iris_small)<- sub(".",names(iris_small),fixed = TRUE)
#check which is the bigger one and the smaller
max(iris_big$Sepal.Length) #bigger
max(iris_small$Sepal_Length) #smaller
#function to correct max
adjust_max <- function(x,max_val) {
return(ifelse(x >= max_val,x))
}
#apply it to get a final result
iris_final <- iris_big
# iterate over columns,assuming same positions
# you can edit the 1:ncol(iris_final) to only take the columns you want
for (i in 1:ncol(iris_final)) {
#check numeric
if (is.numeric(iris_final[,i])) {
#applies the function - notice we call iris_final and iris_small
iris_final[,i] <- sapply(iris_final[,i],adjust_max,max_val = max(iris_small[,i]))
}
}
#check answer is correct
apply(iris_final[,1:4],2,max)
apply(iris_small[,max)
tail(iris_final)
对于 tidyverse 方法，您可以使用 transmute 代替 mutate。 transmute 将在每次迭代中仅返回一列，而 mutate 将每次返回所有列。
除此之外，为了使其更加tidyverse友好，我使用 .data 而不是 get。同样使用 pmin 而不是复杂的 ifelse 解决方案。
library(dplyr)
library(purrr)
fixmax<- function(data,data2,var1,var2) {
data<- data %>% transmute("{var1}" := pmin(.data[[var1]],max(data2[[var2]])))
return(data)
}
要将函数应用于每一对列，您可以使用 map2_dfc，它还将结果合并到一个数据框中。
lst1 <- names(iris[,1:4])
lst2 <- names(iris2[,1:4])
在应用函数之前比较两个数据帧的最大值。
map_dbl(iris[lst1],max)
#Sepal.Length Sepal.Width Petal.Length Petal.Width
# 9.9 6.4 8.9 4.5
map_dbl(iris2[lst2],max)
#Sepal_Length Sepal_Width Petal_Length Petal_Width
# 7.9 4.4 6.9 2.5
应用函数-
iris[lst1] <- map2_dfc(lst1,lst2,~fixmax(iris,.x,.y))
比较应用函数后两个数据帧的最大值。
map_dbl(iris[lst1],max)
#Sepal.Length Sepal.Width Petal.Length Petal.Width
# 7.9 4.4 6.9 2.5
map_dbl(iris2[lst2],max)
#Sepal_Length Sepal_Width Petal_Length Petal_Width
# 7.9 4.4 6.9 2.5
这是一个主要的基本方式。我还重命名了变量，因为我在复制时遇到了一些麻烦，因为最初该方法会保存 iris 对象。
该方法是，我们不改变 data.frame 对象，而是仅从修改后的函数中返回预期值的向量。然后，我们将这些值重新分配回我们原来的 data.frame。
fixmax2 = function(x,y) {
max_y = max(y,na.rm = TRUE)
ifelse(x >= max_y,max_y,y)
}
cols = which(sapply(df_plus,is.numeric))
df_plus[cols] = Map(fixmax2,df_plus[cols],df_iris[cols])
df_plus
原始数据：
library(dplyr)
df_plus = iris %>% mutate_at((1:4),~. + 2) ## let's not save over iris
df_iris = iris
names(df_iris)<-sub(".",names(df_iris),fixed = TRUE)
您应该考虑使用列索引；一个完整的（不包括数据框构造）基础 R 解决方案可能如下所示：
# Resolve the indices of the numeric vectors in
# iris: num_cols => integer vector
num_cols <- which(
vapply(
iris,is.numeric,logical(1)
),arr.ind = TRUE
)
# Map the pmin function over iris to select the
# minimum of the vector element in iris and the
# maximum values of that vector in iris2:
# iris => data.frame
iris[,num_cols] <- Map(function(i){
pmin(
iris[,max(
iris2[,na.rm = TRUE
)
)
},num_cols
)
您可以通过创建在每列中重复的最大值的矩阵并使用 pmin 来获取 iris2 中的最大值与其他数据帧中的值之间的最小值来实现此目的。我创建了一个新的 fixmax 函数，它只将两个数据帧作为参数。
准备数据
library(tidyverse)
initial <- iris %>% mutate_at(1:4,~.+2)
iris2 <- iris
names(iris2)<-sub(".",fixed = TRUE)
print(max(initial$Sepal.Length))
# [1] 9.9
print(max(iris2$Sepal_Length))
# [1] 7.9
创建函数
fixmax <- function(df,dfmax){
colids <- which(unlist(lapply(dfmax,is.numeric)))
dfmax <- apply(dfmax[,colids],max) %>%
matrix(nrow=nrow(dfmax),ncol=length(colids),byrow=TRUE) %>%
as.data.frame()
df[,colids] <- pmin(df[,dfmax)
return(df)
}
测试功能
newiris <- fixmax(initial,iris2)
print(max(newiris$Sepal.Length))
# [1] 7.9
assertthat::assert_that(!identical(newiris,iris2))
# [1] TRUE
assertthat::assert_that(all((initial == newiris) || (iris2 == newiris)))
# [1] TRUE
imax = apply(iris2[,max) %>%
matrix(nrow=nrow(iris2),ncol=4,byrow=TRUE) %>%
as.data.frame()
assertthat::assert_that(all(newiris[,1:4] <= imax))
# [1] TRUE
print(head(newiris))
# Sepal.Length Sepal.Width Petal.Length Petal.Width Species
# 1 7.1 4.4 3.4 2.2 setosa
# 2 6.9 4.4 3.4 2.2 setosa
# 3 6.7 4.4 3.3 2.2 setosa
# 4 6.6 4.4 3.5 2.2 setosa
# 5 7.0 4.4 3.4 2.2 setosa
# 6 7.4 4.4 3.7 2.4 setosa
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。