I have the below sample code from an application to genarate a plot and render to UI.
library(shiny)
ui <- fluidPage(
selectInput("choice", "Choose", choices = names(mtcars)),
actionButton("run", "Run"),
plotOutput("some_ui")
)
server <- function(input, output, session) {
output$some_ui <- renderPlot({
if(input$run==0) return()
withProgress(message = paste("Drawing heatmap, please wait."),{
heatmap_render(x,y) ##custom function to generate plot###
})
})
}
This is not a working example as it includes a custom function to generate plot. This approach works.
However, i would need to display a default plot when the application is launched and before te action button is clicked. I tried a couple of approaches.
ui <- fluidPage(
selectInput("choice", "Choose", choices = names(mtcars)),
actionButton("run", "Run"),
plotOutput("some_ui")
)
server <- function(input, output, session) {
output$some_ui <- renderUI({
if(input$run == 0)return()
list(src = "www/heatmap.png")
})
output$some_ui <- renderPlot({
if(input$run == 0) return()
withProgress(message = paste("Drawing heatmap, please wait."),{
heatmap_render(x,y) ##custom function to generate plot###
})
})
}
This did not render the default plot but works normal when the action button is clicked.
Apporoach 2: Changed plotOutput to uiOutput.
ui <- fluidPage(
selectInput("choice", "Choose", choices = names(mtcars)),
actionButton("run", "Run"),
uiOutput("some_ui")
)
server <- function(input, output, session) {
output$some_ui <- renderUI({
if(input$run==0)return()
list(src = "/www/heatmap.png")
})
output$some_ui <- renderPlot({
if(input$run == 0) return()
withProgress(message = paste("Drawing heatmap, please wait."),{
heatmap_render(x,y) ##custom function to generate plot###
})
})
}
This gives the error Error in pngfun: invalid quartz() device size when actionButton is triggered. And defualt image ("www/heatap.png")is not shown.
Also using renderImage in approach 2 gives the same error Error in pngfun: invalid quartz() device size when actionButton is triggered.And defualt image ("www/heatap.png")is not shown.
output$some_ui <- renderImage({
if(input$run==0)return()
list(src = "www/heatmap.png", contentType = 'image/png')
}, deleteFile = FALSE)
Any help to render default plot when the application is launched?
Related
I want to update output data on update button every time.
Here is my code which show the output on update button for the first time I run the code but in runtime if the input is changed, the output is updated automatically.
library(shiny)
ui <- fluidPage(
titlePanel("My Shop App"),
sidebarLayout(
sidebarPanel(
helpText("Controls for my app"),
selectInput("item",
label = "Choose an item",
choices = list("Keyboard",
"Mouse",
"USB",
sliderInput("price",
label = "Set Price:",
min=0, max = 100, value=10),
actionButton ("update","Update Price")
),
mainPanel(
helpText("Selected Item:"),
verbatimTextOutput("item"),
helpText("Price"),
verbatimTextOutput("price")
)
)
)
server <- function(input, output) {
SelectInput <- eventReactive (input$update , {
output$item = renderText(input$item)
output$price = renderText(input$price)
})
output$item <- renderText(SelectInput())
output$price <- renderText(SelectInput())
}
shinyApp(ui = ui, server = server)
Either create a dependency and put them into the reactive and return it:
server <- function(input, output) {
SelectInput <- eventReactive(input$update,{
list(item = input$item, price = input$price)
})
output$item <- renderText(SelectInput()$item)
output$price <- renderText(SelectInput()$price)
}
Or you can isolate, but then you have to add the button reaction to each listener
server <- function(input, output) {
output$item <- renderText({
req(input$update)
input$update
isolate(input$item)
})
output$price <- renderText({
req(input$update)
input$update
isolate(input$price)
})
}
I'd like to have an actionButton that cycles its class between "btn-success", "btn-warning", "btn-danger" based on the button click. Unfortunately I can't seem to figure out how to get that value into the class argument of the actionButton.
library(shiny)
v <- reactiveValues(btn_status = "btn-secondary")
ui <- fluidPage(
# Application title
titlePanel("Change Button Color on click"),
# Create an action button that cycles through 3 bootstrap colors and can be reset
mainPanel(
actionButton("run","L", class = isolate(v$btn_status)),
actionButton("reset", "Clear"),
textOutput("status"),
)
)
server <- function(input, output) {
observeEvent(input$run, {
v$btn_status <- "btn-success"
})
observeEvent(input$reset, {
v$btn_status <- "NULL"
})
output$status <- renderText({
v$btn_status
})
}
shinyApp(ui = ui, server = server)
It's not entirely clear to me what you're trying to do (see my comment above); but I think you're after something like this:
library(shiny)
valid_status <- c("btn-success", "btn-warning", "btn-danger")
ui <- fluidPage(
titlePanel("Change Button Color on click"),
mainPanel(
uiOutput("statusButton"),
actionButton("reset", "Clear"),
textOutput("status"),
)
)
server <- function(input, output, session) {
v <- reactiveValues(button_idx = 1)
get_button_idx <- reactive(v$button_idx)
output$statusButton <- renderUI({
idx <- get_button_idx()
actionButton("run", "L", class = valid_status[idx])
})
observeEvent(input$run, {
v$button_idx <- ifelse(v$button_idx < 3, v$button_idx + 1, 1)
})
observeEvent(input$reset, {
v$button_idx <- 1
})
output$status <- renderText({
valid_status[v$button_idx]
})
}
shinyApp(ui = ui, server = server)
producing
The key is to use a reactive value within renderUI to update the class of the actionButton. To align the buttons you could use fluidRow if necessary.
Here is a sample code to generate a plot upon clicking the actionButton.
shinyApp(
shinyUI(fluidPage(
inputPanel(
numericInput("n", "n", 10),
actionButton("update", "Update")
),
plotOutput("plot")
)),
shinyServer(function(input, output) {
values <- reactiveValues()
values$data <- c()
obs <- observe({
input$update
isolate({ values$data <- c(values$data, runif(as.numeric(input$n), -10, 10)) })
}, suspended=TRUE)
obs2 <- observe({
if (input$update > 0) obs$resume()
})
output$plot <- renderPlot({
dat <- values$data
hist(dat)
})
})
)
I would like to display a default plot which is in www/test.png to appear when the application is launched. And then change the plot after clicking the actionButton as per the user input.
First, I create a simple plot, export it as an image (manually, not in code) and name it Rplot.png (save it where you want):
plot(mtcars$mpg)
Then, in the shiny app, we have to distinguish two situations :
when the app starts, no button is clicked yet, we render the image with renderImage
when we click on the button, we replace renderImage with renderPlot and render an interactive plot
This means that we must use uiOutput in ui part so that we can choose the output to be an image or a plot according to the situation.
Here's an example (I didn't adapt your code but it should not be too difficult):
library(shiny)
# determine your path to image here (you should use the package "here" to do so)
ui <- fluidPage(
selectInput("choice", "Choose", choices = names(mtcars)),
actionButton("run", "Run"),
uiOutput("some_ui")
)
server <- function(input, output, session) {
### "Static" part: no click on actionButton yet
output$some_ui <- renderUI({
imageOutput("image_plot")
})
output$image_plot <- renderImage({
list(src = "Rplot.png",
contentType = 'image/png')
}, deleteFile = FALSE) # Do not forget this option
### Click on actionButton
observeEvent(input$run, {
output$some_ui <- renderUI({
plotOutput("dynamic_plot")
})
output$dynamic_plot <- renderPlot({
plot(mtcars[[input$choice]])
})
})
}
shinyApp(ui, server)
The key is to use renderUI, so you can either show an image or a R plot. This should do what you desire:
shinyApp(
shinyUI(fluidPage(
inputPanel(
numericInput("n", "n", 10),
actionButton("update", "Update")
),
uiOutput("out")
)),
shinyServer(function(session, input, output) {
values <- reactiveValues()
# check if plot has been already rendered
check <- reactiveVal(FALSE)
values$data <- c()
observeEvent(input$update, {
# set check to TRUE
check(TRUE)
input$update
values$data <- c(values$data, runif(as.numeric(input$n), -10, 10))
dat <- values$data
output$plot <- renderPlot({
hist(dat)
})
})
# initial picture.
output$picture <- renderImage({
list(src = "temp.png")
}, deleteFile = FALSE)
output$out <- renderUI({
# in the beginning, check is FALSE and the picture is shown
if (!check()) {
imageOutput("picture")
} else {
# as soon as the button has been pressed the first time,
# the plot is shown
plotOutput("plot")
}
})
})
)
I know, that this has been solved a while, but I needed a solution, without uiOutput. Plus I find this much simpler.
library(shiny)
if (interactive()) {
shinyApp(
ui = fluidPage(
actionButton("btn", "Click me"),
br(),
plotOutput('some_plot', width = '100%')
),
server = function(input, output) {
output$some_plot <- renderPlot({
if (!input$btn) {
# default plot
plot(1, 1, col = 'red')
} else{
# updated plot
plot(1000, 1000, col = 'green')
}
})
}
)
}
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 am trying to adapt R Shiny: automatically refreshing a main panel without using a refresh button to a new minimal working example:
ui <- fluidPage(
pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel."),
actionButton("newButton", "New Button"),
actionButton("newButton2", "Another New Button")
),
mainPanel(
verbatimTextOutput("nText"),
textOutput("some_text_description"),
plotOutput("some_plot")
)
)
)
server <- function(input, output, session) {
# builds a reactive expression that only invalidates
# when the value of input$goButton becomes out of date
# (i.e., when the button is pressed)
ntext <- eventReactive(input$goButton, {
input$n
})
output$nText <- renderText({
ntext()
})
# Prep some text for output
output$some_text_description <- renderText({
if (input$newButton == 0) {return(NULL)}
else {
"Lorem ipsum dolorom."
}
})
# Prep some figure for output
# Simple Bar Plot
output$some_plot <- renderPlot({
if (input$newButton2 == 0) {return(NULL)}
else {
counts <- table(mtcars$gear)
barplot(counts, main="Car Distribution", xlab="Number of Gears")
}
})
}
shinyApp(ui = ui, server = server)
In the code above, I have three actionButton commands, one which produces a plot, one which produces text output, and one which produces a number (as verbatim text output). As you click through each button, new output appears alongside previously generated output (from the last button you pressed).
Without needing to implement a refresh button that clears everything manually, how do I get each actionButton to override (i.e., wipe) the output of the others automatically without them all stacking atop of each other in the main panel. My understanding is that I need to use some combination of observeEvent, NULL, and reactiveValues but my attempts have so far been unsuccessful.
You can use renderUI() for that.
output$all <- renderUI({
global$out
})
Within a global reactiveValue global$out you can store which ui element you would like to display. (Initially it should be empty, therefore NULL).
global <- reactiveValues(out = NULL)
And then listen for the clicks in the Buttons and update global$out accordingly.
observeEvent(input$goButton, {
global$out <- verbatimTextOutput("nText")
})
observeEvent(input$newButton, {
global$out <- textOutput("some_text_description")
})
observeEvent(input$newButton2, {
global$out <- plotOutput("some_plot")
})
Full app would read:
library(shiny)
ui <- fluidPage(
pageWithSidebar(
headerPanel("actionButton test"),
sidebarPanel(
numericInput("n", "N:", min = 0, max = 100, value = 50),
br(),
actionButton("goButton", "Go!"),
p("Click the button to update the value displayed in the main panel."),
actionButton("newButton", "New Button"),
actionButton("newButton2", "Another New Button")
),
mainPanel(
uiOutput("all")
)
)
)
server <- function(input, output, session) {
global <- reactiveValues(out = NULL)
observeEvent(input$goButton, {
global$out <- verbatimTextOutput("nText")
})
observeEvent(input$newButton, {
global$out <- textOutput("some_text_description")
})
observeEvent(input$newButton2, {
global$out <- plotOutput("some_plot")
})
output$all <- renderUI({
global$out
})
output$nText <- renderText({
input$n
})
output$some_text_description <- renderText({
"Lorem ipsum dolorom."
})
# Simple Bar Plot
output$some_plot <- renderPlot({
counts <- table(mtcars$gear)
barplot(counts, main="Car Distribution", xlab="Number of Gears")
})
}
shinyApp(ui = ui, server = server)