从嵌套列表深处提取命名元素的通用方法答案

【问题标题】：generalized approach to pulling named elements from deep within a nested list从嵌套列表深处提取命名元素的通用方法
【发布时间】：2021-02-12 02:36:48
【问题描述】：

我昨天问了一个问题，询问如何按名称访问嵌套列表的所有元素。 https://stackoverflow.com/a/64579426/9806500

是否有一个通用函数可以让我获得列表中更深的命名元素？特别是，我试图获取对 Slack 消息的回复的用户和时间戳，并且消息模式名称在消息的 replies 级别下重复使用 user 和 ts 成对指定谁和何时回复.我无法通过上面的 purrr 解决方案链接找到他们。不确定这是因为user 和ts 也是主要消息的元素名称，还是因为我无法通过使用~ purrr::map() 作为map() 中的映射器函数访问那么远的级别。

l <- list(folder_1 = list(
      `msg_1-1` = list(type = "message",
                   subtype = "channel_join",
                   ts = "1585771048.000200",
                   user = "UFUNNF8MA",
                   text = "<@UFUNNF8MA> has joined the channel"),
      `msg_1-2` = list(type = "message",
                       subtype = "channel_purpose",
                       ts = "1585771049.000300",
                       user = "UNFUNQ8MA",
                       text = "<@UNFUNQ8MA> set the channel purpose: Talk about xyz")),
      folder_2 = list(
        `msg_2-1` = list(type = "message",
                      subtype = "channel_join",
                      ts = "1585771120.000200",
                      user = "UQKUNF8MA",
                      text = "<@UQKUNF8MA> has joined the channel",
                      replies = list(list(user = "UABCDEFG8", ts = "1585771220.002200"),
                          list(user = "UGFEDCBA8", ts = "1585771220.022000")))))

谢谢！

【问题讨论】：

标签： r list tidyverse slack purrr

【解决方案1】：

你可以这样做：

unlist(l)[grep("\\.user", names(unlist(l)))]
#>         folder_1.msg_1-1.user         folder_1.msg_1-2.user 
#>                   "UFUNNF8MA"                   "UNFUNQ8MA" 
#>         folder_2.msg_2-1.user folder_2.msg_2-1.replies.user 
#>                   "UQKUNF8MA"                   "UABCDEFG8" 
#> folder_2.msg_2-1.replies.user 
#>                   "UGFEDCBA8"

对于更通用的解决方案，您可以：

 get_elements <- function(list, field) {
   as.character(unlist(list)[grep(paste0(field, "$"), names(unlist(list)))])
 }

允许：

get_elements(l, "user")
#> [1] "UFUNNF8MA" "UNFUNQ8MA" "UQKUNF8MA" "UABCDEFG8" "UGFEDCBA8"

get_elements(l, "ts")
#> [1] "1585771048.000200" "1585771049.000300" "1585771120.000200"

【讨论】：

我的实际目标列表是一个包含 200 多个用户的工作区中一年的 Slack 数据存档。虽然这种方法适用于玩具数据集，但我担心它不会扩展。

【解决方案2】：

你可以使用这个递归函数：

# assign the function
get_ele <- function(x, what){
  is_list <- vapply(x, is.list, FALSE)
  c(sapply(x[is_list], get_ele, what), x[[what]])
}

# use the function
unname(unlist(get_ele(l, "user")))
#R> [1] "UFUNNF8MA" "UNFUNQ8MA" "UABCDEFG8" "UGFEDCBA8" "UQKUNF8MA"

unname(unlist(get_ele(l, "ts")))
#R> [1] "1585771048.000200" "1585771049.000300" "1585771120.000200"

如果你需要多次这样做，那么这个 C++ 版本可能会更快：

#include <Rcpp.h>
#include <vector>
using namespace Rcpp;

void get_ele_inner(Rcpp::List x, Rcpp::CharacterVector what, 
                   std::vector<SEXP> &out_list){
  SEXP names = x.attr("names");
  if(!Rf_isNull(names)){
    CharacterVector names_str(names);
    for(R_len_t i = 0; i < x.size(); ++i){
      if(names_str[i] == what[0])
        out_list.emplace_back(x[i]);
      else if(Rf_isNewList(x[i]))
        get_ele_inner(x[i], what, out_list);
      
    }
  } else 
    for(auto xi : x)
      if(Rf_isNewList(xi))
        get_ele_inner(xi, what, out_list);
}

// [[Rcpp::export(rng = false)]]
SEXP get_ele(SEXP x, Rcpp::CharacterVector what) {
  std::vector<SEXP> out_list;
  get_ele_inner(x, what, out_list);
  
  R_len_t const n_ele = out_list.size();
  Rcpp::List out(n_ele);
  for(R_len_t i = 0; i < n_ele; ++i)
    out[i] = out_list[i];
  
  return out;
}

