user6253481 user6253481 - 7 months ago 19
HTML Question

In R Shiny how to embed HTML Radio buttons within a Table

I'm trying to embed rows of radio buttons within a table in R/Shiny using HTML. From Shiny HTML examples I can create rows of radio buttons and get the input values (input$a1value, input$a2value) but am unable to read those values when I wrap it in table HTML. See code below:

ui <- shinyUI(fluidPage(

mainPanel(
uiOutput("htmltable"),
textOutput("a1value"),
textOutput("a2value")

)
))

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

output$htmltable <- renderText({
HTML('
<table class="data table table-bordered table-condensed">
<tr><td>

<div id="a1" class="form-group shiny-input-radiogroup shiny-input-container">
<label class="control-label" for="a1">Radio button in a table example </label>
<div class="shiny-options-group">
<div class="radio"> <td><label><input type="radio" name="a1" checked="checked" value="1"></label></td>
</div><div class="radio"> <td><label><input type="radio" name="a1" value="2"> </label></td>
</div><div class="radio"> <td><label><input type="radio" name="a1" value="3"> </label></td>
</div><div class="radio"> <td><label><input type="radio" name="a1" value="4"> </label></td>
</div><div class="radio"> <td><label><input type="radio" name="a1" value="5"> </label></td>
</div></div></div>
</td></tr>
<tr><td>
<div id="a2" class="form-group shiny-input-radiogroup shiny-input-container">
<label class="control-label" for="a2"> </label>
<div class="shiny-options-group">
<div class="radio"> <td><label><input type="radio" name="a2" checked="checked" value="1"></label></td>
</div><div class="radio"> <td><label><input type="radio" name="a2" value="2"> </label></td>
</div><div class="radio"> <td><label><input type="radio" name="a2" value="3"> </label></td>
</div><div class="radio"> <td><label><input type="radio" name="a2" value="4"> </label></td>
</div><div class="radio"> <td><label><input type="radio" name="a2" value="5"> </label></td>
</div></div></div>
</td></tr> </table>')})

output$a1value <- renderText({input$a1})
output$a2value <- renderText({input$a2})

})

shinyApp(ui=ui,server=server)


I can get a1value and a2value before wrapping the HTML with the table HTML construct but not afterwards.

Answer

An example using mtcars dataset

Our function to build the html table

ff <- function(i)data.frame(vals = sprintf("<td>%s</td>",mtcars[i,1]),rads = sprintf('<td><div class="form-group shiny-input-container"><input name="row-%s" type="checkbox" id="row-%s" /><label for="row-%s">%s</label></div>',i,i,i,row.names(mtcars[i,])))

precompile table elements

a <- rbind.pages(lapply(1:15,function(x)ff(x)))

For the headers

ths <- paste("<tr>\n",paste0(paste0("<th>",colnames(a),"</th>"),collapse = "\n"),"\n</tr>",sep="") %>%HTML

For the body

tbods <- paste0(apply(a,1,function(i)sprintf("<tr>%s</tr>",paste0(i,collapse = ""))),collapse="\n")%>%HTML

You would use renderUI on the server side

tagList(tags$table(tags$head(ths),tags$tbody(tbods)))%>%html_print

UPDATE: I'm using the mtcars dataset

mtcars$html <- llply(1:nrow(mtcars),function(i)
HTML(sprintf('<div><input type="radio" name="myRadio" value="%s" class="our-class" id="%s"/> %s <label for="%s">%s</label></div>',i,row.names(mtcars)[[i]],i,row.names(mtcars)[[i]],row.names(mtcars)[[i]])))%>%unlist

NOTE:this is my function internally, but use the function we used before to make the table

aa<-rt.table_prep(mtcars)


tags$html(tags$head(tags$link(href = "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.6/css/bootstrap.min.css"),tags$script(src="https://code.jquery.com/jquery-1.10.2.js")),tags$body(tags$div(class="container",tags$div(class="row",tags$div(id = "log",style="font-size:56px"),tags$table(tags$thead(aa[[1]]),tags$tbody(aa[[2]])))),tags$script(HTML("$('input').on('click',function(){$('#log').html($('input:checked').val()+'is checked');});"))))%>%html_print

which gives us:http://codepen.io/CarlBoneri/pen/YqOBBN