Dynamically add button UI and associated observeEvents - r

In my Shiny application, I'd like the click of a button to dynamically populate a list of new buttons. Each of these buttons should act specifically and uniquely.
So far I have been able to get the "main" button to create the list of buttons. I have not been able to figure out how to get each of the individual buttons to act accordingly. For simplicity, let's say that I'd like to print the label of the button. In reality, each button triggers should trigger a a variety of things and set a number of reactive values, but that's outside the scope for now.
Here is a reproducible example. In particular, only the last button receives an event listener. And when it fires, it for some reason fires N times; in this example N = 5. In reality too, the buttons may disappear on another event, but then should show up again if that "main" button was clicked a second time.
library(shiny)
ui <- pageWithSidebar(headerPanel("test"),
sidebarPanel(actionButton("build", "Build")),
mainPanel(uiOutput("buttons")))
server <- function(input, output) {
observeEvent(input$build, {
output$buttons <- renderUI({
btns <- list()
for (ix in 1:5) {
name <- paste("btn_", ix)
btns <- c(btns,
list(actionButton(
name, paste("Button", ix)
)))
observeEvent(input[[name]], {
print(name)
})
}
btns
})
})
}
shinyApp(ui, server)
What do I need to do in order to have an event listener associated with each button?
I have tried a variety of things, including wrapping the observeEvent() in local({}), creating a new button name with the namespace like ns <- NS(name) and ns(name) after, and moving renderUI outside of the parent observeEvent().
I've taken a look at Shiny - Can dynamically generated buttons act as trigger for an event, How to create dynamic number of observeEvent in shiny?, and Dynamic number of actionButtons tied to unique observeEvent, among others, but either I didn't understand them or they weren't quite right.
Bonus points if you can explain what's happening behind the scenes so I can learn more about Shiny reactivity!
Created on 2021-12-01 by the reprex package (v2.0.1)

Here is a sample app using purrr from the tidyverse that work very good to create multiple inputs. I also added textOutput's to see that the buttons are being clicked. This app could be further modified to select the amount of buttons to create.
App::
library(shiny)
number_of_buttons <- 5
outputs <- map(paste0('btn_', seq(1:number_of_buttons)), ~textOutput(outputId = .))
ui <- pageWithSidebar(headerPanel("test"),
sidebarPanel(actionButton("build", "Build")),
mainPanel(uiOutput("buttons"),
tagList(outputs)))
# server ------------------------------------------------------------------
server <- function(input, output) {
observeEvent(input$build, {
#this creates a list with five buttons to pass into `renderUI`
buttns_inputs <-
paste0('btn_', seq(1:number_of_buttons)) %>%
map(~ actionButton(., .))
output$buttons <- renderUI({
tagList(buttns_inputs)
})
})
#for debugging purposes
observe({
req(input$btn_1)
names(input) %>%
str_subset('^btn') %>%
walk(~ {output[[.]] <<- renderPrint({input[[.]] %>% print}) })
})
}
shinyApp(ui, server)
Simplified version:
library(shiny)
number_of_buttons <- 5
ui <- pageWithSidebar(
headerPanel("test"),
sidebarPanel(actionButton("build", "Build")),
mainPanel(uiOutput("buttons"))
)
# server ------------------------------------------------------------------
server <- function(input, output) {
observeEvent(input$build, {
# this creates a list with five buttons to pass into `renderUI`
buttns_inputs <-
paste0("btn_", seq(1:number_of_buttons)) %>%
map(~ actionButton(., .))
output$buttons <- renderUI({
tagList(buttns_inputs)
})
})
}
shinyApp(ui, server)

Related

how to make renderText() only trigger by a button Rshiny

