use the same dataTableOutput in different tabs - r

Is there a possibility to reuse a dataTableOutput in several tabs? The only possibility I found was using a layout where the dataTableOutput gets its own row but I don't want it above all tabs.
If I just call the dataTableOutput multiple times, none of the tables get printed.
EDIT:
Thanks to the answer of daattali I got this almost done. The only thing I didn't mentioned before was, I need the two tables synchronised in a way. At the moment, when I try to update each other via proxy, the whole system gets buggy when selecting to many rows in a short time...

You can't use the same id (since you can't have two elements on the same page with the same id), but what you can do is generate the table once as a reactive value and then simply return that value inside the render table functions. This has the benefit of only running the code for generating the table once, and re-using the table in as many outputs as you want.
Example:
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("tab1", "tab 1", DT::dataTableOutput("table1")),
tabPanel("tab2", "tab 2", DT::dataTableOutput("table2"))
)
)
server <- function(input, output, session) {
table_data <- reactive({
DT::datatable(iris)
})
output$table1 <- DT::renderDataTable(table_data())
output$table2 <- DT::renderDataTable(table_data())
}
shinyApp(ui = ui, server = server)

Related

How to disable all Shiny UI elements, including a downloadButton

This answer explains how can one disable/enable all UI elements in a Shiny app.
Among the two solutions given, the one I am interested in uses the shinyjs package (I'd rather not play with javascript directly).
My problem is that UI elements of the class downloadButton are not listed as elements of input.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
tagList(
downloadButton("downloadBtn", "Download button"),
actionButton("printBtn", "Print and disable all members of input")
)
)
server <- function(input, output) {
observeEvent(input$printBtn, {
print (names(input))
for(n in names(input))
shinyjs::disable(id=n)
})
}
shinyApp(ui = ui, server = server)
When I click on the "Print all members of input", only "printBtn" is printed ("downloadBtn" is not).
Hence, since downloadButton is not a member of input, disabling it by looping over all the elements of input - and disabling them one by one does not work.
Is there an elegant workaround that can be used in order to disable all of the elements?

Conditionally display single or multiple tables in Shiny App

I have a shiny app that I am building where the user selects a report from a radio button menu, and then the table displays on the page. I would like to add an option for the user to simultaneously view all reports. I have found something close to what I want from this thread https://gist.github.com/wch/5436415/ , but I can't quite seem to implement it properly. Basically, I think what I have to do is:
In the UI, make a call to uiOutput() to reactively update the User Interface. I will need multiple calls to htmlOutput() if the user selects the "all" button, but only one call to htmlOutput() if the use simply selects one report. For the record, I am creating my tables with the kable() function, which is why I call htmlOutput() instead of tableOutput().
In the server function, I need to make a call to renderUI() that provides the instructions on how many htmlOutput() calls there will be and which reports will be in each call.
Create a loop that then makes a call to renderText that then sends the html code for the htmlOutput function to interpret.
I can get most of the way there. I can get Shiny to have reactive tables, and output individual reports, but I am struggling to get the looping range to reactively update so that I see all three tables in my testing app. Here is what I have:
library(shiny)
library(shinydashboard)
library(knitr)
library(kableExtra)
data("cars")
data("iris")
data("airquality")
UI<-dashboardPage(
dashboardHeader(),
dashboardSidebar(sidebarMenu(
menuItem("Options", radioButtons(inputId = "Tables", label="test", choices= c("cars", "iris", "airquality", "all"))
) )),
dashboardBody(
uiOutput(outputId = "TABLE"),
textOutput("N")
)
)
server<-function(input, output){
TBL<-list("cars", "iris", "airquality")
T1<-knitr::kable(head(cars))
T2<-knitr::kable(head(iris))
T3<-knitr::kable(head(airquality))
tmp<-list(cars=T1, iris=T2, airquality=T3)
TABLES<-reactive({
ifelse(input$Tables=="all", tmp, tmp[input$Tables])
})
val<-reactive({
tmp<-TABLES()
length(tmp)})
n<-isolate(val())
output$TABLE<-renderUI({
req(input$Tables)
TAB<-TABLES()
TBL<-names(TAB)
tbls<-lapply(1:length(TBL), function(i){
tblnm<-paste("tbl", i, sep="_")
htmlOutput(tblnm)})
do.call(tagList, tbls)
})#Close Render UI
for(i in 1:n){
local({
j<-i
tblnm<-paste("tbl", j, sep="_")
output[[tblnm]]<-renderText(kables(TABLES()))
})
}
output$N<-renderText(n)
}#Close Server
shinyApp(ui = UI, server = server)
Here is where I think I am going wrong:
I included a textOutput() for the value of n, and despite having the reactive() call to get the length of TABLES, when I isolate() I still get the value of 1 even when I select the "all" report button, which should give me 3. Am I misinterpreting how isolate() works? Is there another way to get a value out of a reactive() function that can be used outside of a *Output() or reactive() function? Any guidance would be much appreciated. Thanks so much.
I think your server function is needlessly complex.
render functions are a reactive context themselves, so no need to define variables which only exist in those contexts as specifically reactive.
server<-function(input, output){
TBL<-list("cars", "iris", "airquality")
T1<-knitr::kable(head(cars))
T2<-knitr::kable(head(iris))
T3<-knitr::kable(head(airquality))
tmp<-list(cars=T1, iris=T2, airquality=T3)
output$TABLE<-renderUI({
if(input$Tables=="all"){ind <- names(tmp)}else{ind <- input$Tables}
lapply(tmp, HTML)[ind]
})
output$N <- renderText({
if(input$Tables=="all"){ind <- names(tmp)}else{ind <- input$Tables}
length(ind)
})
}

