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
