I have a shiny app with a longer computation depending on the input. I am wondering if it is possible to display a text in the main panel at the same time when the computation is done (and not before).
Let's make an easy example. I simulated the longer computation with Sys.sleep():
# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
h3('This is an example'),
plotOutput("distPlot")
)
)
))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
Sys.sleep(5)
})
})
# Run the application
shinyApp(ui = ui, server = server)
The goal would be, to show the text 'This is an example' at the same time the computation is done and not before.
I think I have to make the text somehow reactive, but so far I haven't found a solution for this. Maybe a conditionalPanel could do it, but how can I bring the computation time in the condition? Any ideas?
Would this be what you search for? Your text variable as a reactive after observing the event of distPlot
library(shiny)
# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
textOutput('text1'),
plotOutput("distPlot")
)
)
))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
Sys.sleep(2)
})
observeEvent(plotOutput("distPlot"), {
output$text1 <- renderText({ paste("Number of bins:", input$bins)})
})
})
# Run the application
shinyApp(ui = ui, server = server)
Related
I make shiny app with websocket connection, and want close connection, when i exiting (stop) my shiny app. I have a suggestion that function on.exit() can solve my problem, but I do not know where to use it in shiny app. Are there any other ways to close the connection when the application stops?
You can use session$onSessionEnded for this purpose. Once the session ended the code inside will run. For example:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
session$onSessionEnded(function() {
# you can put your code here to close the connection
})
}
# Run the application
shinyApp(ui = ui, server = server)
I have some plots which are displayed once the submit button is clicked but before that, the tab remains clean. I want some text to be displayed there so that the user can see something before hitting the submit button and once when the button is clicked, I want the text to be removed and it must display the plots.
Here is my take on the example shiny app:
library(shiny)
library(shinyjs)
# Define UI for application that draws a histogram
ui <- fluidPage(
useShinyjs(),
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("submit", "Show plot")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel(
"Plot",
uiOutput("help_text"),
plotOutput("distPlot")
)
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$help_text <- renderUI({
HTML("<b>Click 'Show plot' to show the plot.</b>")
})
plot_data <- eventReactive(input$submit, {
hide("help_text")
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$distPlot <- renderPlot({
plot_data()
})
}
# Run the application
shinyApp(ui = ui, server = server)
In the following code,
is it possible to put bins in movable panel like the color change panel.
The follwoing image shows one panel is movable but the other is not movable.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
shiny::tags$head(
shinythemes::themeSelector()
),#taghead
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
How to make movable panel?
Please let me know.
**Answer: The following code makes a draggable panel**
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
shiny::tags$head(
shinythemes::themeSelector()
),#taghead
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
# Show a plot of the generated distribution
mainPanel(
absolutePanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
draggable = T
),
plotOutput("distPlot")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Movable panels can be achieved with absolutePanel.
Is there a way to get italic words in my shiny titlePanel?
I tried
library(shiny)
# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Old <em>Faithful Geyser</em> Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})
# Run the application
shinyApp(ui = ui, server = server)
and this print the title as Old <em>Faithful Geyser</em> Data. The em does not get interpreted. Am I doing something wrong or isn't there a way to get italic font in the title?
hello try this it should work
titlePanel( div(HTML("Old <em>Faithful Geyser</em> Data")))
This is my ui.R. This is an example provided in Shiny tutorial. I just edited it.
library(shiny)
library(markdown)
# Define UI for application that draws a histogram
shinyUI(fluidPage(
# Application title
titlePanel("Hello Shiny!"),
# Sidebar with a slider input for the number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
absolutePanel(
bottom = 0, left=420, width = 800,
draggable = TRUE,
wellPanel(
em("This panel can be moved")
)
)
))
))
and my server. R
library(shiny)
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
# Expression that generates a histogram. The expression is
# wrapped in a call to renderPlot to indicate that:
#
# 1) It is "reactive" and therefore should be automatically
# re-executed when inputs change
# 2) Its output type is a plot
output$distPlot <- renderPlot({
x <- faithful[, 2] # Old Faithful Geyser data
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})**
In this case, sliderInput is not working. If i remove absolute panel, sliderInput is ok. What may be the problem? Many thanks
The absolutePanel uses the jqueryui javascript library. It has its own slider. This results in a conflict with sliderInput which uses jslider library. You can see this as follows:
library(shiny)
runApp(
list(ui = fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("distPlot")
, tags$head(tags$script(src = "shared/jqueryui/1.10.3/jquery-ui.min.js"))
)
)
),
server = function(input, output) {
output$distPlot <- renderPlot({
x <- faithful[, 2] # Old Faithful Geyser data
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
)
)
EDIT: This has been fixed in the latest dev version of shiny. The slider component has been removed from the jqueryui inc. https://github.com/rstudio/shiny/commit/7e12a281f51e047336ba2c501fcac43af5253225