Optimizing Shiny Performance with Tabs and suspendWhenHidden = FALSE

I've got a Flexdashboard-based Shiny application with several tabs, and within each tab, grids of multiple plots. Performance is a bit of an issue, particularly when deployed on the free Shiny Server.
Initially, the main issue was that clicking each tab would require re-rendering of the plots. I set the suspendWhenHidden option to be FALSE, and this helps - Now switching the input has a slow delay to load all the plots, but at least when navigating the UI, performance is snappy.
This got me thinking, however - is there any way to achieve a hybrid of the two behaviors? So say I'm on an active tab which just produces a single plot. This plot renders quickly. Can we tell shiny to render this plot, display it to the user, and then in the background, continue loading all the elements of the other tabs? As it stands now, the active tab will not finish rendering the plot until all plots on the hidden tabs are also rendered.
In summary, a hybrid suspendWhenHidden = FALSE and TRUE:
Render the active tab elements first, display to the user, then
Continue rendering the elements on the hidden tabs
I thought perhaps setting priority might achieve this, but it doesn't seem to work. Any thoughts or suggestions?
Here's a minimal reproducible example. The goal would be for the first plot (in tab 1) to render and appear before beginning rendering of the second plot (in tab 2) - But the plot should start rendering in tab 2 without requiring a click of tab 2.
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
numericInput('n', 'Size', 10)
),
mainPanel(
tabsetPanel(
tabPanel("Tab1", plotOutput("plot1")),
tabPanel("Tab2", plotOutput("plot2"))))
)
)
# Define the server code
server <- shinyServer(function(input, output, session) {
output$plot1 <- renderPlot({plot(1:input$n)},height = 400,width=800)
output$plot2 <- renderPlot({ Sys.sleep(5); plot(1:input$n,col="red")},height = 400,width=800)
outputOptions(output, "plot2", suspendWhenHidden = FALSE)
})
# Return a Shiny app object
shinyApp(ui = ui, server = server)
There is two ways to achieve this
Load all the tabs and then show the output
Use eventReactive to activate the other tabs
For the first option just put below additionally
outputOptions(output, "plot1", suspendWhenHidden = FALSE)
and if you want reactivity write eventReactive functions for each tab.

With selectizeInput, stop the list of choices from closing after each selection

