How do I add a loader page while my UI populates with computations on my dataset inside the server function? My UI populates with values in about 30 secs. So I want this loader page to show for 30 secs and then hide it to show my actual UI which would have filled up by then.
Any help would be appreciated. Here's the sample code below:
ui <- fluidPage(
useShinyjs(),
div(
id = "loading_page",
h1("Loading...")
),
titlePanel("XYZ"),
sidebarLayout(
sidebarPanel(
p("Lorem Ipsum"),
selectInput(inputId = "ab", label = "SelectSomething", choices = c("A","B","C","D")),
p("Please Wait for 30 secs for data to load.."),
sliderInput(inputId = "Age", label = "Age Range", min=16, max=45, value=c(16,45)),
actionButton(inputId = "update", label = "Go!")
),
mainPanel(
h3("ABC:"),
uiOutput("table"),
br(),
uiOutput("OP1"),
br(),
uiOutput("OP2"),
uiOutput("OP3"),
br(),
uiOutput("OP4")
)
)
)
dataset<-readRDS(file = "my_data.rds")
server <- function(input, output, session) {
})
It appears that you are using code from https://stackoverflow.com/a/35665217/3358272, which makes this a dupe of sorts, but perhaps not in the vein of: how to do that with more UI components.
Just wrap all of your title and sidepanel stuff in hidden(div(...)) with an id.
From there, you can allow other things to do some work by using a reactive observe block that fires twice: the first time it sets a wake-up alarm (3000 milliseconds here), the second time it removes the #loading_page div.
ui <- fluidPage(
useShinyjs(),
div(
id = "loading_page",
h1("Loading...")
),
hidden(
div(
id = "main_content",
titlePanel("XYZ"),
sidebarLayout(
sidebarPanel(
p("Lorem Ipsum"),
selectInput(inputId = "ab", label = "SelectSomething", choices = c("A","B","C","D")),
p("Please Wait for 30 secs for data to load.."),
sliderInput(inputId = "Age", label = "Age Range", min=16, max=45, value=c(16,45)),
actionButton(inputId = "update", label = "Go!"),
),
mainPanel(
h3("ABC:"),
uiOutput("table"),
br(),
uiOutput("OP1"),
br(),
uiOutput("OP2"),
uiOutput("OP3"),
br(),
uiOutput("OP4")
)
)
)
)
)
server <- function(input, output, session) {
already_started <- FALSE
observe({
if (already_started) {
removeUI("#loading_page")
} else {
invalidateLater(3000, session)
already_started <<- TRUE
}
})
}
It would also be "right" to use a reactiveVal for already_started. The reason I didn't was that we don't need reactivity from it, just a two-shot memory.
Related
I'm creating a R Shiny App that contains three tabs. I would like to display a filter on the first two tabs and no filter on the third tab. I would like the filter on tabs one and two to be synchronized.
library(shiny)
server <- function(input, output, session) {
dataset <- reactive({
get(input$dataset, "package:datasets")
})
output$summary <- renderPrint({
summary(dataset())
})
output$table <- renderTable({
dataset()
})
output$table_head <- renderTable({
head(dataset())
})
}
ui <- fluidPage(
tabsetPanel(type = "tabs",
tabPanel(title = "tab one filtered",
sidebarLayout(
sidebarPanel(
selectInput("dataset", label = "filter", choices = ls("package:datasets"))
),
mainPanel(
verbatimTextOutput("summary")
)
)
),
tabPanel(title = "tab two filtered",
sidebarLayout(
sidebarPanel(
selectInput("dataset", label = "filter", choices = ls("package:datasets"))
),
mainPanel(
tableOutput("table")
)
)
),
tabPanel(title = "tab three unfiltered",
mainPanel(
tableOutput("table_head")
)
)
)
)
shinyApp(ui, server)
My code is very similar to this. When I run this, the filter on the second page does not work. How can I display a synchronized filter on the first two tabs and no filter on the third tab. I've seen the suggestion to have the selectInput outside of the tabsetPanel but the filter will show on the third page. Thanks for the help.
You can't have two elements with the same ID in a given layout. So first you'll want to given them separate IDs
tabPanel(title = "tab one filtered",
sidebarLayout(
sidebarPanel(
selectInput("dataset1", label = "filter", choices = ls("package:datasets"))
),
mainPanel(
verbatimTextOutput("summary")
)
)
),
tabPanel(title = "tab two filtered",
sidebarLayout(
sidebarPanel(
selectInput("dataset2", label = "filter", choices = ls("package:datasets"))
),
mainPanel(
tableOutput("table")
)
)
),
then you'll need to do some extra work in the server to keep them insync.
server <- function(input, output, session) {
datasetname <- reactiveVal(ls("package:datasets")[1])
observeEvent(input$dataset1, {
updateSelectInput(session, "dataset2", selected=input$dataset1)
datasetname(input$dataset1)
})
observeEvent(input$dataset2, {
updateSelectInput(session, "dataset1", selected=input$dataset2)
datasetname(input$dataset2)
})
dataset <- reactive({
get(datasetname(), "package:datasets")
})
...
}
We keep a separate reactive value datasetname to keep track of the active name. Then we update the UI when one of the two dataset1/dataset2 values changes.
I am trying to get a Shiny dashboard although my graph will not work.
I have a data.frame consisting of a Date column in date format and 4 numeric column types which are ISA, NonISA, FixedRateInterest and VariableRateInterest and have filled the N/A values with 0.
I have checkboxes with a date range slider and I can get the graph to render but when I try and add in the DateRangeslider it doesn't not work and throws the following error:
Unknown input:data.frame
This is my code to create the dashboard. Can anyone help me understand why it is not working please? I know it has something to do with the ggplot line but not sure what.
Thanks
isa <- read.csv("isa.csv")
isa$Date <- paste0(isa$Date, "01")
isa$Date <- as.character(isa$Date)
isa$Date <- as.Date(isa$Date, format = "%Y%m%d")
date <- isa$Date
# Define UI ----
ui <- fluidPage(
titlePanel("Customer"),
sidebarLayout(
sidebarPanel(
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
img(src = "Logo.jpg", height = 100, width = 150)),
fluidRow(
h1("Choose Dataset"),
br(),
br(),
column(1,
checkboxGroupInput(inputId = "product",
h3("Product"),
choices = c('ISA',
"Non-ISA",
"Fixed",
"Variable"),
selected = 1)),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
br(),
column(2,
dateRangeInput(inputId = "dates", h3("Date Range"),
start = min(isa$Date),
end = max(isa$Date),
min = min(isa$Date),
max = max(isa$Date),
separator = "-", format = "yyyy/mm/dd")
))),
br(),
br(),
br(),
mainPanel(
plotOutput("barplot")
)
)
)
# Define server logic ----
server <- function(input, output) {
dataInput <- reactive({
switch(input$product,
"ISA" = ISA,
"Non-ISA" = isa$NonISA,
"Fixed" = isa$FixedRateInterest,
"Variable" = isa$VariableRateInterest)
It Is here that it seems to fail
})
dateInputx <- reactive({
isa[isa$Date >= input$dates[1] & isa$Date <= input$dates[2],]
})
output$barplot <- renderPlot({
And doesn't recognise the x axis on ggplot
ggplot(data = dataInput(), aes_string(x= dateInputx(), y = dataInput())) +
geom_line(stat ="identity")
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Your data argument in ggplot should be a dataframe and not a column. Then, use aes_string() with the corresponding column names. I've tried to make a reproducible example below:
library(shiny)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput('ycol','Y axis',choices = c('City Mileage','Highway Mileage')) #
),
mainPanel(
plotOutput('plot')
)
)
)
server <- function(input,output){
data(mpg) # Replace mpg with your dataframe of choice(isa in your case)
dataInput <- reactive({ # Required y column name as in dataframe
switch(input$ycol,
"City Mileage" = 'cty',
"Highway Mileage" = 'hwy')
})
output$plot <- renderPlot({
# Use aes_string for column names stored in strings
p <- ggplot(data=mpg,aes_string(x='displ',y=dataInput()))+
geom_line()
p
})
}
shinyApp(ui,server)
I'm a Shiny newbie and I have probably a simple question, but I swear I spent half day reading solutions here and can't find anything close to what I need.
Imaging you have a database with employees ID, name, last name, age.
I need to have in my app a text input that allows the user to enter the ID and to see on the same row the name, last name and age.
The problem I face is that textInput will have a label (say "ID").
All the three other fields, that I need to be on the same row, won't have a label.
So what I would need is either a way to add a label to the three textOutput elements or to display them as textInput with a default value that has to change/behave like an output as soon as a user enters a new ID. But how?
This is my sample code:
library(shiny)
u <- fluidPage(
titlePanel("Simple Selectable Reactive Function"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h2("Results"),
fluidRow(column(2,
textInput("input_ID", label = "Cusip 1",
value = "123")),
column(2,
textOutput(outputId = "output_name")),
column(2,
textOutput(outputId = "output_lastname")),
column(2,
textOutput(outputId = "output_age"))
)
)
)
)
s <- function(input,output){
output$output_name <- renderText(
{ # here is where I will check in a database
paste("Sample Name")
})
output$output_lastname <- renderText(
{ # here is where I will check in a database
paste("Sample Last Name")
})
output$output_age <- renderText(
{ # here is where I will check in a database
paste("Sample Age")
})
}
shinyApp(ui=u,server=s)
Perhaps I have to use different widgets?
Thank you
I updated the code to change the label using an textInput as suggested in the comment. Perhaps it helps to understand exactly what you are looking for.
library(dplyr)
library(shiny)
library(shinyjs)
u <- fluidPage(
titlePanel("Simple Selectable Reactive Function"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h2("Results"),
fluidRow(
column(2, textInput("input_ID", label = "Cusip 1",value = "123")),
column(2, textInput("output_name", label = "Firstname") %>% disabled()),
column(2, textInput("output_lastname", label = "Lastname") %>% disabled()),
column(2, textInput("output_age", label = "Age") %>% disabled())))))
s <- function(input,output, session){
observe({
id <- input$input_ID
set.seed(id)
df <- list(firstname = sample(LETTERS, 1), lastname = sample(LETTERS, 1), age = sample(1:100, 1))
updateTextInput(session, inputId = "output_name", label = df[["firstname"]])
updateTextInput(session, inputId = "output_lastname", label = df[["lastname"]])
updateTextInput(session, inputId = "output_age", label = df[["age"]])
})
}
shinyApp(ui=u,server=s)
How I create label for my UI is simply adding a h3 tag above each textoutput:
library(shiny)
u <- fluidPage(
titlePanel("Simple Selectable Reactive Function"),
sidebarLayout(
sidebarPanel(),
mainPanel(
h2("Results"),
fluidRow(column(2,
textInput("input_ID", label = "Cusip 1",
value = "123")),
column(2,
h3("First Name: "),
textOutput(outputId = "output_name")),
column(2,
h3("Last Name: "),
textOutput(outputId = "output_lastname")),
column(2,
h3("Age: ),
textOutput(outputId = "output_age"))
)
)
)
)
I have the following code:
library(shiny)
vec <- seq(1,10)
ui <- fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(
fluidRow(
selectInput("selection", "Select number", vec, multiple = TRUE),
actionButton("First_fives", "First Fives" ),
actionButton("Last_fives", "Last Fives"),
actionButton("ok", "OK"))
),
mainPanel(
fluidRow(
h5("Selected numbers:")),
textOutput('num')
)
)
)
server <- function(input, output, session) {
observeEvent(input$First_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[1:5])
})
observeEvent(input$Last_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[6:10])
})
data <- reactiveValues()
observeEvent(input$ok,{
data$selected <- input$city
})
output$num <- renderText({data$selected})
}
shinyApp(ui = ui, server = server)
I almost managed to do what I want but not quite.
My selectInput box is empty when running the code and you can select amongst 10 items (from 1 to 10). This is fine.
Now I would like, when clicking on the button "First fives", the numbers 1 to 5 to be added to this empty box. In others words I would like to get the same as on the picture below in one click.
Please add selected on the updateSelectInput. The code will be like this:
observeEvent(input$First_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[1:5],selected = vec[1:5])
})
observeEvent(input$Last_fives,{
updateSelectInput(session, inputId = "selection", choices = vec[6:10],selected = vec[6:10])
})
Please not I have only checked this function,not others.
Pls check if this meet your requirements.
Consider the example below
ui.R:
library(shiny)
library(shinyjs)
shinyUI(
tabPanel("VIEW",
tabsetPanel(id="viewic",
tabPanel("view1",
fluidRow( column(2,
actionButton("button1", "BUTTON1")),
column(2,
actionButton("button2", "BUTTON2"))
))
tabPanel(" View2"))),
fluidRow(
uiOutput("ui1")
),
fluidRow(
uiOutput("ui2")
))
Server:
library(shiny)
library(shinyjs)
shinyServer(function(input, output,session){
observeEvent(
input$button1,
output$ui1 <- renderUI({isolate({
column(3,
selectInput("selectview1",
label = "Select Id",
choices = c("1","2","3")
))})}))
observeEvent(
input$button2,
output$ui2 <- renderUI({isolate({
column(3,
selectInput("selectview2",
label = "Select Id",
choices = c("4","5","6")
))})}))
})
How to reset the session,ie; when I press button1 the selectinput with id selectview1 appears and when I press the button2 the selectInput with id selectview2 defined inside it appears but the selectinput that appeared firstly when the button1 was clicked is also being displayed along with it and vice versa.I tried reset and toggle but it didn't worked properly.
EDIT: use conditionalPanel on your selectInputs. So something to the effect of:
conditionalPanel(condition = 'input.button1 % 2 > 0',
uiOutput("ui1")
)
This checks whether or not the value of your actionButton is even and only displays it when it is odd. So assuming the button starts at a 0 value, it will display after 1, 3, 5, 7... clicks.
I think this should work. Can you try it out?
If you just want to hide a button depending on a click, look into conditionalPanel() and wrap your button code (ui side) in that function.
http://shiny.rstudio.com/reference/shiny/latest/conditionalPanel.html
ui.R
library(shiny)
library(shinyjs)
shinyUI(
fluidPage(
tabPanel("VIEW",
tabsetPanel(id="viewic",
tabPanel("view1",
fluidRow( column(2,
actionButton("button1", "BUTTON1")),
column(2,
actionButton("button2", "BUTTON2"))
)),
tabPanel(" View2"))),
fluidRow(
uiOutput("ui1")
),
fluidRow(
uiOutput("ui2")
)))
server.R
library(shiny)
library(shinyjs)
shinyServer(function(input, output,session){
observeEvent(
input$button1,
output$ui1 <- renderUI({isolate({
output$ui2<-renderUI(
isolate({
dataTableOutput(NULL)
} ) )
column(3,
selectInput("selectview1",
label = "Select Id",
choices = c("1","2","3")
))})}))
observeEvent(
input$button2,
output$ui2 <- renderUI({isolate({
output$ui1<-renderUI(
isolate({
dataTableOutput(NULL)
} ) )
column(3,
selectInput("selectview2",
label = "Select Id",
choices = c("4","5","6")
))})}))
})
This code worked.