您可以使用Rcpp::sourceCpp 来编译函数。你提供的列表在我的笔记本电脑上似乎快了 10 倍（尽管这个列表很小）。

【讨论】：

【解决方案3】：

一个“整洁”的解决方案：

# Fixed the reprex list
l <- list(
  folder_1 = list(
    `msg_1-1` = list(
      type = "message",
      subtype = "channel_join",
      ts = "1585771048.000200",
      user = "UFUNNF8MA",
      text = "<@UFUNNF8MA> has joined the channel"
    ),
    `msg_1-2` = list(
      type = "message",
      subtype = "channel_purpose",
      ts = "1585771049.000300",
      user = "UNFUNQ8MA",
      text = "<@UNFUNQ8MA> set the channel purpose: Talk about xyz"
    )
  ),
  folder_2 = list(
    `msg_2-1` = list(
      type = "message",
      subtype = "channel_join",
      ts = "1585771120.000200",
      user = "UQKUNF8MA",
      text = "<@UQKUNF8MA> has joined the channel",
      replies = list(
        list(user = "UABCDEFG8", ts = "1585771220.002200"),
        list(user = "UGFEDCBA8", ts = "1585771220.022000")
      )
    )
  )
)
# use the pipe
`%>%` <- magrittr::`%>%`
# map at 2nd level depth
messages <- purrr::map_depth(l, 2, ~{
  if (!is.null(.x$replies)) {
#Map over replies if present
    .replies <- purrr::map_dfr(.x$replies, ~{
      tibble::tibble(ts = .x$ts, user = .x$user, text = rlang::`%||%`(.x$text, NA))
    })
  } else {
    .replies <- NULL
  }
#output as tibble
  tibble::tibble(
    ts = .x$ts, user = .x$user, text = .x$text, replies =  list(
      .replies
    )
  )
  
}) %>%
#remove one layer of nesting
  unlist(recursive = FALSE) %>%
#bind together and keep folder name
  dplyr::bind_rows(.id = "folder") %>% 
# separate message name into it's own column
  tidyr::separate(folder, into = c("folder", "message"), sep = "\\.")

【讨论】：

感谢@Synchronicity！我现在正在修补map_depth()。我将这些结果提供给对tibble() 的调用，以便我可以随意添加/删除命名属性，而无需尝试修改整个数据框以进行访问。当我完成该部分时，将在此处添加评论，但我认为这非常朝着正确的方向发展。再次感谢！

【解决方案4】：

在rrapply-package 中使用rrapply()（基本rapply() 的扩展版本）：

library(rrapply)

## unlist 'user' nodes as vector
rrapply(l, condition = function(x, .xname) .xname == "user", how = "unlist")
#>         folder_1.msg_1-1.user         folder_1.msg_1-2.user 
#>                   "UFUNNF8MA"                   "UNFUNQ8MA" 
#>         folder_2.msg_2-1.user folder_2.msg_2-1.replies.user 
#>                   "UQKUNF8MA"                   "UABCDEFG8" 
#> folder_2.msg_2-1.replies.user 
#>                   "UGFEDCBA8"

## unlist 'ts' nodes as vector
rrapply(l, condition = function(x, .xname) .xname == "ts", how = "unlist")
#>         folder_1.msg_1-1.ts         folder_1.msg_1-2.ts 
#>         "1585771048.000200"         "1585771049.000300" 
#>         folder_2.msg_2-1.ts folder_2.msg_2-1.replies.ts 
#>         "1585771120.000200"         "1585771220.002200" 
#> folder_2.msg_2-1.replies.ts 
#>         "1585771220.022000"

或返回融化的 data.frames 而不是未列出的向量：

## 'user' nodes as melted data.frame
rrapply(l, condition = function(x, .xname) .xname == "user", how = "melt")
#>         L1      L2      L3   L4   L5     value
#> 1 folder_1 msg_1-1    user <NA> <NA> UFUNNF8MA
#> 2 folder_1 msg_1-2    user <NA> <NA> UNFUNQ8MA
#> 3 folder_2 msg_2-1    user <NA> <NA> UQKUNF8MA
#> 4 folder_2 msg_2-1 replies  ..1 user UABCDEFG8
#> 5 folder_2 msg_2-1 replies  ..2 user UGFEDCBA8

## 'ts' nodes as melted data.frame
rrapply(l, condition = function(x, .xname) .xname == "ts", how = "melt")
#>         L1      L2      L3   L4   L5             value
#> 1 folder_1 msg_1-1      ts <NA> <NA> 1585771048.000200
#> 2 folder_1 msg_1-2      ts <NA> <NA> 1585771049.000300
#> 3 folder_2 msg_2-1      ts <NA> <NA> 1585771120.000200
#> 4 folder_2 msg_2-1 replies  ..1   ts 1585771220.002200
#> 5 folder_2 msg_2-1 replies  ..2   ts 1585771220.022000

【讨论】：