using purr:: map across a data_frame with a list column

Question

I am trying to use purr map function or its variants to map data across multiple functions ( in my case R-Shiny functions). I am reading the parameters from 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"]
          }
        ]
      }
    ]
  }
}

I read this into df format

json <- fromJSON("example.json")

I am trying to generate the tabItem's and its box'es dynamically by wrapping them in map function, for example to just map on tabItem values I can use map.

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

This would generate the html code for tabItem with all the list of ID's I have in the json file. For the json structure I have I need to traverse through ID -> list -> list. And, pass the respective input parameters to tabItem, box Tried the other variants like pmap but could not solve it. How to use purr map functions recursively in a data frame of this data structure?

Here is my attempt

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)))
    ))
}

The current output below. What I get is the tabItem, what is missing is the box and column html output. It seems the map2 does not even render.

[[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

I recommend putting everything together into a single, flat data frame:

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

The first step is to map your character names of functions to the actual functions:

## 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
# ...

Working from the inside outward, you can now systematically apply map2 to generate your shiny elements (functions applied to ID -> column -> box -> tab):

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]] should now match the HTML you produced "by hand". (Minus the discrepancy between "Student graph" in JSON and "Students graph" in the code.)

Answer 2

Had a bit of difficulty understanding exactly what you need out of it but hopefully you can take what you need from this.

What I did in brief is turn the unstructured data into a tidy tall dataframe and loop through that to generate the r shiny code.

1- I run through and grab every boxitem dataframe and add a new column that adds the boxitem's tabName to it.

2- Each row of the boxitem dataframes has a list of custofuns and the unnest function splits them into multiple rows.

3- I combined the boxitem dataframes into one big dataframe that you could manipulate as you see fit.

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- This generates the r shiny code in string format. We are faced with the issue of how wide your columns are going to be if there are lots of them. It loops through each student and creates a column for them.

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