如何为特殊的细分输入更新RadioButtons答案

【问题标题】：How to updateRadioButtons for special subdivided input如何为特殊的细分输入更新RadioButtons
【发布时间】：2021-10-14 11:19:23
【问题描述】：

我的代码的一个目标是细分第一个 radioButtons 输入，其中已完成复制自：post

问题是，我还希望能够根据辅助输入更新单选按钮。

在下面的代码中，或者任何期望有一个细分的第一个输入统一工作的代码中（目前在示例中工作）

缺少的部分是根据第二个输入的选择更新第一个输入。

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)

【问题讨论】：

标签： r shiny radio-button reactive-programming

【解决方案1】：

下面的代码根据第二个的选择更新第一个radioButtons

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)

【讨论】：