loop through columns in dataframe list using lapply and map

Question

I'd like to create a dynamic HTML list based on a list of dataframes datalist. My data is a list of dataframes each with two columns (with not necessarily the same name). I always want the first column of each dataframe to be the list element, and the second column the text seen on hover (using tippy).

library(shiny)
library(tippy)



# list of dataframes
datalist <- list(data.frame(A = c("col_1", "col_2", "col_3"), B = c("val_1", "val_2", "val_3")),
                 data.frame(X = c("col_4", "col_5", "col_6"), Y = c("val_4", "val_5", "val_6")),
                 data.frame(A = c("col_7", "col_8", "col_9"), B = c("val_7", "val_8", "val_9")))



# named list
names(datalist) <- c("Group 1", "Group 2", "Group 3")

ui <-
  # rowPalette(datafile)
  # Should give me this:
  tagList(
    div(h1("Group 1"),
        tags$li(tippy("col_1", "val_1")),
        tags$li(tippy("col_2", "val_2")),
        tags$li(tippy("col_3", "val_3"))),

    div(h1("Group 2"),
        tags$li(tippy("col_4", "val_4")),
        tags$li(tippy("col_5", "val_5")),
        tags$li(tippy("col_6", "val_6"))),

    div(h1("Group 3"),
        tags$li(tippy("col_7", "val_7")),
        tags$li(tippy("col_8", "val_8")),
        tags$li(tippy("col_9", "val_9")))
  )

server <- function(input, output) {
}


shinyApp(ui = ui, server = server)

The code above produces a repetitive output, looping over each row in every data frame. I wrote a function that can create a single list element:

# Create function for single li
# name will be col_ and hover with be val_
rowBlock <- function(name) {
  tags$li(tippy(name, name))
}
# rowBlock("test", "tooltip") prints test with a tooltip "tooltip"

I figured I could possibly use this function to create a second function that will loop over each dataframe in the list and

1) Give it a header taken from names(datalist)

2) Use the rowBlock function with lapply but this needs TWO arguments: the first column for the text of the list element and the second column is the hover text of the element.

This doesn't quite work but maybe it's close???

rowPallete <- function(data) {
  Map(function(x, y, z)
  div(h5(x),
      tags$ul(rowBlock(y, z))),
  names(data),
  data[[1]][[1]], #I'm not looping through these properly
  data[[1]][[2]]  #I'm not looping through these properly
  )
}

Can anyone help me dynamically achieve the desired output using the datalist as the functions input?

Answer 1

You can use map2() from purrr to iterate over two equal length items.

In rowBlock(), we can use apply() to iterate tippy() over rows in each dataframe from datalist and then map() to iterate tags$li() over those tippy outputs.

I had to reshuffle the order of a few items, so here's the full code block.

library(shiny)
library(tippy)

# list of dataframes
datalist <- list(data.frame(A = c("col_1", "col_2", "col_3"), B = c("val_1", "val_2", "val_3")),
                 data.frame(X = c("col_4", "col_5", "col_6"), Y = c("val_4", "val_5", "val_6")),
                 data.frame(A = c("col_7", "col_8", "col_9"), B = c("val_7", "val_8", "val_9")))

# named list
names(datalist) <- c("Group 1", "Group 2", "Group 3")

library(purrr)

rowPallete <- function(data) {
  map2(names(data),
       data,
       ~div(h5(.x),
            tags$ul(rowBlock(.y)))) %>% 
    map(.,
        tagList)
}

rowBlock <- function(name) {
  apply(name,
        1,
        function(x){tippy(paste(x[1]), paste(x[2]))}) %>%
    map(.,
        ~tags$li(.x))
}



ui <-
  tagList(rowPallete(datalist))

server <- function(input, output) {
}


shinyApp(ui = ui, server = server)

And here's an image.