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
R - Reading Lines from a .Txt-File After a Specific Line
Arranging Arrows Between Points Nicely in Ggplot2
What If I Want to Web Scrape with R for a Page with Parameters
Avoid Ggplot2 to Partially Cut Axis Text
As_Labeller with Expression() in Ggplot2 Facet_Wrap
Generate Rows Between Two Dates into a Data Frame in R
Possible Issue About Random Number Generator
R: Why Kable Doesn't Print Inside a for Loop
Add Legend to "Geom_Bar" Using the Ggplot2 Package
Select Last Row by Group for All Columns Data.Table
Twitter Emoji Encoding Problems with Twitter and R
Glmulti and Liner Mixed Models
Function Composition in R (And High Level Functions)
Extend Axis Limits Without Plotting (In Order to Align Two Plots by X-Unit)
Plot Linear Regressions Lines Without Interaction in Ggplot2