在“发光数据表”中用于“子选择”的单选按钮可以被选择。行/分组在一列中 [英] Radiobuttons in Shiny DataTable for "subselection" of rows/ grouping in one column

问题描述

我要完成的工作类似于

请注意，在交互之前，元素仍将具有 NULL 值。但是，使用 if 语句可以解决此问题，当输入元素为 NULL 。

编辑：您可以使用以下循环创建 divs ：

  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）
} 
} 
  

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

解决方案

You can nest the div elements into each other like this:

  ui = fluidPage(
    title = "Radio buttons in a table",
    div(id = "A", class = "shiny-input-radiogroup",
      div(id = "B", class = "shiny-input-radiogroup",
        div(id = "C", class = "shiny-input-radiogroup",
          div(id = "D", class = "shiny-input-radiogroup", DT::dataTableOutput("foo"))    
        )
      )
    ),

I also modified renderText in order to print all the values.

output$test <- renderPrint( {
  str(input$A)
  str(input$B)
  str(input$C)
  str(input$D)
})

Here is the result after interacting with the dataTableOutput (selected the Feb radio button):

Please note that the elements will still have NULL value until interaction. You can get around this problem though, with an if statement, using the default values of radio buttons when the input elements are NULL.

Edit: You can create the divs with a loop like this:

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

这篇关于在“发光数据表”中用于“子选择”的单选按钮可以被选择。行/分组在一列中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！