I have a Shiny app with multiple actionButton commands. When I click each button individually (e.g., to plot a graph or render a table), I would like my main panel to automatically update/refresh with the corresponding graph or table. Instead, my Shiny app simply appends the output of one actionButton to the previous output of the other actionButton within the same panel.
From previous Stack Overflow posts, it seems that the only way around this problem is to implement a refresh button. For instance, in the following MWE:
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10),
actionButton("submit1" ,"Submit", icon("refresh"),
class = "btn btn-primary"),
actionButton("refresh1" ,"Refresh", icon("refresh"),
class = "btn btn-primary")
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
global <- reactiveValues(refresh = FALSE)
observe({
if(input$refresh1) isolate(global$refresh <- TRUE)
})
observe({
if(input$submit1) isolate(global$refresh <- FALSE)
})
observeEvent(input$submit1, {
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
if(global$refresh) return()
tagList(lapply(1:10, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)
Source: https://stackoverflow.com/a/43522607
You need to click on the refresh button in order to clear the previous output before displaying a new output, otherwise they will stack on top of each other.
Is there a way to dynamically/reactively refresh a main panel without explicitly clicking on a refresh button? For instance, it would be nice to click on a new actionButton button to display the next output and have it auto-refresh the main panel at the same time. Please feel free to supply your own MWE to show how this process could work.
The code looks familiar ;)
Turns out you were right with your idea. Basically you have to trigger the output twice. Once to clear the panel and once to write the new outputs. So thats what i do below with global$dt.
Full app below:
library(DT)
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10),
actionButton("submit1" ,"Submit", icon("refresh"),
class = "btn btn-primary")
),
mainPanel(
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
global <- reactiveValues(dt = NULL)
observeEvent(input$submit1, {
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
observeEvent(input$submit1, {
global$dt <- NULL
global$dt <- tagList(lapply(1:input$amountTable, function(i) {
dataTableOutput(paste0('T', i))
}))
})
output$dt <- renderUI({
global$dt
})
}
shinyApp(ui, server)
Related
I have a simple task of printing the output of a call to table() on a selected variable.
I want to display the output when the button "Print" is clicked.
In the following example, once the button is clicked, the output is always triggered when I change the selected variable.
If I clicked "Print", and then change the selected variable, I want the ouput to be gone, waited to be printed again when clicking "Print".
Thank you!
Here is a reproducible example:
library(shiny)
data = iris
ui = fluidPage(
uiOutput("selectvar"),
actionButton("print", "Print"),
verbatimTextOutput("info")
)
server = function(input, output, session)
{
output$selectvar = renderUI({
selectInput("selectedvar",
"Select variable",
choices = colnames(iris))
})
tab = reactive( table(data[[input$selectedvar]]) )
observeEvent(input$print, {
output$info = renderPrint( tab() )
})
}
shinyApp(ui, server)
That's because output$info is reactive to tab(), even while it is enclosed in an observeEvent. I think this app does what you want:
library(shiny)
data = iris
ui = fluidPage(
uiOutput("selectvar"),
actionButton("print", "Print"),
verbatimTextOutput("info")
)
server = function(input, output, session)
{
output$selectvar = renderUI({
selectInput("selectedvar",
"Select variable",
choices = colnames(iris))
})
tab <- reactiveVal()
observeEvent(input$selectedvar, {
tab(NULL)
})
observeEvent(input$print, {
tab(table(data[[input$selectedvar]]))
})
output$info <- renderPrint({
tab()
})
}
shinyApp(ui, server)
I want to generate a boxPlus around my DT-Output. Now when I start my APP, the frame of the box is already there. How do I manage that the box is only displayed when the tableoutput is finished? As input I use a text input.
In my UI I use for the Input:
textInput("name", "Insert Number:")
the final box I create with:
uiOutput("box")
On Serverside I do:
output$name <- renderText(input$name)
New_input <- reactive({
list(input$name)
})
and the box I create like this:
output$box <- renderUI({
boxPlus(
div(style = 'overflow-x: scroll;'), dataTableOutput("table")
)
})
I tried it with: Similar Problem but I can not resolve the problem. Without the box everything works fine.
Never use reactive expressions inside a renderText function.
You have to wrap tagList around your two elements to return a SINGLE element (a list in your case).
Here is a reproduceable example.
library(shiny)
library(shinydashboardPlus)
library(dplyr)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Hide box"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
textInput("name", "Insert Number to filter cyl:")
),
mainPanel(
uiOutput("box")
)
)
)
server <- function(input, output) {
resultdf <- reactive({
mtcars %>%
filter(cyl > input$name)
})
output$box <- renderUI({
output$table <- renderDataTable({
resultdf()
})
if(input$name == "") {
return(NULL)
} else {
return(
tagList(
boxPlus(
div(style = 'overflow-x: scroll;'), dataTableOutput("table")
)
)
)
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have a tabbed UI that shows up whenever the user selects rows in a datatable (in the following code, the outputs are random, in real life the calculation is quite involved).
I would like to condition the tabbed UI showing up to the click of a button. Currently every time you select an additional row, it does the calculation all over again for the already selected rows. I would like to limit that to a one-time calculation when the user is done selecting all the rows he wants to see.
library(shiny)
library(DT)
The UI : the table, the action button and the tabbed section.
ui <- fluidPage(
mainPanel(
fluidRow(
column(12,DT::dataTableOutput(outputId = 'tableCurrencies'))
),
actionButton(inputId = 'showSelectedButton',label = 'Show Selec'),
fluidRow(
uiOutput("myTabUI")
)
)
)
The server function : If I remove the output$myTabUI <- eventReactive(input$launchCalcButton, { part and instead do output$myTabUI <- renderUI ({ ... directly it works as intended (minus the calculation following click on the button of course).
server <- function(input,output){
output$tableCurrencies <- DT::renderDataTable({datatable(data.frame(a=rnorm(10),b=rnorm(10),c=rnorm(10)))})
origTable_selected <- reactive({
ids <- input$tableCurrencies_rows_selected
return(ids)
})
output$myTabUI <- eventReactive(input$launchCalcButton, {
selectedTabs <- renderUI({
myTabs <- lapply(origTable_selected(),function(i) {
tabName <- paste0("test",i)
a <- renderPlot({
hist(rnorm(50))
})
output[[paste0(tabName,"rates")]] <- a
return(tabPanel(
tabName,
fluidRow(
column(6,plotOutput(paste0(tabName,"rates")))
)
))
})
return(do.call(tabsetPanel,myTabs))
})
selectedTabs
})
}
app = shinyApp(ui,server)
runApp(app,port=3250,host='0.0.0.0')
Not sure how to go about fixing this. Any help welcome.
You can use isolate() to limit reactive dependencies
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
fluidRow(
column(12,DT::dataTableOutput(outputId = 'tableCurrencies'))
),
actionButton(inputId = 'showSelectedButton',label = 'Show Selec'),
fluidRow(uiOutput("myTabUI"))
)
)
server <- function(input,output){
output$tableCurrencies <- DT::renderDataTable({
data.frame(a=rnorm(10),b=rnorm(10),c=rnorm(10))})
origTable_selected <- reactive({
input$tableCurrencies_rows_selected
})
output$myTabUI <- renderUI({
input$showSelectedButton
myTabs <- lapply(isolate(origTable_selected()),function(i) {
tabName <- paste0("test",i)
a <- renderPlot({hist(rnorm(50))})
output[[paste0(tabName,"rates")]] <- a
return(tabPanel(
tabName,
fluidRow(column(6,plotOutput(paste0(tabName,"rates"))))
))
})
do.call(tabsetPanel,myTabs)
})
}
shinyApp(ui,server)
I am building a shiny app and I want to refresh the main panel screen. Here is a sample code. I have a submit button to display the data and I have a re-fresh button to clear the screen. I am not so sure how to code the re-fresh button in R and shiny since I am new to this. Thanks for looking into
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10),
actionButton("submit1" ,"Submit", icon("refresh"),
class = "btn btn-primary"),
actionButton("refresh1" ,"Refresh", icon("refresh"),
class = "btn btn-primary")
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
observeEvent(input$submit1, {
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
tagList(lapply(1:10, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)
You could add the possibility of return nothing from the renderUI() if the refresh button is used.
As it is not that straightforward to reset an action button you would have to use a workaround with a reactive variable.
if(global$refresh) return()
This reactive variable you can control with the refresh and submit button
E.g. if(input$refresh1) isolate(global$refresh <- TRUE)
which you wrap in seperate observe functions.
Full code see below:
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("amountTable", "Amount Tables", 1:10),
actionButton("submit1" ,"Submit", icon("refresh"),
class = "btn btn-primary"),
actionButton("refresh1" ,"Refresh", icon("refresh"),
class = "btn btn-primary")
),
mainPanel(
# UI output
uiOutput("dt")
)
)
)
server <- function(input, output, session) {
global <- reactiveValues(refresh = FALSE)
observe({
if(input$refresh1) isolate(global$refresh <- TRUE)
})
observe({
if(input$submit1) isolate(global$refresh <- FALSE)
})
observeEvent(input$submit1, {
lapply(1:input$amountTable, function(amtTable) {
output[[paste0('T', amtTable)]] <- DT::renderDataTable({
iris[1:amtTable, ]
})
})
})
output$dt <- renderUI({
if(global$refresh) return()
tagList(lapply(1:10, function(i) {
dataTableOutput(paste0('T', i))
}))
})
}
shinyApp(ui, server)
I'm a bit rusty to Shiny reactivity, but I want to do two things when a button is clicked:
add that button label to the sidebar (and add more labels to sidebar after more clicks)
update the button labels (i.e. more random integers)
I'm nervous about changing the label before recording it, so I want to get the timing right. Here's a skeleton of what I'm working with:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textOutput("clicks")
),
mainPanel(
uiOutput("button1"),
uiOutput("button2")
))
)
###################
server <- function(input, output, session) {
output$clicks <- renderText({
paste()
})
## reactive values
inside <- reactive({
inside <- sample(1:100,2)
})
## buttons
output$button1 <- renderUI({
actionButton("course1", label = inside()[1], style='padding:50px')
})
output$button2 <- renderUI({
actionButton("course2", label = inside()[2], style='padding:50px')
})
}
shinyApp(ui = ui, server = server)
Right now the sidebar is blank because I'm not sure how to add it, or what to add to make the button labels update after a click (whether to do it inside a reactive value or an observeEvent). Any help is much appreciated!
Here's a way to do it with reactiveValues:
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
textOutput("clicks")
),
mainPanel(
uiOutput("button1"),
uiOutput("button2")
))
)
###################
server <- function(input, output, session) {
# Show history
output$clicks <- renderText({
history[['clicked']]
})
## reactive values
# store history as reactive values
history <- reactiveValues(clicked = c())
# update history when a button is clicked
observeEvent(input$course1,{
history[['clicked']] <- c(history[['clicked']],inside()[1])
})
observeEvent(input$course2,{
history[['clicked']] <- c(history[['clicked']],inside()[2])
})
#update inside when history updates
inside <- reactive({
history[['clicked']]
inside <- sample(1:100,2)
})
## buttons
output$button1 <- renderUI({
actionButton("course1", label = inside()[1], style='padding:50px')
})
output$button2 <- renderUI({
actionButton("course2", label = inside()[2], style='padding:50px')
})
}
shinyApp(ui = ui, server = server)