R 使用apply函数遍历两个列表

我有一个问题，我有一个数据帧列表，其中数据帧的每列在第一行有一个名称，在列中的某些位置有x-s。如果有x，则第一行中的名称视为已选定。 在实际问题中，我阅读了一个包含许多工作表的xlsx文件，其中每个工作表都包含一个大矩阵：每列的第一行有一个名称，在一个稀疏的矩阵中有许多x-s。每张图纸都成为数据帧列表中的数据帧。行名称包含一个标识符，该标识符与查找相关，但与此处描述的我的问题无关

data1 <- data.frame(Col1 = c("Mark", "x", "", "x", "", ""),
                    Col2 = c("Paul", "", "", "", "x", ""),
                    Col3 = c("Jane", "", "", "", "", ""),
                    Col4 = c("Mary", "x", "x", "x", "", ""),
                    Col5 = c("Peter", "x", "x", "x", "", ""),
                    stringsAsFactors = FALSE)

data2 <- data.frame(Col1 = c("Mark", "x", "x", "", "", ""),
                    Col2 = c("Paul", "", "", "", "", ""),
                    Col3 = c("Jane", "", "", "", "", ""),
                    Col4 = c("Mary", "x", "", "x", "", ""),
                    Col5 = c("Peter", "x", "x", "", "", ""),
                             stringsAsFactors = FALSE)

data <- list(data1 = data1, data2 = data2)

我想在列表中的每个数据框中添加一列（“批准人”），如果列中有“x”，则该列是第1行中名称的串联，如下所示：

     Col1   Col2   Col3   Col4   Col5    Approvers          
[1,] "Mark" "Paul" "Jane" "Mary" "Peter" ""                 
[2,] "x"    ""     ""     "x"    "x"     "Mark; Mary; Peter"
[3,] ""     ""     ""     "x"    "x"     "Mary; Peter"      
[4,] "x"    ""     ""     "x"    "x"     "Mark; Mary; Peter"
[5,] ""     "x"    ""     ""     ""      "Paul"             
[6,] ""     ""     ""     ""     ""      ""   

position <- lapply(data, function(x) apply(x, 1, function(y) which(y %in% "x")))
position <- lapply(position, function(x) lapply(x, function(y) {if (length(y) == 0L) return(0) else return(y)})) # remove int(0) and replace with 0
position <- lapply(position, function(x) lapply(x, function(x) paste(x, collapse = ","))) # flatten second level list into string


for (i in 1:length(data)) {
  for (j in 1:nrow(data[[i]])) {
    if (as.numeric(unlist(strsplit(position[[i]][[j]], ",")))[[1]] == 0) {
      data[[i]][j, "Approvers"] <- ""
    } else {
      data[[i]][j, "Approvers"] <- paste(data[[i]][1, as.numeric(unlist(strsplit(position[[i]][[j]], ",")))], collapse = "; ")
    }
  }
}

目前，我通过两个步骤解决这个问题：

我创建了另一个列表列表，其中包含每个x的列位置

在嵌套的for循环中，我查找第一行中的所有名称并将它们连接起来

代码如下：

     Col1   Col2   Col3   Col4   Col5    Approvers          
[1,] "Mark" "Paul" "Jane" "Mary" "Peter" ""                 
[2,] "x"    ""     ""     "x"    "x"     "Mark; Mary; Peter"
[3,] ""     ""     ""     "x"    "x"     "Mary; Peter"      
[4,] "x"    ""     ""     "x"    "x"     "Mark; Mary; Peter"
[5,] ""     "x"    ""     ""     ""      "Paul"             
[6,] ""     ""     ""     ""     ""      ""   

position <- lapply(data, function(x) apply(x, 1, function(y) which(y %in% "x")))
position <- lapply(position, function(x) lapply(x, function(y) {if (length(y) == 0L) return(0) else return(y)})) # remove int(0) and replace with 0
position <- lapply(position, function(x) lapply(x, function(x) paste(x, collapse = ","))) # flatten second level list into string


for (i in 1:length(data)) {
  for (j in 1:nrow(data[[i]])) {
    if (as.numeric(unlist(strsplit(position[[i]][[j]], ",")))[[1]] == 0) {
      data[[i]][j, "Approvers"] <- ""
    } else {
      data[[i]][j, "Approvers"] <- paste(data[[i]][1, as.numeric(unlist(strsplit(position[[i]][[j]], ",")))], collapse = "; ")
    }
  }
}

---

position我们可以使用
lappy
在
列表上循环
，然后使用
apply
在行上循环，并将
第一行的元素粘贴在一起，其中值为
x
：

res <- lapply(data, function(x) {
       x$Approvers <- apply(x, 1, FUN = function(y) paste(x[1,][y =="x"], collapse=";"))
       x})
res
#$data1
#  Col1 Col2 Col3 Col4  Col5       Approvers
#1 Mark Paul Jane Mary Peter                
#2    x              x     x Mark;Mary;Peter
#3                   x     x      Mary;Peter
#4    x              x     x Mark;Mary;Peter
#5         x                            Paul
#6                                          

#$data2
#  Col1 Col2 Col3 Col4  Col5       Approvers
#1 Mark Paul Jane Mary Peter                
#2    x              x     x Mark;Mary;Peter
#3    x                    x      Mark;Peter
#4                   x                  Mary
#5                                          
#6                                          

res作为替代方案，整理这些数据可能是值得的，这样更易于操作和推理。此外，您想要的输出可能并不总是理想的，因为它返回的是整行的
NAs
。这里的代码重新构造数据帧，使列名成为人名。然后对数据进行重塑，使其有两列，
名称
，以及原始数据框（
row_ix
）中的行索引，其中该名称列显示“x”。然后我删除
NAs
，按
第九行
分组，并将名称粘贴在一起，返回更整洁的数据帧

我理解这需要更多的参与，但从长远来看，以更整洁的方式存储数据可能会为您节省问题

library(dplyr)
library(purrr)
library(tidyr)
library(magrittr)

data %>% 
  map(function(x) #map function to all dataframes in list
  x %>% set_colnames(.[1, ]) %>% # set column names equal to first row values
  dmap(~ifelse(. == "x", seq_along(.), NA)) %>% # check for "x" in all rows of all columns
  gather(name, row_ix) %>% # reshape from wide to long, call new columns name and row_ix
  drop_na() %>% # drop NAs in the dataframe
  group_by(row_ix) %>% # group by row index
  summarise(approvers = paste0(name, collapse = ";")) # concatenate names from each group
  )

$data1
# A tibble: 4 × 2
  row_ix       approvers
   <int>           <chr>
1      2 Mark;Mary;Peter
2      3      Mary;Peter
3      4 Mark;Mary;Peter
4      5            Paul

$data2
# A tibble: 3 × 2
  row_ix       approvers
   <int>           <chr>
1      2 Mark;Mary;Peter
2      3      Mark;Peter
3      4            Mary

库（dplyr）
图书馆（purrr）
图书馆（tidyr）
图书馆（magrittr）
数据%>%
映射（函数（x）#将函数映射到列表中的所有数据帧
x%>%set_colnames（[1，]）%>%set#将列名设置为等于第一行值
dmap（~ifelse（.==“x”，seq_沿（.），NA））%>%#检查所有列的所有行中的“x”
聚集（名称，第九行）%>%#从宽改长，调用新列名称和第九行
drop_na（）%>%#在数据帧中drop NAs
分组依据（第九行）%>%#分组依据行索引
摘要（approvers=paste0（name，collapse=“；”））#连接每个组的名称
)
$data1
#一个tibble:4×2
第九行批准人
12分；玛丽；彼得
玛丽；彼得
3.4分；玛丽；彼得
4.5保罗
$data2
#一个tibble:3×2
第九行批准人
12分；玛丽；彼得
2.3分；彼得
玛丽
非常优雅。谢谢Akrun。嵌套的apply函数可能有点慢，因为它会将数据帧强制为矩阵。有没有办法避免在这里应用（而不是重新引入for循环）？没问题，Paul。我之所以采用这种方法，是因为您希望的输出将包含冗余信息——这可能确实符合您的需求，但考虑备选方案总是有帮助的：