4

在带有由 生成的表格的 RStudio 闪亮应用程序中renderTable()，我想添加单选按钮的前导列（当然是反应性的）并更改所选行的样式。最好的策略是什么？我想如果绝对必要我可以使用 jQuery，但没有更简单的方法吗？我尝试将 html 插入renderTable()表达式 args... 中的表格单元格中不起作用。

4

2 回答 2

11

不确定您是否仍在寻找有关此问题的答案。可能不是，但看到它没有得到答复让我很难过。我会自己创建表格 html 并使用renderText().

例如，假设您希望页面上的此数据框在顶行带有单选按钮：

df <- data.frame(A=1:5, B=1:5)

我们首先需要df变成一个HTML表格。以下是制作 HTML 表格单元格和行的函数：

cell_html <- function(table_cell) paste0('<td>', table_cell, '</td>')

row_html <- function(table_row) {
  cells <- sapply(table_row, cell_html)
  collapse_cells <- paste0(cells, collapse='')
  paste0('<tr>', collapse_cells, '</tr>')
}

并使用这些功能：

df_rows <- apply(df, 1, row_html)

现在这里有一个愚蠢的小功能来制作单选按钮：

radio_html <- function(radio_name, radio_value, radio_text) {
  paste0('<input type="radio" name="', 
   radio_name, '" value="', radio_value, '">', radio_text)
}

让我们制作尽可能多的单选按钮df：

radios <- sapply(seq_along(df), 
  function(x) radio_html(paste0('row', x), x, paste(x)))

这将生成表单的 HTML：

<input type="radio" name="row1" value="1">1

对于每一行。然后投入radios其中row_html以制作 HTML 表格行：

radio_row <- row_html(radios)

现在我们只需要组合df单选按钮并将整个内容包装在 HTML 表格标签中。

table_cells <- c(radio_row, df_rows)
collapse_cells <- paste0(table_cells, collapse='')
full_table <- paste0('<table>', collapse_cells, '</table>')

把这整个野兽放在一个renderText()函数中。我不确定您使用的是ui.R自定义 HTML 界面还是您自己的自定义 HTML 界面。我总是做后者，它给你更多的自由。我会在我的页面上有这个：

<div name="x" id="x" class="shiny-html-output"></div>

将我的表渲染为output$x. 要设置所选行的样式，我建议使用 jQuery。一个简单的事件（高度未经测试）[编辑：请参阅下面评论中的建议修改]：

$('table input:radio').change(function() {

  var index = $('#table input:radio').index(this);

  // Add one to skip radio button row.
  $('table tr').eq(index + 1).css('background-color', 'blue');

  // Also handle reset on other rows
  // ...
  // ...

});

您也可以尝试将表格和“选定”类构建到适当的表格行服务器端，并准备好一些 CSS 来设置样式。

在没有样本数据的情况下，所有这些都未经测试，因此预计会出现一些错误。

此外，如果您乐于使用ui.R而不是您自己的自定义 HTML，则此方法应该仍然有效。我只是建议您使用自定义 HTML，因为您似乎正在沿着这条路线徘徊。

我正在回答您的要求...即制作单选按钮的前排。不过，我自己可能不会这样做。为什么不像往常一样制作您的表格renderTable()并单独添加单选按钮，即根本不属于表格的一部分？请参阅Shiny 教程的此页面以获取帮助。如果您绝对必须将单选按钮与表格列对齐，这可以通过一些 CSSing 来实现。

于 2013-03-22T17:19:48.693 回答
5

追求@MadScone 的优秀建议，我想出了以下代码，这是
一些使其对我有用的附加功能的最终解决方案： * 单选按钮位于第 1 列（不是第 1 行） * 它们属于相同的单选组 * 表格标题行格式正确 * 单选按钮选择的行接收特殊格式，无需 jQuery。

values = reactiveValues(PopRow=1)   ### To receive and hold the selected row number.

f.objects_table_for_OneCT = function(){
    f.changeSelectedRow()        #### See definition below.
    df = createObjectsTable()    #### Any data frame goes here; code not provided here.
    selectedRow = values$PopRow
    header_html <- function(table_cell) paste0('<th>', table_cell, '</th>')
    cell_html <- function(table_cell) paste0('<td>', table_cell, '</td>')
    radio_html <- function(radio_name, radio_value, is_checked, radio_text) {
      paste0('<input type="radio" name="', 
             radio_name, '" value=', radio_value, 
                   ifelse(is_checked, " checked ", ""),
                   '>', radio_text)
    }    
    row_html <- function(table_row_num) {
      table_row = df[table_row_num, ]
      cells <- sapply(table_row, cell_html)
      cells <- c(cell_html(radio_html(
                  "whichRow", table_row_num, table_row_num == selectedRow, "")),
               cells)
      collapse_cells <- paste0(cells, collapse='')
      selectedRowStyle = "style='color:red; font-weight:bold'"
      collapse_cells <- paste0('<tr ', 
                     ifelse(table_row_num == selectedRow, selectedRowStyle, ""),
                    '>', collapse_cells, '</tr>')
      collapse_cells 
    }
    df_rows <- sapply(1:nrow(df), row_html) 
    df_header_row <- header_html(c("CHOICE", names(df)))
    collapse_cells <- paste0(c(df_header_row, df_rows), collapse='')    
    full_table <- paste0('<table class=\"data table table-bordered table-condensed\">', 
                         collapse_cells, '</table>')
    return(full_table)
  }

  output$objects_table_for_OneCT = renderText({f.objects_table_for_OneCT()})

（关于最后一行，我习惯性地将我的exprarg 包装在一个函数中，所以我可以debug. 到目前为止它工作得很好。）

响应单选按钮的函数如下：

  f.changeSelectedRow = reactive({
    if(is.null(values$PopRow)) values$PopRow = 1
    if(!is.null(input$whichRow))   ### from the radio button set.
             if(input$whichRow != values$PopRow) values$PopRow = input$whichRow
  })
于 2013-04-12T17:48:59.180 回答