How to updateRadioButtons for special subdivided input

user_6388753 0
Viewed 59

One objective of my code is to subdivide the first radioButtons input, which was accomplished copying from: post

The problem is, I want also to be able to update radioButtons, based on a secondary input.

In the following code, or any code the expected is to have a subdivided first input that works unifiedly (currently works in example)

The missing part is update the first input, based on the selection of the second input.

library(shiny)
{
radioSubgroup <- function(inputId, id, label, choices, inline = TRUE, selected) {
  values <- paste0(id, "-", choices)
  choices <- setNames(values, choices)
  rb <- radioButtons(inputId, label, choices, selected = selected, inline = inline)
  rb$children
}

radioGroupContainer <- function(inputId, ...) {
  class <- "form-group shiny-input-radiogroup shiny-input-container"
  div(id = inputId, class = class, ...)
}

ui <- fluidPage(
  titlePanel("Example: linked radio buttons"),
  
  sidebarLayout(
    sidebarPanel(width=6
                 ,h4("Main input in three rows")
                 ,uiOutput("rgc")
                 ,h4("secondary input")
                 ,radioButtons("secondInput","", 1:2) 
    ),
    
    mainPanel(
      fluidRow(
        column(4,
               strong("Selected input:"), textOutput("selectedInput", inline = TRUE)

        )
      )
    )
  )
)

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

  nucsel <- reactive({
    input$secondInput
  })
  
  output$rgc <- renderUI({
        radioGroupContainer("selectedInput",
                  fluidRow(column(12,

                           radioSubgroup("selectedInput", "cars",     label = "cars:",     choices = 1:6
                                         ,selected=nucsel())
                           ,radioSubgroup("selectedInput", "pressure", label = "pressure:", choices = 7:12
                                         ,selected=character(0))
                           ,radioSubgroup("selectedInput", "faithful", label = "faithful:", choices = 13:18
                                          ,selected=character(0))
                  )
                  )
  )
  })
  
  selectedInput <- reactive({
    req(input$selectedInput)
    parts <- unlist(strsplit(input$selectedInput, "-"))
    list(id = parts[1], value = parts[2])
  })
  
  output$selectedInput <- renderText({
    selectedInput()$value
  })

}
}
shinyApp(ui, server)
shiny reactive-programming radio-button r
1 Answers

The code below updates the first radioButtons based on the selection of the second one

library(shiny)
{
  radioSubgroup <- function(inputId, id, label, choices, inline = TRUE, selected) {
values <- paste0(id, "-", choices)
choices <- setNames(values, choices)
rb <- radioButtons(inputId, label, choices, selected = selected, inline = inline)
rb$children
}

updateRadioSubgroup <- function(session, inputId, id, inline, selected, ...) {
value <- paste0(id, "-", selected)
updateRadioButtons(session, inputId, label = NULL, choices = NULL, inline = inline, selected = value)
}

radioGroupContainer <- function(inputId, ...) {
class <- "form-group shiny-input-radiogroup shiny-input-container"
div(id = inputId, class = class, ...)
}

ui <- fluidPage(
titlePanel("Example: linked radio buttons"),

sidebarLayout(
  sidebarPanel(width=6
               ,h4("Main input in three rows")
               ,uiOutput("rgc")
               ,h4("secondary input")
               ,radioButtons("secondInput","", 1:2, selected = character(0)) 
  ),
  
  mainPanel(
    fluidRow(
      column(4,
             strong("Selected input:"), textOutput("selectedInput", inline = TRUE)
             
      )
    )
  )
)
)

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

nucsel <- reactive({
  input$secondInput
  
})

output$rgc <- renderUI({

  radioGroupContainer("selectedInput",
                      fluidRow(column(12,
                                      
                                      radioSubgroup("selectedInput", "cars",     label = "cars:",     choices = 1:6
                                                    ,selected=character(0))
                                      ,radioSubgroup("selectedInput", "pressure", label = "pressure:", choices = 7:12
                                                     ,selected=character(0))
                                      ,radioSubgroup("selectedInput", "faithful", label = "faithful:", choices = 13:18
                                                     ,selected=character(0))
                      )
                      )
  )
})


observe({
  req(input$secondInput)
  sel <- input$secondInput
  updateRadioSubgroup(session, "selectedInput", "cars", selected = sel, inline = TRUE)
})

selectedInput <- reactive({
  req(input$selectedInput)
  parts <- unlist(strsplit(input$selectedInput, "-"))
  list(id = parts[1], value = parts[2])
})

output$selectedInput <- renderText({
  selectedInput()$value
})

}
}
shinyApp(ui, server)
user_18924330
Related