时间戳

首页 > 解决方案 > 在 purrr::pmap() 中应用 for 循环

r - 在 purrr::pmap() 中应用 for 循环

问题描述

从两列中soldier，superior我试图创建一个列在每个列之上的上级列，soldier稍后我可以将其取消嵌套以形成长数据，所有列都高于每个士兵的等级。因此，对于“Srg”，值将是“Lt，Maj，Col，Gen”，对于“Maj”，值将是“Col，Gen”。

目前，我发现将此 for 循环应用于整个数据帧的唯一方法purrr::pmap()需要我将变量和数据帧名称硬编码到 for 循环中。

有没有一种方法可以在一个更通用的函数中提取这些等级，该函数将数据和变量名作为参数？ 

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

# Create test data
data <-
  dplyr::tibble(
    soldier = c("Srg", "Lt", "Maj", "Col", "Gen"),
    superior  = c("Lt", "Maj", "Col", "Gen", NA)
  )

# Define custom function
get_ranks_above <- function(id, max_steps = 5){

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

  for (i in 1:max_steps) {
    ranks_above[[i]] <- 
      data.frame(
        superior_list = data$superior[data$soldier == id]
      )

    id <- ranks_above[[i]]$superior_list
  }

  do.call(rbind, ranks_above)
}

# Apply custom function
data_ranked <- 
  data %>%
  mutate(
    ranks_above = pmap(
      list(id = soldier), 
      get_ranks_above
    )
  )

# Unnest list column and add numeric ranks
data_ranked %>% 
  unnest(ranks_above) %>% 
  drop_na() %>% 
  group_by(soldier) %>% 
  mutate(rank_from_top = seq(n(),1)) %>% 
  ungroup()

当我尝试get_ranks_above()使用数据和变量名称的参数编写自定义函数时，我收到一条错误消息： mutate_impl(.data, dots) 中的错误：评估错误：元素 1 的长度为 2，而不是 1 或 5..

get_ranks_above <- function(data, id = soldier, lower_rank = data$soldier, upper_rank = data$superior, max_steps = 5){

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

  for (i in 1:max_steps) {
    ranks_above[[i]] <- 
      data.frame(
        superior_list = upper_rank[lower_rank == id]
      )

    id <- ranks_above[[i]]$superior_list
  }

  do.call(rbind, ranks_above)
}

data_ranked <- 
  data %>%
  mutate(
    ranks_above = pmap(
      list(
        data = data, 
        id = soldier, 
        lower_rank = data$soldier, 
        upper_rank = data$superior, 
        max_steps = 5
      ), 
      get_ranks_above
    )
  )

标签： rfor-looppurrr

解决方案

我会用有序的因素来解决这个问题。一旦您拥有包含所有信息的表格，您就可以轻松地将其合并到任何数据框。大概的概念：

library(dplyr)
library(purrr)
sld_levels <- c("Srg", "Lt", "Maj", "Col", "Gen")
tibble(sld_rank = factor(sld_levels, 
                         levels = sld_levels, 
                         ordered = TRUE)) %>% 
  mutate(rank_above = map(.x = sld_rank, ~sld_rank[.x < sld_rank]))

推荐阅读