从 for 循环到 purrr：命名子列表赋值

Question

我终于尝试从 for 循环跳到 purrr。基本示例非常直观，但翻译 for 循环一直很棘手，尤其是在尝试将输出对象分配给列表时。 考虑以下示例，我尝试将嵌套 for 循环的输出分配给命名列表元素。

library(tidyverse)

# output list
loop_list <- list()

# iterate over colors
for (color in diamonds %>% distinct(color) %>% pull()){
  
  # sublist for each color
  loop_list[[color]] <- list()
  
  # iterate over cuts
  for(cut in diamonds %>% distinct(cut) %>% pull()){
    
    # filter data
    data <- diamonds %>% 
      filter(color == color & cut == cut)
    
    # define output
    out <- data %>% 
      pull(price) %>% 
      mean()
    
    # assign output to sublist of its color
    loop_list[[color]][[cut]] <- out
    
    # clean up filtered data set
    rm(data)
  }
}

此嵌套循环将输出对象分配给数据集每种颜色的正确命名的子列表。我的 purrr 尝试创建了类似的东西，但没有命名的子列表。所有输出对象都分配到同一个列表中，这不是我想要的。

grid <- expand_grid(color = diamonds %>% distinct(color) %>% pull(),
                    cut = diamonds %>% distinct(cut) %>% pull())

myfunc <- function(data, color, cut){
  
  # create output object
  out <- data %>% 
    # filter data
    filter(color == color & cut == cut) %>%  
    pull(price) %>% 
    mean()
  
  # return output
  return(out)
}

purrr_list <- grid %>%
  pmap(myfunc, data = diamonds)

有没有办法用 purrr 达到相同的输出？我知道使用<<- 进行全局分配是可能的，但据我了解，这通常是不鼓励的。

Answer 1

最好更改参数名称以避免与实际列名冲突。

myfunc <- function(data, col1, col2){
  
  # filter data
  data <- diamonds %>% 
    filter(color == col1 & cut == col2)
  
  # define output
  out <- data %>% 
    pull(price) %>% 
    mean()
  
  # return output
  return(out)
}


grid %>% 
     pmap_dbl(~ myfunc(diamonds, ..1, ..2))
#[1] 2597.550 3538.914 3423.644 3214.652 3682.312 4451.970 5946.181 5078.533 5255.880 4685.446 4918.186 6294.592 4574.173 5103.513 4975.655
#[16] 3889.335 5216.707 4276.255 4535.390 5135.683 3374.939 4324.890 3495.750 3778.820 3827.003 3720.706 4500.742 4123.482 3872.754 4239.255
#[31] 2629.095 3631.293 3405.382 3470.467 4291.061

---

如果我们需要嵌套输出

library(dplyr)
grid %>% 
    split(.$color) %>% 
    map(~ pmap(.x, ~ myfunc(diamonds, ..1, ..2)) %>% 
    setNames(.x$cut))

-输出

#$D
#$D$Ideal
#[1] 2629.095

#$D$Premium
#[1] 3631.293

#$D$Good
#[1] 3405.382

#$D$`Very Good`
#[1] 3470.467

#$D$Fair
#[1] 4291.061


#$E
#$E$Ideal
#[1] 2597.55

#$E$Premium
#[1] 3538.914

#$E$Good
#[1] 3423.644
# ..