I'm trying to make an editable and downloadable data table in shiny app. After I edit the table, the data table automatically disappear for some reason. This only happen when the data dat is reactive (which is necessary in my app).
Does anyone knows what is going on? Thanks a lot.
example code below:
library(shiny)
library(DT)
ui <- fluidPage(
selectInput("nrow",
"num of rows",
choices = 1:5,
selected = 3,
multiple = FALSE),
DTOutput("table")
)
server <- function(input, output){
dat = reactive({
iris[1:as.integer(input$nrow),]
})
output[["table"]] <- renderDT({
datatable(dat(), editable = "cell", extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
"csv"
)
))
})
observeEvent(input[["table_cell_edit"]], {
cellinfo <- input[["table_cell_edit"]]
dat() <<- editData(dat(), input[["table_cell_edit"]], "table")
})
}
shinyApp(ui, server)
Try this:
library(shiny)
library(DT)
ui <- fluidPage(
selectInput("nrow","num of rows",choices = 1:5,selected = 3,multiple = FALSE),
DTOutput("table")
)
server <- function(input, output){
v <- reactiveValues()
observeEvent(input$nrow,{
v$dat <- iris[1:as.integer(input$nrow),]
})
output[["table"]] <- renderDT({
datatable(v$dat, editable = "cell", extensions = "Buttons", options = list(dom = "Bfrtip",buttons = list("excel")))
})
observeEvent(input[["table_cell_edit"]], {
cellinfo <- input[["table_cell_edit"]]
v$dat <<- editData(v$dat, input[["table_cell_edit"]], "table")
})
}
shinyApp(ui, server)
Is it OK like this ? A possible unwanted behavior is that the table is reset after changing the number of rows. But I don't think we can avoid that... since these are two different tables.
library(shiny)
library(DT)
ui <- fluidPage(
selectInput("nrow",
"num of rows",
choices = 1:5,
selected = 3,
multiple = FALSE),
DTOutput("table")
)
server <- function(input, output){
dat0 <- iris
dat <- reactiveVal()
observe({
dat(dat0[1:as.integer(input$nrow),])
})
output[["table"]] <- renderDT({
datatable(dat(), editable = "cell", extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
"csv"
)
))
})
observeEvent(input[["table_cell_edit"]], {
cellinfo <- input[["table_cell_edit"]]
dat(editData(dat(), input[["table_cell_edit"]], "table"))
})
}
shinyApp(ui, server)
Related
I am trying to delete the row in the table below but not able to . Can anyone please guide me here.
The row should get deleted when the user selects the row and then clicks on action button
library(shiny)
library(httr)
library(jsonlite)
library(readxl)
library(DT)
library(glue)
ui <- fluidPage({
au <- read_excel("au.xlsx")
au <- as.data.frame(au)
df <- reactiveValues(asd = NULL)
mainPanel(
dataTableOutput("ir"),
actionButton("ac", "ac")
)
})
server <- function(input, output, session) {
output$ir <- renderDataTable({
df$asd <- head(iris)
datatable(df$asd)
})
observeEvent(input$ac,{
# browser()
df$asd <- df$asd[-c(as.numeric(input$ir_rows_selected)),]
})
}
shinyApp(ui, server)
Here is the way using a Shiny button:
library(shiny)
library(DT)
ui <- fluidPage(
actionButton("delete", "Delete selected row"),
br(),
DTOutput("tbl")
)
server <- function(input, output, session){
output[["tbl"]] <- renderDT({
datatable(iris[1:5,],
callback = JS(c(
"$('#delete').on('click', function(){",
" table.rows('.selected').remove().draw();",
"});"
))
)
}, server = FALSE)
}
shinyApp(ui, server)
And here is the way using a button integrated in the DT table:
library(shiny)
library(DT)
ui <- fluidPage(
br(),
DTOutput("tbl")
)
server <- function(input, output, session){
output[["tbl"]] <- renderDT({
datatable(iris[1:5,],
extensions = 'Buttons',
options = list(
dom = 'Bfrtip',
buttons = list(
list(
extend = "collection",
text = "Delete selected row",
action = DT::JS(c(
"function ( e, dt, node, config ) {",
" dt.rows('.selected').remove().draw();",
"}"))
)
)
)
)
}, server = FALSE)
}
shinyApp(ui, server)
With these methods, the table is not re-rendered when the row is deleted.
IS there a way to get datatable when the user clicks on the row. Basically when the user clicks on any row, the last 4 columns of that specific row should be displayed in a modal (in datatable format)
library(shiny)
ui <- fluidPage(
DT::dataTableOutput("mydatatable")
)
server <- function(input, output, session) {
mycars = head(mtcars)
output$mydatatable = DT::renderDataTable(mycars, selection = 'single',
rownames = FALSE, options = list(dom = 't'))
observeEvent(input$mydatatable_rows_selected,
{
showModal(modalDialog(
title = "You have selected a row!",
mycars[input$mydatatable_rows_selected,]
))
})
}
shinyApp(ui, server)
You can use renderDataTable inside modalDialog.
library(shiny)
library(DT)
ui <- fluidPage(
DT::dataTableOutput("mydatatable")
)
server <- function(input, output, session) {
mycars = head(mtcars)
output$mydatatable = DT::renderDataTable(mycars, selection = 'single',
rownames = FALSE, options = list(dom = 't'))
observeEvent(input$mydatatable_rows_selected,
{
showModal(modalDialog(
title = "You have selected a row!",
DT::renderDataTable({
DT::datatable(mycars[input$mydatatable_rows_selected, (ncol(mycars) - 3):ncol(mycars)])
})
))
})
}
shinyApp(ui, server)
I have the shiny app below in which the user clicks on a cell in the upper table and the relative cell should be displayed in the lower table. The issue is that when I unselect the cells in the upper the cells in the lower not only remain but become more.
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(
fluidRow(
DT::dataTableOutput("myDatatable"),
DT::dataTableOutput("myDatatable2")
)
)
server <- shinyServer(function(input, output, session) {
dat1 <- reactive({
matrix(iris[,5])
})
list_all <- reactiveVal(character())
observeEvent(input$myDatatable_cell_clicked, {
list_all(append(list_all(), input$myDatatable_cell_clicked$value))
})
output$myDatatable <- DT::renderDataTable(dat1(),
selection=list( target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable2 <- DT::renderDataTable(matrix(list_all()),
selection="none",
server = FALSE,
rownames=FALSE)
})
shinyApp(ui, server)
Please try below:
library(shiny)
library(DT)
data("mtcars")
ui <- shinyUI(
fluidRow(
DT::dataTableOutput("myDatatable"),
DT::dataTableOutput("myDatatable2")
)
)
server <- shinyServer(function(input, output, session) {
dat1 <- reactive({
matrix(iris[,5])
})
list_all <- reactiveVal(character())
observeEvent(input$myDatatable_cells_selected, {
if (nrow(input$myDatatable_cells_selected) == 0) {
list_all(character())
} else {
list_all(dat1()[input$myDatatable_cells_selected[,1]])
}
})
output$myDatatable <- DT::renderDataTable(dat1(),
selection=list( target="cell"),
server = FALSE,
rownames=FALSE)
output$myDatatable2 <- DT::renderDataTable(matrix(list_all()),
selection="none",
server = FALSE,
rownames=FALSE)
})
shinyApp(ui, server)
The main difference is using input$myDatatable_cells_selected which keeps the currently selected cells as opposed to input$myDatatable_cell_clicked which contains the clicked cell even when unselected, causing your issue.
Here is another version based on input$myDatatable_cells_selected using reactive over reactiveVal (should always be the preferred way in shiny) + this works for multiple columns.
library(shiny)
library(DT)
library(datasets)
ui <- shinyUI(fluidRow(
DT::dataTableOutput("myDatatable"),
DT::dataTableOutput("myDatatable2")
))
server <- shinyServer(function(input, output, session) {
dat1 <- reactive({
data.frame(iris[, 5])
})
selected <- reactive({
req(input$myDatatable_cells_selected)
selected <- input$myDatatable_cells_selected
selected[, 2] <- selected[, 2] + 1
return(selected)
})
output$myDatatable <- DT::renderDataTable(
dat1(),
selection = list(target = "cell"),
server = FALSE,
rownames = FALSE
)
output$myDatatable2 <- DT::renderDataTable(
data.frame(dat1()[selected()]),
selection = "none",
server = FALSE,
rownames = FALSE)
})
shinyApp(ui, server)
In data table, we can use argument editable to make the table editable. I'm making a shiny app in which table is both editable and downloadable.
My question is how I can download a datatable after I edit it?
Here is my app code:
library(shiny)
library(DT)
server <- function(input, output) {
df = iris
output$data = DT::renderDataTable ({
DT::datatable(df, editable = list(
target = 'row',
disable = list(columns = c(1, 3, 4))
))
})
output$downloadData <- downloadHandler(
filename = function() {
#paste(input$dataset, ".csv", sep = "")
},
content = function(file) {
write.csv(df, file, row.names = FALSE)
}
)
}
ui <- fluidPage(
DT::dataTableOutput('data'),
downloadButton("downloadData", "Download")
)
shinyApp(ui = ui, server = server)
When you edit a cell of a datatable named "XXX", the info about the cell edit is in input$XXX_cell_edit. This info contains the indices of the edited cell and its new value. So you can do:
library(shiny)
library(DT)
dat <- iris[1:3, ]
ui <- fluidPage(
downloadButton("downloadData", "Download"),
DTOutput("table")
)
server <- function(input, output){
output[["table"]] <- renderDT({
datatable(dat, editable = "cell")
})
df <- reactiveVal(dat)
observeEvent(input[["table_cell_edit"]], {
cell <- input[["table_cell_edit"]]
newdf <- df()
newdf[cell$row, cell$col] <- cell$value
df(newdf)
})
output[["downloadData"]] <- downloadHandler(
filename = function() {
"mydata.csv"
},
content = function(file) {
write.csv(df(), file, row.names = FALSE)
}
)
}
shinyApp(ui, server)
Alternatively, as suggested by #MrGumble, you can use the embedded button of Datatables instead of a downloadHandler. This is more stylish.
library(shiny)
library(DT)
dat <- iris[1:3, ]
ui <- fluidPage(
DTOutput("table")
)
server <- function(input, output){
output[["table"]] <- renderDT({
datatable(dat, editable = "cell", extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
"csv"
)
))
})
observeEvent(input[["table_cell_edit"]], {
cellinfo <- input[["table_cell_edit"]]
dat <<- editData(dat, input[["table_cell_edit"]], "table")
})
}
shinyApp(ui, server)
You can add a download button directly to a DT datatable, which offers the user to download the current data in the table, see R Shiny: How to add download buttons in DT::renderDataTable
If you however want to use the edited data for server-side calculations, you are are on the right track, but need to save the edited table into the data.frame using replaceData. See e.g. https://yihui.shinyapps.io/DT-edit/
I have a shiny app that a user can check whether they want the data table displayed in the main panel. Depending on the numericinput, if they select 1, only 1 datatable be displayed or if they select 2 it will display 2 datatables I am not so sure how to code this in shiny R since I am new to this. Thank you for looking into this.
Here is my code
library("shiny")
df1 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df1<-rbind(df1,setNames(as.list(c(10,20,30,40)), names(df2)))
df2 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df2<-rbind(df2,setNames(as.list(c(100,200,300,400)), names(df2)))
df3 <- data.frame("2010-01"=double(),
"2010-02"=double(),
"2010-03"=double(),
"2010-04"=double()
)
df3<-rbind(df3,setNames(as.list(c(1000,2000,3000,4000)), names(df2)))
ui <-fluidPage(
sidebarPanel(
checkboxInput("add_data", "Add Data Table(s)"),
conditionalPanel(condition="input.add_data === true",
numericInput("numofdata",
label="Number of Data Table(s):",
min = 1,
max = 3,
value = 1,
step = 1),
uiOutput("num_of_data"),
textOutput("see_ranges")
),
actionButton("submit", "Submit")
),
mainPanel(
titlePanel("Output Data Table"),
DT::dataTableOutput("datatable.view", width = "95%")
) # end of main panel
)
server <- function(input, output, session) {
output$num_of_data <- renderUI({
lapply(1:input$numofdata, function(i) {
print(trend_list())
})
})
output$see_ranges <- renderPrint({
print(trend_list())
})
data.filter <- reactive({
df(i)
})
output$datatable.view <- DT::renderDataTable(
{
input$submit
if (input$submit==0) return()
isolate({
for(i in 1:input$numoftrends) {
datatable(data.filter(i),
rownames=FALSE,
extensions = c("FixedColumns", "FixedHeader", "Scroller"),
options = list(searching=FALSE,
autoWidth=TRUE,
rownames=FALSE,
scroller=TRUE,
scrollX=TRUE,
pagelength=1,
fixedHeader=TRUE,
class='cell-border stripe',
fixedColumns =
list(leftColumns=2,heightMatch='none')
)
)
}
})
})
}
shinyApp(ui = ui, server = server)
You should look at this article:
http://shiny.rstudio.com/gallery/creating-a-ui-from-a-loop.html
You will seen then that one has to create multiple renderDataTable instead of muliple datatable within one renderDataTable().
Also in your code you call df like a function df() but it is only defined as a variable.
See a generic running example below.
EDIT: Changed dynamic part of UI.
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10, 3)
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
observe({
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
tagList(lapply(1:input$amountTable, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)