I have some code with a datatable, wherein one column may be edited to a value in a dropdown list.
Whenever the datatable is edited, I would like the output to be saved/defined as a different reactive variable (i.e. printed to iris_edited
) so that I can monitor the data and in future use it in a different function.
Currently, the server-side editing of the data table outputs to output[["dtable"]]
- which I cannot use since it is an output
I have tried what feels like an innumerable amount of observe and reactive clauses such as
iris_edited<-reactiveValues()
observe({iris_edited$data<-iris$data})
observe({print(iris_edited$data})
and
iris_edited<-reactiveValues()
observe({iris_edited<-output$dtable})
observe({print(iris_edited$data})
but I can only get 'NULL' or other errors.
I am not averse to using other packages/methods to get the same result!
Minimum working example of current code:
(PS please forgive any mistakes -I am a noob )
library(DT)
callback <- c(
"var id = $(table.table().node()).closest('.datatables').attr('id');",
"$.contextMenu({",
" selector: '#' + id + ' td.factor input[type=text]',",
" trigger: 'hover',",
" build: function($trigger, e){",
" var levels = $trigger.parent().data('levels');",
" if(levels === undefined){",
" var colindex = table.cell($trigger.parent()[0]).index().column;",
" levels = table.column(colindex).data().unique();",
" }",
" var options = levels.reduce(function(result, item, index, array){",
" result[index] = item;",
" return result;",
" }, {});",
" return {",
" autoHide: true,",
" items: {",
" dropdown: {",
" name: 'Edit',",
" type: 'select',",
" options: options,",
" selected: 0",
" }",
" },",
" events: {",
" show: function(opts){",
" opts.$trigger.off('blur');",
" },",
" hide: function(opts){",
" var $this = this;",
" var data = $.contextMenu.getInputValues(opts, $this.data());",
" var $input = opts.$trigger;",
" $input.val(options[data.dropdown]);",
" $input.trigger('change');",
" }",
" }",
" };",
" }",
"});"
)
createdCell <- function(levels){
if(missing(levels)){
return("function(td, cellData, rowData, rowIndex, colIndex){}")
}
quotedLevels <- toString(sprintf("\"%s\"", levels))
c(
"function(td, cellData, rowData, rowIndex, colIndex){",
sprintf(" $(td).attr('data-levels', '[%s]');", quotedLevels),
"}"
)
}
ui <- fluidPage(
tags$head(
tags$link(
rel = "stylesheet",
href = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.8.0/jquery.contextMenu.min.css"
),
tags$script(
src = "https://cdnjs.cloudflare.com/ajax/libs/jquery-contextmenu/2.8.0/jquery.contextMenu.min.js"
)
),
DTOutput("dtable")
)
server <- function(input, output){
output[["dtable"]] <- renderDT({
datatable(
iris, editable = "cell", callback = JS(callback),
options = list(
columnDefs = list(
list(
targets = 5,
className = "factor",
createdCell = JS(createdCell(c(levels(iris$Species), "another level")))
)
)
)
)
}, server = FALSE)
}
shinyApp(ui, server)```