如何更新特殊细分输入的单选按钮

Question

我的代码中有一个 objective 是细分第一个 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)

Answer 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)

如何更新特殊细分输入的单选按钮

How to updateRadioButtons for special subdivided input

r

radio-button

reactive-programming

shiny