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.
Related
I've got a table that will initialize, but will not update. I use a few inputs, which then get called by a function to calculate the outputs. They will initialize with the correct values, but when I click the actionButton, nothing happens.
output$view<-renderTable({
tabSvol<-isolate(
data.frame(
S=c(
func1(input$in1),
func2(input$in2),
func3(input$in1,input$2)
)
)
)
tabSvol
})
Here's a MRE that allows you to add rows to a reactive table.
library(shiny)
library(tidyverse)
ui <- fluidPage(
numericInput("a", "A: ", value=NA),
selectInput("b", "B:", choices=c("X", "Y", "Z")),
actionButton("add", "Add row"),
tableOutput("table")
)
server <- function(input, output) {
rv <- reactiveValues(table=tibble(A=numeric(0), B=character(0)))
output$table <- renderTable({
rv$table
})
observeEvent(input$add, {
rv$table <- rv$table %>% add_row(A=input$a, B=input$b)
})
}
shinyApp(ui = ui, server = server)
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)
})
}
Tell me in R Shiny, there are two action buttons. I want to update the data according to the button I press. But for some reason it only responds to the second button and not to the first button. What is the solution?
if (interactive()) {
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("action_1", "Get 1"),
actionButton("action_2", "Get 2"),
),
mainPanel(
textOutput("result")
),
)
)
server <- function(input, output) {
data <- eventReactive(input$action_1, 1)
data <- eventReactive(input$action_2, 2)
output$result <- renderText(data())
}
shinyApp(ui, server)
}
The second line of this piece of code overwrites the first one:
data <- eventReactive(input$action_1, 1)
data <- eventReactive(input$action_2, 2)
You can do:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("action_1", "Get 1"),
actionButton("action_2", "Get 2"),
),
mainPanel(
textOutput("result")
),
)
)
server <- function(input, output) {
result <- reactiveVal()
observeEvent(input$action_1, { result(1) })
observeEvent(input$action_2, { result(2) })
output$result <- renderText(result())
}
shinyApp(ui, server)
}
If you have many buttons you can simply add a class to it and some simple JS to monitor the last click like so:
library(shiny)
monitorJS <- "$(document).on('click', '.monitor', function () {
Shiny.onInputChange('last_click',this.id);
});"
ui <- fluidPage(
tags$head(tags$script(monitorJS)),
sidebarLayout(
sidebarPanel(
uiOutput("buttons")
),
mainPanel(
textOutput("result")
),
)
)
server <- function(input, output, session) {
output$buttons <- renderUI({
a <- list()
for(i in 1:200){
id <- paste0("action_",i)
name <- paste0("Get ",i)
a[[i]] <- actionButton(id, name, class = "monitor")
}
tagList(a)
})
data <- eventReactive(input$last_click,{
# Your click ligic here
value <- gsub("action_","",input$last_click)
value
})
output$result <- renderText({
data()
})
}
shinyApp(ui, server)
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 want to add the input text to a vector in a Shiny app every time a button is clicked. This is the example I'm working with:
library(shiny)
ui <- fluidPage(
textInput(inputId = "inquiry", label = "enter text"),
actionButton(inputId = "searchButton", label = "Run"),
verbatimTextOutput("queryList", placeholder = FALSE)
)
server <- function(input, output, session) {
queryList <- c()
observeEvent(input$searchButton, {
queryList[length(queryList)+1] <- input$inquiry
output$queryList <- renderPrint({
queryList
})
})
}
shinyApp(ui = ui, server = server)
So if "item1" is entered and the button is clicked, then "item2" is entered and the button is clicked again, queryList should look like c("item1", "item2"), but it seems to just be replacing "item1" with "item2". I'm sure I'm missing something very simple...queryList[length(queryList)+1] looks a little strange, but it works in a non-reactive environment.
Making queryList reactive fixed it for me:
library(shiny)
ui <- fluidPage(
textInput(inputId = "inquiry", label = "enter text"),
actionButton(inputId = "searchButton", label = "Run"),
verbatimTextOutput("queryList", placeholder = FALSE)
)
server <- function(input, output, session) {
queryList <- reactiveValues()
queryList$values <- c()
observeEvent(input$searchButton, {
queryList$values[length(queryList$values) + 1] <- input$inquiry
})
output$queryList <- renderPrint({
if (!is.null(queryList$values)) {
queryList$values
}
})
}
shinyApp(ui = ui, server = server)