Question

我有两个checkboxGroupInputs，我想一并更新两个。换句话说，更新一个应该更新另一个，但是更新另一个应该保留第一个选择的内容，然后继续更新选择。 Bu更新，我的意思是提供选择值。

玩具示例提供了一个说明性的案例，但是，在这里，我们可以清楚地看到，当我完成更新第一个框并连续更新第二个框时，第一个框将重置。我想避免这种重置。同样，用户是否开始在第一个或第二个框中进行选择也无关紧要。该过程应该对此保持不变。

我尝试了两种方法，一种是使用updateCheckboxGroupInput函数，另一种是使用反应式（淘汰）。

欢迎提出任何建议：

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)

Answer 1

我不确定您要做什么，但是以下内容可以解决您的问题吗？

在处理最小和最大范围值时，我更喜欢inputSlider，但是，我不确定您要达到的目标。

更新当输入值从整数值更改为NULL时，observeEvent似乎没有更新的问题。现在，我将两个observeEvent语句重写为一个observe，并且现在在取消选择值时也可以使用。

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)

更新两个checkboxGroupInput

1 个答案: