Question

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

Answer 1

不确定您是否还在寻找答案。或许不会，但它使我伤心地看到它没有答案。我只想自己创建表格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界面。我总是做后者，它给你更多的自由。我会在我的页面上看到这个：

<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()正常生成你的表格并单独添加单选按钮，即根本不是表格的一部分？请参阅this page of the Shiny tutorial以获取帮助。如果你必须将单选按钮与表格列对齐，可以通过一些CSS来实现。

Answer 2

追求@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()})

（关于最后一行，我习惯性地将expr arg包装在一个函数中，所以我可以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
  })

在RStudio闪亮，希望自定义一个表

2 个答案: