泛化用于自定义函数的 for 循环

Question

使用下面的 for 循环，我可以创建给定员工上方所有经理的列表（本质上是员工经理、她经理的经理等的列表）

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

# Create test data 
ds <-
  tibble(
    emp_id = c("001", "002", "003", "004", "005"),
    mgr_id  = c("002", "004", "004", "005", NA)
  )

# Hardcoded for-loop example 
  mgr_ids_above <- vector("list", length = 5)
  id <- "001"

  for (i in seq_along(mgr_ids_above)) {
    mgr_ids_above[[i]] <- ds$mgr_id[ds$emp_id == id]

    id <- mgr_ids_above[[i]]
  }

  # drop NAs
  mgr_ids_above <- unlist(mgr_ids_above)
  mgr_ids_above <- mgr_ids_above[!is.na(mgr_ids_above)]

  # return to list format
  as.list(mgr_ids_above)

我希望将此 for 循环应用于整个数据框并将结果保存在列表列中。我可以使用pmap() 成功地做到这一点，将硬编码的 for 循环应用于我的数据帧，但是当我尝试编写一个通用函数时，一切都崩溃了。

# Define custom function with hardcoded data and variable names
get_mgrs_above <- function(id, max_steps = 5){

  mgr_ids_above <- vector("list", length = max_steps)

  for (i in seq_along(mgr_ids_above)) {
    mgr_ids_above[[i]] <- ds$mgr_id[ds$emp_id == id]

    id <- mgr_ids_above[[i]]
  }

  # drop NAs
  mgr_ids_above <- unlist(mgr_ids_above)
  mgr_ids_above <- mgr_ids_above[!is.na(mgr_ids_above)]

  # return to list format
  as.list(mgr_ids_above)
}

# Apply custom function
ds_mgrs_above <-
  ds %>%
  mutate(
    ranks_above = pmap(
      list(id = emp_id),
      get_mgrs_above
    )
  )

上面代码的输出是

A tibble: 5 x 3
emp_id mgr_id ranks_above
  <chr>  <chr>  <list>     
1 001    002    <list [3]> 
2 002    004    <list [2]> 
3 003    004    <list [2]> 
4 004    005    <list [1]> 
5 005    NA     <list [0]>

ranks_above 列表列的内容看起来像

ds_mgrs_above$ranks_above[[1]]

[[1]]
[1] "002"

[[2]]
[1] "004"

[[3]]
[1] "005"

所有数据和变量作为参数提供的失败函数失败并显示消息“mutate_impl(.data, dots) 中的错误： 评估错误：元素 1 的长度为 2，而不是 1 或 5..”：

get_mgrs_above <- function(
  data,
  id = emp_id,
  mgr_id = mgr_id,
  emp_id = emp_id,
  max_steps = 5){

  mgr_ids_above <- vector("list", length = max_steps)

  for (i in seq_along(mgr_ids_above)) {
    mgr_ids_above[[i]] <- data$mgr_id[data$emp_id == id]

    id <- mgr_ids_above[[i]]
  }

  # drop NAs
  mgr_ids_above <- unlist(mgr_ids_above)
  mgr_ids_above <- mgr_ids_above[!is.na(mgr_ids_above)]

  # return to list format
  as.list(mgr_ids_above)
}

ds %>%
  mutate(
    ranks_above = pmap(
      list(
        data = ds,
        id = emp_id,
        mgr_id = mgr_id,
        emp_id = emp_id,
        max_steps = 5
      ),
      get_mgrs_above
    )
  )

为避免混淆，这篇文章是关于如何编写一个通用函数，该函数将从两列创建一个列表列。这是对拥有约 15,000 名员工的数据框进行更大规模数据整理尝试的一个组成部分。

Answer 1

您的循环结构让我感到困惑，因此我使用while 对其进行了更改。这只允许在最后应用map。

get_mgrs_above <- function(id, data = NULL, max_steps = 5) {

  stopifnot(!is.null(data))

  mgr_ids_above <- list()

  mgr  <- id
  iter <- 0

  while (iter < max_steps & !is.na(mgr)) {

    mgr <- data$mgr_id[data$emp_id == mgr]

    if (!is.na(mgr)) {
      mgr_ids_above <- append(mgr_ids_above, mgr)
    }

    iter <- iter + 1

  }

  return(mgr_ids_above)

}

ds$ranks_above <- map(ds$emp_id, get_mgrs_above, data = ds)

Answer 2

这是我做我认为你想做的事情的尝试。我想不出一种方法来调整您的代码，但我希望这种方法有意义。基本上，您希望从员工 ID 及其直接经理 ID 的单个表中获取每个员工的完整命令链。在这里，我制作了该表 lookup 并反复将其加入到一个输入数据帧中，该输入数据帧基本上只是员工 ID，一个 command_chain list-col 我将每个额外的经理添加到其中，以及一个将 ID 存储到的 current_join 列在每次迭代中查找。

然后我们可以简单地将join_once 函数包装在join_all 中，它会一直调用它，直到我们到达所有命令链的末尾（只有NAs）。我清理了输出以丢弃 NA 并将命令链打印为逗号分隔的字符串，这样您就可以看到它做了什么。

在某种程度上我不知道这是否特别有效，因为您必须加入许多可能不需要它的变量（例如，这里 004 的加入次数比必要的多三倍）但至少在概念上很简单我想。

library(tidyverse)
lookup <- tibble(
    emp_id = c("001", "002", "003", "004", "005"),
    mgr_id = c("002", "004", "004", "005", NA)
  )

input <- lookup %>%
  select(emp_id) %>%
  mutate(command_chain = emp_id, current_join = emp_id)

join_once <- function(df) {
  df %>%
    left_join(lookup, by = c("current_join" = "emp_id")) %>%
    mutate(
      command_chain = map2(command_chain, mgr_id, ~ c(.x, .y)),
      current_join = mgr_id
    ) %>%
    select(-mgr_id)
}

join_all <- function(df) {
  output <- df
  while (!all(is.na(output$current_join))) {
    output <- join_once(output)
  }
  return(output)
}

output <- join_all(input)
output %>%
  mutate(
    command_chain = map(command_chain, ~ discard(.x, is.na)),
    cc_as_string = map_chr(command_chain, ~ str_c(.x, collapse = ","))
    ) %>%
  select(-current_join)
#> # A tibble: 5 x 3
#>   emp_id command_chain cc_as_string   
#>   <chr>  <list>        <chr>          
#> 1 001    <chr [4]>     001,002,004,005
#> 2 002    <chr [3]>     002,004,005    
#> 3 003    <chr [3]>     003,004,005    
#> 4 004    <chr [2]>     004,005        
#> 5 005    <chr [1]>     005

由reprex package (v0.2.0) 于 2018 年 8 月 22 日创建。