在RStudioshiny，希望自定义一个表
在一个带有由renderTable()生成的表的RStudioshiny应用程序中，我想添加一个前导列的单选按钮（当然是被动的）并更改所选行的样式。 什么是最好的策略？ 我想如果绝对必要的话我可以使用jQuery，但是不是更简单的方法吗？ 我已经尝试将html插入到renderTable()表达式中的表格单元格args …不起作用。
不确定你是否还在寻找答案。 可能不是，但是看到它没有答案让我很难过。 我只想自己创建表格html并使用renderText() 。
例如，假设您希望页面上的数据框在顶行显示单选按钮：
df <- data.frame(A=1:5, B=1:5)
我们首先需要将df转换为HTML表。 这是制作HTML表格单元格和行的函数：
cell_html <- function(table_cell) paste0('', table_cell, ' ') row_html <- function(table_row) { cells <- sapply(table_row, cell_html) collapse_cells <- paste0(cells, collapse='') paste0('', collapse_cells, ' ') }
并使用这些function：
df_rows <- apply(df, 1, row_html)
现在，这是制作单选按钮的一个愚蠢的小function：
radio_html <- function(radio_name, radio_value, radio_text) { paste0('', radio_text) }
让我们制作与df中的列一样多的单选按钮：
radios <- sapply(seq_along(df), function(x) radio_html(paste0('row', x), x, paste(x)))
这将产生以下forms的HTML：
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('', collapse_cells, '
')
把这整个野兽放在renderText()函数中。 我不确定您使用的是ui.R还是您自己的自定义HTML界面。 我总是做后者，它给你更多的自由。 我会在我的页面上看到这个：
要使我的表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教程的此页面以获取帮助。 如果你必须将单选按钮与表格列对齐，可以通过一些CSS来实现。
追求@MadScone的出色建议，我提出了以下代码，这是最终的解决方案。
使其适用于我的一些其他function包括：*单选按钮位于第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('', table_cell, ' ') cell_html <- function(table_cell) paste0('', table_cell, ' ') radio_html <- function(radio_name, radio_value, is_checked, radio_text) { paste0('', 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('', collapse_cells, ' ') 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('', collapse_cells, '
') return(full_table) } output$objects_table_for_OneCT = renderText({f.objects_table_for_OneCT()})
（关于最后一行，我习惯性地将我的expr arg包装在一个函数中，所以我可以debug 。到目前为止它工作得很好。）
响应单选按钮的function如下：
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 })