代码之家 › 专栏 › 技术社区 › user5249203

使用purr::map跨越具有列表列的数据框架

purrr tidyverse r

user5249203 · 技术社区 · 7 年前

我尝试使用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 通过将它们包装在map函数中动态地进行映射,例如只映射到值我可以用地图。

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

这将生成 标签项 json文件中的所有ID列表。对于json结构,我需要遍历 ID -> list -> list . 并将相应的输入参数传递给 标签项 箱 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)))
    ))
}

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>

2 回复 | 直到 7 年前

Artem Sokolov 7 年前

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

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

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中的“学生图”和代码中的“学生图”之间的差异。)

Sahir Moosvi 7 年前

有点难以理解你到底需要什么,但希望你能从中得到你需要的。

简单地说,我所做的就是将非结构化数据转换成一个整洁的高数据帧,并循环通过它来生成r代码。

1-我遍历并获取每个boxitem数据帧,然后添加一个新列,将boxitem的tabName添加到其中。

2-boxItemDataFrames的每一行都有一个custofuns列表,unnest函数将它们拆分为多行。

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],"'))
  )
)"
         )
       )