renderUI на основе строк в таблице - PullRequest
Новая
       14

renderUI на основе строк в таблице

1 голос
/ 26 марта 2020

Я хотел бы элементы пользовательского интерфейса на основе строк в реактивном .

Это отличается от Как создать пользовательский интерфейс в Блестящий от a для l oop, длина которого основана на вводе цифр c? 

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)

Приведенный выше код статически зацикливает пользовательский интерфейс вывода чисел. Мне нужно, чтобы число Hi, this is output B#[i] соответствовало количеству строк в таблице Dynami c. Поскольку эта таблица фильтруется, количество выходных пользовательских интерфейсов должно уменьшаться. 

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

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

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

Я надеялся, что вышеприведенное сработает, но просто выдает ошибку или не может найти функцию appdata.

Любая помощь будет принята с благодарностью. Спасибо вам.

1 Ответ

0 голосов
/ 26 марта 2020

Я нашел решение этой проблемы, код ниже работает и дополнительно отображает информацию из таблицы! 

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