I am trying to edit data table and update the records post row editing on click of action button "Update Table". How to retrive/display new Data table records reactively post modifying fields in existing Data table record?
library(shiny)
library(shinyjs)
library(DT)
library(data.table)
mydata = data.frame(id=letters[1:5], val=sample(10,5,T))
lengthofData <- nrow(mydata)
mydata[["Constraint Type"]] <- c(">")
))
mydata[["Constraint Value"]] <- c(1)
ui = fluidPage(dataTableOutput("table"),
actionButton("goButton", "Update Table"),
dataTableOutput("newtable"))
server = function(input,output){
x <- mydata
output$table <- renderDataTable( x,server = FALSE,
escape = FALSE,
selection = 'none')
proxy = dataTableProxy('table')
xNew<-reactiveValues()
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col + 1
v = info$value
x[i, j] <<- DT:::coerceValue(v, x[i, j])
replaceData(proxy, x, resetPaging = FALSE, rownames = FALSE)
xNew<<-x
})
observeEvent(input$goButton,{
output$newtable <- renderDataTable( xNew(),server = FALSE,
escape = FALSE,
selection = 'none')
})
}
shinyApp(ui,server)
Related
edit: Here is the solution to the original problem. I found it after scouring stack and the other part, persistent filters was found on a blog. May anyone who finds this never have to suffer like I have.
source_data <-
iris %>%
mutate(Species = as.factor(Species))
source_data$Date <- Sys.time() + seq_len(nrow(source_data))
# default global search value
if (!exists("default_search")) default_search <- ""
# default column search values
if (!exists("default_search_columns")) default_search_columns <- NULL
shinyApp(
ui = fluidPage(
DT::dataTableOutput('dataTable')
),
server = function(input, output, session) {
reactive_values <- reactiveValues(source_data = NULL)
observe({
reactive_values$source_data <- source_data
})
output$dataTable <- DT::renderDataTable(
reactive_values$source_data,
editable = list(target = "cell", disable = list(columns = c(1, 2))),
filter = "top",
selection = 'none',
options = list(
scrollX = TRUE,
stateSave = FALSE,
searchCols = default_search_columns,
search = list(
regex = FALSE,
caseInsensitive = FALSE,
search = default_search
)
)
)
proxy <- dataTableProxy('dataTable')
observe({
input$dataTable_cell_edit
# when it updates, save the search strings so they're not lost
isolate({
# update global search and column search strings
default_search <- input$dataTable_search
default_search_columns <- c("", input$dataTable_search_columns)
# update the search terms on the proxy table (see below)
proxy %>%
updateSearch(keywords =
list(global = default_search,
columns = default_search_columns))
})
})
observeEvent(input$dataTable_cell_edit, {
info = input$dataTable_cell_edit
str(info)
i <- info$row
j <- info$col
v <- info$value
reactive_values$source_data[i, j] <<- DT:::coerceValue(v, reactive_values$source_data[i, j])
source_data[i, j] <<- DT:::coerceValue(v, reactive_values$source_data[i, j])
replaceData(proxy, source_data, resetPaging = FALSE, rownames = FALSE)
})
}
)
I have spent days trying to find just the right solution to this problem and while I've seen many discussions nothing quite "works" how I need it to.
I need my solution to meet these requirements;
the table is editable
There are filters that are reactive to the contents of the table
When new values are entered into the table the edits are a) saved into the data b) reflected in the filters
I've tried DT while it has the nicest looking output I couldn't get the DT filters to update and if you made an edit and filtered the table the edit would be reverted.
rHandsOnTable had a better looking edit option but same issues as above.
dqshiny, an augment for rHandsonTable enables me to save the data and it updates the filter, but the filter options weren't good, the "select" input doesn't seem let me select nothing to display all results. And because my actual data has a lot of text in each box as I horizontally scroll the height of the cells change and this makes the filters and cell widths desync.
With that said here is what I've tried, I hope someone can help me figure out
### DT that doesn't update filters but saves content
shinyApp(
ui = fluidPage(
DT::dataTableOutput('x1')
),
server = function(input, output, session) {
x = iris
x$Date = Sys.time() + seq_len(nrow(x))
output$x1 = DT::renderDataTable(x, editable = TRUE, filter = "top", selection = 'none', rownames = FALSE)
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col + 1
v = info$value
x[i, j] <<- DT:::coerceValue(v, x[i, j])
replaceData(proxy, x, resetPaging = FALSE, rownames = FALSE)
})
}
)
dqShiny "works" but in my full dataset when I set each column's filter type something must be wrong with how it processes the data because it's discarding a lot of rows out of hand and I can't figure out why. Also can't turn off filters for specific columns. all or nothing as far as I can tell.
# library(tidyverse)
# library(shiny)
# library(rhandsontable)
# install.packages("remotes")
# library(remotes)
# remotes::install_github("daqana/dqshiny")
# library(dqshiny)
shinyApp(
ui = fluidPage(
dq_handsontable_output("randomTable", 9L)
),
server = function(input, output, session) {
hw <- c("Hello", "my", "funny", "world!")
data <- data.frame(A = rep(hw, 500), B = hw[c(2,3,4,1)],
C = 1:500, D = Sys.Date() - 0:499, stringsAsFactors = FALSE)
dq_render_handsontable(
"randomTable",
data = data,
width_align = TRUE,
filters = c("Select"),
table_param =
list(
height = 800,
readOnly = TRUE,
stretchH = "all",
highlightCol = TRUE,
highlightRow = TRUE
),
col_param =
list(
list(col = c("A", "B"), readOnly = FALSE, colWidths = "100%"),
list(col = c("C", "D"), colWidths = 300)
),
horizontal_scroll = TRUE
)
}
)
and then simple hands on table that I can't get to work even a little.
shinyApp(
ui = fluidPage(
rHandsontableOutput("randomTable")
),
server = function(input, output, session) {
hw <- c("Hello", "my", "funny", "world!")
data <- data.frame(
A = rep(hw, 500),
B = hw[c(2, 3, 4, 1)],
C = 1:500,
D = Sys.Date() - 0:499,
stringsAsFactors = FALSE
)
output$randomTable <- renderRHandsontable({
data %>%
rhandsontable(
height = 800,
readOnly = TRUE,
stretchH = "all",
colWidths = "100%"
) %>%
hot_col(c("A", "B"), readOnly = FALSE) %>%
hot_col(c("C", "D"), colWidths = 300) %>%
hot_table(highlightCol = TRUE, highlightRow = TRUE)
})
}
)
Perhaps you are looking for this
### DT updates filters
shinyApp(
ui = fluidPage(
DT::dataTableOutput('x1')
),
server = function(input, output, session) {
dfx <- reactiveValues(data=NULL)
observe({
x <- iris
x$Date = Sys.time() + seq_len(nrow(x))
dfx$data <- x
})
output$x1 = renderDT(dfx$data, editable = TRUE, filter = "top", selection = 'none', rownames = FALSE)
#proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col + 1
v = info$value
dfx$data[i, j] <<- DT:::coerceValue(v, dfx$data[i, j])
#replaceData(proxy, x, resetPaging = FALSE, rownames = FALSE)
})
}
)
I am trying to develop a shiny app that will allow users to add, delete and save edits to a DT table with the editable settings enabled. However for some reason I am not being able to add a row. Anybody has any clues as to why this is happening?
I am using the iris dataset as an example. (saveRDS(iris,"iris.rds"))
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1'),
actionButton("save", "Save Table"),
actionButton("add_btn","Add Button")
),
server = function(input, output, session) {
x <- readRDS("iris.rds")
output$x1 = renderDT(x, selection = 'none', editable = TRUE)
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
x[i, j] <<- DT::coerceValue(v, x[i, j])
replaceData(proxy, x, resetPaging = FALSE) })
observeEvent(input$add_btn,
{newrow <- setNames(data.frame(matrix(ncol = ncol(x), nrow = 1)),
colnames(x))
x<<-rbind(x,newrow)})
observeEvent(input$save,
{saveRDS(x, "iris.rds")
})
}
)
You were using values$data an unknown data.frame instead of using x, and u weren't updating the DT output using the replaceData function:
observeEvent(input$add_btn,
{ newrow <- setNames(data.frame(matrix(ncol = ncol(x), nrow = 1)),
colnames(x))
x<<-rbind(x,newrow)
replaceData(proxy, x, resetPaging = F)
})
I have created an application using reactiveValues to populate the datatable similar to the response here R Shiny DT - edit values in table with reactive
What I cannot seem to figure out is after editing the table it resets to the first page. This does not happen when the datatable is not created from a reactiveValues table.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1'),
verbatimTextOutput("print")
),
server = function(input, output, session) {
x = reactiveValues(df = NULL)
observe({
df <- iris
df$Date = Sys.time() + seq_len(nrow(df))
x$df <- df
})
output$x1 = renderDT(x$df, selection = 'none', editable = TRUE)
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
x$df[i, j] <- isolate(DT::coerceValue(v, x$df[i, j]))
replaceData(proxy, x(), resetPaging = FALSE) # important I have tried with and without this line no impact on page resetting
})
output$print <- renderPrint({
x$df
})
}
)
I wanted to share that I figured out how to solve this, still a little confused as to why it was so complicated but if anyone else has the same issue.
x = reactiveValues(df = NULL)
x$df2 = NULL
#Tells which data to pull based on how the OSC list is populated
FundData <- observe({
if(input$SelectFunds == 'None Selected'){
x$df <- head(QDataAnalystSummary,0)
}else if(input$SelectFunds == 'Load OSC List'){
tmp_funds <- subset(QDataAnalystSummary,as.character(QDataAnalystSummary$OSC) %in% as.character(OSCData()$OSC))
tmp_funds <- subset(tmp_funds,tmp_funds$`Quarter End` == CurrentQtr)
tmp_funds_new <- NULL
for(i in 1:nrow(OSCData())){
tmp_fd <- subset(tmp_funds,tmp_funds$OSC == OSCData()$OSC[i])
tmp_funds_new <- rbind(tmp_funds_new,tmp_fd)
}
tmp_funds_new
x$df <- tmp_funds_new
x$df2 <- tmp_funds_new
}
else if(input$SelectFunds == 'Search By Analyst'){
tmp_funds5 <- subset(QDataAnalystSummary,QDataAnalystSummary$Analyst %in% input$Analyst)
tmp_funds5 <- subset(tmp_funds5,tmp_funds5$`Quarter End` == CurrentQtr)
x$df <- tmp_funds5
})
#Summary Table showing general fund info and current quarter stats for IC Meeting Funds
output$summary_ic <- DT::renderDT({
QDAW <- subset(QDataAnalystSummary,QDataAnalystSummary$OSC %in% OSCData()$OSC & QDataAnalystSummary$`Quarter End` ==CurrentQtr)
if(nrow(QDAW) >= 1){
QDAW$Notes <- ''
QDAW_new <- NULL
for(i in 1:nrow(OSCData())){
tmp_fd <- subset(QDAW,QDAW$OSC == OSCData()$OSC[i])
QDAW_new <- rbind(QDAW_new,tmp_fd)
}
QDAW <- QDAW_new
}
datatable(QDAW,
rownames = FALSE,caption = "Current Quarter Data",
filter = "top",extensions = c('Buttons','ColReorder'),editable = list(target = 'cell',disable = list(columns=c(0:9))),
options = list(initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color':'rgb(85,114,138)','color': '#fff'});","}"),
autoWidth = TRUE,
columnDefs = list(list(width = '2%', targets = list(0,1,6,7,8,9)),
# list(width = '20%', targets = list()),
list(className = 'dt-center',targets = c(1,5,6,7,8,9)),
list(visible = FALSE, targets = c(0,5,8,9))
)
,resetPaging = FALSE,
bFilter = 1,bSortClasses = 1,
aLengthMenu = list(c(10,20,50, -1), list('10','20','50','All')),iDisplayLength = 10,
searchHighlight = TRUE,
dom = 'Blfrtip',buttons = c('colvis','excel','copy'),colReorder= TRUE,
scrollX = TRUE,
# scrollY = "1000px",
fixedHeader = TRUE,
paging=TRUE,server = TRUE))%>%
formatRound('Trailing Average', 2) %>%
formatStyle('Trailing Average',
color = 'white',
background = styleInterval(c(50,75),c('green','orange','red'))) %>%
formatCurrency('AUM')
})
proxy = dataTableProxy('summary_ic')
observeEvent(input$summary_ic_cell_edit, {
info = input$summary_ic_cell_edit
str(info)
i = info$row
j = info$col + 1 # column index offset by 1
v = info$value
x$df2[i, j] <<- isolate(DT::coerceValue(v, x$df2[i, j]))
replaceData(proxy, x$df2, resetPaging = FALSE, rownames = FALSE)
})
shinyApp(
ui = fluidPage(
DTOutput('x1')
),
server = function(input, output, session) {
x = iris
output$x1 = renderDT(x, selection = 'none', editable = list(target = 'row', disable = list(columns=c(1,3,4))))
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
x[i, j] <<- DT::coerceValue(v, x[i, j])
replaceData(proxy, x, resetPaging = FALSE) # important
})
}
)
I obtain the following warnings:
Warning in DT::coerceValue(v, x[i, j]) :
The data type is not supported: data.frame
Warning: Error in [[: attempt to select less than one element in integerOneIndex
How do I make sure coerceValue is editing and saving my new input?
Quick question: you seem to be using most of the example from here but not all. Is there a reason for that? You could use the code there, as below, which is simpler:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1')
),
server = function(input, output, session) {
x = iris
output$x1 = renderDT(x, selection = 'none', editable = list(target = 'cell', disable = list(columns=c(1,3,4))))
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
x <<- editData(x, info)
replaceData(proxy, x, resetPaging = FALSE) # important
})
}
)
PS: target = "cell" as mentioned by Stéphane Laurent.
Is it possible to update a reactive data source by editing the DT::DataTable? Below code is based on this code with change that x is made reactive. The problem starts when trying to change x in observeEvent.
The purpose of having x reactive is that I intend to source it from an external database, then have edits to the DT::DataTable write back to the database so that it stays in sync with what the user sees (I'm fine with doing that - it is not part of the question).
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1')
),
server = function(input, output, session) {
x = reactive({
df <- iris
df$Date = Sys.time() + seq_len(nrow(df))
df
})
output$x1 = renderDT(x(), selection = 'none', editable = TRUE)
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
# problem starts here
x()[i, j] <<- isolate(DT::coerceValue(v, x()[i, j]))
replaceData(proxy, x(), resetPaging = FALSE) # important
})
}
)
I am not sure if I understand you correctly, but maybe this solution might help you a bit. I changed your reactive into a reactiveValues object and I removed the replaceData line.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1'),
verbatimTextOutput("print")
),
server = function(input, output, session) {
x = reactiveValues(df = NULL)
observe({
df <- iris
df$Date = Sys.time() + seq_len(nrow(df))
x$df <- df
})
output$x1 = renderDT(x$df, selection = 'none', editable = TRUE)
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
# problem starts here
x$df[i, j] <- isolate(DT::coerceValue(v, x$df[i, j]))
})
output$print <- renderPrint({
x$df
})
}
)
If you don't show the row names in your DT then you should add 1 to info$col to get the correct column i.e., j = info$col + 1.