renderUI based on the rows in a table

Question

I would like to render UI elements based on the rows in a reactive dataframe.

This is different from How to create a UI in Shiny from a for loop whose length is based on numeric input?

library(shiny)
library(tidyverse)

x1 <- c(1,2,3,3,3,3)
x2 <- c('red', 'blue', 'green', 'green','green','blue')
x3 <- c('small', 'medium', 'large', 'large', 'large', 'small')



df <-data.frame(x1,x2,x3)


ui <- fluidPage(

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            selectizeInput("number",
                        "Number:",
                        choices = c(1,2,3),
                        multiple = TRUE
                    ),
            selectizeInput("color",
                        "color:",
                        choices = c('red', 'blue', 'green'),
                        multiple = TRUE
            ),
            selectizeInput("size",
                        "size:",
                        choices = c('small', 'medium', 'large'),
                        multiple = TRUE
            )
        ),

        # Show a plot of the generated distribution
        mainPanel(
            DT::dataTableOutput("table"),

            lapply(1:3, function(i) {

                    uiOutput(paste0('b', i))
            }



        )
    )
)
)


server <- function(input, output, session) {
    appdata <-reactive({
        df %>%
            filter(
                is.null(input$number) | x1 %in% input$number,
                is.null(input$color) | x2 %in% input$color,
                is.null(input$size)  | x3 %in% input$size
            )
    })

    output$table <- DT::renderDataTable({
        df <- appdata()

        action <-
            DT::dataTableAjax(session, df, outputId = "table")

        DT::datatable(df, options = list(ajax = list(url = action), lengthMenu =c(5,10,15), pageLength = 5), escape = FALSE)
    })

    lapply(1:3, function(i) {
        output[[paste0('b', i)]] <- renderUI({
            strong(paste0('Hi, this is output B#', i))
        })
    })

}


# Run the application 
shinyApp(ui = ui, server = server)

The code above statically loops the number output UI. I need the number of Hi, this is output B#[i] to match the number of rows in the dynamic table. As that table is filtered, the number of output UI should shrink.

mainPanel(
            DT::dataTableOutput("table"),

            lapply(1:nrow(appdata()), function(i) {

                    uiOutput(paste0('b', i))
            }

I was hoping the above would work but that just throws error of could not find function appdata.

Any help would be appreciated. Thank-you.

Answer 1

I found a solution to this issue code below works and additionally displays information from the table!

library(shiny)
library(shinydashboard)
library(tidyverse)

x1 <- c(1,2,3,3,3,3)
x2 <- c('red', 'blue', 'green', 'green','green','blue')
x3 <- c('small', 'medium', 'large', 'large', 'large', 'small')


df <-data.frame(x1,x2,x3)


ui <- dashboardPage(
    dashboardHeader(title = "Resource Finder"),

    # Sidebar for inputs 
    dashboardSidebar(
            selectizeInput("number",
                        "Number:",
                        choices = c(1,2,3),
                        multiple = TRUE
                    ),
            selectizeInput("color",
                        "color:",
                        choices = c('red', 'blue', 'green'),
                        multiple = TRUE
            ),
            selectizeInput("size",
                        "size:",
                        choices = c('small', 'medium', 'large'),
                        multiple = TRUE
            )
        ),

        # Show a plot of the generated distribution
    dashboardBody(    

    fluidRow(
        box(
            DT::dataTableOutput("table")
        )
    ),

    fluidRow(

          uiOutput("programinfo")



        )
    )

)


server <- function(input, output, session) {
    appdata <-reactive({
        df %>%
            filter(
                is.null(input$number) | x1 %in% input$number,
                is.null(input$color) | x2 %in% input$color,
                is.null(input$size)  | x3 %in% input$size
            )
    })

    output$table <- DT::renderDataTable({
        df <- appdata()

        action <-
            DT::dataTableAjax(session, df, outputId = "table")

        DT::datatable(df, options = list(ajax = list(url = action), lengthMenu =c(5,10,15), pageLength = 5), escape = FALSE)
    })

    output$programinfo<- renderUI({
        lapply(1:nrow(appdata()), function(i) {
            box(

                h2(appdata()[i,'x2']),
                p(paste0("A Program of: ", appdata()[i,'x2'])),
                h3(appdata()[i,'x3']),
                p(paste( "Hours: ",appdata()[i,3], sep = " "))
            )

                # withTags({
                #     div(
                #         h2(appdata()[i,1]),
                #         h3(appdata()[i,1]),
                #         p(appdata()[i,1]),
                #         body(
                #             b("Monday: "), appdata()[i,1], br(),
                #             b("Sunday: "), appdata()[i,1], br()
                #         )
                #     )
                # })


            })
    })


}

# Run the application 
shinyApp(ui = ui, server = server)