jeudi 22 juin 2017

Shiny: select n checkboxes of groupInput

in one part of my shiny app I am having a checkboxGroupInput, but only want the user to be able to pick exactly n options(in this example 2). Here I would like to have exactly two of the 'Fertilizer'-checkboxes chosen. I am familiar with (pre)selecting all or one specific one but could not find a way yet to have exactly n boxes checked. (the others may be disabled) . I also wan the validation message working for the case non, or only one box is checked. Thanks for your help!

library(shiny)
library(data.table)
library(DT)

tdata <- data.table(fruit = c("Apple", "Apple", "Apple", "Apple", "Apple", "Apple", "Apple", "Apple","Banana", "Banana","Banana","Banana","Banana", "Banana","Banana","Banana"), 
                    Fertilizer = rep.int(c(1,2,3,4,5,6,7,8),2))

ui <- (fluidPage(tagList(
             sidebarLayout(
               sidebarPanel(uiOutput("file_input")),
               mainPanel(dataTableOutput('fruit_table')) 
      ))))

server <- function(input, output) {

  fileData <- reactive(
      return(tdata)
  )

  output$file_input <- renderUI ({
    if(is.null(fileData())){
      return()
    }else{
      tagList(
        checkboxGroupInput(inputId = "fruit",
                           label = "fruit",
                           choices = c(unique(fileData()[,get("fruit")])),
                           selected = fileData()[1, 1, with = FALSE]),
        checkboxGroupInput(inputId = "tube",
                           label = "Fertilizer",
                           choices = unique(fileData()[,get("Fertilizer")]),
                           selected = fileData()[1, 2, with = F])

        )}})

  output$fruit_table <- renderDataTable({
    if(is.null(fileData())){
      return(NULL)
    }else{

      validate(
        need(input$fruit, 'Check at least one fruit'),
        need(input$tube, 'Check at least two Fertilizer')

      )

      filter_expr <- TRUE

      if (!(is.null(input$fruit))) {
        filter_expr <- filter_expr & fileData()[,fruit] %in% input$fruit
      }
      if (!(is.null(input$tube))) {
        filter_expr <- filter_expr & fileData()[,Fertilizer] %in% input$tube
      }



      datatable(fileData()[filter_expr,],options = list(pageLength = 25))

    }})}
shinyApp(ui = ui, server = server)
shinyApp(ui = ui, server = server)




Aucun commentaire:

Enregistrer un commentaire