renderUI 基于表中的行答案

【问题标题】：renderUI based on the rows in a tablerenderUI 基于表中的行
【发布时间】：2020-03-27 00:07:19
【问题描述】：

我想render UI 元素基于响应式dataframe 中的行。

这与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)

上面的代码静态循环数字输出 UI。我需要Hi, this is output B#[i] 的数量来匹配动态表中的行数。随着该表被过滤，输出 UI 的数量应该会减少。

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

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

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

我希望上面的方法可以工作，但是只是抛出了找不到函数appdata的错误。

任何帮助将不胜感激。谢谢。

【问题讨论】：

标签： render dataframe r shiny render shiny-reactivity

【解决方案1】：

我发现下面这个问题代码的解决方案有效，并且还显示了表格中的信息！

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)

【讨论】：