Shiny - Observe() Triggered by Dynamicaly Generated Inputs

Shiny - observe() triggered by dynamicaly generated inputs

I'm not an expert in Shiny, but It seems that it's not possible to trigger one observer with dynamically generated inputs. My workaround is based on this answer: R shiny - last clicked button id.

The idea is to keep track of the last selection on all the dynamicallygenerated selectInput's using a JavaScript function. That function will update a shiny input variable with the id of the last selectedInput used.

Below is you code modified with the solution. Please note that because we need to distinguish between the dynamically generated selectInput's and others selectInput's, I wrapped those selectInput's in a div with a dummy class. The JavaScript function will only react to those that are inside that div. Also, the functions will generate a random number inside the JavaScript function to make the observer react to changes in the same selectInput.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
dashboardHeader(title = "Dynamic selectInput"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody(
# keep track of the last selection on all selectInput created dynamically
tags$script("$(document).on('change', '.dynamicSI select', function () {
Shiny.onInputChange('lastSelectId',this.id);
// to report changes on the same selectInput
Shiny.onInputChange('lastSelect', Math.random());
});"),
numericInput("graph_tytle_num","Number of Graph Title elements",value = 1,min = 1,max = 10),
uiOutput("graph_title"),
plotOutput("plot")
)
)

server <- function(input, output, session) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})

#elements of graphic titles
output$graph_title <- renderUI({
buttons <- as.list(1:input$graph_tytle_num)
# use a div with class = "dynamicSI" to distinguish from other selectInput's
div( class = "dynamicSI",
lapply(buttons, function(i)
column(3,
selectInput(inputId = paste0("title_element",i),
label = paste("Title element",i),
choices = paste0(LETTERS[i],seq(1,i*2)),
selected = 1)
)
)
)
})

# react to changes in dynamically generated selectInput's
observe({
input$lastSelect

if (!is.null(input$lastSelectId)) {
cat("lastSelectId:", input$lastSelectId, "\n")
cat("Selection:", input[[input$lastSelectId]], "\n\n")
}

isolate({ #I dont want to have the numericInput input$graph_tytle_num to be a trigger
#Create the graph title
title <- c()
for(i in 1:input[["graph_tytle_num"]]){
title <- paste(title,input[[paste0("title_element",i)]])
}

output$plot <-renderPlot({hist(rnorm(100,4,1),
breaks = 10,
main = title)})
})

})

}

shinyApp(ui, server)

Finally, you can extend this approach to any other Shiny widget just by modifying the selector on the JavaScript function. For instance, if you want to have actionButton's you can change the event and the selector from change and select to click and button.

Access a dynamically generated input in r shiny

This solution mimics a couple others found on SO, namely this one.

The key is to create a reactiveValues object and then assign the values using [[i]]. In my case it helped to use a submit button to trigger that.

Complete, working code is as follows:

UI module:

library(shiny)
mod1UI <- function(id) {
ns <- NS(id)
tagList(
numericInput(ns("n"), "N",value = NULL),
actionButton(ns("draw"),"Generate Letters"),
hr(),
numericInput(ns("groups"), "Enter number of groups (1-3)", value=NULL),
uiOutput(ns("groupings")),
actionButton(ns("submit"), "Submit Groupings")
)
}

Server Module:

mod1 <- function(input, output, session, data) {
ns <- session$ns
x <- reactiveValues(data=NULL)

observeEvent(input$draw, {
req(input$n)
x$data <- sample(letters,input$n)
})

output$groupings <- renderUI({
req(input$groups)
ltrs <- data()
lapply(1:input$groups, function(i) {
selectizeInput(paste0(session$ns("usergroup"),i),
paste0("Select letters for Group ", i),
choices = ltrs,
options = list(placeholder = "Select letters for this group",
onInitialize = I('function() { this.setValue(""); }')), multiple=T)
})
})

gps <- reactiveValues(x=NULL)
observeEvent(input$submit, {
lapply(1:input$groups, function(i) {
gps$x[[i]] <- input[[paste0("usergroup", i)]]
})
})

test <- session$ns("test")

return(list(dat = reactive({x$data}),
groups = reactive({gps$x})
))
}

UI:

ui <- navbarPage("Fancy Title",id = "tabs",
tabPanel("Panel1",
sidebarPanel(
mod1UI("input1")
),
mainPanel(verbatimTextOutput("lettersy")
)
)
)

Server:

server <- function(input, output, session) {
y <- callModule(mod1, "input1", data=y$dat)
output$lettersy <- renderText({
as.character(c(y$groups()))
})
}

shinyApp(ui, server)

Shiny - Can dynamically generated buttons act as trigger for an event

You can also create observers dynamically. Just make sure that they are created only once, otherwise they will execute several times.

Below is your code modified to create as many observers as buttons. Please note that if an observer for the button already exist, it should not be created. You can customize your observers too, so each observer could have its own behavior.

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
dashboardHeader(title = "Dynamic selectInput"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody(
numericInput("go_btns_quant","Number of GO buttons",value = 1,min = 1,max = 10),
uiOutput("go_buttons"),
plotOutput("plot")
)
)

server <- function(input, output, session) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})

# to store observers and make sure only once is created per button
obsList <- list()

output$go_buttons <- renderUI({
buttons <- as.list(1:input$go_btns_quant)
buttons <- lapply(buttons, function(i)
{
btName <- paste0("go_btn",i)
# creates an observer only if it doesn't already exists
if (is.null(obsList[[btName]])) {
# make sure to use <<- to update global variable obsList
obsList[[btName]] <<- observeEvent(input[[btName]], {
cat("Button ", i, "\n")
output$plot <-renderPlot({hist(rnorm(100, 4, 1),breaks = 50*i)})
})
}
fluidRow(
actionButton(btName,paste("Go",i))
)
}
)
})

}

