使用 purrr:: 在具有列表列的数据框中映射

Question

我正在尝试使用 purr map 函数或其变体来跨多个函数映射数据（在我的例子中是 R-Shiny 函数）。我正在读取来自example.json 的参数。

{
  "Section_1": {
    "MainHeader": [{
      "School": "Montessori"
    }],
    "boxitems": [{
        "tabName": "id1",
        "box": [{
            "title": "Students graph",
            "custofun": ["Bob", "Dan", "Sean"]
          },
          {
            "title": "Teacher graph",
            "custofun": ["Robinson"]
          }
        ]
      },
      {
        "tabName": "id2",
        "box": [{
            "title": "Students graph",
            "custofun": ["Felix", "Helix", "Alex"]
          },
          {
            "title": "Teacher graph",
            "custofun": ["Phelix"]
          }
        ]
      }
    ]
  }
}

我把它读成了df 格式

json <- fromJSON("example.json")

我正在尝试通过将 tabItem 及其 box'es 包装在 map 函数中来动态生成它们，例如仅映射 tabItem 值我可以使用 map。

 map(unique(df$id), ~ tabItem(tabName = .x)) 

这将为tabItem 生成html 代码，其中包含我在json 文件中拥有的所有ID 列表。对于我拥有的 json 结构，我需要遍历 ID -> list -> list。并且，将各自的输入参数传递给tabItem，box 尝试了pmap 等其他变体，但无法解决。如何在该数据结构的数据框中递归使用 purr map 函数？

这是我的尝试

json$Section_1$boxitems %>% as.tibble() # to check the strucutre
df <- json$Section_1$boxitems %>% select(tabName,box)
df$box <- setNames(df$box,df$tabName)

BoxCustomFunc <- function(tabName,box) {
   map(tabName , ~ tabItem(tabName = .x),
   map2(x = box, y = box[tabName],
         box(title = .x$title, 
      column(width = 2, get(.y$custofun)(tabName)))
    ))
}

下面的当前输出。我得到的是tabItem，缺少的是框和列的html 输出。似乎map2 甚至没有渲染。

[[1]]
<div role="tabpanel" class="tab-pane" id="shiny-tab-id1"></div>

[[2]]
<div role="tabpanel" class="tab-pane" id="shiny-tab-id2"></div>

Answer 1

我建议将所有内容放在一个单一的平面数据框中：

df <- fromJSON( "example.json" )$Section_1$boxitems %>% as.tibble() %>% 
  unnest() %>% unnest() %>% mutate( Width = rep(c(2, 12, 4, 12), 2) )
# # A tibble: 8 x 4
#   tabName title         custofun Width
#   <chr>   <chr>         <chr>    <dbl>
# 1 id1     Student graph Bob          2
# 2 id1     Student graph Dan         12
# 3 id1     Student graph Sean         4
# 4 id1     Teacher graph Robinson    12
# 5 id2     Student graph Felix        2
# 6 id2     Student graph Helix       12
# 7 id2     Student graph Alex         4
# 8 id2     Teacher graph Phelix      12

第一步是将函数的字符名称映射到实际函数：

## Assuming that Felix, Helix, Alex and Phelix are defined
X <- df %>% mutate_at( "custofun", map, rlang::parse_expr ) %>%
  mutate_at( "custofun", map, rlang::eval_tidy )
# # A tibble: 8 x 4
#   tabName title         custofun Width
#   <chr>   <chr>         <list>   <dbl>
# 1 id1     Student graph <fn>         2
# 2 id1     Student graph <fn>        12
# ...

从内向外工作，您现在可以系统地应用map2 来生成闪亮的元素（函数应用于 ID -> 列 -> 框 -> 选项卡）：

Y <- X %>% mutate( fres = invoke_map(custofun, tabName) ) %>%
  mutate( Col = map2(Width, fres, column) ) %>%
  group_by( tabName, title ) %>%
  summarize_at( "Col", list ) %>%
  mutate( Box = map2(title, Col, ~box(title=.x, .y)) ) %>%
  summarize_at( "Box", list ) %>%
  transmute( Tab = map2(tabName, Box, ~tabItem(tabName = .x, .y)) )
# # A tibble: 2 x 1
#   Tab            
#   <list>         
# 1 <S3: shiny.tag>
# 2 <S3: shiny.tag>

Y$Tab[[1]] 现在应该与您“手动”生成的 HTML 相匹配。 （减去 JSON 中的“学生图”和代码中的“学生图”之间的差异。）

Answer 2

有点难以准确理解你需要什么，但希望你能从中得到你需要的东西。

我所做的就是将非结构化数据转换成一个整齐的高数据框，然后循环生成 r 闪亮的代码。

1- 我遍历并抓取每个 boxitem 数据框并添加一个新列，将 boxitem 的 tabName 添加到其中。

2- boxitem 数据框的每一行都有一个 custofuns 列表，unnest 函数将它们分成多行。

3- 我将 boxitem 数据框组合成一个大数据框，您可以根据需要对其进行操作。

library(jsonlite)
library(tidyverse)

json <- fromJSON("example.json")

listOfGraphs <- apply(json$Section_1$boxitems, 1, function(x) x$box %>% mutate(tabName = x$tabName) ) 

listOfTabNames <- lapply(listOfGraphs, function(y) unnest(y))

listOfColumns <- bind_rows(listOfTabNames)

4- 这会生成字符串格式的 r 闪亮代码。如果有很多列，我们面临的问题是列的宽度。它遍历每个学生并为他们创建一个列。

listOfTabItems <- lapply(listOfTabNames, 
       function(x) paste(
         "tabItem(
  tabName = '",x$tabName[1],"',
  box(        
    title = 'Students graph',",
         apply(subset(x, title=="Student graph"), 1, function(y) paste0("column(width = 4, ",y[3],"('",y[2],"'))")), collapse = ", ",
         "),
  box(        
    title = 'Teacher graph',
   column(width = 12, ",subset(x, title=="Teacher graph")$custofun[1],"('",x$tabName[1],"'))
  )
)"
         )
       )