CODEWITHSUNDEEP
rshiny
Adel
Adel

Reputation: 95

Updating two checkboxGroupInput

I have two checkboxGroupInputs and I would like the two update in tandem. In other words, updating one should update the other, but then updating the other should keep what the first selected and then just continue updating the selections. Bu updating, I mean providing the choice values.

The toy example provides an illustrative case, however, here we can clearly see that when I am done updating the first, and the continuous updating the second box, the first box resets. I want to avoid this resetting. Also, it should not matter if the user starts selecting in the first or the second box. The procedure should be invariant to that.

I have tried two approaches, one using the updateCheckboxGroupInput function, and using reactives (commeted out).

Any suggestions are welcomed:

library(shiny)
# Shiny server object
# Define UI for app 
ui <- fluidPage(


  # App title ----
  titlePanel("Hello Shiny!"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    uiOutput("boxes"),


    # Main panel for displaying outputs ----
    mainPanel(

      # Output: Histogram ----
      textOutput(outputId = "TestText")

    )
  )

)

age.values <- 1:10

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

  # define reactive
  age <- reactiveVal()
  age(age.values)

  valuesMax <- reactiveVal()  
  valuesMin <- reactiveVal()

  valuesMin(age.values)
  valuesMax(age.values)


  # v <- age[which(!age %in% valuesMin[1:2])]
  # v

  # Sidebar panel for inputs ----


  # update reactives
  # if valuesMax updates then update valuesMin
  # observeEvent(input$go, {
  #   
  #   # define valuesMin whatever values is remaining
  #   v <- age()[which(!age() %in% input$age.bins.max)]
  #   
  #   valuesMin(v)
  #   
  # })
  # 
  # observeEvent(input$go, {
  #   
  #   # define valuesMin whatever values is remaining
  #   w <- age()[which(!age() %in% input$age.bins.min)]
  #   
  #   valuesMax(w)
  #   
  # })    



  ##### 0. Pre-processing ####
  output$boxes <- renderUI({

    sidebarPanel(
      checkboxGroupInput(inputId = "age.bins.min", 
                         "Select mono decreasing age groups",
                         choiceNames = paste("age group", age()),
                         choiceValues = age(),
                         inline = T,
                         selected=character(0)),


      checkboxGroupInput(inputId = "age.bins.max", 
                         "Select mono increasing age groups ",
                         choiceNames = paste("age group", age()),
                         choiceValues =  age(),
                         inline = T,
                         selected=character(0)),
      actionButton(inputId = "go", 
                   label = "Update"))

  })

  observe({
    x <- input$age.bins.min

    # Can use character(0) to remove all choices
    if (is.null(x))
      x <- character(0)

    w <- age()[which(!age() %in% x)]


    # Can also set the label and select items
    updateCheckboxGroupInput(session, "age.bins.max",
                             label = paste("age group", w),
                             choices = w,
                             selected = character(0))

  })


  observe({
    y <- input$age.bins.max

    # Can use character(0) to remove all choices
    if (is.null(y))
      y <- character(0)

    v <- age()[which(!age() %in% y)]


    # Can also set the label and select items
    updateCheckboxGroupInput(session, "age.bins.min",
                             label = paste("age group", v),
                             choices = v,
                             selected = character(0))

  })



  # output$TestText <- renderText({
  #   max <- paste("valuesMax", valuesMax())
  #   min <- paste("valuesMin", valuesMin())
  #   
  #   print(max)
  #   #print(min)
  #   
  #   
  # })
  # 




}


# Create Shiny app ----
shinyApp(ui = ui, server = server)

Upvotes: 0

Views: 297

Answers (1)

TimTeaFan
TimTeaFan

Reputation: 18551

I am not sure what you are trying to do, but does the following solve your problem?

For dealing with min and max range values I prefer the inputSlider but, then again, I am not sure what you are trying to achieve.

Update There seemed to be a problem with observeEvent not updating when input values changed from an integer value to NULL. I now rewrote the two observeEvent statements as one observe and it works now also when deselecting values.

library(shiny)
# Shiny server object
# Define UI for app 
ui <- fluidPage(


  # App title ----
  titlePanel("Hello Shiny!"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    uiOutput("boxes"),


    # Main panel for displaying outputs ----
    mainPanel(

      # Output: Histogram ----
      textOutput(outputId = "TestText")

    )
  )

)

age.values <- 1:10

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

  # Sidebar panel for inputs ----

  output$boxes <- renderUI({

    sidebarPanel(
      checkboxGroupInput(inputId = "age.bins.min", 
                         "Select mono decreasing age groups",
                         choiceNames = paste("age group", age()),
                         choiceValues = age(),
                         inline = T,
                         selected = character(0)),


      checkboxGroupInput(inputId = "age.bins.max", 
                         "Select mono increasing age groups ",
                         choiceNames = paste("age group", age()),
                         choiceValues = age(),
                         inline = T,
                         selected = character(0)),

      actionButton(inputId = "go", 
                   label = "Update"))

  })

  # define reactive
  age <- reactiveVal(age.values)

     observe({

    x <- input$age.bins.min
    if (is.null(x))
      x <- character(0)

    y <- input$age.bins.max
    if (is.null(y))
      y <- character(0)

    w1 <- age()[!(age() %in% y)]

    w1n <- if(length(w1)==0) character(0)
              else paste("age group", w1)

    w2 <- age()[!(age() %in% x)]

    w2n <- if(length(w2)==0) character(0)
               else paste("age group", w2)

    updateCheckboxGroupInput(session, "age.bins.min",
                             choiceNames = w1n,
                             choiceValues = w1,
                             selected = x)

    updateCheckboxGroupInput(session, "age.bins.max",
                             choiceNames = w2n,
                             choiceValues = w2,
                             selected = y)



  })



}


# Create Shiny app ----
shinyApp(ui = ui, server = server)

Upvotes: 1

Related Questions