jeudi 30 mars 2023

datatable checkbox: JS code + input[["dtable_cell_edit"]] does not work with reactive DT

I am starting with the well known solution used to add checkbox to a datatable (code reported below)

library(shiny)
library(DT)

ui <- fluidPage(
  br(),
  fluidRow(
    column(
      6,
      DTOutput("dtable")
    ),
    column(
      6,
      verbatimTextOutput("reactiveDF")
    )
  )
)

shinyInput <- function(FUN, len, id, ...) {
  inputs <- character(len)
  for (i in seq_len(len)) {
    inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
  }
  inputs
}

dat0 <- data.frame(
  fruit  = c("apple", "cherry", "pineapple", "pear"),
  letter = c("a", "b", "c", "d")
)

dat1 <- cbind(dat0, bool = FALSE)

dat2 <- cbind(
  dat0,
  check = shinyInput(checkboxInput, nrow(dat0), "checkb")
)

js <- c(
  "$('[id^=checkb]').on('click', function(){",
  "  var id = this.getAttribute('id');",
  "  var i = parseInt(/checkb(\\d+)/.exec(id)[1]);",
  "  var value = $(this).prop('checked');",
  "  var info = [{row: i, col: 3, value: value}];",
  "  Shiny.setInputValue('dtable_cell_edit:DT.cellInfo', info);",
  "})"
)

server <- function(input, output, session) {

  Dat <- reactiveVal(dat1)

  output[["dtable"]] <- renderDT({
    datatable(
      dat2, 
      rownames = TRUE,
      escape = FALSE,
      editable = list(target = "cell", disable = list(columns = 3)),
      selection = "none",
      callback = JS(js)
    )
  }, server = FALSE)

  observeEvent(input[["dtable_cell_edit"]], { 
    info <- input[["dtable_cell_edit"]] # this input contains the info of the edit
    print(info)
    Dat(editData(Dat(), info))
  })
  
  output[["reactiveDF"]] <- renderPrint({ 
    Dat()
  })

}

shinyApp(ui, server)

Now i am trying to modify the code in order to work with a reactive dat1, e.g applying a filter on dat0$letter with a proper select input.

At first run with dat0 filtered with letter 'b' (initial choice), the click on check column is registered; then switching the filter to letter 'a', the dt is displayed with the checkboxInput unchecked, but when i click on it the input is not registered (the observeEvent(input[["dtable_cell_edit"]] is not executed)

Here is my code attemp:

library(shiny)
library(DT)

ui <- fluidPage(
  br(),
  selectInput("letter","", choices=c("a", "b", "c", "d"), selected="b"),
  fluidRow(
    column(
      6,
      DTOutput("dtable")
    ),
    column(
      6,
      verbatimTextOutput("reactiveDF")
    )
  )
)

shinyInput <- function(FUN, len, id, ...) {
  inputs <- character(len)
  for (i in seq_len(len)) {
    inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
  }
  inputs
}

dat0 <- data.frame(
  fruit  = c("apple", "cherry", "pineapple", "pear"),
  letter = c("a", "b", "c", "d")
)



js <- c(
  "$('[id^=checkb]').on('click', function(){",
  "  var id = this.getAttribute('id');",
  "  var i = parseInt(/checkb(\\d+)/.exec(id)[1]);",
  "  var value = $(this).prop('checked');",
  "  var info = [{row: i, col: 3, value: value}];",
  "  Shiny.setInputValue('dtable_cell_edit:DT.cellInfo', info);",
  "})"
)

server <- function(input, output, session) {
  Dat <- reactiveVal()
    
  dat1 <-eventReactive(input$letter,{
   
    tmp <- dat0
    tmp <- cbind(tmp, bool = FALSE)
    
    tmp<- tmp[tmp$letter == input$letter,]
    return(list(tbl=tmp))
  })
    
  
  dat2 <-eventReactive(dat1(),{
   
    tmp= dat1()$tbl
    tmp <- cbind(
        tmp,
        check = shinyInput(checkboxInput, nrow(tmp), "checkb"))
    
    Dat(dat1()$tbl)
    
    return(list(tbl=tmp))
    
  })
  
  
  output[["dtable"]] <- renderDT({
    
    tmp <- dat2()$tbl
    datatable(
      tmp, 
      rownames = TRUE,
      escape = FALSE,
      editable = list(target = "cell", disable = list(columns = 3)),
      selection = "none",
      callback = JS(js)
    )
  }, server = FALSE)
  
  observeEvent(input[["dtable_cell_edit"]], { 
   
    info <- input[["dtable_cell_edit"]] # this input contains the info of the edit
    print(info)
    Dat(editData(Dat(), info))
  })
  
  output[["reactiveDF"]] <- renderPrint({ 
    Dat()
  })
  
}

Any idea where i'm wrong? Thanks




Aucun commentaire:

Enregistrer un commentaire