作为表格一部分的单选按钮

Question

再一次，我觉得我错过了一些非常简单的东西。

我正在尝试将一个用户界面放入一个闪亮的应用程序中，该用户界面在表格的最左侧列中具有单选按钮。选择一个按钮将决定在后续分析中使用哪些数据。

到目前为止，我已经设法根据answers to this question 获得表中的单选按钮，但是当我选择不同的单选按钮时，我似乎无法获得与输入对应的反应值来更改。

非常感谢您对我所缺少的内容提供一些指导。

ui.R

library(shiny)

shinyUI(fluidPage(
  titlePanel("Radio Matrix"),
  sidebarLayout(
    sidebarPanel(  ),
    mainPanel(
      tabsetPanel(
        tabPanel(title = "Selection",
          br(),
          uiOutput("table"),
          verbatimTextOutput("gear"),
          verbatimTextOutput("reactive_gear")
        )
      )
    )
  )
))

server.R

library(shiny)

shinyServer(function(input, output) {
  values <- reactiveValues(gear = 3)

  output$table <- 
    renderText({
      f.changeSelectedRow()
      "<!--html_preserve--><table style = 'border-collapse:collapse;'>
      <tr>
        <th colspan = '1'; rowspan = '1'; style=''></th>\n
        <th colspan = '1'; rowspan = '1'; style=''>gear</th></tr>\n\n
      <tr>
        <td colspan = '1'; rowspan = '1'; style='text-align:center;background-color:#DCDCDC;'><input type='radio' name='gear' value='3 checked = 'checked> </td>\n
        <td colspan = '1'; rowspan = '1'; style='text-align:center;background-color:#DCDCDC;'>3</td></tr>\n\n
      <tr>
        <td colspan = '1'; rowspan = '1'; style='text-align:center;background-color:#F5F5F5;'><input type='radio' name='gear' value='4 checked = '> </td>\n
        <td colspan = '1'; rowspan = '1'; style='text-align:center;background-color:#F5F5F5;'>4</td></tr>\n\n
      <tr>
        <td colspan = '1'; rowspan = '1'; style='text-align:center;background-color:#DCDCDC;'><input type='radio' name='gear' value='5 checked = '> </td>\n
        <td colspan = '1'; rowspan = '1'; style='text-align:center;background-color:#DCDCDC;'>5</td></tr>\n
      </table><br/><br/>\n<!--/html_preserve-->"
    })

  f.changeSelectedRow = reactive({
    if(is.null(values$gear)) values$gear <- 3
    if(!is.null(input$gear))   ### from the radio button set.
             if(input$gear != values$gear) values$gear <- input$gear
  })

  output$gear <- renderText(input$gear)
  output$reactive_gear <- renderText(values$gear)

})

返回给output$table的表格是由一系列函数产生的，最终将HTML代码输出为字符串。我只提供了硬编码到renderText 中的 HTML 代码的简化版本，因为我怀疑 HTML 代码不是问题（尽管我可以错）。

我用来生成单选按钮代码的函数是：

radio_html <- function(inputId, label, choices, selected=NULL) {
  if (is.null(selected)) selected <- choices[1]

  paste0("<input type='radio' name='", 
         inputId, "' value='", choices,
         " checked = '",
         ifelse(choices == selected, "checked", ""),
         "> ", label)
}

Answer 1

查看?radioButtons 的 HTML 输出，您需要告诉 Shiny 对这些值做出反应，将它们包装在

<div id='gear' class='form-group shiny-input-radiogroup shiny-input-container'>
      <div class='shiny-options-group'>
      <!-- HTML here -->
      </div>
</div>

您还需要将输入的类设置为shiny-bound-input，这是一个快速响应的自定义 HTML 示例：

library(shiny)

