jeudi 19 octobre 2023

Changes in checkbox statut are lost on new entry in a datatable reactive and editable?

I am working on a shiny app made for data recording. Each time the observers see a new occurence of an event, a new entry must be recorded. This is translate in the app by adding a line in a reactive and editable dataframe. When the field work is over, data must be checked for potential entry mistake. Most of the time this is done by another people. Sometimes, data can be interpreted as an error and deleted because out of the box. Yet,I would like to let observers confirmed out of the box data to make sure it is not deleted. To do so i would like a checkbox available in the dataframe. If i change manually data into the table (text or numeric), changes are saved through the function editable (see code) but if i toggle a checkbox, it is reintialised into untoggled when i add a new entry. Here an exemple:

library(shiny)
library(tidyverse)
library(DT)
library(shinyjs)

shinyApp(
ui <- fluidPage(
  titlePanel("Reactive table with checkbox editable"),
  selectInput("photo","Photo", c("choose"="","Dog", "Shovel", "Cat", "Desk")),
  selectInput("description", "Description", c("choose"="","object", "animal")),
  actionButton("add_line", "Add a line"),
  dataTableOutput("table")
),

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

# Function to manage cell changes
  
  editable<- function(input,data) {
   observeEvent(input$table_cell_edit, {
      info <- input$table_cell_edit
      row <- info$row
      col <- info$col
      value <- info$value
      
      dat <- data()
      if (col == 3) {  
        dat[row, col] <- as.logical(value) 
      } else {
        dat[row, col] <- value
      }
      data(dat)
      
    })} 
    

# Creating an empty frame
  
  myinitialframe <- data.frame(
    Photo = character(),
    Description = character(),
    Confirmed = character(),
    stringsAsFactors = FALSE
  )
  
# Get my empty frame reactive
  mydata <- reactiveVal(myinitialframe) 
  
  # ajout de ligne
  observeEvent(input$add_line, {
    new_row <- data.frame(
      Photo = input$photo,
      Description = input$description,
      Confirmed = FALSE
      )
    newdata <- rbind(new_row,mydata())
    mydata(newdata)
  })
  
# Display the table with checkbox in column "Confirmed"

    output$table <- DT::renderDataTable({
    mydata <- as.data.frame (mydata ())
    
    mydata <- datatable(
      mydata,
      editable = "cell",
      options = list(
        columnDefs = list(
          list(
            targets = c(3),
            render = JS(
              "function(data, type, row, meta) {",
              "  if (type === 'display') {",
              "    return '<input type=\"checkbox\" ' + (data === 'TRUE' ? 'checked' : '') + '/>';", 
              "  }",
              "  return data;",
              "}"
            )
          )
        )
      )
    )
    
})
    editable(input,mydata)


  }
)

I have tried :

  • shinyInput such as proposed in the forum but haven't been able to make it work when there is new lines to enter as assumed because it is not working with a reactive table?
  • Callback and JS :
         callback = JS(
        "table.on('click', 'input[type=checkbox]', function() {",
        "  var data = table.cell(this).data();",
        "  data = !data;",
        "  table.cell(this).data(data).draw(false);",
        "});"
      ),
shinyjs::runjs(
      "shinyjs.toggleCheckbox = function(checkbox) {
        var row = checkbox.closest('tr');
        var rowIndex = mytable.row(row).index();
        var newValue = !mytable.cell(rowIndex, 3).data();
        mytable.cell(rowIndex, 3).data(newValue).draw();
      };"
    ) 



Aucun commentaire:

Enregistrer un commentaire