R shiny: How to add RadioButton in a table? - r

Question

I want to add a choice row at the bottom of table. I searched for some answers but it included many other functions it was hard for me to understand.
library(shiny)
c1 <-c("Time in free flow (mins)",
"Time slowed down by other traffic (mins)",
"Percentage of total time spent with other vehicles close behind",
"Curviness",
"Running costs",
"Toll cost")
c2 <- c('50','10','25%','Moderate','$12.00','$0.00')
c3 <- c('38','5','31%','extreame','$10.50','$3.00')
c4 <- c('62','8','19%','Almost straight','$9.00','$0.50')
c5 <- c('56','15','12%','Moderate','$13.50','$0.00')
t <- cbind(c1,c2,c3,c4,c5)
ui <- fluidPage(
tableOutput("faith")
)
server <- function(input, output, session) {
output$faith <- renderTable({t}, type = "html", bordered = TRUE, striped = TRUE, align = "c")
}
shinyApp(ui = ui, server = server)
I updated some code based on the comments, but still don't know how to get the select value
library(shiny)
library(DT)
c1 <-c("Time in free flow (mins)",
"Time slowed down by other traffic (mins)",
"Percentage of total time spent with other vehicles close behind",
"Curviness",
"Running costs",
"Toll cost")
c2 <- c('50','10','25%','Moderate','$12.00','$0.00')
c3 <- c('38','5','31%','extreame','$10.50','$3.00')
c4 <- c('62','8','19%','Almost straight','$9.00','$0.50')
c5 <- c('56','15','12%','Moderate','$13.50','$0.00')
t <- cbind(c1,c2,c3,c4,c5)
tm <- c('<input type="radio" name="Dec" value="1"/>',
'<input type="radio" name="Dec" value="2"/>',
'<input type="radio" name="Dec" value="3"/>',
'<input type="radio" name="Dec" value="4"/>',
'<input type="radio" name="Dec" value="5"/>')
tmm <- rbind(t,tm)
shinyApp(
ui = fluidPage(
title = 'Radio buttons in a table',
DT::dataTableOutput('foo'),
verbatimTextOutput('sel')
),
server = function(input, output, session) {
output$foo = DT::renderDataTable(
tmm, escape = FALSE, selection = 'none', server = FALSE,
options = list(dom = 't', paging = FALSE, ordering = FALSE),
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-radiogroup');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
output$sel = renderPrint({
str(sapply('Dec', function(i) input[[i]]))
})
}
)
Any suggestion is welcome.
This is what I try to do. Add a single choice row.

Answer 1

I did it!
But still don't know how to submit the select value though observeEvent.
library(shiny)
library(DT)
library(googlesheets4)
c1 <-c("Time in free flow (mins)",
"Time slowed down by other traffic (mins)",
"Percentage of total time spent with other vehicles close behind",
"Curviness",
"Running costs",
"Toll cost")
c2 <- c('50','10','25%','Moderate','$12.00','$0.00')
c3 <- c('38','5','31%','extreame','$10.50','$3.00')
c4 <- c('62','8','19%','Almost straight','$9.00','$0.50')
c5 <- c('56','15','12%','Moderate','$13.50','$0.00')
t <- cbind(c1,c2,c3,c4,c5)
shinyApp(
ui = fluidPage(
title = 'Radio buttons in a table',
DT::dataTableOutput('foo'),
tt <- textOutput('sel')
textOutput('sel'),
actionButton("submit", "submit")
),
server = function(input, output, session) {
m = matrix(
as.character(1:4), nrow = 1, ncol = 4, byrow = TRUE,
dimnames = list(' ', LETTERS[1:4])
)
for (i in seq_len(nrow(m))) {
m[i, ] = sprintf(
'<input type="radio" name="%s" value="%s"/>',
' ', m[i, ]
)
}
m <- cbind('Chioce',m)
m<-rbind(t,m)
output$foo = DT::renderDataTable(
m, escape = FALSE, selection = 'none', server = FALSE,
options = list(dom = 't', paging = FALSE, ordering = FALSE),
callback = JS("table.rows().every(function(i, tab, row) {
var $this = $(this.node());
$this.attr('id', this.data()[0]);
$this.addClass('shiny-input-radiogroup');
});
Shiny.unbindAll(table.table().node());
Shiny.bindAll(table.table().node());")
)
output$sel = renderPrint({
str(sapply(' ', function(i) input[[i]]))
})
observeEvent(input$submit,{
})}
)