What I am trying to accomplish is similar to this thread, but slightly more complicated.
I would like to group the radio buttons into different groups, but in one column so a "subselection" of rows is possible.
Currently only the radio button group with ID "C" works, because the div element is defined for the whole table. I have tried to insert the shiny tags via javascript callback, but I'm only able to insert a radio button for each row or for each column, but not for a subset of multiple rows in one column.
Open to javascript or shiny solutions.
shinyApp(
ui = fluidPage(
title = 'Radio buttons in a table',
tags$div(id="C",class='shiny-input-radiogroup',DT::dataTableOutput('foo')),
verbatimTextOutput("test")
),
server = function(input, output, session) {
m = matrix(
c(round(rnorm(24),1), rep(3,12)), nrow = 12, ncol = 3, byrow = F,
dimnames = list(month.abb, LETTERS[1:3])
)
m[, 2] <- rep(c("A","B","C", "D"), each= 3)
m[, 3] <- paste0('<input type="radio" name="', rep(c("A","B","C", "D"), each= 3),'" value="', month.abb,'"/>')
m[c(1,4,7,10), 3] <- gsub('/>', 'checked="checked"/>', m[c(1,4,7,10), 3], fixed = 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() {
# 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$test <- renderPrint(str(input$C))
}
)
UPDATE:
The rough structure of my final solution with reactive button selection. The inputs and visuals stay preserved with re-rendering the table (just the first time the input renders as NULL
which is no particular problem for me).
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
title = "Radio buttons in a table",
sliderInput("slider_num_rows", "Num Rows", min = 2, max = 12, value = 5),
tags$div(id = 'placeholder'),
verbatimTextOutput("test")
),
server = function(input, output, session) {
rea <- reactive({
m = matrix(
c(round(rnorm(24),1), rep(3,12)), nrow = 12, ncol = 3, byrow = F,
dimnames = list(month.abb, LETTERS[1:3])
)
m[, 2] <- rep(c("A","B","C", "D"), each= 3)
m[, 3] <- paste0('<input type="radio" name="', rep(c("A","B","C", "D"), each= 3),'" value="', month.abb,'"/>')
save_sel <- c()
mon_tes <- c("Jan", "Apr", "Jul", "Oct")
ab <- c("A", "B", "C", "D")
for (i in 1:4){
if (is.null(input[[ab[i]]])){
save_sel[i] <- mon_tes[i]
} else {
save_sel[i] <- input[[ab[i]]]
}
}
sel <- rownames(m) %in% save_sel
m[sel, 3] <- gsub('/>', 'checked="checked"/>', m[sel, 3], fixed = T)
m <- m[1:input$slider_num_rows,]
m
})
output$foo = DT::renderDataTable(
rea(), escape = FALSE, selection = 'none', server = FALSE,
options = list(dom = 't', paging = FALSE, ordering = FALSE,
columnDefs = list(list(className = 'no_select', targets = 3)))
)
observe({
l <- unique(m[, 2])
for(i in 1:length(l)) {
if (i == 1) {
radio_grp <- div(id = l[i], class = "shiny-input-radiogroup", DT::dataTableOutput("foo"))
} else {
radio_grp <- div(id = l[i], class = "shiny-input-radiogroup", radio_grp)
}
}
insertUI(selector = '#placeholder',
ui = radio_grp)
})
output$test <- renderPrint( {
str(input$A)
str(input$B)
str(input$C)
str(input$D)
})
}
)