如何将此嵌套的 for 循环转换为 purrr 函数

问题描述

好的，我正在尝试使用一些 purrr 映射函数替换嵌套 for 循环与另一个 for 循环配对的使用，但我只是没有找到它。我有一个数据帧列表，我知道每个数据帧中至少有一列包含与不在列表中的另一个数据帧中的数据匹配的数据。我需要的是找到包含在列表中的数据帧中的列，这些列包含与外部数据帧中的值匹配的值，并重命名列表中包含的数据帧中的这些列。

需要明确的是，数据帧都是不同数量的行，我在 dfs 列表中查找的数据和我正在检查的数据帧是数十万个随机字符串值 - 它不像就像我下面的例子看起来很简单，但这个例子描绘了画面。

这是我的数据的播放版本。

library(dplyr)
x <- data.frame(first = c(1:3,6:7),second = c(1:3,third = c(1:5))

y <- data.frame(differ = c(10:13),other = c(10:13),nomatch = rep(5),another = c(10:13),argh = c(9:12))

z <- data.frame(nothing = c(20:27),nope = c(20:27),Noway = c(16,17,18,19,5,21,22,23),still = c(21:28),again = c(22:29))

frame_list <- list(first = x,second = y,third = z)

check_against <- data.frame(checking = rep(5,times = 5))

col_name_list <- list()

for (i in 1:length(frame_list)) {
  for (j in 1:length(frame_list[[i]])) {
    if (sum(!(is.na(frame_list[[i]][[j]])) 
            & frame_list[[i]][[j]] 
            %in% check_against[[1]]) > 0) {
      col_name_list[[i]] <- names(frame_list[[i]][j])
    }
  }
}

for (i in 1:length(frame_list)) {
  frame_list[[i]] <- rename(frame_list[[i]],I_want_this_one = col_name_list[[i]])
}

这让我得到了我想要的，但我很想用 purrr 或应用函数替换它。

我尝试了一些根本没有帮助的事情：

library(purrr)

map(frame_list,names) %>% 
  imap(.,unlist(.),function(x,y) {if (sum(!(is.na(x[[y]])) 
                           & x[[y]] 
                           %in% check_against[[1]]) > 0) {
    col_name_list[[y]] <- names(x[[y]])
    
  }
    x[[y]] <- rename(x[[y]],I_want_this_one = col_name_list[[y]])
    })

# or this
map(frame_list,unlist) %>% 
  imap(.,names(.),y) {if (sum(!(is.na(x[[y]])) 
                                             & x[[y]] 
                                             %in% check_against[[1]]) > 0) {
    col_name_list[[y]] <- names(x[[y]])
    
  }
    x[[y]] <- rename(x[[y]],I_want_this_one = col_name_list[[y]])
  })

我很难用函数式方法来实现这一目标。

非常感谢任何建议！

解决方法

对于第一个 purrr 调用，给出 frame_list，对于第二个调用，给出数据表的名称。我在数据框 y 中添加了一个 blah 列，也发生了变化

library(dplyr)
x <- data.frame(first = c(1:3,6:7),second = c(1:3,third = c(1:5))

y <- data.frame(differ = c(10:13),other = c(10:13),nomatch = rep(5),blah=rep(5),another = c(10:13),argh = c(9:12))

z <- data.frame(nothing = c(20:27),nope = c(20:27),noway = c(16,17,18,19,5,21,22,23),still = c(21:28),again = c(22:29))

frame_list <- list(first = x,second = y,third = z)

check_against <- rep(5,5)

col_name_list=purrr::map(frame_list,function(w) {
  m=purrr::map_lgl(w,function(x) {
    return(any(unlist(x) %in% check_against))
  })
  names(w)[m]
})

col_name_list

输出

$first
[1] "third"

$second
[1] "nomatch" "blah"   

$third
[1] "noway"