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 :
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();
};"
)
With server = TRUE (the default) in renderDT, this will be hard. It's easier with server = FALSE, and this option allows to use addRow to add a new row.
Also, there was an error in your JavaScript code: the R data is converted to JavaScript, so TRUE is not the value obtained in JavaScript, this is true instead.
Note that I keep a copy of the table in the reactive dataframe Dat in case you want to save it for example.
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("Editable table with checkboxes"),
selectInput(
"photo", "Photo", c("choose" = "", "Dog", "Shovel", "Cat", "Desk")
),
selectInput(
"description", "Description", c("choose" = "", "object", "animal")
),
actionButton("add_line", "Add a new line"),
DTOutput("table")
)
myinitialframe <- data.frame(
Photo = character(),
Description = character(),
Confirmed = logical(),
stringsAsFactors = FALSE
)
server <- function(input, output, session) {
# we make a reactice dataframe from `myinitialframe`
Dat <- reactiveVal(myinitialframe)
# but we don't use it in `renderDT` !
output[["table"]] <- renderDT({
datatable(
myinitialframe, rownames = TRUE,
editable = "cell", selection = "none",
options = list(
columnDefs = list(
list(
targets = c(3),
render = JS(
"function(data, type, row, meta) {",
" if (type === 'display') {",
" return '<input type=\"checkbox\" ' + (data ? 'checked' : '') + '/>';",
" }",
" return data;",
"}"
)
)
)
)
)
}, server = FALSE)
# instead we will use a proxy in order to be able to add a new row
proxy <- dataTableProxy("table")
# we use`editData` to update the reactive table
observeEvent(input[["table_cell_edit"]], {
info <- input[["table_cell_edit"]]
dat <- Dat()
new_dat <- editData(dat, info, rownames = TRUE)
Dat(new_dat)
})
# now we handle the adding line feature
# with the help of the `addRow` function
observeEvent(input[["add_line"]], {
new_row <- data.frame(
Photo = input[["photo"]],
Description = input[["description"]],
Confirmed = FALSE
)
new_dat <- rbind(Dat(), new_row)
Dat(new_dat)
rownames(new_row) <- nrow(new_dat)
addRow(proxy, new_row, resetPaging = FALSE)
})
}
shinyApp(ui, server)
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("Editable table with checkboxes"),
selectInput(
"photo", "Photo", c("choose" = "", "Dog", "Shovel", "Cat", "Desk")
),
selectInput(
"description", "Description", c("choose" = "", "object", "animal")
),
actionButton("add_line", "Add a new line"),
DTOutput("table")
)
myinitialframe <- data.frame(
Photo = character(),
Description = character(),
Confirmed = integer(),
stringsAsFactors = FALSE
)
callback <- JS(
"table.on('click', 'input[type=checkbox]', function() {",
" var $this = $(this);",
" var row = parseInt($this.attr('name')) + 1;",
" var bit = $this.prop('checked') ? 1 : 0;",
" var info = [{row: row, col: 3, value: bit}];",
" Shiny.setInputValue('table_cell_edit:DT.cellInfo', info);",
"});"
)
server <- function(input, output, session) {
# we make a reactice dataframe from `imynitialframe`
Dat <- reactiveVal(myinitialframe)
# but we don't use in `renderDT` !
output[["table"]] <- renderDT({
datatable(
myinitialframe, rownames = TRUE,
editable = "cell", selection = "none",
callback = callback,
options = list(
columnDefs = list(
list(
targets = c(3),
render = JS(
"function(data, type, row, meta) {",
" if (type === 'display') {",
" return `<input type=\"checkbox\" name=\"${meta.row}\"' + (data ? 'checked' : '') + '/>`;",
" }",
" return data;",
"}"
)
)
)
)
)
}, server = FALSE)
# instead we will use a proxy in order to be able to add a new row
proxy <- dataTableProxy("table")
# we use`editData` to update the reactive table
observeEvent(input[["table_cell_edit"]], {
info <- input[["table_cell_edit"]]
print(info)
dat <- Dat()
new_dat <- editData(dat, info, rownames = TRUE)
Dat(new_dat)
})
# now we handle the adding line feature
# with the help of the `addRow` function
observeEvent(input[["add_line"]], {
new_row <- data.frame(
Photo = input[["photo"]],
Description = input[["description"]],
Confirmed = 0L
)
new_dat <- rbind(Dat(), new_row)
Dat(new_dat)
rownames(new_row) <- nrow(new_dat)
addRow(proxy, new_row, resetPaging = FALSE)
})
}
shinyApp(ui, server)