I have a question when using renderText() function when this text box is triggered by a button. The output Error only triggered by the button for the first time, but for the second or third time, I don't have to click the button, the error text already showed. I think it is really confusing. Here is my code:
library(DT)
shinyServer(function(input, output) {
observeEvent(input$searchbutton, {
if (input$id %in% df$ID) {
data1 <-
datatable({
memberFilter <-
subset(df, df$ID == input$id)
}, rownames = FALSE, options = list(dom = 't'))
output$decision <- DT::renderDataTable({
data1
})
}
else{
output$Error<- renderText(if(input$id %in% df$ID || input$id==""){}
else{
paste("This ID :",input$id,"does not exist")
})
})
}
})
})
so the problem is in this renderText function, if I click the button more than once, the text box will updated automatically when I change the input even i did not click the button.
I guess this issue is because the text box has been triggered, it always 'rendering' the text box, so it did not need to trigger again, if there any solution can make this renderText box always been triggered by button?
It would be better if you could prepare minimal, reproducible example, so we could talk about your real or almost-real app, but I have prepared MRE for our discussion:
library(shiny)
ids <- 1:5
ui <- fluidPage(
numericInput("id_to_check", "Id to check", value = 0),
actionButton("check_id_btn", "Check"),
textOutput("check_result")
)
server <- function(input, output, session) {
observeEvent(input$check_id_btn, {
if (input$id_to_check %in% ids) {
} else {
output$check_result <- renderText({
paste0("This ID: ", input$id_to_check, " does not exist.")
})
}
})
}
shinyApp(ui, server)
So we have ids (from 1 to 5) and the Shiny app, in the server in observeEvent we check if the chosen id (from numericInput) exists in ids and if not, we display the user information that id doesn't exist.
Is this app shows the problem you see in your app? When you push "Check" button (and leave 0 as a id), text is displayed and then, when you change id, text - at least visually - changes and gives wrong results (e.g. if we change id to 1, then we should see any text output according to this part of code:
if (input$id_to_check %in% ids) {
} else {
)
So the first thing is that:
you should never nest objects which belongs to reactive context (observe, reactive, render*),it just won't work in expected way most of the time.
If you want to trigger render* only if the event occurs (like the button is pushed), then you can use bindEvent() function (from shiny):
library(shiny)
ids <- 1:5
ui <- fluidPage(
numericInput("id_to_check", "Id to check", value = 0),
actionButton("check_id_btn", "Check"),
textOutput("check_result")
)
server <- function(input, output, session) {
output$check_result <- renderText({
if (!input$id_to_check %in% ids) {
paste0("This ID: ", input$id_to_check, " does not exist.")
}
}) |>
bindEvent(input$check_id_btn)
}
shinyApp(ui, server)
I have removed observeEvent(), because I don't see the reason to leave it if we want just to display something, but I don't know your app, so maybe you need this, but do not nest anything which is reactive.

How to update a table in shiny every hour OR when the user presses a refresh button?

I have managed to get this, admittedly, very basic table to update on its own using the invalidateLater() function and also to update when pressing the refresh button however, I haven't managed to combine them both whereby the table would update every given time period OR when then user presses the button. Please could you give me a hand, I have added my code below!
if (interactive()) {
# table example
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
tableOutput('table'),
actionButton("refresh", "Update")
)
)
),
server = function(input, output) {
observeEvent(input$refresh, {
invalidateLater(15000)
spot_gold <- fromJSON("https://api.metals.live/v1/spot")[[1]][[1]]
spot_silver <- fromJSON("https://api.metals.live/v1/spot")[[2]][[1]]
spot_platinum <- fromJSON("https://api.metals.live/v1/spot")[[3]][[1]]
spot_palladium <- fromJSON("https://api.metals.live/v1/spot")[[4]][[1]]
spot_prices <- cbind(spot_gold, spot_silver, spot_platinum, spot_palladium)
output$table <- renderTable(spot_prices)
})
}
)
}
The invalidateLater() you placed inside your observeEvent() gets isolated(). One way to trigger on input$refresh OR invalidateLater() is by using observe() instead of observeEvent()
observe({
input$refresh
invalidateLater(15000)
spot_gold <- ...
...
})

In this R Shiny reactivity chain, what is it that allows a change in the user input grid to "stick" around?

In the below functioning MWE code, exactly what is it in the reactivity chain that allows user input modifications to the matrix input grid to stick from one click of the "Modify" action button through to the next click?
Run the code. Click on the "Modify" action button, make a change (to default values or insert a new column) to the user input grid that pops up in the modal dialogue box, and you'll notice that the change instantly appears in the table in the sidebar panel. When you dismiss the modal dialogue, the change sticks in the rendered table in the sidebar panel. And when you click on the "Modify" button again, you'll see that those changes are still reflected in the user input grid. Works well. I need to do the same somewhere else but I'm having trouble understanding how this works!
I'm trying to completely understand this so I can repeat this feature in another section of code.
MWE code:
library(shiny)
library(shinyMatrix)
library(shinyjs)
# Function assigns row headers to input matrix grid
matrix3Headers <- function(){c('A','B','C','D')}
# Assigns default values to first column of input matrix grid
matrix3Default <- matrix(c(1,24,0,100),4,1,dimnames=list(matrix3Headers(),NULL))
# Automatically assigns names to column headers
colnames(matrix3Default) <- paste0("Series ",1:ncol(matrix3Default))
# Matrix input function
matrix3Input <- function(x, matrix3Default){
matrixInput(x,
label = 'Input series terms into below grid:',
value = matrix3Default,
rows = list(extend=FALSE,names=TRUE),
cols = list(extend=TRUE,names=TRUE,editableNames=FALSE,delete=TRUE),
class = 'numeric'
) # close matrix input
} # close function
ui <- fluidPage(
useShinyjs(),
titlePanel('Inputs'),
fluidRow(actionButton('modify','Modify'),tableOutput('table2'))
) # close fluid page
server <- function(input, output, session){
rv <- reactiveValues(
mat3=matrix3Input('matrix3',matrix3Default),
input=matrix3Default,
colHeader = colnames(input)
) # close reactive values
observeEvent(input$modify,{
showModal(modalDialog(
rv$mat3,
)) # close shown modal and modal dialog
}) # close observe event
output$table2 <- renderTable({
req(input$matrix3)
rv$mat3 <- matrix3Input('matrix3',input$matrix3)
if(!is.null(input$modify)) {
df <- input$matrix3
n <- dim(df)[2]
rownames(df) <- matrix3Headers()
rv$input <- df
colnames(df) <- paste("Series", 1:n)
df
}
}, colnames=TRUE) # close output$table2
} # close server
shinyApp(ui, server)
The req(input$matrix3) makes the rendering of table2 (and the execution of the following code) wait until input$matrix3 is created.
When clicking the modify actionButton, the showModal is triggered thanks to the observeEvent observing the input$modify input from the button.
In the modal view must be displayed the rv$mat3, thus calling the execution of the rv reactiveValues and so the execution of the matrix3Input() function. This triggers the creation of input$matrix3.
Once created, the code under the req(input$matrix3) can be executed and thus the df table is rendered (while the modal box is still open). Any live modifications to the matrix in the modal box are reflected to the rendered table2 (below the modal box) thanks to the reactivity, and stored in the rv$mat3 reactiveValues() (with the rv$mat3 <- matrix3Input('matrix3',input$matrix3) line).
Clicking the dismiss button doesn't trigger anything regarding the stored matrix or the rendered table, and just closes the modal box.
When you click the modify actionButton again, you just call the display of the stored rv$mat3 again, and so on.

shiny reactive output, evaluate input only after first click on actionbutton

I have a simple shiny app where the user should input comma-separated values into a text input, chose the output and click on a button to convert to an output.
I have followed the advice in Update content on server only after I click action button in Shiny to change the output only when clicking, and it works.
However, only when starting/ opening the app the first time, the field is empty, yet the output seems to try to evaluate the input field.
It is more of a cosmetic problem, because once the user filled something in, this does not recur, but I wonder how I could avoid this...
My app:
library(shiny)
ui <- fluidPage(
textInput("from", "csv", value = NULL),
actionButton("run", "Run"),
textOutput("to")
)
server <- function(input, output, session) {
list1 <- reactive({
input$run
x <- isolate(paste(read.table(text = input$from, sep = ",")))
x
})
output$to <- renderText({
list1()
})
}
shinyApp(ui = ui, server = server)
The not-desired output - I would like to get rid of the errors.
you can use req(input$from), see Check for required values

Debug shiny render* output

I'm trying to debug my shiny dashboard
For several render* function, I need to debug them with some log (with print or cat) but I can't use those function inside a renderDataTable() / renderText()
for example:
output$selectedData = renderDataTable(
myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]
)
I would like to print something to the console before and after the instruction of renderDataTable() but
output$selectedData = renderDataTable(
cat("rendering...")
myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]
cat("rendered")
)
How can I do this ?
Here is a possible solution to the problem. First I use a variable called data to assingn any calculations to, in your case
data<-myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]. This is used inside the render function and will be created when the output is rendered since it relies on this. I then use an observe function that requires the variable data to be created before printing the second "rendered" to the console. That works once on startup, and will work fine if your data is constant. If you have changing data, for my example the data changes with a user selection, we will have to re-render the table. Since the render function is reactive and you are using input$process_tokens, the render function will re-run when the input changes. In this example it runs when input$select changes. When it runs it resets the variable data to NULL, and we trigger a separate observeEvent that monitors changes to input$select(input$process_tokens). This observeEvent also requires data before continuing, and since the render function set it to null it will not print the second "rendered" until data is created, just as in the first case.
library(shiny)
library(DT)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput("select","select",choices=(c(1,2,3,4)))
),
mainPanel(
dataTableOutput("selectedData")
)
))
server <- function(input, output, session) {
data<-reactive({data.frame(input$select,4,5)})
output$selectedData <- renderDataTable({
data<-NULL
print("rendering..")
data<-datatable(data())
})
#Observe inital rendering (only needed if no change to data)
observe({
req(data)
print("rendered!")
})
#Observe Changes to data
observeEvent(input$select,{
req(data)
print("rendered!")
})
}
shinyApp(ui, server)
Specific code for you:
server <- function(input, output, session) {
output$selectedData <- renderDataTable({
data<-NULL
print("rendering..")
data<- myCsv[which(myCsv[[myCase_id]]==input$process_tokens),]
})
#Observe inital rendering (only needed if no change to data)
observe({
req(data)
print("rendered!")
})
#Observe Changes to data
observeEvent(input$process_tokens,{
req(data)
print("rendered!")
})
}
shinyApp(ui, server)
Note that you will get two "rendered" printouts when the program initially starts, this is b/c both the observe and observeEvent run since both conditions are met. If your data does change with input$process_tokens, then you can get rid of the observe function, and only use the observeEvent. If your data does not change and the table is only rendered once, then get rid of the observeEvent. I was trying to cover all bases.

Resources