Shinydashboard несколько условий в условной панели с одинаковыми входами - PullRequest
1 голос
/ 21 мая 2019

Я создаю приложение с блестящей панели инструментов. Я хочу отобразить несколько selectInput в SidebarMenu относительно выбранного tabItem И tabPanel. Один и тот же selectInput используется в разных tabItem.

Это выглядит просто, но я борюсь с условным синтаксисом в conditionalPanel, используя множественные аргументы с операторами AND (&&), OR (||) и IN (% in%). Я пытался добавить скобку, но она не выполняет свою работу.

Я написал этот код, он воспроизводим и работает, но не выполняет то, что я хочу, так как всегда отображает selectInputs.

library(shinydashboard)
library(dplyr)

mtcars$gear <- as.character(mtcars$gear)
all_gears <- sort(unique(mtcars$gear))
mtcars$cyl <- as.character(mtcars$cyl)
all_cyl <- sort(unique(mtcars$cyl))


ui <- dashboardPage(
    dashboardHeader(title = "test"),
    dashboardSidebar(
        sidebarMenu(id="menu1",
            menuItem(
                "Dashboard",
                tabName = "dashboard",
                icon = icon("dashboard")
            ),
            menuItem(
                "Indicators",
                tabName = "indicators",
                icon = icon("info-circle")
            )
        ),
        conditionalPanel(
            condition = "input.menu1 == 'dashboard' && input.tabselected %in% c('1','2')",
            selectInput(
                inputId = "cylinders",
                label = "Select number of cylinders",
                choices = all_cyl,
                selected = '4',
                multiple = TRUE,
                selectize = FALSE
            )
        ),
        conditionalPanel(
            condition = "(input.menu1 == 'dashboard' && input.tabselected == 2) || input.menu1 == 'indicators'",
            selectInput(
                inputId = "gearsnumber",
                label = "Select number of gears",
                choices = all_gears,
                selected = '3',
                multiple = TRUE,
                selectize = FALSE
            )
        )
    ),
    dashboardBody(
        tabItems(
            tabItem(tabName = "dashboard",
                tabsetPanel(
                    tabPanel("Graph", value=1, plotOutput("plot")),
                    tabPanel("Table", value=2, dataTableOutput("table")),
                    tabPanel("Empty", value=3)
                )
            ),
            tabItem(tabName = "indicators",
                infoBoxOutput("totalweight")
            )
        )
    )
)

server <- function(input, output, session) {

    selectedDatacyl <- reactive({
        req(input$cylinders)
        df <- as.data.frame(mtcars)
        df$gear <- as.character(df$gear)
        df$cyl <- as.character(df$cyl)
        df <- mtcars
        df %>% dplyr::filter(cyl %in% input$cylinders)
    })

    selectedDatagears <- reactive({
        req(input$gearsnumber)
        df <- selectedDatacyl()
        df %>% dplyr::filter(gear %in% input$gearsnumber)
    })

    output$plot <- renderPlot({
        ggplot( data = selectedDatacyl(), aes(x = rownames(selectedDatacyl()), y = mpg)) + geom_point()
    })

    output$table <- DT::renderDataTable({
        DT::datatable(  data = selectedDatagears(),
                        options = list(pageLength = 14),
                        rownames = FALSE)
    })

    output$totalweight <- renderInfoBox({
        infoBox(
            "Total weight",
            paste0(sum(selectedDatagears()$wt), "lbs"), 
            icon = icon("chart-area"), 
            color = "green"
        )
    })

}

shinyApp(ui = ui, server = server)

Что я должен сделать, чтобы эти условия работали? Спасибо всем участникам.

1 Ответ

0 голосов
/ 21 мая 2019

Условие в conditionalPanel является выражением JavaScript, а не выражением R.

Поэтому необходимо заменить

input.menu1 == 'dashboard' && input.tabselected %in% c('1','2')

на

input.menu1 == 'dashboard' && (input.tabselected == '1' || input.tabselected == '2')

или

input.menu1 == 'dashboard' && ['1','2'].indexOf(input.tabselected) > -1
...