hide button in shindydashboard body until table is rendered - r

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)

Related

Enabling download all with server = TRUE datatable by using invisible download button

The goal is to enable download all data from datatable even when server = TRUE. I'm very close already thanks to this post on Github.
This works:
library(shiny)
library(DT)
callback <- JS(
"var a = document.createElement('a');",
"$(a).addClass('dt-button');",
"a.href = document.getElementById('download1').href;",
"a.download = '';",
"$(a).attr('target', '_blank');",
"$(a).text('Download');",
"$('div.dwnld').append(a);",
"$('#download1').hide();"
)
ui <- basicPage(
downloadButton("download1", ""), # no label: this button will be hidden
numericInput("nrows", "Number of rows", 10),
DTOutput("dtable")
)
server <- function(input, output, session){
output$dtable <- renderDT(
datatable(iris[1:input$nrows,],
callback = callback,
extensions = 'Buttons',
options = list(
dom = 'B<"dwnld">frtip',
buttons = list(
"copy"
)
)
)
)
output$download1 <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(iris, file)
}
)
}
shinyApp(ui, server)
The problem is that the download button is briefly visible on app load. How do I ensure the download button is always invisible?
I tried using shinyjs::hidden(), but it causes the download to fail:
library(shiny)
library(shinyjs)
library(DT)
callback <- JS(
"var a = document.createElement('a');",
"$(a).addClass('dt-button');",
"a.href = document.getElementById('download1').href;",
"a.download = '';",
"$(a).attr('target', '_blank');",
"$(a).text('Download');",
"$('div.dwnld').append(a);",
"$('#download1').hide();"
)
ui <- basicPage(
useShinyjs(),
hidden(downloadButton("download1", "")), # no label: this button will be hidden
numericInput("nrows", "Number of rows", 10),
DTOutput("dtable")
)
server <- function(input, output, session){
output$dtable <- renderDT(
datatable(iris[1:input$nrows,],
callback = callback,
extensions = 'Buttons',
options = list(
dom = 'B<"dwnld">frtip',
buttons = list(
"copy"
)
)
)
)
output$download1 <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(iris, file)
}
)
}
shinyApp(ui, server)
EDIT
Using div(style = 'display: none;', ...) also results in a failed download.
library(shiny)
library(DT)
callback <- JS(
"var a = document.createElement('a');",
"$(a).addClass('dt-button');",
"a.href = document.getElementById('download1').href;",
"a.download = '';",
"$(a).attr('target', '_blank');",
"$(a).text('Download');",
"$('div.dwnld').append(a);",
"$('#download1').hide();"
)
ui <- basicPage(
div(style = "display: none;", downloadButton("download1", "")), # no label: this button will be hidden
numericInput("nrows", "Number of rows", 10),
DTOutput("dtable")
)
server <- function(input, output, session){
output$dtable <- renderDT(
datatable(iris[1:input$nrows,],
callback = callback,
extensions = 'Buttons',
options = list(
dom = 'B<"dwnld">frtip',
buttons = list(
"copy"
)
)
)
)
output$download1 <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(iris, file)
}
)
}
shinyApp(ui, server)
You can use the hidden style in the downloadButton as shown below.
library(shiny)
library(shinyjs)
library(DT)
callback <- JS(
"var a = document.createElement('a');",
"$(a).addClass('dt-button');",
"a.href = document.getElementById('download1').href;",
"a.download = '';",
"$(a).attr('target', '_blank');",
"$(a).text('Download');",
"$('div.dwnld').append(a);",
"$('#download1').hide();"
)
ui <- basicPage(
# useShinyjs(),
# hidden(downloadButton("download1", "")), # no label: this button will be hidden
downloadButton("download1", "", style = "visibility: hidden;"),
numericInput("nrows", "Number of rows", 10),
DTOutput("dtable")
)
server <- function(input, output, session){
output$dtable <- renderDT(
datatable(iris[1:input$nrows,],
callback = callback,
extensions = 'Buttons',
options = list(
dom = 'B<"dwnld">frtip',
buttons = list(
"copy"
)
)
)
)
output$download1 <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".csv", sep="")
},
content = function(file) {
write.csv(iris, file)
}
)
}
shinyApp(ui, server)
Include the button in an invisible div :
ui <- basicPage(
div(
style = "display: none;",
downloadButton("download1", ""), # no label: this button will be hidden
),
numericInput("nrows", "Number of rows", 10),
DTOutput("dtable")
)

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)

