依次遍历 R 中的两个列表答案

【问题标题】：Iterate sequentially over two lists in R依次遍历 R 中的两个列表
【发布时间】：2021-07-22 15:13:57
【问题描述】：

我有两个看起来像这样的 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]],na.rm = T),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，Sepal.Width 和@ 987654329@等

有人知道我该怎么做吗？

我尝试使用Map，但我做错了。

lst1 <- names(iris[,1:4])
lst2 <- names(iris2[,1:4])
final_iris<- Map(fixmax,iris, iris2,lst1,lst2)

我的目标是获得一个 df (final_iris)，其中每个变量都已使用fixmax 指定的标准进行了调整。我知道我可以通过像这样在每个变量上运行我的函数来做到这一点。

final_iris <- iris
final_iris <- fixmax(final_iris,iris2,"Sepal.Length","Sepal_Length")
final_iris <- fixmax(final_iris,iris2,"Sepal.Width","Sepal_Width")
final_iris <- fixmax(final_iris,iris2,"Petal.Length","Petal_Length")
final_iris <- fixmax(final_iris,iris2,"Petal.Width","Petal_Width")

但在实际数据中，我必须运行此操作数十次，并且我希望能够按顺序循环我的函数。有谁知道我如何依次循环fixmax 和lst1 和lst2？

【问题讨论】：

标签： r function loops sequence

【解决方案1】：

您可以利用R 内置的矢量化功能，而不是按名称显式迭代不同的数据集和列。如果数据帧具有相同的列/变量排序，则使用 mapply 或 purrr::map2 映射到两个数据帧的函数将逐列迭代，而无需指定列名。

给定两个输入数据帧（df_small 和 df_big），步骤如下：

计算df_small中每一列的最大值以创建df_small_max
使用mapply（或purr::map2_dfc，如果您更喜欢tidyverse映射）将pmin函数应用于df_big的每一列和df_small_max的每个值

#set up fake data
df_small <- iris[,1:4]
df_big <- df_small + 2

# find max of each col in df_small
df_small_max <- sapply(df_small, max)

# replace values of df_big which are larger than df_small_max
df_big_fixed <- mapply(pmin, df_big, df_small_max)




# sanity check -- Note the change in Sepal.Width
df_small_max
#> Sepal.Length  Sepal.Width Petal.Length  Petal.Width 
#>          7.9          4.4          6.9          2.5
head(df_big, 3)
#>   Sepal.Length Sepal.Width Petal.Length Petal.Width
#> 1          7.1         5.5          3.4         2.2
#> 2          6.9         5.0          3.4         2.2
#> 3          6.7         5.2          3.3         2.2
head(df_big_fixed, 3)
#>      Sepal.Length Sepal.Width Petal.Length Petal.Width
#> [1,]          7.1         4.4          3.4         2.2
#> [2,]          6.9         4.4          3.4         2.2
#> [3,]          6.7         4.4          3.3         2.2

^{由reprex package (v2.0.0) 于 2021 年 7 月 31 日创建}

【讨论】：

【解决方案2】：

您的问题很可能与数据框本身就是列表这一事实有关。 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),
                 lst1,
                 lst2)

我怀疑您希望将iris 和iris2 提供给对fixmax() 的每次调用。为了让Map() 像这样回收它们，它们需要是单元素列表。那是你可能想要的：

final_iris<- Map(fixmax, list(iris), list(iris2),lst1,lst2)

要将数据框列表组合成单个数据框，请执行以下操作

do.call(rbind, final_iris)

【讨论】：

谢谢！ final_iris<- Map(fixmax, list(iris), list(iris2),lst1,lst2) 似乎有效。剩下的唯一挑战是结果对象是一个列表，而我想要一个数据框。基本上，修改了变量的单个数据框。我尝试unlist(final_iris)，但它似乎不起作用。你知道我该怎么做吗？
我已更新帖子以阐明我正在寻找的结果。

【解决方案3】：

这是一种基本的方式。我还重命名了变量，因为我在复制时遇到了一些问题，因为最初该方法将保存 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)

【讨论】：

【解决方案4】：

对于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, iris2, .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

【讨论】：

谢谢不知道transmutate。但是超级好用！！

【解决方案5】：

这是你所期待的吗？

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,]
}

【讨论】：

很遗憾没有。我想按顺序在两个列表上迭代一个函数，而您的方法将满足某些标准的观察个体化。一个关键限制是我必须使用您的my_varapproach 为每个变量指定标准。在真实的数据集中，我必须迭代数百个变量。
但这是根据您的示例给出的预期结果？因此，如果您有更多标准和/或数据框，您能否给我更多信息，也许我只需要将我的解决方案放入一个函数中，然后使用 lapply 进行迭代。
不，不幸的是最终的对象不是我想要的。我正在寻找一种方法来在两个变量列表上迭代我的函数，从而生成一个数据框，并将修改后的变量作为结果。您的方法不是处理迭代问题，而是提供一个对象来区分我想要修改的行。这是一个不同的结果。但是非常感谢您对此进行调查！
我已经更新了问题以澄清结果应该是什么样子！

【解决方案6】：

乍一看，您的函数似乎令人费解且难以阅读。我们可以整理函数以使用快速函数为列中的每个值返回 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, 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[,1:4], 2, max)

tail(iris_final)

【讨论】：

【解决方案7】：

您应该考虑使用列索引；一个完整的（不包括数据框构造）基础 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[,i], 
    max(
      iris2[,i],
      na.rm = TRUE
      )
    )
  }, 
  num_cols
)

【讨论】：

【解决方案8】：

您可以通过创建一个在每列中重复的最大值矩阵并使用pmin 获取 iris2 中的最大值与其他数据帧中的值之间的最小值来实现此目的。我创建了一个新的 fixmax 函数，它只将两个数据帧作为参数。

准备数据

library(tidyverse)

initial <- iris %>%  mutate_at(1:4, ~.+2)
iris2 <- iris 
names(iris2)<-sub(".", "_", names(iris2), 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], 2, max) %>% 
            matrix(nrow=nrow(dfmax), ncol=length(colids), byrow=TRUE) %>% 
            as.data.frame()
  
  df[, colids] <- pmin(df[,colids], 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[, 1:4], 2, 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

【讨论】：