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，点）中的错误：评估错误：元素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
    )
  )

为避免混淆，这是一篇有关如何编写可归纳函数的文章，该函数将从两列创建一个列表列。这是对拥有约1.5万名员工的数据帧进行较大数据整理尝试的一个组成部分。

Answer 1

这是我尝试做自己想做的事。我想不出一种方法来修改您的代码，但我希望这种方法有意义。基本上，您希望从一张员工ID及其直接经理的ID表中获取每个员工的完整命令链。在这里，我制作了该表lookup，并反复将其连接到一个输入数据框上，该输入框基本上只是员工ID，一个我添加了每个其他经理的command_chain列表列和一个current_join列，其中存储要在每次迭代中查找的ID。

然后，我们可以简单地将join_once函数包装在join_all中，它将继续调用它，直到到达所有命令链的末尾（只有NA为止）。我清理了输出以丢弃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-08-22创建。

Answer 2

循环的构造方式使我感到困惑，因此我使用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)

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

2 个答案: