updateCheckBoxGroupInput在闪亮的基础上选择其他复选框

时间:2016-05-25 07:42:39

标签: r checkbox shiny

我闪亮的应用程序有多个标签。在其中一个选项卡中,我有绘图输出,我想用它来在另一个选项卡中创建报表。我在第一个选项卡中包含一个复选框,供用户选择报告输出。在第二个选项卡中,我尝试根据第一个选项卡的选择更新复选框组输入。但是我只选择了第一个选项。

可重现的代码如下:这是基于ifelse条件:

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
                   dashboardHeader(
                       title = "MODULE",titleWidth = 225
                   ),
                   dashboardSidebar(
                       width = 225,
                       sidebarMenu(id = "tabs",
                                   menuItem("TOPLINES", tabName = "tplines", icon = shiny::icon("dashboard")),
                                   menuItem("MY MONTHLY REPORTS", tabName = "myweeklyrep", icon = shiny::icon("compass"))
                       )),
                   dashboardBody(
                       tabItems(
                           tabItem(
                               tabName = "tplines",
                               fluidRow(
                                   box(
                                       checkboxInput(inputId = "inventorytop8metrocheck", "Add to reports", value = FALSE),
                                       width = 6, status = "info", title = "Inventory information",
                                       div(plotlyOutput("inventorytop8metro"), width = "100%", height = "400px", style = "font-size:80%;")
                                   ),
                                   box(
                                       checkboxInput(inputId = "top15categoriestplinescheck", "Add to reports", value = FALSE),
                                       width = 6, status = "info", title = "Top 15 categories",
                                       div(plotlyOutput("top15categoriestplines"), style = "font-size:90%")
                                   ))),
                           tabItem(
                               tabName = "myweeklyrep",
                               fluidRow(
                                   h4("AVAILABLE ANALYSIS", align = 'center'),br(),
                                   column(width = 12, 
                                          list(tags$div(align = 'left', 
                                                        class = 'multicol', 
                                                        checkboxGroupInput(inputId  = 'analysisSelector', 
                                                                           label = "Select the analysis:",
                                                                           choices  = "",
                                                                           selected = "",
                                                                           inline   = FALSE)))
                                   ))))))

server <- function(session,input,output){
    observe({
            updateCheckboxGroupInput(session, inputId = "analysisSelector", label = "", choices = 
                                         ifelse(!is.null(input$top15categoriestplinescheck) || length(input$top15categoriestplinescheck) != 0, "Inventory top 8 metros",
                                            ifelse(!is.null(input$inventorytop8metrocheck) || length(input$inventorytop8metrocheck) != 0, "Top 15 categories - Topline", "No selection")),
                                     selected = "",inline = FALSE)

    })
}

shinyApp(ui,server)

我尝试过if,否则如果他们也没有工作。有什么想法吗?

if,else if条件:

    updateCheckboxGroupInput(session, inputId = "analysisSelector", label = "", choices = 
                                 if(!is.null(input$top15categoriestplinescheck) || length(input$top15categoriestplinescheck) != 0){
                                     "Inventory top 8 metros"
                                 } else if (!is.null(input$inventorytop8metrocheck) || length(input$inventorytop8metrocheck) != 0){
                                     "Top 15 categories - Topline"
                                 } else {
                                     return()
                                 },
                             selected = "",inline = FALSE)

编辑:

我尝试了以下选项:无论选择是否选中,都会显示复选框。

getlist <- reactive({
        if(!is.null(input$top15categoriestplinescheck) & !is.null(input$inventorytop8metrocheck)){
            c("Top 15 categories - Topline","Inventory of top 8 metros - Topline")
        } else if (!is.null(input$top15categoriestplinescheck)){
            "ABC"
        } else if (!is.null(input$inventorytop8metrocheck)){
            "DEF"
        } else {
            return()
        }
    })

    observe({
            updateCheckboxGroupInput(session, inputId = "analysisSelector", label = "Select the analysis:", choices = 
                                         as.list(getlist()),
                                     selected = "",inline = FALSE)            
    })

1 个答案:

答案 0 :(得分:1)

这实际上更容易处理observeEvent,如此函数的文档中所述(请参阅?observeEvent)。据我所知,它实际上以observe包裹,但更直观。

你必须传递两个参数:一个事件(在这种情况下,点击你的一个checkboxGroupInput)以及发生此事件时要执行的操作。

server函数因此变为:

server <- function(session,input,output){
    updateAnalysisSelector <- function(session) {
        choices <- ifelse(input$top15categoriestplinescheck, "Inventory top 8 metros",
                          ifelse(input$inventorytop8metrocheck, "Top 15 categories - Topline", "No selection"))
        updateCheckboxGroupInput(session, 
                                 inputId = "analysisSelector", 
                                 label = "Select the analysis:", 
                                 choices = choices,
                                 selected = "",
                                 inline = FALSE)
    }

  observeEvent(input$top15categoriestplinescheck, updateAnalysisSelector(session))
  observeEvent(input$inventorytop8metrocheck, updateAnalysisSelector(session))
}

如果您的用户界面没有两个单独的复选框组,我确信这可以简化,但这适用于您当前的实施。