shiny : un actionButton() peut-il renvoyer une erreur en cas de radioButtions() vides/non sélectionnées ?

Question

Je n'ai pas trouvé de solution à ma question. Fil SO s'en est approché, mais pas complètement.

J'ai produit un simple app qui contiennent plusieurs radioButtons() . Logique par rapport au concept de base de la app Certains d'entre eux sont vides, comme dans l'exemple suivant radioButtons( ... , selected=character(0)) tandis que d'autres ont des valeurs présélectionnées.

Il est important de noter que tous les radioButtons() doit avoir une valeur sélectionnée avant que le actionButton() d'entamer une analyse plus approfondie.

Question : comment concevoir un actionButton() qui (1) renvoie une erreur en cas de non sélection. radioButtons() et (2) renvoie ce que radioButtons() qui contiennent des valeurs non sélectionnées, en particulier ?

Résultats attendus

Rédigé avec

library(shiny)
library(shinyjs)
library(shinycustomloader)
library(shinyWidgets)

ui <- fluidPage(

  useShinyjs(),

  tabsetPanel(

    # GTR
    tabPanel(title = HTML(paste(h4("Gross Total Resection"),
                                h6("Simpson Grade I-III", align = "left"))),
             br(), br(),

             fluidRow(

               column(
                 4,
                 wellPanel(
                   style = "height:275px",
                   h4("Patient-related factors", align="center"), br(),
                   sliderInput("GTR_age", "Age", 
                               min = 18, max = 100, value = 60), br(), 

                   radioButtons("GTR_sex", "Sex", choiceValues=list("Male","Female"),
                                choiceNames=list("Male","Female"), selected=character(0), inline = T)
                 ), br(), br(),

                 fluidRow(align="center", br(), actionBttn("GTRdo", "Submit", style = "material-flat"))
               ),

               column(
                 4,
                 wellPanel(
                   style = "height:375px", 
                   h4("Tumor-related factors", align="center"), br(),

                   radioButtons("GTR_WHO", "WHO Grade", choiceValues=list("WHO-I","WHO-II", "WHO-III"),
                                choiceNames=list("WHO-I","WHO-II","WHO-III"), selected=character(0), inline=T), br(),

                   sliderInput("GTR_Ki67", "Ki-67 proliferative index", 
                               min = 0, max = 60, value = 5), br(),

                   selectInput("GTR_location", "Location",
                               c("Convexity" = "0",
                                 "Parasagittal" = "1",
                                 "Anterior skull-base" = "2",
                                 "Mid skull-base" = "3",
                                 "Posterior skull-base" = "4"))
                 )),

                 column(
                   4,
                   wellPanel(
                     style = "height:525px", 
                     h4("Treatment-related factors", align="center"), br(),

                     radioButtons("GTR_Simpson", "Simpson Grade", choiceValues=list("Grade I","Grade II", "Grade III"),
                                  choiceNames=list("Grade I","Grade II","Grade III"), selected=character(0), inline=T), br(),

                     radioButtons("GTR_EXBR", "External Beam Radiation", choiceValues=list("No","Yes"),
                                  choiceNames=list("No","Yes"), selected ="No", inline=T),
                     sliderInput("GTR_EXBRGy", "Cumulative Gy",
                                  min = 40, max = 60, value = 54.2, step = 0.2), br(),

                     radioButtons("GTR_SRS", "Stereotactic radiosurgery", choiceValues=list("No","Yes"),
                                  choiceNames=list("No","Yes"), selected ="No", inline=T),
                     sliderInput("GTR_SRSGy", "Cumulative Gy",
                                  min = 12, max = 22, value = 15, step = 1), br(),

                   )
                 )

               )
             )
    )
  )

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

  GTR_rvs <- reactiveValues(prev_value = 54.2)

  observeEvent(input$GTR_EXBR, {
    if(input$GTR_EXBR == "No"){
      updateSliderInput(session, "GTR_EXBRGy",min = 0, max = 0, value=0)
      GTR_rvs$prev_value <- input$GTR_EXBRGy
      disable("GTR_EXBRGy")
    }else{
      updateSliderInput(session, "GTR_EXBRGy",  min = 40, max = 60, value = GTR_rvs$prev_value)
      enable("GTR_EXBRGy")
    }
  })

  observeEvent(input$GTR_EXBRGy, {
    print(input$GTR_EXBRGy)
  })

  GTR_rvs_srs <- reactiveValues(prev_value = 15)

  observeEvent(input$GTR_SRS, {
    if(input$GTR_SRS == "No"){
      updateSliderInput(session, "GTR_SRSGy",min = 0, max = 0, value=0)
      GTR_rvs_srs$prev_value <- input$GTR_SRSGy
      disable("GTR_SRSGy")
    }else{
      updateSliderInput(session, "GTR_SRSGy",  min = 12, max = 22, value = GTR_rvs_srs$prev_value)
      enable("GTR_SRSGy")
    }
  })

  observeEvent(input$GTR_SRSGy, {
    print(input$GTR_SRSGy)
  })

}

shinyApp(ui, server)

Answer 1

Cela devrait vous donner ce que vous voulez. Il utilise les techniques suivantes :

• renderUI() pour afficher le message d'erreur, avec la mise en forme
• req() pour vérifier si le message d'erreur rouge doit être affiché

