Page Refresh Button in R Shiny

Add a page refresh button by using R Shiny

I do have a very simple and nice solution but it won't work for a file input.

Here's a solution that'll work for all inputs except a file input:

UPDATE 2017: this solution did not work on file inputs for the first 2 years, but it does now.

library(shiny)
library(shinyjs)
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
div(
id = "form",
textInput("text", "Text", ""),
selectInput("select", "Select", 1:5),
actionButton("refresh", "Refresh")
)
),
server = function(input, output, session) {
observeEvent(input$refresh, {
shinyjs::reset("form")
})
}
))

When you press "Refresh", all inputs will be reset to their initial values.

But file inputs are very strange and it's hard to "reset" them. See here. You could hack some JavaScript together to try to almost kind of reset an input field if you want. Here's how you would perform an actual page refresh:

library(shiny)
library(shinyjs)
runApp(shinyApp(
ui = fluidPage(
shinyjs::useShinyjs(),
shinyjs::extendShinyjs(text = "shinyjs.refresh = function() { location.reload(); }"),
textInput("text", "Text", ""),
actionButton("refresh", "Refresh")
),
server = function(input, output, session) {
observeEvent(input$refresh, {
shinyjs::js$refresh()
})
}
))

Disclaimer: both these solutions use a package I wrote, shinyjs

R Shiny Page Refresh Button for Multiple Tabs

You have to create 3 different buttons for each Tab, then you can call one of those to refresh:

library(shiny)
library(shinyjs)
library(shinydashboard)

jscode <- "shinyjs.refresh = function() { history.go(0); }"

header <- dashboardHeader(

)

sidebar <- dashboardSidebar(
tags$head(tags$style(HTML('.content-wrapper { height: 1500px !important;}'))),
sidebarMenu (
menuItem("A", tabName = "d1"),
menuItem("B", tabName = "d2"),
menuItem("C", tabName = "d3")
)
)

body <- dashboardBody(
useShinyjs(),
extendShinyjs(text = jscode),
tabItems(
tabItem(tabName = "d1",
box(title = "AAA",
actionButton("b1", "Save"))
),
tabItem(tabName = "d2",
box(title = "BBB",
actionButton("b2", "Save"))
),
tabItem(tabName = "d3",
box(title = "CCC",
actionButton("b3", "Save"))
)
)
)

# UI
ui <- dashboardPage(header, sidebar, body)

# Server
server <- function(input, output, session) {

observeEvent(c(input$b1,input$b2,input$b3), {
js$refresh()
},ignoreNULL = T,ignoreInit = T)

}

# Shiny dashboard
shiny::shinyApp(ui, server)

Simple refresh button in flexdashboard/Shiny? R

We can use invalidateLater(10000) to fetch the data every 10 seconds if the reset button is not preferred.

app:

library(shiny)
library(shinyjs)
library(DT)
library(gsheet)

ui <- fluidPage(
useShinyjs(),
actionButton("reset", inputId = "Refresh"),
DTOutput("table")
)

server <- function(input, output, session) {
observeEvent(input$Refresh, {
refresh()
})

data <- reactive({
#invalidateLater(10000)
gsheet2tbl("https://docs.google.com/spreadsheets/d/1CB2IQHb3g5d8KsEr-_lJNXPKnTBn2nhz_-AzBjRyRK4/edit#gid=0")
})

output$table <- renderDataTable({
datatable(data(),
editable = TRUE,
options = list(
columnDefs = list(list(className = "dt-center", targets = "_all"))
)
)
})
}

shinyApp(ui, server)

A third alternative is to directly re-render the data when the button is pressed:

code:

library(shiny)
library(shinyjs)
library(DT)
library(gsheet)

data <- gsheet2tbl("https://docs.google.com/spreadsheets/d/1CB2IQHb3g5d8KsEr-_lJNXPKnTBn2nhz_-AzBjRyRK4/edit#gid=0")

ui <- fluidPage(
useShinyjs(),
actionButton("reset", inputId = "Refresh"),
DTOutput("table")
)

server <- function(input, output, session) {

observeEvent(input$Refresh, {

df <- gsheet2tbl("https://docs.google.com/spreadsheets/d/1CB2IQHb3g5d8KsEr-_lJNXPKnTBn2nhz_-AzBjRyRK4/edit#gid=0")

output$table <- renderDT({
datatable(df,
editable = TRUE,
options = list(
columnDefs = list(list(className = "dt-center", targets = "_all"))
)
)})

})

#this will render once at the start of the app
output$table <- renderDataTable({

datatable(data,
editable = TRUE,
options = list(
columnDefs = list(list(className = "dt-center", targets = "_all"))
)
)
})
}

shinyApp(ui, server)

R Shiny: automatically refreshing a main panel without using a refresh button

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)

refresh the main panel screen in shiny using the action button

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)


Related Topics



Leave a reply



Submit