Update a dataset after putting a new value in the dt::datatable
As far as I get it the filter for the datatable columns gets deactivated when a column contains only one value, i.e. that's not specific to NAs. The same occurs if you replace the NAs by empty strings or e.g. an a. Unfortunately I wasn't able to find anything on this behavior in the documentation.
However, to activate the filter after you edited a cell you could follow the example app referenced in Section 2.4 of the docs. Following the example you could add an observeEvent to update your dataset d to take account of the editing. Additionally to ensure that the datatable gets updated I made renderDataTable reactive on input$TABLE_cell_edit. After doing so that datatable gets updated after an edit and the filter gets activated automatically:
library(shiny)
library(shinydashboard)
library(DT)
d <- structure(list(owner = c(
"7 MILL IRON RANCH LLC", "7/S LAND & CATTLE COMPANY LLC",
"AHL/KENNETH L(TRUSTEE & JOHN E AHL ETAL"
), acres = c(
1900.6207117,
654.7908393, 641.3866548
), n = c(5L, 2L, 1L), landman = c(
NA_character_,
NA_character_, NA_character_
)), row.names = c(NA, -3L), class = c(
"tbl_df",
"tbl", "data.frame"
))
#d$landman <- letters[1:3]
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
dataTableOutput("TABLE"),
)
)
server <- (function(input, output, session) {
observeEvent(input$TABLE_cell_edit, {
d <<- editData(d, input$TABLE_cell_edit, 'TABLE')
})
output$TABLE <- renderDataTable({
input$TABLE_cell_edit
datatable(d,
filter = "top", editable = "cell", class = "hover cell-border stripe",
caption = "Owners wit more than 500 aggregated accrs",
extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = c("copy", "csv", "excel")
)
)
})
})
shinyApp(ui, server)
In Shiny, update DataTable with new values from user input
You can render the result of eventReactive, where you return the updated dataset. Don't forget to use <<- to modify the global dataset as well:
server = function(input,output){
output$table <- renderDataTable( df())
df <- eventReactive(input$goButton, {
if(input$NewID!="" && !is.null(input$NewVal) && input$goButton>0){
newrow = data.table(id = input$NewID,
val = input$NewVal)
mydata <<- rbind(mydata, newrow)
}
mydata
}, ignoreNULL = FALSE)
}
Updating column total after manually changing value in child table cell R Shiny
Here is a solution with a footer and the footerCallback option. But it does not handle the columns with a "$".
df1 <- iris[1:3,]
df2 <- data.frame(
Daypart = c("Morning", "Afternoon", "Evening"),
X1 = c(3, 2, 4),
X2 = c(10, 20, 30),
stringsAsFactors = FALSE
)
# function to make the required dataframe
NestedData <- function(dat, children){
stopifnot(length(children) == nrow(dat))
g <- function(d){
if(is.data.frame(d)){
purrr::transpose(d)
}else{
purrr::transpose(NestedData(d[[1]], children = d$children))
}
}
subdats <- lapply(children, g)
oplus <- sapply(subdats, function(x) if(length(x)) "⊕" else "")
cbind(" " = oplus, dat, "_details" = I(subdats), stringsAsFactors = FALSE)
}
# make the required dataframe
# one must have: length(children) == nrow(dat)
Dat <- NestedData(
dat = df1,
children = list(df2, df2, df2)
)
## whether to show row names (set TRUE or FALSE)
rowNames <- FALSE
colIdx <- as.integer(rowNames)
## make the callback
parentRows <- which(Dat[,1] != "")
callback = JS(
"function onUpdate(updatedCell, updatedRow, oldValue) {};",
"table.MakeCellsEditable({",
" onUpdate: onUpdate,",
" inputCss: 'my-input-class',",
" confirmationButton: {",
" confirmCss: 'my-confirm-class',",
" cancelCss: 'my-cancel-class'",
" }",
"});",
sprintf("var parentRows = [%s];", toString(parentRows-1)),
sprintf("var j0 = %d;", colIdx),
"var nrows = table.rows().count();",
"for(var i=0; i < nrows; ++i){",
" if(parentRows.indexOf(i) > -1){",
" table.cell(i,j0).nodes().to$().css({cursor: 'pointer'});",
" }else{",
" table.cell(i,j0).nodes().to$().removeClass('details-control');",
" }",
"}",
"",
"// make the table header of the nested table",
"var format = function(d, childId){",
" if(d != null){",
" var html = ",
" '<table class=\"display compact hover\" ' + ",
" 'style=\"padding-left: 30px;\" id=\"' + childId + '\"><thead><tr>';",
" for(var key in d[d.length-1][0]){",
" html += '<th>' + key + '</th>';",
" }",
" html += '</tr></thead><tfoot><tr>'",
" for(var key in d[d.length-1][0]){",
" html += '<th></th>';",
" }",
" return html + '</tr></tfoot></table>';",
" } else {",
" return '';",
" }",
"};",
"",
"// row callback to style the rows of the child tables",
"var rowCallback = function(row, dat, displayNum, index){",
" if($(row).hasClass('odd')){",
" $(row).css('background-color', 'papayawhip');",
" $(row).hover(function(){",
" $(this).css('background-color', '#E6FF99');",
" }, function() {",
" $(this).css('background-color', 'papayawhip');",
" });",
" } else {",
" $(row).css('background-color', 'lemonchiffon');",
" $(row).hover(function(){",
" $(this).css('background-color', '#DDFF75');",
" }, function() {",
" $(this).css('background-color', 'lemonchiffon');",
" });",
" }",
"};",
"",
"// header callback to style the header of the child tables",
"var headerCallback = function(thead, data, start, end, display){",
" $('th', thead).css({",
" 'border-top': '3px solid indigo',",
" 'color': 'indigo',",
" 'background-color': '#fadadd'",
" });",
"};",
"",
"// footer callback to display the totals",
"var footerCallback = function(tfoot, data, start, end, display){",
" $('th', tfoot).css('background-color', '#fed8b1');",
" var api = this.api();",
" api.columns().eq(0).each(function(index){",
" if(index == 0) return $(api.column(index).footer()).html('Total');",
" var coldata = api.column(index).data();",
" var total = coldata",
" .reduce(function(a, b){return parseFloat(a) + parseFloat(b)}, 0);",
" $(api.column(index).footer()).html(total);",
" })",
"}",
"",
"// make the datatable",
"var format_datatable = function(d, childId){",
" var dataset = [];",
" var n = d.length - 1;",
" for(var i = 0; i < d[n].length; i++){",
" var datarow = $.map(d[n][i], function (value, index) {",
" return [value];",
" });",
" dataset.push(datarow);",
" }",
" var id = 'table#' + childId;",
" if (Object.keys(d[n][0]).indexOf('_details') === -1) {",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'footerCallback': footerCallback,",
" 'columnDefs': [{targets: '_all', className: 'dt-center'}]",
" });",
" } else {",
" var subtable = $(id).DataTable({",
" 'data': dataset,",
" 'autoWidth': true,",
" 'deferRender': true,",
" 'info': false,",
" 'lengthChange': false,",
" 'ordering': d[n].length > 1,",
" 'order': [],",
" 'paging': false,",
" 'scrollX': false,",
" 'scrollY': false,",
" 'searching': false,",
" 'sortClasses': false,",
" 'rowCallback': rowCallback,",
" 'headerCallback': headerCallback,",
" 'footerCallback': footerCallback,",
" 'columnDefs': [",
" {targets: -1, visible: false},",
" {targets: 0, orderable: false, className: 'details-control'},",
" {targets: '_all', className: 'dt-center'}",
" ]",
" }).column(0).nodes().to$().css({cursor: 'pointer'});",
" }",
" subtable.MakeCellsEditable({",
" onUpdate: onUpdate,",
" inputCss: 'my-input-class',",
" confirmationButton: {",
" confirmCss: 'my-confirm-class',",
" cancelCss: 'my-cancel-class'",
" }",
" });",
"};",
"",
"// display the child table on click",
"table.on('click', 'td.details-control', function(){",
" var tbl = $(this).closest('table'),",
" tblId = tbl.attr('id'),",
" td = $(this),",
" row = $(tbl).DataTable().row(td.closest('tr')),",
" rowIdx = row.index();",
" if(row.child.isShown()){",
" row.child.hide();",
" td.html('⊕');",
" } else {",
" var childId = tblId + '-child-' + rowIdx;",
" row.child(format(row.data(), childId)).show();",
" td.html('⊖');",
" format_datatable(row.data(), childId);",
" }",
"});")
## the datatable
dtable <- datatable(
Dat, callback = callback, rownames = rowNames, escape = -colIdx-1,
options = list(
columnDefs = list(
list(visible = FALSE, targets = ncol(Dat)-1+colIdx),
list(orderable = FALSE, className = 'details-control', targets = colIdx),
list(className = "dt-center", targets = "_all")
)
)
)
path <- "~/Work/R/DT" # folder containing the files dataTables.cellEdit.js
# and dataTables.cellEdit.css
dep <- htmltools::htmlDependency(
"CellEdit", "1.0.19", path,
script = "dataTables.cellEdit.js", stylesheet = "dataTables.cellEdit.css")
dtable$dependencies <- c(dtable$dependencies, list(dep))
dtable
How can I add a new column and data to a datatable that already contains data?
Just keep going with your code - you're on the right track:
//call SQL helper class to get initial data
DataTable dt = sql.ExecuteDataTable("sp_MyProc");
dt.Columns.Add("NewColumn", typeof(System.Int32));
foreach(DataRow row in dt.Rows)
{
//need to set value to NewColumn column
row["NewColumn"] = 0; // or set it to some other value
}
// possibly save your Dataset here, after setting all the new values
Update datatable based on user input, include update of corresponding columns, not just the one edited
The problem is how you pass the reactive data to your custom render_dt. I'm not completely sure why, but changes to reactivs$ex_df are not recognised. The changes you see in the x column are not due to the updated ex_df, but the changes directly made in the table. Therefore, I changed it back to using renderDT directly. I've made some additional changes:
ex_dfitself is not reactive. It is stored in areactiveValuesobject, where every entry itself is already reactive.- assignments to
reactiveValuesdon't need<<- - the edited value in
cell_editis a character vector
library(shiny)
library(tidyverse)
library(shinydashboard)
library(scales)
library(DT)
# define functions
## generate example data
create_sample_df <- function(x) {
data.frame(
x = x %>% unlist
) %>% mutate(y = x + 1)
}
# UI ----
header <- dashboardHeader(title = 'blah')
sidebar <- dashboardSidebar()
body <- dashboardBody(DT::DTOutput('ex_df'))
ui <- dashboardPage(header, sidebar, body)
# Server ----
server <- function(input, output) {
x <- rnorm(10, 0, 2) %>% as.integer %>% as.list
# the df to be displayed as a DT::datatable.
ex_df <- create_sample_df(x)
## set to initially be the on open result of ex_df, before any user input
reactivs <- reactiveValues(ex_df = ex_df)
observeEvent(input$ex_df_cell_edit, {
info = input$ex_df_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
# update budgets, which in turn is used to generate data during create_sample_df()
x[[i]] <<- as.numeric(v)
# now update the reactive values object with the newly generated df
reactivs$ex_df <- create_sample_df(x)
})
output$ex_df <- renderDT({
datatable(reactivs$ex_df,
editable = "cell",
rownames = FALSE,
options = list(target = 'cell',
disable = list(columns = c(1))))
})
}
shinyApp(ui, server)
Edit
here a solution without observeEvent and only a reactive() for ex_df. Then you can pass the unevaluated reactive to your render_dt function:
library(shiny)
library(tidyverse)
library(shinydashboard)
library(scales)
library(DT)
# define functions
## generate example data
create_sample_df <- function(x) {
data.frame(
x = x %>% unlist
) %>% mutate(y = x + 1)
}
## render DT
render_dt = function(data_in, editable = 'cell', server = TRUE, ...) {
renderDT(data_in(), selection = 'none', server = server, editable = editable, ...)
}
# UI ----
header <- dashboardHeader(title = 'blah')
sidebar <- dashboardSidebar()
body <- dashboardBody(DT::DTOutput('ex_df'))
ui <- dashboardPage(header, sidebar, body)
# Server ----
server <- function(input, output) {
x <- rnorm(10, 0, 2) %>% as.integer %>% as.list
# the df to be displayed as a DT::datatable.
setup_df <- create_sample_df(x)
ex_df <- eventReactive(input$ex_df_cell_edit, {
# on startup
if (is.null(input$ex_df_cell_edit)) {
setup_df
# for edits
} else {
info = input$ex_df_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
# update budgets, which in turn is used to generate data during create_sample_df()
x[[i]] <<- as.numeric(v)
create_sample_df(x)
}
},
ignoreNULL = FALSE)
output$ex_df <- render_dt(data_in = ex_df,
rownames = FALSE,
list(target = 'cell',
disable = list(columns = c(1))))
}
shinyApp(ui, server)
keep selected rows when changing dataset in shiny DT datatable
You can save selected rows only when going to change df like
server <- function(input, output, session) {
dd=reactiveValues(select=NULL)
observeEvent(input$dataset,{
dd$select=as.numeric(isolate(input$name_table_rows_selected))
})
getDataset <- reactive({
result <- list()
result[['dataset']] <- switch(input$dataset,
'df1'=df1,
'df2'=df2)
return(result)
})
output$name_table <- DT::renderDataTable({
DT::datatable(getDataset()[['dataset']],
options=list(pageLength=5),
selection = list(mode = 'multiple', selected =dd$select )
)
})
name_proxy = DT::dataTableProxy('name_table')
}
shinyApp(ui, server)
Or a bit modification of @drmariod variant: use eventReactive instead of reactive
server <- function(input, output, session) {
getDataset <- eventReactive(input$dataset,{
result <- list()
result[['dataset']] <- switch(input$dataset,
'df1'=df1,
'df2'=df2)
result[['selection']] <- testing()
return(result)
})
testing <- function() {
list(selected=as.numeric(input$name_table_rows_selected))
}
output$name_table <- DT::renderDataTable({
DT::datatable(getDataset()[['dataset']],
options=list(pageLength=5),
selection=getDataset()[['selection']])
})
name_proxy = DT::dataTableProxy('name_table')
}
Update row(s) of a Shiny DataTable while maintaining position
This can be done from inside R without getting into the structure of the datatable through JS or something like that.
We utilize the various table state information we get from the DT package to render the new updated datatable like the one before. Everything we use is discribed in this DT documentation.
Item one: Selection. You can pre-select rows by adding selected = ... inside the selection argument of the datatable. This can be combined with the variable input$table_rows_selected to save the previously selected row and pre-select that exact row on re-rendering.
Item two: Page. The datatable package has an option displayStart that specifies which row should be shown first when rendering the table. Documentation here. So, if you have 5 rows per page, displayStart = 9 would start the display on page 3. (JavaScript arrays start at 0, so always subtract 1.) This can be combined with input$table_rows_current which is a vector of currently visible row numbers. If we store the first entry (minus 1), we know where to start the display.
Full code example below:
library(shiny)
runApp(shinyApp(
ui = fluidPage(
title = "minimal-working-example",
fluidRow(
column(3, inputPanel(
selectInput("field", "Field", choices = names(mtcars)),
numericInput("value", "Value", 0),
actionButton("submit", "Submit")
)),
column(9,
DT::dataTableOutput("table")
)
)
),
server = function(input, output) {
v <- reactiveValues(mtcars=mtcars)
previousSelection <- NULL
previousPage <- NULL
observeEvent(input$submit, {
previousSelection <<- input$table_rows_selected
previousPage <<- input$table_rows_current[1] - 1
v$mtcars[input$field] <- input$value
})
output$table <- DT::renderDataTable({
DT::datatable(
v$mtcars,
selection = list(mode = "single", target = "row", selected = previousSelection),
options = list(pageLength = 5, displayStart = previousPage))
})
}
))
Related Topics
Find Locations Within Certain Lat/Lon Distance in R
Generating Multiple Plots in Ggplot by Factor
Geom_Density to Match Geom_Histogram Binwitdh
Why Is Subsetting on a "Logical" Type Slower Than Subsetting on "Numeric" Type
Writing Data Frame to PDF Table
How to Return 5 Topmost Values from Vector in R
First Day of the Month from a Posixct Date Time Using Lubridate
Should I Avoid Programming Packages with Pipe Operators
How to Find Common Rows Between Two Dataframe in R
In R, How to Check If Two Variable Names Reference the Same Underlying Object
Rjava Linker Error Licuuc with Anaconda & Fopenmp Error Without Anaconda for MACos Sierra 10.12.4
Substitute Dt1.X with Dt2.Y When Dt1.X and Dt2.X Match in R