R Shiny: How to write loop for observeEvent
observeEvent works great in lapply :
library("shiny")
ui <- fluidPage(
fluidRow(
column(
width = 6,
lapply(
X = 1:6,
FUN = function(i) {
sliderInput(inputId = paste0("d", i), label = i, min = 0, max = 10, value = i)
}
)
),
column(
width = 6,
verbatimTextOutput(outputId = "test")
)
)
)
server <- function(input, output){
vals <- reactiveValues()
lapply(
X = 1:6,
FUN = function(i){
observeEvent(input[[paste0("d", i)]], {
vals[[paste0("slider", i)]] <- input[[paste0("d", i)]]
})
}
)
output$test <- renderPrint({
reactiveValuesToList(vals)
})
}
shinyApp(ui = ui, server = server)
EDIT : for previous version of shiny, use this in server (add assign) :
lapply(
X = 1:6,
FUN = function(i){
assign(
paste0("obs", i),
observeEvent(input[[paste0("d", i)]], {
vals[[paste0("slider", i)]] <- input[[paste0("d", i)]]
})
)
}
)
Update shiny output from for loop inside observeEvent using reactiveValues
I rewrote your sever codes to make it working.
You cannot update UI in a loop as I already mentioned in the comment, it isn't how Shiny works. Use invalidateLater() to do something similar to a for loop.
And also, invalidateLater() doesn't work in observeEvent, so you need to write the loop logic in observe()
isolate() is used to prevent recursive triggering of the observer, so it only re-evaluate every 0.5 second based on invalidateLater(500)
server = function(input, output, session){
vars = reactiveValues(cc="",ct=0)
startSearch <- reactiveVal(FALSE)
startSearch <- eventReactive(input$searchgt,{
TRUE
})
observe({
req(startSearch())
if (isolate(vars$ct) < 10){
invalidateLater(500)
isolate({
vars$ct=vars$ct+1
vars$cc=paste('<b style="color:blue">',"Searching...",vars$ct,"</b>")
vars$busca = try(print("Something"),silent = T)
})
} else {
vars$cc=paste('<b style="color:red">',"Some warning.","</b>")
}
})
output$warngt = renderUI({HTML(vars$cc)})
}
How do I loop an observeEvent in shiny? to change style in leaflet when polygons are clicked
Try this
observe({
lapply(1:input$nomaps, function(i) {
observeEvent(input[[paste0("plot_", i,"_shape_click")]], {
# execute only if the polygon has never been clicked
selected.id <- input[[paste0("plot_", i,"_shape_click")]]
data <- rv$df[rv$df$ID==selected.id$id,]
if (selected.id$group == "unclicked_poly") {
change_color(map = paste0("plot_", i),
id_to_remove = selected.id$id,
data = data,
colour = "yellow",
new_group = "clicked1_poly")
} else {
leafletProxy(paste0("plot_", i)) %>%
removeShape(selected.id$id) %>% # remove previous occurrence
addPolygons(
data = data,
label = as.character(data$display),
layerId = data$ID,
group = "unclicked_poly") # back to initialize group
}
})
})
})
For loop in observe Event
According to the docs, observeEvent()
eventExpr A (quoted or unquoted) expression that represents the event; this can be a simple reactive value like input$click, a call to a reactive expression like dataset(), or even a complex expression inside curly braces
Try this:
observeEvent({
for (...) {
input[[...]]
}
}, {
print("Cleicked")
})
Observe event inside loop
You can Do this:
library(shiny)
loadBackup <- function(x){
if(file.exists(x)){
init <- readRDS(x)
} else {
init <- NULL
}
return(init)
}
ui <- fluidPage(
navbarPage(
"Scouting",
id = "navtab",
tabPanel("Attack",
navlistPanel(
tabPanel('OH1',
mainPanel(
tags$b("______1____________2____________3_____________4______"),
br(),
uiOutput(outputId = "CustomUI")
)
)
)
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues(length = 4,
width = 4)
initialize <- reactive({
backup <- matrix(0, nrow = rv$length, ncol = rv$width)
.backup <- loadBackup("backup.rds")
if(!is.null(.backup)){
dim <- dim(.backup)
backup[1:dim[1],1:dim[2]] <- .backup
}
for(x in 1:rv$length){
for(y in 1:rv$width){
rv[[paste0("a_OH1_z",x,"_q",y)]] <- backup[x,y]
}
}
})
savebackup <- reactive({
backup <- matrix(0, nrow = rv$length, ncol = rv$width)
for(x in 1:rv$length){
for(y in 1:rv$width){
backup[x,y] <- rv[[paste0("a_OH1_z",x,"_q",y)]] + input[[paste0("aOH1z",x,"q",y)]]
}
}
saveRDS(backup, file = "backup.rds")
})
session$onSessionEnded(function() {
isolate(savebackup())
})
output$CustomUI <- renderUI({
initialize()
column(12,
lapply(1:rv$length, function(x){
fluidRow(
br(),
lapply(1:rv$width, function(y, x){
actionButton(paste0("aOH1z",x,"q",y),
rv[[paste0("a_OH1_z",x,"_q",y)]],
style = "width: 100px; height:100px; background-color:blue; color:white;")
}, x = x)
)
})
)
})
observe(
lapply(1:rv$length, function(x){
lapply(1:rv$width, function(y, x){
z <- rv[[paste0("a_OH1_z",x,"_q",y)]] + input[[paste0("aOH1z",x,"q",y)]]
updateActionButton(session,paste0("aOH1z",x,"q",y),label = z)
}, x = x)
})
)
}
shinyApp(ui, server)
LoadBackup will check for a specific file, if it finds it it will return it's value, if not, it returns 0.
Files are saved when the session ends with the session$onSessionEnded call back function. The UI is built using an lapply which I adapted from this example given by RStudio.
The entire UI is built from the width and length reactive values that I specify, so the user may increase the size as they wish. You could remove this and make it inputs and it should still work the same.
RDS files are saved locally on the device so this will not be reproducible on shinyapps.io. You will need to look for database solutions for that.
observeEvent in insertUI generated in loop
For loops in R all run in the same scope, which means a variable defined in the loop will be shared by all iterations. This is an issue if you create a function in each loop iteration that accesses this variable, and assume that it'll be unique for each iteration.
Here's a simple demo:
counter <- 0; funcs <- list()
for (i in 1:3) {
counter <- counter + 1
funcs[[i]] <- function() print(counter)
}
for (i in 1:3) {
funcs[[i]]() # prints 3 3 3
}
In this Shiny app, the observeEvent handler accesses the local variable add, and doesn't get called until after the for loop is over, and add is at its final value.
There are a few ways to get around this and create a unique scope for each loop iteration. My favorite is to use an apply function to replace the for loop. Then each apply iteration runs in its own function so local variables are unique each item.
library(shiny)
# Define the UI
ui <- fluidPage(
#actionButton("adder", "Add"),
tags$div(id = 'placeholder')
)
# Define the server code
server <- function(input, output) {
rv <- reactiveValues(counter = 0)
lapply(1:3, function(i) {
isolate({
rv$counter <- rv$counter + 1
add <- sprintf("%03d",rv$counter)
#prefix <- generateRandomString(1,20)
filterId <- paste0('adder_', add)
divId <- paste0('adder_div_', add)
elementFilterId <- paste0('adder_object_', add)
removeFilterId <- paste0('remover_', add)
insertUI(
selector = '#placeholder',
ui = tags$div(
id = divId,
actionButton(removeFilterId, label = "Remove filter", style = "float: right;"),
textInput(elementFilterId, label = paste0("Introduce text #",rv$counter), value = "")
)
)
})
# Observer that removes a filter
observeEvent(input[[removeFilterId]],{
removeUI(selector = paste0("#", divId))
})
})
}
# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(launch.browser = T))
Note that I also removed the outer observeEvent since the server function runs on session initialization anyway.
How to break a for loop basing on captured shinyalert input value
Shiny alert does not seem to be run synchronous to the loop. Put print(decision) in front of the for-loop. It'll show in the console that the loop runs independently from the user clicking on the alert messages. That means: it won't work with a for loop or any other loop. It can only be done using the event mechanisms provided by Shiny.
The solution below creates and manipulates a reactive value RequiredAnswers. Any change to it will trigger the shiny alert to open and ask the user to confirm the first element of the RequiredAnswers vector. In other words, it removes the element that has just been answered with "No".
Each answer to the alert will be caught by observeEvent(input$AnswerAlert, {}). If the response was "cancel" it dismisses the first element of RequiredAnswers thus triggering the next alert. This way we get a loop. If the response was "Ok" it will clear RequiredAnswers and no more alerts will be triggered (because observeEvent(RequiredAnswers(), {}) does not respond to RequiredAnswers == NULL.
Drawback: if the user clicks 'Cancel' quite fast, Shiny does not recognize the event observeEvent(input$AnswerAlert, {}) does not get called. I cannot say for sure what the source of this is. My guess is a bug in Shiny Alert.
Another way would be to do it recursively (see the section "Chaining modals" in the documentation). This way, the lost events may be avoided.
library(shiny)
library(shinyalert)
ui <- fluidPage(
actionButton("run", "Run"),
verbatimTextOutput("answer", placeholder = TRUE)
)
server <- function(input, output, session) {
RecentDecision <- reactiveVal()
RequiredAnswers <- reactiveVal()
# Responds to the alert being confirmed or dismissed
observeEvent(input$AnswerAlert, {
if (input$AnswerAlert) {
Answer <- RequiredAnswers()[1]
RecentDecision(Answer)
print(RecentDecision())
RequiredAnswers(NULL)
} else {
# Remove the first item of RequiredAnswers
# Clear it completely when the end has been reached
if (length(RequiredAnswers()) == 1) {
RequiredAnswers(NULL)
RecentDecision(NULL)
}
else
RequiredAnswers(RequiredAnswers()[-1])
}
})
# Responds to changes, ignores NULL
observeEvent(RequiredAnswers(), {
shinyalert(
title = "Do you accept following element?",
text = RequiredAnswers()[1],
showCancelButton = TRUE,
inputId = "AnswerAlert" # use individual id
)
})
# Respond to the Run button
observeEvent(input$run, {
# Set up the vector of desired answers
RequiredAnswers(c("A", "B", "C", "D", "E"))
})
output$answer <- renderText({
if (!is.null(RecentDecision()))
RecentDecision()
else
"No answer, yet"
})
}
shinyApp(ui = ui, server = server)
modalDialog inside a loop in shinyapp
Here is a way with shinyalert. That's strange, if you put a button in a Shiny alert, then clicking the button automatically closes the alert. That's why I use actionLink instead of actionButton. The app does not react as usual when clicking one button/link, so I use the onclick attribute which runs Shiny.setInputValue. As you can see I'm using local in the loop, otherwise that does not work as expected. But I think (I didn't test) that instead of using for+local, you can use an ordinary lapply.
library(shiny)
library(shinyalert)
dialog_filtro <- function(i, input, session, RESFIL, ID, LabelID, messagee) {
al <- shinyalert(
title = "Menssagem importante",
text = tagList(
tags$p(messagee),
actionLink(
ID[1], LabelID[1], class = "btn btn-primary",
onclick = sprintf(
'Shiny.setInputValue("%s", true, {priority: "event"});',
ID[1]
)
),
actionLink(
ID[2], LabelID[2], class = "btn btn-primary",
onclick = sprintf(
'Shiny.setInputValue("%s", true, {priority: "event"});',
ID[2]
)
),
),
html = TRUE,
session = session
)
observeEvent(input[[ID[1]]], {
RESFIL$dest[[i]] <- i + 10
closeAlert(id = al)
}, domain = session)
observeEvent(input[[ID[2]]], {
RESFIL$dest[[i]] <- i + 100
closeAlert(id = al)
}, domain = session)
}
ui <- fluidPage(
verbatimTextOutput("res")
)
server <- function(input, output, session) {
RESFIL <- reactiveValues(dest = NULL)
lista <- list(a = 2, a = 3)
grupdest <- rep(list(0), length(lista))
RESFIL$dest <- grupdest
for (i0 in 1:length(lista)) {
local({
i <- i0
if (lista[[i]] > 0) {
dialog_filtro(
i,
input,
session,
RESFIL,
ID = c(paste0("yes", i), paste0("no", i)),
LabelID = c("Yes", "No"),
messagee = paste0("This is the loop ", i)
)
} else {
RESFIL$dest[[i]] <- i + 1000
# removeModal() not clear what you want to do here: remove which modal?
}
})
}
output$res <- renderPrint({
RESFIL$dest
})
}
shinyApp(ui = ui, server = server)
Related Topics
Geom_Smooth and Exponential Fits
Converting Utc Time to Local Standard Time in R
How to Use a Character as Attribute of a Function
Concatenate Values Across Columns in Data.Table, Row by Row
R Doesn't Reset the Seed When "L'Ecuyer-Cmrg" Rng Is Used
Saving a File to Sharepoint with R
Add Hline with Population Median for Each Facet
Update() Inside a Function Only Searches the Global Environment
How to Convert a Hex String to Text in R
Assigning and Removing Objects in a Loop: Eval(Parse(Paste(
How to Save a Data Frame in a Txt or Excel File Separated by Columns
Ggplot2: Dashed Line in Legend
Equation Numbering in Rmarkdown - for Export to Word
Continuous Color Bar with Separators Instead of Ticks
Search for Corresponding Node in a Regression Tree Using Rpart