download button disappear after editing data table in shiny app - r

I have included editable table in my shiny app I developed in my organization. Use this simple example to illustrate the issue. This is an extension of this question
In this app, after I edit any cell, the download button just disappear. Does anyone know why that happens? Thanks a lot in advance.
library(shiny)
library(DT)
library(dplyr)
# UI
ui = fluidPage(
selectInput("nrows",
"select n entries",
choices = 100:150,
selected = 100,
multiple = FALSE),
downloadButton("download1", "Download iris as csv"),
DTOutput('tbl'),
checkboxGroupInput(
'datacols',
label='Select Columns:',
choices= c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width', 'Species'),
selected = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width', 'Species'),
inline=TRUE)
)
# SERVER
server = function(input, output) {
dat = reactiveValues()
observe ({
dat$dat = iris[1:input$nrows, ]
})
# render DT
output$tbl = renderDT({
datatable(dat$dat,
editable = "cell",
callback = JS(
"$('div.dwnld').append($('#download1'));",
"var checkboxes = $('input[name=datacols]');",
"checkboxes.each(function(index,value){",
" var column = table.column(index+1);",
" $(this).on('click', function(){",
" if($(this).prop('checked')){",
" column.visible(true);",
" }else{",
" column.visible(false);",
" }",
" });",
"});"
),
extensions = "Buttons",
options = list(
dom = 'B<"dwnld">frtip',
buttons = list("copy")
)
)
})
observeEvent(input[["tbl_cell_edit"]], {
cellinfo <- input[["tbl_cell_edit"]]
dat$dat <<- editData(dat$dat, cellinfo, "tbl")
})
output$download1 <- downloadHandler(
filename = function() {
paste("data_", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(dat$dat %>% select(one_of(input$datacols)), file)
}
)
}
shinyApp(ui, server)

Related

Shiny: How to disable download button when there no data?

I'm working inside a module which queries some data and then shows it on a DT::datatable, I added a download button so I can download the data with the filters applied.
I already called useShinyjs() in the main ui file of the app.
But I want to disable the download button in case there is no data.
I've tried the following.
observeEvent(data(), {
if (!nrow(data()) > 0) {
shinyjs::disable("download")
} else {
shinyjs::enable("download")
})
However the next error message shows up, and the app crashes as soon as I run it.
Expecting a single string value: [type=character; extent=0]
ui Code:
module_ui <- function(id) {
ns <- NS(id)
tagList(
fluidRow(
tabBox(
title = tagList(
downloadButton(ns("download"), label = "Download data")
),
width = 12,
tabPanel(
title = HTML("Documentation"),
div(style = 'overflow-x: scroll;font-size:90%', DTOutput(ns("table")))
)
)
)
)
}
server Code:
module_server <- function(id,
connection,
update_button,
update_button_name) {
moduleServer(
id = id,
module = function(input, output, session) {
ns <- session$ns
# 1 . Data -----
data <- eventReactive(list(update_button()), {
data <- dbGetQuery(
connection,
glue::glue("SELECT * FROM Process;)
return(data)
}, ignoreNULL = FALSE, ignoreInit = FALSE)
# 2 . Table -----
output$table<- renderDT({
shiny::validate(
shiny::need(!is_null(data()) && nrow(data()) > 0, 'No data...')
)
datatable(
data = data(),
selection = "single",
style = "bootstrap",
rownames = FALSE,
filter = 'top',
options = list(
searchHighlight = TRUE,
dom = 'tipr',
pageLength = 20,
columnDefs = list(
list(visible = F, targets = c(0)),
list(width = "200px", targets = "_all")
)
)
)
}, server = TRUE)
# 3 . Download -----
observeEvent(data(), {
if (nrow(data()) > 0) {
shinyjs::enable("download")
} else {
shinyjs::disable("download")
}
})
output$download <- downloadHandler(
filename = "Documentation.xlsx",
content = function(file) {
openxlsx::write.xlsx(
x = data() %>% slice(input$tabla_rows_all),
file = file,
asTable = FALSE,
row.names = FALSE
)
}
)
Many thanks in advance to whoever can help!
Use shinyjs::toggleState() instead. Here is a reproducible example:
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
fileInput(
inputId = "file1", label = "Choose a file to upload:", accept = ".csv"
),
tableOutput(
outputId = "table1"
),
downloadButton(
outputId = "download_data", class = "btn-success"
)
)
server <- function(input, output, session) {
the_data <- reactive({
req(input$file1)
read.csv(input$file1$datapath)
})
output$table1 <- renderTable({
the_data() |> head()
})
# <-- observe if there's any input file -->
observe({
# mandatory condition: there should be an input file
mand_condition <- \() {
!is.null(input$file1)
}
shinyjs::toggleState(
id = "download_data", condition = mand_condition()
)
})
output$download_data <- downloadHandler(
filename = \() {
input$file1$name
},
content = function(file) {
write.csv(the_data(), file)
}
)
}
shinyApp(ui, server)

No Checkbox in ShinyApp

I'm trying to display a csv file and create checkboxes to allow filtering. The app runs without any errors but I get a blank box where the checkboxes would be. How can I get the checkboxes to show up?
library(shiny)
library(DT)
df <- read.csv("new_and_deactivated_accounts.csv", header = TRUE)
ui <- fluidPage(
# Application title
titlePanel("GIS Workload"),
sidebarLayout(
sidebarPanel(
conditionalPanel(
'input.dataset === "df"',
checkboxGroupInput("checkbox", "Select something",
names(df), selected = names(df))
)
),
mainPanel(
tabsetPanel(
id='df',
tabPanel(DT::dataTableOutput("mytable1"))
)
)
)
)
server <- function(input, output) {
output$mytable1 <- DT::renderDataTable({
DT::datatable(df[, input$checkbox, drop = FALSE])
})
}
# Run the application
shinyApp(ui, server)
Here's a portion of what displays, where the checkboxes should be are empty and because it's a semi-private, I opted not to show the data, but included the headers.
They are there, just hidden as you are using a conditional panel and the condition isn't being met.
You can remove this part, or ensure the conditions are being met:
conditionalPanel('input.dataset === "df"',
Here is your full code with that line removed, and mtcars used instead of your data:
library(shiny)
library(DT)
df <- mtcars
ui <- fluidPage(
# Application title
titlePanel("GIS Workload"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("checkbox", "Select something",
names(df), selected = names(df))
),
mainPanel(
tabsetPanel(
id='df',
tabPanel(DT::dataTableOutput("mytable1"))
)
)
)
)
server <- function(input, output) {
output$mytable1 <- DT::renderDataTable({
DT::datatable(df[, input$checkbox, drop = FALSE])
})
}
# Run the application
shinyApp(ui, server)
Here is some generic Shiny code that should help you.
library(shiny)
library(DT)
mymtcars <- mtcars
mymtcars[["Select"]] <- paste0('<input type="checkbox" name="row_selected" value=',1:nrow(mymtcars),' checked>')
mymtcars[["_id"]] <- paste0("row_", seq(nrow(mymtcars)))
callback <- c(
sprintf("table.on('click', 'td:nth-child(%d)', function(){",
which(names(mymtcars) == "Select")),
" var checkbox = $(this).children()[0];",
" var $row = $(this).closest('tr');",
" if(checkbox.checked){",
" $row.removeClass('excluded');",
" }else{",
" $row.addClass('excluded');",
" }",
" var excludedRows = [];",
" table.$('tr').each(function(i, row){",
" if($(this).hasClass('excluded')){",
" excludedRows.push(parseInt($(row).attr('id').split('_')[1]));",
" }",
" });",
" Shiny.setInputValue('excludedRows', excludedRows);",
"});"
)
ui = fluidPage(
verbatimTextOutput("excludedRows"),
DTOutput('myDT')
)
server = function(input, output) {
output$myDT <- renderDT({
datatable(
mymtcars, selection = "multiple",
options = list(pageLength = 5,
lengthChange = FALSE,
rowId = JS(sprintf("function(data){return data[%d];}",
ncol(mymtcars)-1)),
columnDefs = list( # hide the '_id' column
list(visible = FALSE, targets = ncol(mymtcars)-1)
)
),
rownames = FALSE,
escape = FALSE,
callback = JS(callback)
)
}, server = FALSE)
output$excludedRows <- renderPrint({
input[["excludedRows"]]
})
}
shinyApp(ui,server, options = list(launch.browser = TRUE))

Move to the next row of the selected one in a DT::datatable with the use of an actionButton()

I have the shiny app below in which I click on datatable row and display its index next to it. Is it possible to press the Next button and display the index of the next row? The table's next row will be highlighted accordingly everytime as well.
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
title = 'Select Table Rows',
h1('A Server-side Table'),
fluidRow(
column(9, DT::dataTableOutput('x3')),
column(3, verbatimTextOutput('x4')),
actionButton("next","Next row")
)
),
server = function(input, output, session) {
# server-side processing
mtcars2 = mtcars[, 1:8]
output$x3 = DT::renderDataTable({datatable(selection = list(target = "row", mode = "single"),mtcars2 )})
# print the selected indices
output$x4 = renderPrint({
s = input$x3_rows_selected
if (length(s)) {
cat('These rows were selected:\n\n')
cat(s, sep = ', ')
}
})
})
library(shiny)
library(DT)
dat <- iris[1:6,]
callback <- JS(
"$('#btn-next').prop('disabled', true);",
"var selected_row = null;",
"table.on('select', function( e, dt, type, indexes ) {",
" $('#btn-next').prop('disabled', false);",
" selected_row = indexes[0];",
"});",
"table.on('deselect', function( e, dt, type, indexes ) {",
" $('#btn-next').prop('disabled', true);",
"});",
"var nrows = table.rows().count();",
"$('#btn-next').on('click', function() {",
" var next_row = selected_row + 1 < nrows ? selected_row + 1 : 0;",
" table.row(next_row).select();",
"});"
)
ui <- fluidPage(
br(),
DTOutput("dtable"),
br(),
splitLayout(
textOutput("selectedRow"),
actionButton("btn-next", "select next row"),
cellWidths = "150px"
)
)
server <- function(input, output, session) {
output[["dtable"]] <- renderDT({
datatable(
dat,
extensions = "Select",
selection = "none",
callback = callback,
options = list(
columnDefs = list(
list(className = "dt-center", targets = "_all")
),
select = list(style = "single")
)
)
}, server = FALSE)
output[["selectedRow"]] <- renderText({
i <- input[["dtable_rows_selected"]]
paste0(
"Selected row: ",
ifelse(is.null(i), "none", i)
)
})
}
shinyApp(ui, server)

download button disappear when deselecting column or editing data table in shiny app

I built a shiny app for downloading customized and editable data table. Here I use iris dataset as an example.
According to this post, I add a button to download the whole dataset as csv.
However, one issue came up. When I tried to uncheck some column OR edit table, the download button simply disappear. And it never show up again.
I spend hours trying to figure it out but was unsuccessful.
Does anyone know why that happens? Thanks a lot in advance.
library(shiny)
library(DT)
library(dplyr)
# UI
ui = fluidPage(
downloadButton("download1","Download iris as csv"),
DT::dataTableOutput('tbl'),
checkboxGroupInput('datacols',
label='Select Columns:',
choices= c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width', 'Specie'),
selected = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width', 'Specie'),
inline=TRUE )
)
# SERVER
server = function(input, output) {
df = reactiveValues()
observe ({
df$dat = iris %>% select(one_of(input$datacols))
})
# render DT
output$tbl = renderDT({
datatable(df$dat,
editable = "cell",
callback = JS("$('div.dwnld').append($('#download1'));"),
extensions = "Buttons",
options = list(
dom = 'B<"dwnld">frtip',
buttons = list(
"copy" ) ) )
})
observeEvent(input[["tbl_cell_edit"]], {
cellinfo <- input[["tbl_cell_edit"]]
df$dat <- editData(df$dat, input[["tbl_cell_edit"]] )
})
output$download1 <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(df$dat, file)
}
)
}
shinyApp(ui, server)
Very interesting case.
Each time you edit a cell or select/unselect a column, this changes df$dat, and then the table is rerendered. But then the element #download1 which was included in the table does not exist anymore in the DOM.
We have to find a way to select/unselect some columns and to edit some cells without rerendering the table. Here is one:
library(shiny)
library(DT)
library(dplyr)
# UI
ui = fluidPage(
downloadButton("download1", "Download iris as csv"),
DTOutput('tbl'),
checkboxGroupInput(
'datacols',
label='Select Columns:',
choices= c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width', 'Species'),
selected = c('Sepal.Length', 'Sepal.Width', 'Petal.Length', 'Petal.Width', 'Species'),
inline=TRUE)
)
# SERVER
server = function(input, output) {
dat <- iris
# render DT
output$tbl = renderDT({
datatable(dat,
editable = "cell",
callback = JS(
"$('div.dwnld').append($('#download1'));",
"var checkboxes = $('input[name=datacols]');",
"checkboxes.each(function(index,value){",
" var column = table.column(index+1);",
" $(this).on('click', function(){",
" if($(this).prop('checked')){",
" column.visible(true);",
" }else{",
" column.visible(false);",
" }",
" });",
"});"
),
extensions = "Buttons",
options = list(
dom = 'B<"dwnld">frtip',
buttons = list("copy")
)
)
})
observeEvent(input[["tbl_cell_edit"]], {
cellinfo <- input[["tbl_cell_edit"]]
dat <<- editData(dat, cellinfo, "tbl")
})
output$download1 <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(dat %>% select(one_of(input$datacols)), file)
}
)
}
shinyApp(ui, server)

