Блестящий оператор if с prettyRadioButtons и checkboxGroupInput - PullRequest
Новая
       110

Блестящий оператор if с prettyRadioButtons и checkboxGroupInput

0 голосов
/ 20 июня 2020

Моему ShinyApp нужны две группы флажков (check1 и check2 в моем коде ниже). Приложение будет заполнять различные раскрывающиеся меню в зависимости от выбора пользователя.

Однако оператор if else, кажется, работает нормально с prettyRadioButtons, но когда я применяю его к checkboxGroupInput, он не работает. Упрощенная версия моего приложения показана ниже. Я что-то упустил в своей выписке if? Заранее спасибо! 

ui <- fluidPage(
  titlePanel("Dynamic Boxes"),
  fluidRow(
    prettyRadioButtons("check1", "Please Pick", c("Option 1" = "op1", "Option 2" = "op2"), selected=character(0), shape="square", outline = T, inline = T),
    checkboxGroupInput("check2", "Please Pick", c("Option 3" = "op3", "Option 4" = "op4"), inline = T),

    fluidRow(hidden(selectInput('select_1', 'No.1 Select',choices = list1))),
    fluidRow(hidden(selectInput('select_2', 'No.2 Select',choices = list2))),
    fluidRow(hidden(selectInput('select_3', 'No.3 Select',choices = list3))),
    fluidRow(hidden(selectInput('select_4', 'No.4 Select',choices = list4))),
    fluidRow(hidden(selectInput('select_5', 'No.5 Select',choices = list5)))
  )
)


server <- function(input, output){
  observeEvent(input$check1, {
    if(!is.null(input$check1)){
      if(input$check1 == 'op1'){
        showElement('select_1')
      }
      else if(input$check1 == 'op2'){
        if(length(input$check2) == 1){
          if(input$check2 == 'op3'){showElement('select_2')}
          else if(input$check2 == 'op4'){showElement('select_3')}
        } 
        else if(length(input$check2) == 2){showElement('select_4')}
      }
    }
  })

}

1 Ответ

0 голосов
/ 20 июня 2020

Приведенный ниже пример реализует ваш if-else logi c для selectInput с использованием renderUI: 1) он ничего не отображает, пока ни один из переключателей не выбран; 2) показывает опции в list1, если выбрана кнопка 1 («Вариант 1»); 3) если выбрана кнопка 2 («Вариант 2»), ничего не отображается, пока ни один из флажков не отмечен, отображаются параметры в list2, если отмечен только флажок 1 («Вариант 3»), параметры в list3 если установлен только флажок 2 («Вариант 4»), и параметры в list4, если отмечены оба флажка. В вашем примере параметры кода в list5 никогда не будут отображаться, поэтому мне трудно сказать, где вы хотите его разместить, и я проигнорировал его. 

library(shiny)
library(shinyWidgets)

list1 = letters[1:3]
list2 = letters[4:6]
list3 = letters[7:9]
list4 = letters[10:12]

ui <- fluidPage(
  titlePanel("Dynamic Boxes"),
  fluidRow(
    prettyRadioButtons("check1", "Please Pick", c("Option 1" = "op1", "Option 2" = "op2"), selected=character(0), shape="square", outline = T, inline = T),
    checkboxGroupInput("check2", "Please Pick", c("Option 3" = "op3", "Option 4" = "op4"), inline = T),
    uiOutput("select")
  )
)


server <- function(input, output){

  output$select = renderUI({

    req(input$check1) 

    if (input$check1 == 'op1') {
      selectInput('select_1', 'No.1 Select',choices = list1)
    } 
    else if (input$check1 == 'op2') {
      req(input$check2)
      if (length(input$check2) == 1) {
        if(input$check2 == 'op3') {
          selectInput('select_2', 'No.2 Select',choices = list2)
        }
        else if (input$check2 == 'op4') {
          selectInput('select_3', 'No.3 Select',choices = list3)
        }
      } 
      else if(length(input$check2) == 2){
        selectInput('select_4', 'No.4 Select',choices = list4)
      }
    }
  })

}

shinyApp(ui, server)

Я думаю, что комбинация переключателей и флажки, возможно, немного сложны, поскольку на основе меток, показывающих, например, список 4, на самом деле является комбинацией вариантов 2–4. У вас может быть веская причина для такого выбора дизайна, и в этом случае отлично! Но если нет, то, возможно, слегка измененный дизайн, такой как ниже, упростил бы задачу пользователю (и вам самим!). 

# Continuing from above ----
ui <- fluidPage(
  titlePanel("Dynamic Boxes"),
  fluidRow(
    prettyRadioButtons("check1", "Please Pick", c("Option 1" = "op1", "Option 2" = "op2"), selected=character(0), shape="square", outline = T, inline = T),
    uiOutput("check2"),
    uiOutput("select")
  )
)


server <- function(input, output) {

  output$check2 = renderUI({
    req(input$check1)
    if (input$check1=='op2') {
      prettyRadioButtons("check2", "Please Pick", 
                         c("Option 2.1" = "op3", "Option 2.2" = "op4", "Option 2.3" = "op5"), 
                         selected=character(0), shape="square", outline = T, inline = T)
    }
  })

  output$select = renderUI({
    req(input$check1) 
    if (input$check1 == 'op1') {
      selectInput('select_1', 'No.1 Select',choices = list1)
    } 
    else if (input$check1 == 'op2') {
      req(input$check2)
      if (input$check2 == 'op3') {
        selectInput('select_2', 'No.2 Select',choices = list2)
      } else if (input$check2== 'op4') {
        selectInput('select_3', 'No.3 Select',choices = list3)
      } else {
        selectInput('select_4', 'No.4 Select',choices = list4)
      }
    }
  })

}

shinyApp(ui, server)

Надеюсь, это поможет!

...