Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

in RStudio shiny, wishing to customize a table

Tags:

jquery

r

shiny

In an RStudio shiny application with a table produced by renderTable(), I'd like to add a leading column of radio-buttons (reactive, of course) and change the style of the selected row. What's the best strategy? I think I can use jQuery if absolutely necessary, but isn't there a simpler way? I've tried inserting html into table cells within the renderTable() expression args... doesn't work.

like image 359
Roger Avatar asked Dec 05 '22 11:12

Roger


2 Answers

Not sure if you're still looking for an answer on this. Probably not, but it makes me sad to see it unanswered. I would just create the table html myself and use renderText().

As an example, say you want this data frame on your page with radio buttons in the top row:

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

We first need to turn df into a HTML table. Here's functions to make HTML table cells and rows:

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>')
}

And using those functions:

df_rows <- apply(df, 1, row_html) 

Now here's a silly little function to make radio buttons:

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

Let's make as many radio buttons as there are columns in df:

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

That will produce HTML of the form:

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

For each row. Then throw radios into row_html to make a HTML table row out of them:

radio_row <- row_html(radios)

Now we just need to combine df, the radio buttons and wrap the whole thing in HTML table tags.

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

Put this whole beast in a renderText() function. I'm not sure if you are using the ui.R or your own custom HTML interface. I always do the latter, it gives you a lot more freedom. I would have this on my page:

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

To render my table to output$x. To style your selected row I would recommend using jQuery. A simple event along the lines of (highly untested) [EDIT: see suggested amendment in comments below]:

$('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
  // ...
  // ...

});

You could alternatively try and build the table and a "selected" class to the appropriate table row server-side, with some CSS ready to style it.

In the absence of sample data, all of this is untested so expect some errors.

Also, if you are happy using ui.R rather than your own custom HTML, this method should still work. I just suggest using custom HTML as you seem to be wandering down that route.


I was answering what you asked... i.e. to make a leading row of radio buttons. I probably wouldn't do that myself though. Why not just produce your table as normal with renderTable() and add in the radio buttons separately, i.e. not part of the table at all? See this page of the Shiny tutorial for help. If you absolutely have to line up the radio buttons with the table columns, this could be achieved with some CSSing.

like image 90
Ciarán Tobin Avatar answered Dec 20 '22 16:12

Ciarán Tobin


Pursuing @MadScone 's excellent advice, I came up with the following code, which is the definitive solution to
Some additional features that make it work for me are: * the radio buttons are in column 1 (not row 1) * they belong to the same radio group * the table header row is properly formatted * the row selected by radio button receives special formatting, without needing 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()})

(Concerning the last line, I habitually wrap my expr arg in a function, so I can debug. So far it's worked fine.)

The function that responds to the radio buttons is as follows:

  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
  })
like image 31
Roger Avatar answered Dec 20 '22 14:12

Roger