Related
I have a Shiny app with a Bookmark button and a DT table that allow the users to edit the contents (https://yuchenw.shinyapps.io/DT_Bookmark/). However, it seems like the Bookmark function cannot document the edited contents in the DT table.
Here is an example. I changed the car name in the first row to "Mazda RX4 aaaaa", and then I clicked "Bookmark button". It can generate an URL. But when I copied and pasted the URL to a new browser, it shows the original state of the app.
Is there a way to make the Bookmark function working? Here is the code.
library(shiny)
library(DT)
ui <- fluidPage(
titlePanel("Bookmark DT Example"),
sidebarLayout(
sidebarPanel(
bookmarkButton()
),
mainPanel(
DTOutput(outputId = "mDT")
)
)
)
server <- function(input, output){
rev <- reactiveValues(dat = mtcars)
output$mDT <- renderDT(
mtcars,
rownames = TRUE,
selection = "none",
editable = TRUE
)
dat_proxy <- dataTableProxy("mDT")
observeEvent(input$mDT_cell_edit, {
rev$dat <- editData(rev$dat, input$mDT_cell_edit, dat_proxy)
})
}
shinyApp(ui, server, enableBookmarking = "url")
The last modification to the datatable is registered in input$mDT_cell_edit.
input$mDT_cell_edit is saved in the bookmarked state, and you can use onRestore to restore it.
However, the full data used in the DT isn't saved : you could use onBookmark to save it too.
As this goes over the 2000 characters allowed by an url, you need to store the bookmark on the server with enableBookmarking = "server".
This is what is done in the code below, to show the way to move forward. It would of course be more efficient to save/restore the list of modifications only.
library(shiny)
library(DT)
server <- function(input, output){
rev <- reactiveValues(dat = mtcars)
output$mDT <- renderDT(
rev$dat,
rownames = TRUE,
selection = "none",
editable = TRUE
)
dat_proxy <- dataTableProxy("mDT")
observeEvent(input$mDT_cell_edit, {
info <- input$mDT_cell_edit
i <- info$row
j <- info$col
if (j>0) {
rev$dat[i, j] <<- DT::coerceValue(info$value, rev$dat[i, j])}
else {
row.names(rev$dat)[i] <- info$value
}
DT::replaceData(dat_proxy, rev$dat, resetPaging = FALSE, rownames = T)
})
onBookmark(function(state) {
state$values$rev_dat <- rev$dat
})
# restore table selection and search
onRestored(function(state) {
if (!identical(rev$dat,state$values$rev_dat)) {
rev$dat <- state$values$rev_dat
DT::replaceData(dat_proxy, state$values$rev_dat, resetPaging = FALSE, rownames = T)
}
})
}
shinyApp(ui, server, enableBookmarking = "server")
In the following app, I would like to add a global button, to save the tables in the 2 panels at the same time.
Ideally, they should be saved to an xlsx file, in tabs named after the corresponding tabs.
Please note that the tabs were created using a module.
Many thanks!!
library(shiny)
library(DT)
modDtUi <- function(id){ # UI module
ns = NS(id)
DT::dataTableOutput(ns('x1'))
}
modDt <- function(input, output, session, data, globalSession){ # Server module
x <- data
output$x1 <- DT::renderDataTable(x, selection = 'none', editable = TRUE)
proxy <- dataTableProxy('x1', session = globalSession)
}
ui <- fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Table1", modDtUi("editable")),
tabPanel("Table2", modDtUi("editable2"))
)
)
)
server <- function(input, output, session) {
callModule(modDt,"editable", data = head(iris,10), globalSession = session)
callModule(modDt,"editable2", data = tail(iris,5), globalSession = session)
}
shinyApp(ui = ui, server = server)
I believe this demo works.
I used reactiveValues v$data to store the data inside the module. The module will return v$data so it can be retrieved when you want to save the data in the shiny server.
I also added an observeEvent to detect changes in the data, and update the data table with replaceData.
The excel file is created using the writexl library, but you could substitute with others of course.
Let me know if this works for you. I imagine there are some elements of this answer that can be improved upon - and if we can identify them, would like to edit further.
library(shiny)
library(DT)
library(writexl)
modDtUi <- function(id){ # UI module
ns = NS(id)
DT::dataTableOutput(ns(id))
}
modDt <- function(input, output, session, data, id, globalSession){ # Server module
v <- reactiveValues(data = data)
output[[id]] <- DT::renderDataTable(v$data, selection = 'none', editable = TRUE)
proxy <- dataTableProxy(id, session = globalSession)
id_input = paste(id, "cell_edit", sep = "_")
# Could add observeEvent here to detect edit event
observeEvent(input[[id_input]], {
info = input[[id_input]]
if (!is.null(info)) {
v$data[info$row, info$col] <<- DT::coerceValue(info$value, v$data[info$row, info$col])
}
replaceData(proxy, v$data, resetPaging = FALSE)
})
return(data = reactive({v$data}))
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
width = 2,
actionButton("btn", "Save Both")
),
mainPanel(
tabsetPanel(
tabPanel("Table1", modDtUi("editable1")),
tabPanel("Table2", modDtUi("editable2"))
)
)
)
)
server <- function(input, output, session) {
e1 <- callModule(modDt, "editable1", data = head(iris,10), id = "editable1", globalSession = session)
e2 <- callModule(modDt, "editable2", data = tail(iris,5), id = "editable2", globalSession = session)
observeEvent(input$btn, {
print("Saving...")
sheets <- list("e1" = e1(), "e2" = e2())
write_xlsx(sheets, "test.xlsx")
})
}
shinyApp(ui = ui, server = server)
I want to creat an shiny app where users have to edit datatable.
There is the code contains reproductible exemple:
library(shiny)
library(dplyr)
library(DT)
line<-c(1,1,1,1,1)
op<-c(155,155,155,156,156)
batch<-c(1,2,3,1,2)
voile<-c(1,NA,NA,NA,NA)
depot<-c(2,NA,2,NA,NA)
boe<-data.frame(line,op,batch)
ui <- fluidPage(
# Application title
titlePanel("test dust"),
actionButton("refresh", label = "refresh"),
DT::dataTableOutput("mytable"),
actionButton("save", label = "save"),
)
# Define server logic required to draw a histogram
server <- function(input, output) {
DTdust<- eventReactive(input$refresh, {
DTdust <-data.frame(line,op,batch,voile,depot)
})
merged<-reactive({
merged<-merge(boe,DTdust(),all.x = TRUE)
})
mergedfiltred<-reactive({
mergedfiltred<- filter(merged(),is.na(voile)|is.na(depot) )
})
output$mytable = DT::renderDataTable( mergedfiltred(),editable = list(target = 'cell',
disable = list(columns = c(1:3))),selection = 'none'
)
}
# Run the application
shinyApp(ui = ui, server = server)
I wish this works like this —>
When user clic on refresh button. Dtdust.csv (here simulated) is read , then it merged with boe.csv (simulated too) an filter to get only rows without resulta for voile and depot col.
And display this merged filtred ino editable datatable .
This part works.
After i want to extract the data from edited datatable to make some processing on it (extract rows completed, rbind it on dtdust and save as dtdust.csv. But that’s ok i think.)
I’ m in trouble to extract edited datatable.
I see some exemple to do it with classic dataframe but it not work with reactive one.
I’m beeginner so if you can comment a lot your answers i can learn how to and not just ctrl+c ctrl+v your code :)
Thanks
You need to define a reactiveValues data frame. Then you need to update it via observeEvent whenever any cell is modified via mytable_cell_edit. The updated dataframe is now available in the server side, and part of it is now printed in the second table. You can use DF1$data for further analysis or subsetting. Full updated code is below.
library(shiny)
library(dplyr)
library(DT)
line<-c(1,1,1,1,1)
op<-c(155,155,155,156,156)
batch<-c(1,2,3,1,2)
voile<-c(1,NA,NA,NA,NA)
depot<-c(2,NA,2,NA,NA)
boe<-data.frame(line,op,batch)
ui <- fluidPage(
# Application title
titlePanel("test dust"),
actionButton("refresh", label = "refresh"),
DTOutput("mytable"), DTOutput("tb2"),
actionButton("save", label = "save"),
)
# Define server logic required to draw a histogram
server <- function(input, output) {
DF1 <- reactiveValues(data=NULL)
DTdust<- eventReactive(input$refresh, {
req(input$refresh)
DTdust <-data.frame(line,op,batch,voile,depot)
})
merged<-reactive({
req(DTdust())
merged<-merge(boe,DTdust(),all.x = TRUE)
})
mergedfiltred<-reactive({
mergedfiltred <- filter(merged(),is.na(voile)|is.na(depot) )
DF1$data <- mergedfiltred
mergedfiltred
})
output$mytable = renderDT(
mergedfiltred(),
editable = list(target = 'cell', disable = list(columns = c(1:3))), selection = 'none'
)
observeEvent(input$mytable_cell_edit, {
info = input$mytable_cell_edit
str(info)
i = info$row
j = info$col
v = info$value
DF1$data[i, j] <<- DT::coerceValue(v, DF1$data[i, j])
})
output$tb2 <- renderDT({
df2 <- DF1$data[,2:5]
plen <- nrow(df2)
datatable(df2, class = 'cell-border stripe',
options = list(dom = 't', pageLength = plen, initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'background-color': '#000', 'color': '#fff'});",
"}")))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Hi thanks for your solution #YBS.
I finaly find a solution by myself half an hour after asking here... (i previously turning arround hours and hours).
There is what i do :
output$x2 = DT::renderDataTable({
req(dat$x2)
DT::datatable(dat$x2)
})
dat <- reactiveValues()
# update edited data
observeEvent(input$mytable_cell_edit, {
data_table <- dat$x2
data_table[input$mytable_cell_edit$row, input$mytable_cell_edit$col] <- as.numeric(input$mytable_cell_edit$value)
dat$x2 <- data_table
})
Have a good day
I have the following program. As the title suggests, every time I edit an item on pages after the first page the table goes back to the first page. I'd like the table to stay on the page I'm editing without jumping back to the first page.
I've seen this problem on other threads here but their solutions don't seem to work with current version of DT and shiny packages.
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]))
})
output$print <- renderPrint({
x$df
})
}
)
Any help would be appreciated
You can do like this:
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
DTOutput('x1'),
verbatimTextOutput("print")
),
server = function(input, output, session) {
dat <- reactiveVal(cbind(iris, Date = Sys.time() + seq_len(nrow(iris))))
output$x1 = renderDT(isolate(dat()), selection = 'none', editable = TRUE)
proxy = dataTableProxy('x1')
observeEvent(input$x1_cell_edit, {
info = input$x1_cell_edit
dat(editData(dat(), info, proxy, resetPaging = FALSE))
})
output$print <- renderPrint({
dat()
})
}
)
Please see DT-edit. I have copied the 2 relevant examples below:
library(shiny)
library(DT)
dt_output = function(title, id) {
fluidRow(column(
12, h1(paste0('Table ', sub('.*?([0-9]+)$', '\\1', id), ': ', title)),
hr(), DTOutput(id)
))
}
render_dt = function(data, editable = 'cell', server = TRUE, ...) {
renderDT(data, selection = 'none', server = server, editable = editable, ...)
}
shinyApp(
ui = fluidPage(
title = 'Double-click to edit table cells',
dt_output('client-side processing (editable = "cell")', 'x1'),
dt_output('server-side processing (editable = "cell")', 'x5')
),
server = function(input, output, session) {
d1 = iris
d1$Date = Sys.time() + seq_len(nrow(d1))
d5 = d1
options(DT.options = list(pageLength = 5))
# client-side processing
output$x1 = render_dt(d1, 'cell', FALSE)
observe(str(input$x1_cell_edit))
# server-side processing
output$x5 = render_dt(d5, 'cell')
# edit a single cell
proxy5 = dataTableProxy('x5')
observeEvent(input$x5_cell_edit, {
info = input$x5_cell_edit
str(info) # check what info looks like (a data frame of 3 columns)
d5 <<- editData(d5, info)
replaceData(proxy5, d5, resetPaging = FALSE) # important
# the above steps can be merged into a single editData() call; see examples below
})
}
)
I am not sure why you seem to be unnecessarily complicating the process with your reactiveValues but that is probably the cause of your table needing to refresh back to the first page.
My R program works as expected. It shows a table containing my dataFrame, and lets me edit the values.
How do I capture those values and save them to my dataframe, or a copy of my dataframe?
require(shiny)
library(rhandsontable)
DF = data.frame(val = 1:10, bool = TRUE, big = LETTERS[1:10],
small = letters[1:10],
dt = seq(from = Sys.Date(), by = "days", length.out = 10),
stringsAsFactors = F)
rhandsontable(DF, rowHeaders = NULL)
EDIT:
The above code produces a table with rows and columns. I can edit any of the rows and columns. But when I look at my dataFrame, those edits do not appear. What I am trying to figure out is what do I need to change so I can capture the new values that were edited.
I know this thread's been dead for years, but it's the first StackOverflow result on this problem.
With the help of this post - https://cxbonilla.github.io/2017-03-04-rhot-csv-edit/, I've come up with this:
library(shiny)
library(rhandsontable)
values <- list()
setHot <- function(x)
values[["hot"]] <<- x
DF <- data.frame(val = 1:10, bool = TRUE, big = LETTERS[1:10],
small = letters[1:10],
dt = seq(from = Sys.Date(), by = "days", length.out = 10),
stringsAsFactors = FALSE)
ui <- fluidPage(
rHandsontableOutput("hot"),
br(),
actionButton("saveBtn", "Save changes")
)
server <- function(input, output, session) {
observe({
input$saveBtn # update dataframe file each time the button is pressed
if (!is.null(values[["hot"]])) { # if there's a table input
DF <<- values$hot
}
})
observe({
if (!is.null(input$hot)){
DF <- (hot_to_r(input$hot))
setHot(DF)
}
})
output$hot <- renderRHandsontable({
rhandsontable(DF) %>% # actual rhandsontable object
hot_table(highlightCol = TRUE, highlightRow = TRUE, readOnly = TRUE) %>%
hot_col("big", readOnly = FALSE) %>%
hot_col("small", readOnly = FALSE)
})
}
shinyApp(ui = ui, server = server)
However, I don't like my solution on the part of DF <<- values$hot as I previously had problems with saving changes to the global environment. I've couldn't figure it out any other way, though.
It seems to be accessible now via input$NAME_OF_rHandsontableOutput and can be converted to a data.frame via hot_to_r().
Reproducible example:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
rHandsontableOutput("hottable")
)
server <- function(input, output, session) {
observe({
print(hot_to_r(input$hottable))
})
output$hottable <- renderRHandsontable({
rhandsontable(mtcars)
})
}
shinyApp(ui, server)
I was able to accomplish this with a more simple solution for saving data while the app is open and after it is closed for shiny 1.7++
Create an observe event dependent upon a save button clicked at any point when the app is open. I've scaled this method in more complex apps where you have a selectizeinput for swapping in and out different data frames into the rhandsontable, each of which are edited, saved and recalled while the app is open.
In the server:
observeEvent(input$save, { #button is the name of the save button, change as needed
df <<- hot_to_r(input$rhandsontable) #replace rhandsontable with the name of your own
}) #df is the data frame that have it access when the app starts
In the UI:
actionButton("save","Save Edits")
I don't know what you want to recover exactly, but this seems to work:
DF <- rhandsontable(DF, rowHeaders = NULL)
library(jsonlite)
fromJSON(DF$x$data)
If you are using Shiny then input$table$changes$changes can give you the edited value with row and column index. Below is the code if you want to update only specific cell and not the complete table using hot_to_t().
library(shiny)
library(rhandsontable)
DF = data.frame(val = 1:10, bool = TRUE, big = LETTERS[1:10],
small = letters[1:10],
dt = seq(from = Sys.Date(), by = "days", length.out = 10),
stringsAsFactors = F)
ui <- fluidPage(
rHandsontableOutput('table')
)
server <- function(input, output) {
X = reactiveValues(data = DF)
output$table <- rhandsontable::renderRHandsontable({
rhandsontable(X$data, rowHeaders = NULL)
})
observeEvent(input$table$changes$changes,{
row = input$table$changes$changes[[1]][[1]]
col = input$table$changes$changes[[1]][[2]]
value = input$table$changes$changes[[1]][[4]]
X$data[row,col] = value
})
}
shinyApp(ui, server)
Here's an example from related post How to add columns to a data frame rendered with rhandsontable in R Shiny with an action button?, which started with Tonio Liebrand's solution above but rendered reactively with columns added by the user via action button so you can see the table evolve and see how manual edits to the table stick around:
library(shiny)
library(rhandsontable)
myDF <- data.frame(x = c(1, 2, 3))
ui <- fluidPage(rHandsontableOutput('hottable'),
br(),
actionButton('addCol', 'Add'))
server <- function(input, output, session) {
EmptyTbl <- reactiveVal(myDF)
observeEvent(input$hottable, {
EmptyTbl(hot_to_r(input$hottable))
})
output$hottable <- renderRHandsontable({
rhandsontable(EmptyTbl())
})
observeEvent(input$addCol, {
newCol <- data.frame(c(1, 2, 3))
names(newCol) <- paste("Col", ncol(hot_to_r(input$hottable)) + 1)
EmptyTbl(cbind(EmptyTbl(), newCol))
})
}
shinyApp(ui, server)