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