How to fix filter options not popping up for esquisserUI in Shiny?

I have some requests for my app.
{1} After readjusting the mainPanel, esquisserUI filters are not popping up anymore. Here is the working example which I followed https://dreamrs.github.io/esquisse/articles/shiny-usage.html
In addition, I also looked at this GitHub issue, however it was for disabling the filters: https://github.com/dreamRs/esquisse/issues/71
And final request regarding general information:
{2} what does server = FALSE will do for huge datasets? (https://rstudio.github.io/DT/server.html) DT recommends to leave it as default to TRUE state, however if I do that, I don't get the full data upon download. I only get the data in the current page. Are there problems you foresee?
Thank you, here is a reproducible example.
library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)
library(shinythemes)
library(xlsx)
library(DT)
# Credit: #Iz100 helped me a lot with UI.
ui <- fluidPage(
theme = shinytheme("simplex"),
useShinyjs(),
# Create Right Side Text
navbarPage(
title= div(HTML("G<em>T</em>")),
tabPanel("Data Set Info",
materialSwitch(inputId = "toggleSidebar", label = "Toggle Panel: ",
value = TRUE, status = "warning"),
sidebarLayout(
# radio/action buttons
sidebarPanel(
id = "Sidebar",
prettyRadioButtons(
inputId = "controller",
label = "Choose:",
choices = c("About"= 1,
"iris"= 2,
"mtcars" = 3),
icon= icon("check"),
selected = 1,
status = "success",
animation="smooth"
),
br(),
br(),
a(actionButton(inputId = "admin_email", label = "Contact Admin",
icon = icon("envelope", lib = "font-awesome")),
href="mailto:my_awesome_email_address.com")
),
#panel where output is shown from server
mainPanel(
id = "main_panel",
tabsetPanel(
id = "hidden_tabs",
type = "hidden",
tabPanelBody(
"panel1", "navigation"
),
tabPanelBody(
"panel2",
tabsetPanel(
tabPanel("Data", DT::DTOutput('panel1_data')),
tabPanel("Summary", verbatimTextOutput("panel1_sum")),
tabPanel(
"Plot",
esquisserUI(
id = "esquisse2",
header = FALSE,
choose_data = FALSE
)
)
)
),
tabPanelBody(
"panel3",
tabsetPanel(
tabPanel("Data", DT::DTOutput('panel3_data')),
tabPanel("Summary", verbatimTextOutput("panel3_sum")),
tabPanel(
"Plot",
esquisserUI(
id = "esquisse3",
header = FALSE,
choose_data = FALSE
)
)
)
)
)
)
)
) ,
#resizes the navbar tabs/button
tags$head(tags$style(HTML('.navbar-brand {width: 270px; font-size:35px; text-align:left;}')))
)
)
server <- function(input, output, session) {
# this event hides the side panel when toggled on/off
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
if(!isTRUE(input$toggleSidebar)) {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
} else {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
}
})
myModal <- function() {
div(id = "Download_DATA",
modalDialog(easyClose = TRUE,
title = "Alert!",
"Please remove all the filters if you want a full dataset.",
br(),
br(),
downloadButton("download_excel","Download as XLSX")
)
)
}
# here we put all the data
data_sets <- list(df1 = data.frame(),
df2= iris,
df3 = mtcars)
# store current dataset in reactive so we can work with plot panels
data_to_use <- reactiveValues(name = "df", data = data.frame())
# modules only need to be called it once but individually for esquisse
callModule(
module = esquisserServer,
id = "esquisse2",
data = data_to_use
)
callModule(
module = esquisserServer,
id = "esquisse3",
data = data_to_use
)
observeEvent(input$controller, {
# skip first panel since it is used to display navigation
updateTabsetPanel(session, inputId= "hidden_tabs", selected = paste0("panel", input$controller))
# enswure value is avilable throught selected tabSet
req(input$controller)
# get current data and df name
data_to_use$data <- data_sets[[as.numeric(input$controller)]]
data_to_use$name <- names(data_sets[as.numeric(input$controller)])
# update table and sum
output[[paste0('panel', input$controller, '_data')]] <- DT::renderDT(server = FALSE, {
DT::datatable(data_to_use$data,
filter = 'top',
extensions = 'Buttons',
options = list(scrollY = 600,
scrollX = TRUE,
dom = '<"float-left"l><"float-right"f>rt<"row"<"col-sm-4"B><"col-sm-4"i><"col-sm-4"p>>',
lengthMenu= list(c(10, 25, 50, -1),
c('10', '25', '50','All')),
buttons = list(
list(extend = "collection", text = "Download",
filename = "data_excel",
exportOptions = list(
modifier = list(page = "all")
),
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('Download_DATA', true, {priority: 'event'});}"
)
)
),
scrollCollapse= TRUE,
lengthChange = TRUE,
widthChange= TRUE,
rownames = TRUE))})
output[[paste0('panel', input$controller, '_sum')]] <- renderPrint(summary(data_to_use$data))
})
# observes if download is clicked
observeEvent(input$Download_DATA, {
showModal(myModal())
})
# writes to an excel file
output$download_excel <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".xlsx", sep="")
},
content = function(file) {
write.xlsx(data_to_use$data, file, row.names = FALSE)
}
)
}
#runs the app
shinyApp(ui= ui, server= server)
1. I checked the HTML of esquisserUI, they give all dropdowns the same IDs if you use multiple esquisserUI. This is a big NO in HTML development and will cause a lot of issues. They call it a module, but they didn't follow Shiny module guidelines where to use NS() for all UI IDs. The easy proof is try this below. Then uncomment the second set of esquisserUI and esquisserServer and try again. You will find the dropdown no longer works.
library(esquisse)
ui <- fluidPage(
esquisserUI(
id = "esquisse1",
header = FALSE,
choose_data = FALSE
)#,
# esquisserUI(
# id = "esquisse2",
# header = FALSE,
# choose_data = FALSE
# )
)
server <- function(input, output, session) {
data_to_use <- reactiveValues(data = iris, name = "iris")
callModule(
module = esquisserServer,
id = "esquisse1",
data = data_to_use
)
# callModule(
# module = esquisserServer,
# id = "esquisse2",
# data = data_to_use
# )
}
shinyApp(ui, server)
Currently there is no straight fix for this unless you ask them to fix it. We need to use a workaround:
I added a new tab to the main panel called "plot" which is the esquisserUI, and two buttons in the data panel so when you click on the button, it will jump you to the plot panel with the right data.
library(shiny)
library(shinyjs)
library(shinyWidgets)
library(esquisse)
library(shinythemes)
library(xlsx)
library(DT)
# Credit: #Iz100 helped me a lot with UI.
ns <- NS("myapp")
ui <- fluidPage(
theme = shinytheme("simplex"),
useShinyjs(),
# Create Right Side Text
navbarPage(
title= div(HTML("G<em>T</em>")),
tabPanel("Data Set Info",
materialSwitch(inputId = "toggleSidebar", label = "Toggle Panel: ",
value = TRUE, status = "warning"),
sidebarLayout(
# radio/action buttons
sidebarPanel(
id = "Sidebar",
prettyRadioButtons(
inputId = "controller",
label = "Choose:",
choices = c("About"= 1,
"iris"= 2,
"mtcars" = 3,
"plots" = 4),
icon= icon("check"),
selected = 1,
status = "success",
animation="smooth"
),
br(),
br(),
a(actionButton(inputId = "admin_email", label = "Contact Admin",
icon = icon("envelope", lib = "font-awesome")),
href="mailto:my_awesome_email_address.com")
),
#panel where output is shown from server
mainPanel(
id = "main_panel",
tabsetPanel(
id = "hidden_tabs",
type = "hidden",
tabPanelBody(
"panel1", "navigation"
),
tabPanelBody(
"panel2",
tabsetPanel(
tabPanel(
"Data", DT::DTOutput('panel2_data'),
actionButton("plot2", "Plot iris")
),
tabPanel("Summary", verbatimTextOutput("panel2_sum"))
)
),
tabPanelBody(
"panel3",
tabsetPanel(
tabPanel(
"Data", DT::DTOutput('panel3_data'),
actionButton("plot3", "Plot mtcars")
),
tabPanel("Summary", verbatimTextOutput("panel3_sum"))
)
),
tabPanelBody(
"panel4",
esquisserUI(
id = "esquisse",
header = FALSE,
choose_data = FALSE
)
)
)
)
)
),
#resizes the navbar tabs/button
tags$head(tags$style(HTML('.navbar-brand {width: 270px; font-size:35px; text-align:left;}')))
)
)
server <- function(input, output, session) {
# this event hides the side panel when toggled on/off
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
if(!isTRUE(input$toggleSidebar)) {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
} else {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
}
})
myModal <- function() {
div(id = "Download_DATA",
modalDialog(easyClose = TRUE,
title = "Alert!",
"Please remove all the filters if you want a full dataset.",
br(),
br(),
downloadButton("download_excel","Download as XLSX")
)
)
}
# here we put all the data
data_sets <- list(df1 = data.frame(),
df2= iris,
df3 = mtcars)
# store current dataset in reactive so we can work with plot panels
data_to_use <- reactiveValues(name = "df", data = data.frame())
# modules only need to be called it once but individually for esquisse
callModule(
module = esquisserServer,
id = "esquisse",
data = data_to_use
)
# go to plot panel if plot button clicked
observeEvent(c(input$plot2, input$plot3), {
updatePrettyRadioButtons(session, "controller", selected = 4)
}, ignoreInit = TRUE)
observeEvent(input$controller, {
# skip first panel since it is used to display navigation
updateTabsetPanel(session, inputId= "hidden_tabs", selected = paste0("panel", input$controller))
# enswure value is avilable throught selected tabSet
# only render data if data panels are selected
req(input$controller %in% 2:3)
# get current data and df name
data_to_use$data <- data_sets[[as.numeric(input$controller)]]
data_to_use$name <- names(data_sets[as.numeric(input$controller)])
# update table and sum
output[[paste0('panel', input$controller, '_data')]] <- DT::renderDT(server = FALSE, {
DT::datatable(data_to_use$data,
filter = 'top',
extensions = 'Buttons',
options = list(scrollY = 600,
scrollX = TRUE,
dom = '<"float-left"l><"float-right"f>rt<"row"<"col-sm-4"B><"col-sm-4"i><"col-sm-4"p>>',
lengthMenu= list(c(10, 25, 50, -1),
c('10', '25', '50','All')),
buttons = list(
list(extend = "collection", text = "Download",
filename = "data_excel",
exportOptions = list(
modifier = list(page = "all")
),
action = DT::JS("function ( e, dt, node, config ) {
Shiny.setInputValue('Download_DATA', true, {priority: 'event'});}"
)
)
),
scrollCollapse= TRUE,
lengthChange = TRUE,
widthChange= TRUE,
rownames = TRUE))})
output[[paste0('panel', input$controller, '_sum')]] <- renderPrint(summary(data_to_use$data))
})
# observes if download is clicked
observeEvent(input$Download_DATA, {
showModal(myModal())
})
# writes to an excel file
output$download_excel <- downloadHandler(
filename = function() {
paste("data-", Sys.Date(), ".xlsx", sep="")
},
content = function(file) {
write.xlsx(data_to_use$data, file, row.names = FALSE)
}
)
}
#runs the app
shinyApp(ui= ui, server= server)
2. So server = TRUE only sends a very small portion of the entire dataset to UI for large ones. When you scroll or jump pages, new data will be sent. This saves time and has better performance. If it is FALSE, all data will be sent at once. Imagine you need to load a 2GB table in your browser everytime you start the app, how slow will it be. For small datasets, you can leave it FALSE.
Updates
It seems esquisse people fixed the bug. Install the develop version and then:
ui <- fluidPage(
esquisse_ui(
id = "esquisse1",
header = FALSE
),
esquisse_ui(
id = "esquisse2",
header = FALSE
)
)
server <- function(input, output, session) {
data_to_use <- reactiveValues(data = iris, name = "iris")
esquisse_server(id = "esquisse1", data_rv = data_to_use)
esquisse_server(id = "esquisse2", data_rv = data_to_use)
}
shinyApp(ui, server)