ui <- shinyUI(fluidPage(
  titlePanel("Radio Matrix"),
  sidebarLayout(
    sidebarPanel(  ),
    mainPanel(
      tabsetPanel(
        tabPanel(title = "Selection",
                 br(),
                 uiOutput("table"),
                 verbatimTextOutput("gear"),
                 verbatimTextOutput("reactive_gear")
        )
      )
    )
  )
))

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

  output$table <- 
    renderText({
      '
      <div id="dist" class="form-group shiny-input-radiogroup shiny-input-container">
      <label class="control-label" for="dist">Distribution type:</label>
      <div class="shiny-options-group">
      <div class="radio">
      <label>
      <input type="radio" name="dist" value="norm" checked="checked"/>
      <span>Normal</span>
      </label>
      </div>
      <div class="radio">
      <label>
      <input type="radio" name="dist" value="unif"/>
      <span>Uniform</span>
      </label>
      </div>
      <div class="radio">
      <label>
      <input type="radio" name="dist" value="lnorm"/>
      <span>Log-normal</span>
      </label>
      </div>
      <div class="radio">
      <label>
      <input type="radio" name="dist" value="exp"/>
      <span>Exponential</span>
      </label>
      </div>
      </div>
      </div> 
      '
    })

  output$reactive_gear <- renderText(input$dist)

})

shinyApp(ui=ui,server=server)

还要检查您是否有正确数量的引号，我认为您在 radio_html 函数中缺少一些引号。希望这可以帮助！

Answer 2

这个答案的功劳归于奥斯卡。在研究了他的示例之后，我设法制定了一对可以一起使用以获得所需外观的函数。

这需要开发版包生成格式化表格的html代码，但这是一个可泛化的过程

1. 创建数据框
2. 使用radio_html 添加一列单选按钮
3. 将您的数据框转换为 HTML 表格
4. 将该html代码运行到radio_table。确保 radio_html 和 radio_table 的 inputId 参数相等。

---

devtools::install_github("nutterb/pixiedust")
library(pixiedust)
library(shiny)

#* Generate a vector of radio buttons to include in a data frame
radio_html <- function(inputId, label, choices, selected=NULL) {
  if (is.null(selected)) selected <- choices[1]

  paste0("<input class='radio' type='radio' name='", 
         inputId, "' value='", choices,
         "' checked = '",
         ifelse(choices == selected, "checked", ""),
         "'> ", label)
}

#* Generate the tags around the table that allow the radio buttons to react
radio_table <- function(table_code, inputId, label){
  paste0("<div id='", inputId, "' class='form-group shiny-input-radiogroup shiny-input-container'>",
         "  <label class='control-label' for='", inputId, "'>", label, "</label>",
         "  <div class='shiny-options-group'>",
         table_code,
         "  </div>",
         "</div>")
}


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

  output$table <- 
    renderText({
      DF <- data.frame(dist = c("Normal", "Uniform", "Lognormal", "Exponential"),
                       stringsAsFactors = FALSE)

      DF$button <- radio_html(inputId = "dist",
                              label = "",
                              choices = c("norm", "unif", "lognorm", "exp"))

      #* This is mostly formatting fluff
      dust(DF[, 2:1], format = "html") %>%
        sprinkle_colnames("", "") %>%
        sprinkle(border = "all",
                 border_color = "#A9A9A9",
                 bg_pattern = c("#DCDCDC", "#F5F5F5"),
                 bg_pattern_by = "rows") %>%
        sprinkle_print_method("html") %>%
        print(asis = FALSE) %>%
        radio_table("dist", "Distribution")
    })


  output$dist <- renderText(input$dist)

})


ui <- shinyUI(fluidPage(
  titlePanel("Radio Matrix"),
  sidebarLayout(
    sidebarPanel(  ),
    mainPanel(
      tabsetPanel(
        tabPanel(title = "Selection",
                 br(),
                 uiOutput("table"),
                 verbatimTextOutput("dist")
        )
      )
    )
  )
))

shinyApp(ui = ui, server = server)