• toggleState() pour que le bouton "Soumettre" ne soit cliquable que si tous les boutons radio spécifiés ne sont pas de longueur 0 (comme spécifié par character(0)

  library(shiny) library(shinyjs) library(shinycustomloader) library(shinyWidgets)

  ui <- fluidPage(

  useShinyjs(),

  tabsetPanel(

  # GTR
  tabPanel(title = HTML(paste(h4("Gross Total Resection"),
                              h6("Simpson Grade I-III", align = "left"))),
           br(), br(),
  
           fluidRow(
  
             column(
               4,
               wellPanel(
                 style = "height:275px",
                 h4("Patient-related factors", align="center"), br(),
                 sliderInput("GTR_age", "Age", 
                             min = 18, max = 100, value = 60), br(), 
  
                 radioButtons("GTR_sex", "Sex", choiceValues=list("Male","Female"),
                              choiceNames=list("Male","Female"), selected=character(0), inline = T)
               ), br(), br(),
  
               fluidRow(align="center", br(), actionBttn("GTRdo", "Submit", style = "material-flat"),br(),
                        uiOutput("req_text", style = "width: 200px; color: red"))
             ),
  
             column(
               4,
               wellPanel(
                 style = "height:375px", 
                 h4("Tumor-related factors", align="center"), br(),
  
                 radioButtons("GTR_WHO", "WHO Grade", choiceValues=list("WHO-I","WHO-II", "WHO-III"),
                              choiceNames=list("WHO-I","WHO-II","WHO-III"), selected=character(0), inline=T), br(),
  
                 sliderInput("GTR_Ki67", "Ki-67 proliferative index", 
                             min = 0, max = 60, value = 5), br(),
  
                 selectInput("GTR_location", "Location",
                             c("Convexity" = "0",
                               "Parasagittal" = "1",
                               "Anterior skull-base" = "2",
                               "Mid skull-base" = "3",
                               "Posterior skull-base" = "4"))
               )),
  
             column(
               4,
               wellPanel(
                 style = "height:525px", 
                 h4("Treatment-related factors", align="center"), br(),
  
                 radioButtons("GTR_Simpson", "Simpson Grade", choiceValues=list("Grade I","Grade II", "Grade III"),
                              choiceNames=list("Grade I","Grade II","Grade III"), selected=character(0), inline=T), br(),
  
                 radioButtons("GTR_EXBR", "External Beam Radiation", choiceValues=list("No","Yes"),
                              choiceNames=list("No","Yes"), selected ="No", inline=T),
                 sliderInput("GTR_EXBRGy", "Cumulative Gy",
                             min = 40, max = 60, value = 54.2, step = 0.2), br(),
  
                 radioButtons("GTR_SRS", "Stereotactic radiosurgery", choiceValues=list("No","Yes"),
                              choiceNames=list("No","Yes"), selected ="No", inline=T),
                 sliderInput("GTR_SRSGy", "Cumulative Gy",
                             min = 12, max = 22, value = 15, step = 1), br(),
  
               )
             )
  
           )
  )

  ) )

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

  GTR_rvs <- reactiveValues(prev_value = 54.2)

  observeEvent(input$GTR_EXBR, { if(input$GTR_EXBR == "No"){ updateSliderInput(session, "GTR_EXBRGy",min = 0, max = 0, value=0) GTR_rvs$prev_value <- input$GTR_EXBRGy disable("GTR_EXBRGy") }else{ updateSliderInput(session, "GTR_EXBRGy", min = 40, max = 60, value = GTR_rvs$prev_value) enable("GTR_EXBRGy") } })

  observeEvent(input$GTR_EXBRGy, { print(input$GTR_EXBRGy) })

  GTR_rvs_srs <- reactiveValues(prev_value = 15)

  observeEvent(input$GTR_SRS, { if(input$GTR_SRS == "No"){ updateSliderInput(session, "GTR_SRSGy",min = 0, max = 0, value=0) GTR_rvs_srs$prev_value <- input$GTR_SRSGy disable("GTR_SRSGy") }else{ updateSliderInput(session, "GTR_SRSGy", min = 12, max = 22, value = GTR_rvs_srs$prev_value) enable("GTR_SRSGy") } })

  observeEvent(input$GTR_SRSGy, { print(input$GTR_SRSGy) })

  observe({ toggleState(id = "GTRdo", condition = length(input$GTR_sex) > 0 & length(input$GTR_WHO) > 0 & length(input$GTR_Simpson) > 0) })

  output$req_text <- renderUI({ req(length(input$GTR_sex) == 0 | length(input$GTR_WHO) == 0 | length(input$GTR_Simpson) == 0)

  out <- tagList(p("Please choose:"),
                 tags$ul(style = "text-align: left"))
  
  if(length(input$GTR_sex) == 0) {
    out[[2]] <- tagAppendChild(out[[2]],tags$li("Sex"))
  }
  if(length(input$GTR_WHO) == 0) {
    out[[2]] <- tagAppendChild(out[[2]],tags$li("WHO Grade"))
  }
  if(length(input$GTR_Simpson) == 0) {
    out[[2]] <- tagAppendChild(out[[2]],tags$li("Simpson Grade"))
  }
  out

  })

  }

  shinyApp(ui, server)