ShinyApp: keep dynamically generated input values from being lost

One way to do it is using insertUI and removeUI. Try this

library(shiny)

ui <- fluidPage(
actionButton("addInput", "Agregar"),
actionButton("removeInput", "Eliminar"),
#uiOutput("inputs"),
tagList(tags$div(id = 'placeholder')),
h3("When you select any value from any input and then press an actionButton, the values are lost because the inputs are rendered once again. How can I keep the values selected even after adding or deletion of a new input?")
)

server <- function(input, output, session) {
numvars <- reactiveVal(0)
i <- reactive({
i <- input$addInput - input$removeInput
if(i <= 0 ){ i <- 1 }
return(i)
})

### keep track of elements/lines inserted and not yet removed
inserted <- c()

observeEvent(input$addInput,{
if (numvars()<0) {
numvars(0) # clicking on remove button too many times yields negative number; reset it to one
}

newValue <- numvars() + 1
numvars(newValue)
# btn needs to be adjusted if removing and adding
if (input$removeInput==0){
btn <- input$addInput
}else {
if (input$addInput > input$removeInput) {
btn <- input$addInput - input$removeInput # addInput counter does not decrease
}else btn <- numvars()
}

id <- paste0('txt', btn)

insertUI(
selector = '#placeholder',
## wrap element in a div with id for ease of removal
ui = tags$div(
div(
shiny::selectInput(paste0('vble_',btn), '', choices = c(LETTERS))
),
id = id
)
)
inserted <<- c(inserted, id) ## removes last one first

#print(numvars())
#print(inserted)

})

observeEvent(input$removeInput,{
newValue <- numvars() - 1
numvars(newValue)
if (newValue<0) numvars(0)

if (numvars()>0){
removeUI(
## pass in appropriate div id
selector = paste0('#', inserted[length(inserted)])
)
inserted <<- inserted[-length(inserted)]
}else inserted <<- c()
})

}

shinyApp(ui, server)

How to identify which observer is being triggered in Shiny when multiple dynamic observers are in use

Geovany's comment helped. I was also helped by this link.
The trick was to associate just one observer with each Submit button.

Here is the code that works, in case it is useful for anyone

library(shiny)
library(purrr)
options(shiny.reactlog = TRUE)
ui <- fluidPage(
actionButton("generate_tab", "Generate Tabs"),
tabsetPanel(id = "tabs",
uiOutput('tabsN')),
verbatimTextOutput("rvInput")

)

server <- function(input, output, session) {
# browser()
rv <- reactiveValues(no_of_tabs = 0L,
inputs = list()
)

#generating the UI dynamically
observeEvent(input$generate_tab, {
rv$no_of_tabs <- rv$no_of_tabs + 1
appendTab(inputId = "tabs",
tabPanel(
title = paste0("Tab_", rv$no_of_tabs),
selectInput(
paste0("Input", rv$no_of_tabs),
paste0("Input", rv$no_of_tabs),
choices = c('', LETTERS),
selected = NULL
),
actionButton(paste0("submit_input", rv$no_of_tabs), "submit input")
))
})

observe({
lapply(1:rv$no_of_tabs, function(x) {
observeEvent(input[[paste0("submit_input", x)]], {
rv$inputs[[x]] <- input[[paste0("Input", x)]]
})
})
})

output$rvInput <- renderPrint({
rv$inputs
})

}

shinyApp(ui, server)

R Shiny store the user input from multiple dynamically generated textAreaInput fields in an object in the server part

First, you want to make sure to assign each of your dynimcally added elements to have a unique name. You have just hard coded the letter "i" in the sample. You want something like

textAreaInput(inputId = paste0("varconst_",i), label = paste("Variables constituting scale", i), 
width = "700px", height = "100px", value = NULL)

Then you can observe those text boxes with something like this

observeEvent(lapply(paste0("varconst_", input$selectedScoresCheckBoxes), function(x) input[[x]]), {
obj <- Map(function(x) input[[paste0("varconst_",x)]], input$selectedScoresCheckBoxes)
dput(obj)
})

Here I just used dput to dump the list to the console so you can see it as it gets updated but you can do whatever you want with that.

How to add warnings to UI outputs generated dynamically in Shiny

I think you have a couple of problems here.

First, you have forgotten to add useShinyFeedback() to your UI definition.

ui = shinyUI(
fluidPage(
useShinyFeedback(),
titlePanel("Compare"),
...

Second, you've put the observeEvents that monitor your first item values inside your renderUI. That's not going to work: R's standard scoping means that these observeEvents won't be available to monitor changes in the corresponding input widgets. The solution is to create a separate observeEvent to create your observers on the inputs:

  observeEvent(input$numitems, {
lapply(1:(input$numitems), function(i) {
observeEvent(input[[paste0('firstitem',i)]], {
shinyFeedback::feedbackWarning(
inputId = paste0('firstitem',i),
show = input[[paste0('firstitem',i)]] > 100,
text = "Number less than 100 required.",
color="red"
)
})
})
})

Making these changes gives me, for example,

Sample Image

With regard to your final question about the Submit actionButton, and as a general observation, I think your life will be much easier if you use Shiny modules to solve this problem. This will allow you to delegate the error checking to the indivudual modules and remove the need to continually loop through the indices of the dynamic inputs. This will lead to shorter, simpler, and more understandable code.

One thing to bear in mind if you do this: make sure you put a call to useShinyFeedback in the definition of the module UI.



Related Topics



Leave a reply



Submit