2

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)
  • I think there should be a way something like: https://stackoverflow.com/questions/42745432/from-a-table-row-with-two-dropdowns-get-selected-value-which-drop-down-change. However dont know how to implement it in shiny – ayush varshney Jan 05 '22 at 13:38
  • 1
    Also see [this related answer](https://stackoverflow.com/questions/69344974/dt-dynamically-change-column-values-based-on-selectinput-from-another-column-in/69389649#69389649). – ismirsehregal Jan 05 '22 at 15:25
  • @ismirsehregal: this was really helpful to update the values using sapply, nice trick i found multiple solutions provided by you but none of them are related to update second dropdown and let say if we have more than 5 dropdowns in datatable, what would be ideal solution for this, would really appreciate your help if you can share this by some example. you are the hope!!! – ayush varshney Jan 05 '22 at 15:51
  • @ismirsehregal no worries, we will wait for your guidance.... – ayush varshney Jan 05 '22 at 16:11

1 Answers1

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)
ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
  • Thanks for your effort however seems like this could be really slow as we are initialising and assigning IDs to all of the datapoints. And when you have large data this can be slow.(though i haven't tested it yet.) But in mentioned example SO wants to have dynamic capabilty of selecting required no of rows and wanted to create dynamic ID's to avoid overwriting hence we may need to consider writing initial data frame code inside server only to make it faster. Whats your opinion? – ayush varshney Jan 05 '22 at 18:03
  • is there any other solution as its takes few seconds to update the table which doesnot look good. – ayush varshney Jan 06 '22 at 03:29
  • also, in this case the result will override however we really wanted to store all the changes as separate entries – ayush varshney Jan 06 '22 at 06:46
  • I guess you'll need a JS solution. Regarding the dynamic no. of rows I think it's better to keep things simple in the first place. That's something to deal with after solving the dropdown issue. – ismirsehregal Jan 06 '22 at 07:16
  • thats correct, regarding dynamic no of rows we have achieved the same. unfortunately were not able to share the complete code here which is working perfect as per the requirement. we are only struggling with updating filters within the table as there are 4 different filters in each row and has to be updated based on the selection of first filter inputs... i am surprised that in shiny datatable we dont have any solution for it. – ayush varshney Jan 06 '22 at 08:24
  • i wish some expert can help us here with a good solution of updating the filters quickly basis on the selection provided in first filter within datatable. – ayush varshney Jan 06 '22 at 08:26
  • It's easier using rhandsontable. Please see [this](https://stackoverflow.com/questions/57634100/is-there-a-way-to-have-different-dropdown-options-for-different-rows-in-an-rhand/57755862#57755862) or [this](https://github.com/jrowen/rhandsontable/issues/105#issuecomment-818627510). – ismirsehregal Jan 06 '22 at 08:30