hide button in shindydashboard body until table is rendered

I have a shiny app where I load a file and a tabla is rendered, I want to hid a button in the body until the table is rendered. This button is going to save the filters in a file. I am using shinySaveButton from shinyFiles because I want the user to navigate until a folder and choose a custom filename
Here is the UI
header <- dashboardHeader()
sidebar <- dashboardSidebar(
sidebarUserPanel("Test"),
sidebarMenu(
id = "tabs",
menuItem("Archivo variantes", tabName = "fileupload", icon = icon("table")),
conditionalPanel("input.tabs == 'fileupload' ",
shinyFilesButton("file", "Choose a file" , multiple = FALSE,
title = "Please select a file:",
buttonType = "default", class = NULL)#,
)
)
)
body <- dashboardBody(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"),
shinyjs::useShinyjs(),
tabItems(
tabItem(tabName = "fileupload",
fluidRow(column(12,
div(DT::dataTableOutput('tabla') %>% withSpinner(color="#0dc5c1"), style = 'overflow-x: auto'))),
fluidRow(column(2, offset = 0,
shinySaveButton('save', 'Save filters', 'Save as...') )))
)
)
ui <- dashboardPage(header, sidebar, body)
And here is the server
## Server side
server = function(input, output, session) {
options(shiny.maxRequestSize=100*1024^2)
if (!exists("default_search_columns")) default_search_columns <- NULL
volumes = getVolumes()
volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()())
file_selected <- reactive({
shinyFileChoose(input, "file", roots = volumes, session = session)
if (is.null(input$file))
return(NULL)
print(parseFilePaths(volumes, input$file)$datapath)
return(parseFilePaths(volumes, input$file)$datapath)
})
contents <- reactive({
if (is.null(file_selected()))
return()
print(file_selected())
df <- read.delim(file_selected(), header = TRUE, stringsAsFactors=FALSE, as.is=TRUE)
return(tidyr::separate_rows(df, Gene.refGene, sep = ";"))
})
# Reactive function creating the DT output object
output$tabla <- DT::renderDataTable({
if(is.null(contents()))
return()
datos <- contents()
DT::datatable(datos,
rownames = FALSE,
style = 'bootstrap',
class = 'compact cell-border stripe hover',
filter = list(position = 'top', clear = FALSE),
escape = FALSE,
extensions = c('Buttons', "FixedHeader", "Scroller"),
options = list(
stateSave = FALSE,
autoWidth = TRUE,
search = list(regex = TRUE, caseInsensitive = TRUE),
initComplete = JS(
"function(settings, json) {",
"$(this.api().table().header()).css({'font-size': '12px'});",
"}"),
scroller = TRUE,
scrollX = TRUE,
scrollY = "600px",
deferRender=TRUE,
buttons = list('colvis', list(
extend = 'collection',
buttons = list(list(extend='csv',
filename = 'results'),
list(extend='excel',
filename = 'results')),
text = 'Download'
)),
FixedHeader = TRUE
),
callback = JS('table.page(3).draw(false); "setTimeout(function() { table.draw(true); }, 300);"')) %>% formatStyle(columns = colnames(.$x$data), `font-size` = "12px")
})
filtros <- eventReactive(input$tabla_search_columns, {
str(input$tabla_search_columns)
return(input$tabla_search_columns)
})
observeEvent(input$save,
{
observe(
if(is.null(input$tabla)) {
shinyjs::disable("save")
} else { shinyjs::enable("save") }
)
})
observe({
volumes <- getVolumes()
volumes <- c(Home = fs::path_home(), "R Installation" = R.home(), getVolumes()())
shinyFileSave(input, "save", roots=volumes, session=session)
fileinfo <- parseSavePath(volumes, input$save)
if (nrow(fileinfo) > 0) {
write.table(filtros(), fileinfo$datapath, row.names = FALSE, col.names=FALSE, quote=TRUE, sep="\t")
}
})
}
shinyApp(ui, server)
I am trying to use shinyjs::disable and shinyjs::enable but I can't make it work, the button save filters is shown before selecting a file. And I want to be hidden until the table is rendered
Any help would be appreciated
Shiny triggers the JavaScript event shiny:value when an output is rendered. So you can disable the button at the initialization of the app, and with the help of this JS event you can enable the button whenever the table is rendered. Here is a minimal example:
library(shiny)
library(shinyFiles)
js <- paste(
"$(document).ready(function(){",
" $('#save').prop('disabled', true);", # disable the 'save' button
"});",
"$(document).on('shiny:value', function(e){",
" if(e.name === 'table'){", # if 'table' is rendered
" $('#save').prop('disabled', false);", # then enable the 'save' button
" }",
"});"
, sep = "\n"
)
ui <- fluidPage(
tags$head(tags$script(HTML(js))),
shinySaveButton("save", "Save", "Save file"),
actionButton("go", "Render table"),
tableOutput("table")
)
server <- function(input, output){
output[["table"]] <- renderTable({
req(input[["go"]]>0)
iris[1:4, ]
})
}
shinyApp(ui, server)

Resources