download button disappear after editing data table in shiny app

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)

make conditionalPanel appears when RData file is loaded in shinydashboard

I am making a shiny app that interacts with a big data.frame that I have stored as an RData file. I want the user to select the file, and once the RData is completely loaded (takes ~15 seconds) a second panel should show up allowing the user to input some sample name and do some operations.
Here is how my app looks now
header <- dashboardHeader(title="Analysis and database")
sidebar <- dashboardSidebar(
useShinyjs(),
sidebarUserPanel(),
hr(),
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "sidebarmenu",
menuItem("Analyse old data by Sample", tabName="oldfile", icon = icon("table"), startExpanded = FALSE),
fileInput(inputId = "file1", "Choose database file"),
conditionalPanel(
#condition = "input.sidebarmenu === 'oldfile'",
condition = "output.fileUploaded == 'true' ",
textInput(inputId = "sample", label ="Type a sample ID"),
actionButton("go2", "Filter")
)
)
)
body <- dashboardBody(
tags$style(type="text/css",
".shiny-output-error { visibility: hidden; }",
".shiny-output-error:before { visibility: hidden; }"),
tabItems(
tabItem("oldfile", "Sample name data.table",
fluidRow(DT::dataTableOutput('tabla_oldfile') %>% withSpinner(color="#0dc5c1")))
)
)
ui <- dashboardPage(header, sidebar, body)
### SERVER SIDE
server = function(input, output, session) {
options(shiny.maxRequestSize=100000*1024^2)
prop <- reactive({
if (input$go2 <= 0){
return(NULL)
}
result <- isolate({
if (is.null(input$file1))
return(NULL)
if (is.null(input$sample))
return(NULL)
inFile <- input$file1
print(inFile$datapath)
#big_df <- load(inFile$datapath)
print (big_df)
print(input$sample)
oldtable <- big_df1 %>% filter_at(vars(GATK_Illumina.samples:TVC_Ion.samples),
any_vars(stringi::stri_detect_fixed(., as.character(input$sample))))
oldtable
})
result
})
output$fileUploaded <- reactive({
return(!is.null(prop()))
})
outputOptions(output, 'fileUploaded', suspendWhenHidden=FALSE)
output$tabla_oldfile <- DT::renderDataTable({
DT::datatable(prop(),
filter = 'top',
extensions = 'Buttons',
options = list(
dom = 'Blftip',
buttons =
list('colvis', list(
extend = 'collection',
buttons = list(list(extend='csv',
filename = 'results'),
list(extend='excel',
filename = 'results'),
list(extend='pdf',
filename= 'results')),
text = 'Download'
)),
scrollX = TRUE,
pageLength = 5,
lengthMenu = list(c(5, 15, -1), list('5', '15', 'All'))
), rownames = FALSE
)
})
}
shinyApp(ui, server)
I have used the solution provide in Make conditionalPanel depend on files uploaded with fileInput but I can't make it work, there is another implementation using shinyjs package but don't know how to use it on my example

Resources