shiny: can an actionButton() return an error in case of empty/non-selected radioButtions()?

Question

I have not found a solution to my question, this SO thread came close but not entirely.

I have produced a simple app, which contain several radioButtons(). Logical to the basic concept of the app, some of them are empty as in radioButtons( ... , selected=character(0)) whereas others have preselected values.

Importantly, all radioButtons() must have a selected value before the actionButton() initiate further analysis.

Question: how can one design an actionButton() that (1) returns an error in case of non-selected radioButtons() and (2) returns what radioButtons() that contain non-selected values, specifically?

Expected output

Written with

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)

score 4 · Accepted Answer · answered Apr 28 '20 at 19:46

This should give you what you want. It uses the following techniques:

renderUI() to display the error message, with formatting
req() to check if the red error message should be displayed
toggleState() to make the "Submit" button clickable only when all specified radio buttons are not of length 0 (as specified by 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)

Hi @Wil. Very nice solution, which indeed did what I requested. Thank you very much. Have a great day. Best. — cmirian, Apr 29 '20 at 09:11

shiny: can an actionButton() return an error in case of empty/non-selected radioButtions()?

1 Answers1