MayaGans
MayaGans

Reputation: 1845

lapply with 2 vectors? A Shiny example

I'm sorry if this is a little redundant with posts pertaining to lapply with multiple arguments but I'm still struggling to apply those concepts within my nested functions. I also appoligize if the title doesn't quite get to the crux of my question and am open to suggestions!

I'd like to create a series of lists in Shiny from a series of data frames, where each list is given a title corresponding to the name of the data frame:

Desired Output

test

test2

test3

I first created all_tests, a list containing all the dataframes, with names corresponding to the dataframes.

I want to use this within a series of functions:

library(shiny)

# This is a repex where really I'm going to be importing x # of data frames
# I want to use their column names within each list
# And title each list the name of the dataframe
test <- data.frame("A" = NA, "B" = NA, "C" = NA)
test2 <- data.frame("D" = NA, "E" = NA, "F" = NA)
test3 <- data.frame("G" = NA, "H" = NA, "I" = NA)

all_tests <- list(colnames(test), colnames(test2), colnames(test3))
names(all_tests) <- c("test", "test2", "test3")

# each column name should be a li
rowBlock <- function(name) {
  tags$li(
    class = "block", id = name,
    div(name)
  )
}

# each dataframe should be its own list
# and titled with the name of the df
rowPallete <- function(data) {
  div(
    lapply(names(data), h5),
    tags$ul(
      class="all_blocks",
      lapply(data, rowBlock)
    ))
}

# combine the different dataframes into a series of lists
# to be used within app.R
rowArea <- function(bins) {
  column(1, offset = 0, style='padding:0px;',
         lapply(bins, rowPallete)
  )
}

I can get the code to work when I don't include ul titles, but I'm struggling to apply two vectors to the same lapply function. I've been playing around with using column names, names(all_tests) but seem to still be missing something. Any help appreciated!

Upvotes: 0

Views: 148

Answers (1)

IceCreamToucan
IceCreamToucan

Reputation: 28675

This seems to be what you're after (rowBlock is unchanged)

# each dataframe should be its own list
# and titled with the name of the df
rowPallete <- function(data) {
  Map(function(x, y) 
        div(h5(x), tags$ul(class = 'all_blocks', lapply(colnames(y), rowBlock))),
      names(data),
      data)
}

rowArea <- function(bins) {
  column(1, offset = 0, style='padding:0px;',
         rowPallete(bins)
  )
}

ui <- rowArea(all_tests)
server <- function(input, output) {
}

shinyApp(ui = ui, server = server)

Upvotes: 1

Related Questions