I am trying to include a selectizeInput widget in a Shiny app. However, one aspect of its behavior is problematic: each time I make a selection, the box containing the choices closes.
I took a look at the example app here: http://shiny.rstudio.com/gallery/selectize-examples.html. Specifically, input number 2: Multi-select. The selection window remains open in this example, yet I see no differences between that code and mine which would account for the variance in behavior.
For the sake of a reproducible example, I have put together the following code:
ui <- fluidPage(uiOutput("example"))
server <- function(input, output, session){
output$example <- renderUI({
selectizeInput(
inputId="people",
label=NULL,
choices=paste("A", 1:50, sep="_"),
multiple = TRUE,
selected=input$people
)
})
} # close server
shinyApp(ui = ui, server=server)
My guess is that I'm missing something obvious, so here's a chance for an easy answer for someone that knows their way around Shiny. Any help will be greatly appreciated.
When you remove the selected=input$people line, it works as intended.

Can I save the old value of a reactive object when it changes?

Note: After coming up with the answer I reworded the question to make if clearer.
Sometimes in a shiny app. I want to make use of a value selected by the user for a widget, as well as the previous value selected for that same widget. This could apply to reactive values derived from user input, where I want the old and the new value.
The problem is that if I try to save the value of a widget, then the variable containing that value has to be reactive or it will not update every time the widget changes. But, if I save the the value in a reactive context it will always give me the current value, not the previous one.
How can I save the previous value of a widget, but still have it update every time the user changes the widget?
Is there a way that does not require the use of an actionButton every time the user changes things? Avoiding an actionButton can be desirable with adding one is otherwise unnecessary and creates excess clicking for the user.
Seeing as the session flush event method seems to be broken for this purpose, here is an alternative way to do it using an observeEvent construct and a reactive variable.
library(shiny)
ui <- fluidPage(
h1("Memory"),
sidebarLayout(
sidebarPanel(
numericInput("val", "Next Value", 10)
),
mainPanel(
verbatimTextOutput("curval"),
verbatimTextOutput("lstval")
)
)
)
server <- function(input,output,session) {
rv <- reactiveValues(lstval=0,curval=0)
observeEvent(input$val, {rv$lstval <- rv$curval; rv$curval <- input$val})
curre <- reactive({req(input$val); input$val; rv$curval})
lstre <- reactive({req(input$val); input$val; rv$lstval})
output$curval <- renderPrint({sprintf("cur:%d",curre())})
output$lstval <- renderPrint({sprintf("lst:%d",lstre())})
}
options(shiny.reactlog = TRUE)
shinyApp(ui, server)
Yielding:
Update This answer was posted before the advent of the reactiveValues/observeEvent model in shiny. I think that #MikeWise 's answer is the better way to do this.
After some playing around this is what I came up with. The ui.r is nothing special
ui.r
library(shiny)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId="XX", label="Choose a letter",choices=letters[1:5])
),
mainPanel(
textOutput("Current"),
textOutput("old")
)
)
))
"Current" will display the current selection and "old" displays the previous selection.
In the server.r I made use of three key functions: reactiveValues, isolate and session$onFlush.
server.r
library(shiny)
server <- function(input, output,session) {
Values<-reactiveValues(old="Start")
session$onFlush(once=FALSE, function(){
isolate({ Values$old<-input$XX })
})
output$Current <- renderText({paste("Current:",input$XX)})
output$old <- renderText({ paste("Old:",Values$old) })
}
The server.r works like this.
First, Values$old is created using the reactiveValues function. I gave it the value "Start" to make it clear what was happening on load up.
Then I added a session$onFlush function. Note that I have session as an argument in my server function. This will run every time that shiny flushes the reactive system - such as when the selectizeInput is changed by the user. What is important is that it will run before input$XX gets a new value - so the value has changed at the selectizeInput but not at XX.
Inside the session$onFlush I then assign the outgoing value of XX to Values$old. This is done inside an isolate() as this will prevent any problems with input$XX gets updated with the new values. I can then use input$XX and Values$old in the renderText() functions.

Resources