Question

我正在尝试使用purr映射函数或其变体跨多个函数（在我的情况下为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")

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

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

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

这是我的尝试

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，缺少的是box和column 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],"'))
  )
)"
         )
       )

使用purr ::使用列表列在data_frame中进行映射

2 个答案: