Dynamic number of actionButtons tied to unique observeEvent
Your really close, just wrap the observeEvent
part in local.
library(shiny)
ui <- basicPage(
fluidRow(
actionButton(inputId = "add_button",
label = "Add Button")
),
uiOutput("more_buttons")
)
server <- function(input, output){
rvs <- reactiveValues(buttons = list(actionButton(inputId = "button1",
label = 1)))
observeEvent(eventExpr = input$add_button,
handlerExpr = {
len <- length(rvs$buttons) + 1
rvs$buttons[[len]] <- actionButton(inputId = paste0("button",len),
label = len)
})
output$more_buttons <- renderUI({
do.call(fluidRow, rvs$buttons)
})
observeEvent(rvs$buttons,{
for(ii in 1:length(rvs$buttons)){
local({
i <- ii
observeEvent(eventExpr = input[[paste0("button",i)]],
handlerExpr = {print(sprintf("You clicked btn number %d",i))})
})
}
})
}
shinyApp(ui, server)
How to create dynamic number of observeEvent in shiny?
Very interesting question, and a very commendable reprex. I managed to find a solution. You can replace your server object with this:
server <- function(input, output, session) {
alld <- reactiveValues()
alld$ui <- list()
# Action to add new Segment
observeEvent(input$addSeg,{
new_id <- length(alld$ui) + 1
sub_name <- paste0("addSub_", new_id)
alld$ui[[new_id]] <- list(
actionButton(sub_name, "Add a Sub Segment")
)
observeEvent(input[[sub_name]], {
new_text_id <- length(alld$ui[[new_id]]) + 1
alld$ui[[new_id]][[new_text_id]] <- HTML(paste0("<br>addSub<br>"))
})
})
output$myUI <- renderUI({alld$ui})
output$txt <- renderText({
capture.output(str(alld$ui))
})
}
Let's talk about your original code. Your first observer works just fine. The second one, however, is causing the unwanted behaviour. It returns a list of new observers, one for every addSub
button currently in the app. This means that on the first click, it creates an observer for addSub_1
, and on the second click, it returns an observer for addSub_1
and addSub_2
. However, the first addSub_1
observer still exists. This means that when you click addSub_1
, there are two observers responding and the text is shown twice.
My solution is to combine your two observers into one. When you click addSeg
, the button is created in the UI-list, and the observer that handles it is also created. This way, there are no duplicates and the app works as expected.
observeEvent listen to any input with same name pattern
I made this work for a number of buttons that you would define in the eventExpr
of the observeEvent
library(shiny)
ui <- fluidPage(
actionButton("button_1", label = "Button 1"),
actionButton("button_2", label = "Button 2"),
actionButton("button_3", label = "Button 3")
)
server <- function(input, output, session) {
observeEvent(
eventExpr = {
buttons <- paste0("button_",1:10)
list_of_buttons = NULL
for(var in buttons) {
list_of_buttons <- append(list_of_buttons, input[[var]])
}
list_of_buttons
},
handlerExpr = { #Replace with listen to any input with id starting with "button_"
showModal(modalDialog("Thanks for pushing the button"))
},
ignoreInit = T
)}
shinyApp(ui, server)
Generate observers for dynamic number of inputs
In your example everything works fine so long an actionButton has been pressed only once. For instance, when I create 3
buttons/observers I get correct IDs printed in the console - there is one observer for each new generated actionButton. √
[1] "add_1"
[1] "add_2"
[1] "add_3"
However, when I choose the number other than 3
and then press submit
again, the problem you described begins.
Say, I want now 4
actionButtons - I input 4
and press submit
. After that, I press once each new generated button and I get a following output:
[1] "add_1"
[1] "add_1"
[1] "add_2"
[1] "add_2"
[1] "add_3"
[1] "add_3"
[1] "add_4"
By clicking on submit
button, I created observers for three first buttons again - I have two observers for the first three buttons and only one for the new fourth button.
We can play this game on and on and going to get more and more observers for each button. It is very similar when we create a smaller number of buttons than previously.
The solution to this would be to keep track of which action buttons have been already defined and then to generate observers only for new ones. In the example below I depicted how you could do this. It may not be best programmed but it should serve well to show the idea.
Full example:
library("shiny")
ui <- fluidPage(
numericInput("numButtons", "Number of buttons to generate",
min = 1, max = 100, value = NULL),
actionButton("go", "Submit"),
uiOutput("ui")
)
server <- function(input, output) {
# Keep track of which observer has been already created
vals <- reactiveValues(x = NULL, y = NULL)
makeObservers <- eventReactive(input$go, {
IDs <- seq_len(input$numButtons)
# For the first time you press the actionButton, create
# observers and save the sequence of integers which gives
# you unique identifiers of created observers
if (is.null(vals$x)) {
res <- lapply(IDs, function (x) {
observeEvent(input[[paste0("add_", x)]], {
print(paste0("add_", x))
})
})
vals$x <- 1
vals$y <- IDs
print("else1")
# When you press the actionButton for the second time you want to only create
# observers that are not defined yet
#
# If all new IDs are are the same as the previous IDs return NULLL
} else if (all(IDs %in% vals$y)) {
print("else2: No new IDs/observers")
return(NULL)
# Otherwise just create observers that are not yet defined and overwrite
# reactive values
} else {
new_ind <- !(IDs %in% vals$y)
print(paste0("else3: # of new observers = ", length(IDs[new_ind])))
res <- lapply(IDs[new_ind], function (x) {
observeEvent(input[[paste0("add_", x)]], {
print(paste0("add_", x))
})
})
# update reactive values
vals$y <- IDs
}
res
})
observeEvent(input$go, {
output$ui <- renderUI({
num <- as.numeric(isolate(input$numButtons))
rows <- lapply(1:num, function (x) {
actionButton(inputId = paste0("add_", x),
label = paste0("add_", x))
})
do.call(fluidRow, rows)
})
makeObservers()
})
}
shinyApp(ui, server)
R Shiny - dynamically created actionButtons either all firing at once (observeEvent) or not firing at all (eventReactive)
This works with the code below.
- the
drawCallback
option runsShiny.bindAll
on the table; it tells Shiny that new inputs are added - the use of
local
in the for loop is needed, otherwise the value ofi
would be the same across all instances in the loop (it would be the lasti
)
server <- function(input, output, session) {
observeEvent(input$run, {
iris_data <- iris[1:input$rows,]
row.names(iris_data) <- paste0("<button id='details_", 1:nrow(iris_data),"' type='button' class='btn btn-default action-button'", ">Details</button>")
output$iris <- renderDT({
datatable(iris_data, selection="single", escape=FALSE,
options = list(
drawCallback = JS(
"function(){",
" Shiny.bindAll(this.api().table().node());",
"}"
)
)
)
})
appendTab(inputId="navbar", tabPanel("Data", DTOutput("iris")))
})
observeEvent(input$rows, {
for(j in 1:input$rows){
local({
i <- j
observeEvent(input[[paste0("details_",i)]], {
showModal(
modalDialog(
fluidPage(
fluidRow(h3(strong("Details"), align="center")), hr(),
fluidRow(splitLayout(strong("Sepal Length: "), iris[i,1])),
fluidRow(splitLayout(strong("Sepal Width: "), iris[i,2])),
fluidRow(splitLayout(strong("Petal Length: "), iris[i,3])),
fluidRow(splitLayout(strong("Petal Width: "), iris[i,4])),
fluidRow(splitLayout(strong("Species: "), iris[i,5])),
size="l"))
)
})
})
}
})
}
Here is an alternative way:
library(shiny)
library(shinyBS)
library(DT)
ui<-navbarPage(
title="Title", id="navbar",
tabPanel("Main",
selectInput(inputId="rows", label="# of Rows", choices=c(5,10,25)),
actionButton(inputId="run", "Run")),
tabPanel("Data",
DTOutput("iris"),
uiOutput("modals"))
)
server <- function(input, output, session) {
output$iris <- renderDT({
if(input$run > 0){
iris_data <- iris[1:input$rows,]
row.names(iris_data) <- sapply(1:input$rows, function(i){
paste0("<button type='button' class='btn btn-default action-button'",
" onclick = \"", sprintf("$('#modal%d').modal('show');\"", i),
">Details</button>")
})
datatable(iris_data, selection="single", escape=FALSE)
}
})
output$modals <- renderUI({
modals <- lapply(1:input$rows, function(i){
bsModal(
id = paste0("modal",i),
title = paste0("Details of row ", i),
trigger = "",
fluidPage(
fluidRow(splitLayout(strong("Sepal Length: "), iris[i,1])),
fluidRow(splitLayout(strong("Sepal Width: "), iris[i,2])),
fluidRow(splitLayout(strong("Petal Length: "), iris[i,3])),
fluidRow(splitLayout(strong("Petal Width: "), iris[i,4])),
fluidRow(splitLayout(strong("Species: "), iris[i,5]))
)
)
})
do.call(tagList, modals)
})
}
shinyApp(ui=ui, server=server)
How to create dynamic number of observeEvent in another observeEvent?
This behaviour occurs because the custom UI element is re-rendered every time a new element is added to the list. Once you click "V2" and the new text element is added, the selectInput
itself re-renders and resets to V1, which is noticed by the observer you've created.
The following might be a solution for you:
observeEvent(input$addSeg,{
new_id <- length(alld$ui) + 1
sub_name <- paste0("addSub_", new_id)
alld$ui[[new_id]] <- list(
selectInput(sub_name,
"Add a variable",
choices = c("", "V1","V2"),
selected = "")
)
observeEvent(input[[sub_name]], {
if (input[[sub_name]] == "") return()
new_text_id <- length(alld$ui[[new_id]]) + 1
alld$ui[[new_id]][[new_text_id]] <- HTML(paste0("Variable ",input[[sub_name]]," added<br>"))
}, ignoreInit = TRUE)
})
What I've done here is add an empty option to your selectInput
s, and a condition to the corresponding observer that it shouldn't do anything if the input is empty. This way, I'm harnessing the "resetting" behaviour to be useful instead of annoying.
Related Topics
Get Country (And Continent) from Longitude and Latitude Point in R
Shiny Slider Customized Values
Is There an Equivalent in Ggplot to The Varwidth Option in Plot
Ggplot2 Violin Plot: Fill Central 95% Only
How to Generate Multivariate Random Numbers with Different Marginal Distributions
R Script in Power Bi Returns Date as Microsoft.Oledb.Date
Staggered and Stacked Geom_Bar in The Same Figure
How to Create a Rank Variable Under Certain Conditions
How to Define "Hidden Global Variables" Inside R Packages
Trouble Displaying Contours in R and Ggplot with Basic Dataset
Force Ggplot to Evaluate Counter Variable
Change Position of Tick Marks of a Single Graph, Using Ggplot2