How to update row-wise filter in Shiny datatable

Question

I'm trying to update row-wise filter in datatable basis on the inputs we receive from user on every row, so that only relevant values in sub-sequent inputs can be selected.

I have tried to replicate my scenario using below code, where in if User selects "setosa" as "spieces_selector" hence only "1-50" values should appear in "New_Data_selector". Similarly if a User selects "versicolor" in 2nd row hence for 2nd row "New_Data_selector" should have the values from "51-100".

Would appreciate your help on this.

library(shiny)
library(DT)

iris$New_Data <- c(1:150)

ui <- fluidPage(
  title = 'Selectinput column in a table',
  h3("Source:", tags$a("Yihui Xie", href = "https://yihui.shinyapps.io/DT-radio/")),
  numericInput('num', "enter a number", value = 5, min = 1, max = 10, step = 1),
  DT::dataTableOutput('foo'),
  verbatimTextOutput('sel'),
  actionButton(
    "saveBtn",
    "Submit Request",
    style = "color: #fff; background-color: #282364;
                                     border-color: #2e6da4",
    class = "btn btn-primary"
  )
)

server <- function(input, output, session) {
  data <- reactive({
    df <- head(iris, input$num)
    
    for (i in 1:nrow(df)) {
      df$species_selector[i] <- as.character(selectInput(paste0("sel1", i),
                                                         "",
                                                         choices = unique(iris$Species),
                                                         width = "100px"))
      
      df$New_Data_selector[i] <- as.character(selectInput(paste0("sel2", i),
                                                         "",
                                                         choices = unique(iris$New_Data),
                                                         width = "100px"))
    }
    df
  })
  
  output$foo = DT::renderDataTable(
    data(), 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-container');
      });
      Shiny.unbindAll(table.table().node());
      Shiny.bindAll(table.table().node());")
  )
  output$sel = renderPrint({
    str(sapply(1:nrow(data()), function(i) input[[paste0("sel", i)]]))
  })
  
  observeEvent(input$saveBtn, {
    
    Test_Data <- sapply(1:nrow(data()), function(i) input[[paste0("sel", i)]])
    Test_Data <- as.data.frame(Test_Data)
    print(Test_Data)})
  
}

shinyApp(ui, server)

Answer 1

The following works (based on my earlier answer) - but it's pretty slow. Will need to investigate further.

library(DT)
library(shiny)
library(datasets)
library(data.table)

myIris <- copy(iris)
setDT(myIris)

myIris[, Index := seq_len(.N)]

selectInputIDs_A <- paste0("sel_A", myIris$Index)
selectInputIDs_B <- paste0("sel_B", myIris$Index)

myIris[, selectInputs_A := sapply(selectInputIDs_A, function(x){as.character(selectInput(inputId = x, label = "", choices = unique(myIris$Species), selected = "setosa"))})]
myIris[, selectInputs_B := sapply(selectInputIDs_B, function(x){as.character(selectInput(inputId = x, label = "", choices = unique(myIris[Species == "setosa"]$Index), selected = "setosa"))})]

initTbl <- copy(myIris)

ui <- fluidPage(
  DT::dataTableOutput(outputId = 'my_table')
)

server <- function(input, output, session) {
  
  displayTbl <- reactive({
    myIris[, selectInputs_A := sapply(selectInputIDs_A, function(x){as.character(selectInput(inputId = x, label = "", choices = unique(Species), selected = input[[x]]))}),]
    myIris[, selectInputs_B := sapply(seq_along(selectInputs_B), function(x){as.character(selectInput(inputId = selectInputIDs_B[x], label = "", choices = unique(myIris[Species == input[[selectInputIDs_A[x]]]]$Index), selected = input[[selectInputIDs_A[x]]]))})]
  })
  
  output$my_table = DT::renderDataTable({
    DT::datatable(
      initTbl, escape = FALSE, selection = 'none', rownames = FALSE,
      options = list(paging = FALSE, ordering = FALSE, scrollx = TRUE, dom = "t",
                     preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                     drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  }, server = TRUE)
  
  my_table_proxy <- dataTableProxy(outputId = "my_table", session = session)
  
  observeEvent({sapply(selectInputIDs_A, function(x){input[[x]]})}, {
    replaceData(proxy = my_table_proxy, data = displayTbl(), rownames = FALSE) # must repeat rownames = FALSE see ?replaceData and ?dataTableAjax
  }, ignoreInit = TRUE)
  
}

shinyApp(ui = ui, server = server)