I'm stumped on a three part process:
The example app below does 1 and 2, but not 3. After I make an edit AND click the only_johns checkbox, the dataTable displays the original data.
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
sidebarMenu(
downloadButton("downloadResults","Download Results"),
checkboxInput("only_johns", "only_johns")
)
)
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'admin', class = 'active',
fluidRow(
box(
dataTableOutput('userTable'), width = 6
)
)
)
)
)
ui <- dashboardPage(title = 'admin function test', header, sidebar, body)
server <- function(input, output, session){
#1
start.df <- reactiveValues(data=NA)
start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
id = 1:60, stringsAsFactors = FALSE)
#2 temp display filters df
display.df <- reactiveValues(data=start.df)
observe({
temp <- isolate(start.df$data)
if (input$only_johns) {
display.df$data <- temp[temp$userName == "John",]
} else {
display.df$data <- temp
}
})
# Display editable datatable
output$userTable <- renderDataTable({
req(display.df$data)
DT::datatable(isolate(display.df$data),
editable = TRUE,
rownames = FALSE)
})
###Tracking Changes###
proxy = dataTableProxy('userTable')
observe({
DT::replaceData(proxy, display.df$data, rownames = FALSE, resetPaging = FALSE)
})
observeEvent(input$userTable_cell_edit, {
display.df$data <<- editData(display.df$data, input$userTable_cell_edit, rownames = FALSE)
})
output$downloadResults <- downloadHandler(
filename = function(){paste("userTest.csv", sep = "")},
content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
)
}
shinyApp(ui = ui, server = server)
So far you only update the diplay.df$data
, but you need to update the original start.df$data
. I've included this in my solution, to find the correct row irrespective of the current filtering, I've introduced the column row_id
that is hidden in the DT. Also, I've simplified your code a bit.
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
sidebarMenu(
downloadButton("downloadResults","Download Results"),
checkboxInput("only_johns", "only_johns")
)
)
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'admin', class = 'active',
fluidRow(
box(
dataTableOutput('userTable'), width = 6
)
)
)
)
)
ui <- dashboardPage(title = 'admin function test', header, sidebar, body)
server <- function(input, output, session){
#1
start.df <- reactiveValues(data=NA)
start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
id = 1:60,
row_id = 1:60,
stringsAsFactors = FALSE)
#2 temp display filters df
display.df <- reactiveValues(data=start.df)
observeEvent(input$only_johns, {
temp <- isolate(start.df$data)
if (input$only_johns) {
display.df$data <- temp[temp$userName == "John",]
} else {
display.df$data <- temp
}
})
# Display editable datatable
output$userTable <- renderDataTable({
req(display.df$data)
DT::datatable(isolate(display.df$data),
editable = TRUE,
rownames = FALSE,
options = list(
columnDefs = list(
list(
visible = FALSE,
targets = 2
)
)
))
})
###Tracking Changes###
proxy = dataTableProxy('userTable')
observeEvent(input$userTable_cell_edit, {
display.df$data <- editData(display.df$data, input$userTable_cell_edit, rownames = FALSE)
DT::replaceData(proxy, display.df$data, rownames = FALSE, resetPaging = FALSE)
# update the data in the original df
# get the correct row_id
curr_row_id <- display.df$data[input$userTable_cell_edit[["row"]], "row_id", drop = TRUE]
# get the correct column position
column_pos <- input$userTable_cell_edit[["col"]] + 1 # DT starts indexing at 0
# update the data
temp <- start.df$data
temp[temp$row_id == curr_row_id, column_pos] <- input$userTable_cell_edit[["value"]]
start.df$data <- temp
})
output$downloadResults <- downloadHandler(
filename = function(){paste("userTest.csv", sep = "")},
content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
)
}
shinyApp(ui, server)
Here is a version where the page gets not reset. The problem was that with the edited data, display.df$data
was changed, which triggered the rerendering of output$userTable
and this resetted the page. To circumvent this, I've added another reactive value that contains the edited data and don't change display.df
anymore, it is only changed by changing the input filtering.
library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)
header <- dashboardHeader(title = "demo")
sidebar <- dashboardSidebar(
sidebarMenu(
downloadButton("downloadResults","Download Results"),
checkboxInput("only_johns", "only_johns")
)
)
body <- dashboardBody(
tabItems(
tabItem(
tabName = 'admin', class = 'active',
fluidRow(
box(
dataTableOutput('userTable'), width = 6
)
)
)
)
)
ui <- dashboardPage(title = 'admin function test', header, sidebar, body)
server <- function(input, output, session){
#1
start.df <- reactiveValues(data=NA)
start.df$data <- data.frame(userName = rep(c("John","Ida","Mike"),20),
id = 1:60,
row_id = 1:60,
stringsAsFactors = FALSE)
#2 temp display filters df
display.df <- reactiveValues(data=isolate(start.df))
edit.df <- reactiveValues(data = isolate(start.df))
observeEvent(input$only_johns, {
temp <- isolate(start.df$data)
if (input$only_johns) {
display.df$data <- temp[temp$userName == "John",]
edit.df$data <- temp[temp$userName == "John",]
} else {
display.df$data <- temp
edit.df$data <- temp
}
})
# Display editable datatable
output$userTable <- renderDataTable({
req(display.df$data)
DT::datatable(display.df$data,
editable = TRUE,
rownames = FALSE,
options = list(
columnDefs = list(
list(
visible = FALSE,
targets = 2
)
)
))
})
###Tracking Changes###
proxy = dataTableProxy('userTable')
observeEvent(input$userTable_cell_edit, {
edit.df$data <- editData(edit.df$data, input$userTable_cell_edit, rownames = FALSE)
DT::replaceData(proxy, edit.df$data, rownames = FALSE, resetPaging = FALSE)
# update the data in the original df
# get the correct row_id
curr_row_id <- edit.df$data[input$userTable_cell_edit[["row"]], "row_id", drop = TRUE]
# get the correct column position
column_pos <- input$userTable_cell_edit[["col"]] + 1 # DT starts indexing at 0
# update the data
temp <- start.df$data
temp[temp$row_id == curr_row_id, column_pos] <- input$userTable_cell_edit[["value"]]
start.df$data <- temp
})
output$downloadResults <- downloadHandler(
filename = function(){paste("userTest.csv", sep = "")},
content = function(file){write.csv(start.df$data, file, row.names = FALSE)}
)
}
shinyApp(ui, server)