It seems that there is missing API, there is invalidateLater, but it's same as JS setInterval and it seems that there are no way to stop it.
Is there way to invalidate once or cancel the timer?
Wrap it in a conditional, an if statement.
How can I do that in I wan to have a function, that will force of update reactive context:
Right now I have this:
force <- function(fn) {
if (mypkg:::isReactiveContext()) {
mypkg:::invalidateLater(0)
fn()
} else {
shiny::observeEvent(NULL, {
shiny::invalidateLater(0)
fn()
}, once = TRUE, ignoreNULL = FALSE, ignoreInit = FALSE)
}
}
isReactiveContext <- function() {
## access of reactive value outside of reactive context will throw exception
tryCatch({
e <- new.env()
shiny::makeReactiveBinding("dummy", env = e)
e$dummy <- 10
e$test <- e$dummy + 10
TRUE
}, error = function() {
FALSE
})
}
invalidateLater <- function(millis, session = getDefaultReactiveDomain(), once = FALSE) {
if (once) {
shiny:::force(session)
scheduler <- shiny:::defineScheduler(session)
ctx <- shiny:::getCurrentContext()
timerHandle <- scheduler(millis, function() {
if (is.null(session)) {
ctx$invalidate()
return(invisible())
}
if (!session$isClosed()) {
session$cycleStartAction(function() {
ctx$invalidate()
})
}
timerHandle()
invisible()
})
timerHandle
} else {
shiny::invalidateLater(millis, session)
}
}
The code is just the same as invalidateLater in shiny but I'm removing the handler, this API is useless, Will create issue on GitHub, once is useful same as returning timerHandle from the function.
Here is a full reproducible example, which shows the use of invalidateLater an arbitrary number of times only. I did 4 each time, you could do 1.
ui <- fluidPage(
sliderInput("n", "Number of observations", 2, 1000, 500),
uiOutput("countertext"),
plotOutput("plot")
)
server <- function(input, output, session) {
update_counter <- reactiveVal(0)
output$plot <- renderPlot({
isolate(update_counter(update_counter() + 1))
if (update_counter() < 4) {
invalidateLater(300, session)
}
hist(rnorm(isolate(input$n)))
})
output$countertext <- renderUI({
h1(paste0("counter: ", update_counter()))
})
observeEvent(
input$n,
update_counter(0)
)
}
shinyApp(ui, server)It don't work with R6Class, same as reactive values in first place:
#' Force of reactive value trigger
## TODO: waiting for better solution (reply on SO or GitHub)
## https://github.com/rstudio/shiny/issues/2488
## https://stackoverflow.com/q/60654485/387194
force <- function(fn) {
fr <- Force$new(fn)
fr$trigger()
}
#' Force R6 Class that use private toogle to trigger function
#' with force of reactive value only once
Force <- R6::R6Class(
'Force',
private = list(
toggle = TRUE,
update_counter = NULL,
fn = NULL
),
public = list(
initialize = function(fn) {
private$fn <- fn
private$update_counter <- shiny::reactiveVal(0)
},
trigger = function() {
if (!MyPkg:::isReactiveContext()) {
shiny::observeEvent(NULL, {
self$tigger()
}, once = TRUE, ignoreNULL = FALSE, ignoreInit = FALSE)
} else {
if (private$update_counter() == 0) {
shiny::invalidateLater(0)
}
isolate({
private$update_counter(private$update_counter() + 1)
})
private$fn()
}
}
)
)
This also don't work, events keep fireing in the loop:
forcer <- function(fn) {
env <- new.env()
update_counter <- shiny::reactiveVal(0)
env$trigger <- function() {
if (!myPkg:::isReactiveContext()) {
shiny::observeEvent(NULL, {
env$trigger()
}, once = TRUE, ignoreNULL = FALSE, ignoreInit = FALSE)
} else {
isolate(update_counter(update_counter() + 1))
if (update_counter() < 2) {
shiny::invalidateLater(0)
}
fn()
}
}
env
}
force <- function(fn) {
f <- forcer(fn)
f$trigger()
}
If I call force it keep firing without stoping.
I understand the code that you are writing might not work, have you stopped to confirm that the code I wrote does work, and does exactly what you originally asked how to do ?
Do you want to ask a further question ? I'm not sure of the purpose of the code you are sharing.
Do you have a specific use case in mind ?
I have code where I need to force observeEvent that don't fire If I change reactiveValue that's why I use invalidateLater. I need to something like this:
self$on("foo", function() {
print('x')
})
private$trigger("foo")
and trigger just use
self$events[["foo"]] <- data
self$on is wrapper over observeEvent.
without the force when I have R6Class it don't work. Using raw observeEvent and self$events[["foo"]] <- data it work without problems, I'm trying to came up with a hack that will work, since authors of shiny closed the issue on GitHub they say that I should not use reactiveValues to create event system but I need reactiveValues sincce I use self$events in redner functions that should update the DOM when it change the value.
Simple example like you show maybe will work but anything more complicated like my example don't work.
I have to wonder if you are simply at odds with the framework such as it is.
Shiny provides a powerful way to do reactive programming, it handles reactivity and event management for the user, making it relatively easy for the programmer to 'hook things up' and shiny takes care of the details of the internal messaging etc.
It seems like you arent' satisfied with it (you chose not to work with shiny modules?) and want to create your own framework that works differently taking the event management into your own hands?
Perhaps you can fork shiny and do your own thing, but It seems like a big ambitious project ...
I'm finding it hard to follow your language, I apologise if there is a language barrier issue.
I have code where I need to force observeEvent that don't fire If I change reactiveValue that's why I use invalidateLater.
you use reactiveValues in some places, and your use of them does not cause observeEvent to fire ... so you need to force that and tried to use invalidate later to do the forcing?
Can you provide a reprex of this, similar to my reprex ? observeEvents where the event is a reactiveValue change is common place... im not sure how what you are working on would impact that, is it a namespace issue ? Have you considered rebuilding your shiny components in a shiny way, with shiny modules ? I've used shiny modules a lot and not felt particularly limited in the effects I can achieve with them.
Hire is simple aplication that was using to show the issue to one of my colleague
library(shiny)
ui <- fluidPage(
uiOutput('output')
)
Foo <- R6::R6Class(
"Foo",
private = list(
trigger = function(name, data = NULL) {
if (name %in% ls(self$events)) {
print(shiny::isolate(self$events[[name]]))
if (is.null(data)) {
self$events[[name]] <- shiny::isolate({
if (is.logical(self$events[[name]])) {
print("a")
!self$events[[name]]
} else if (is.null(self$events[[name]]$value)) {
print("b")
TRUE
} else {
print("c")
!self$events[[name]]$value
}
})
} else {
print("d")
new.data <- list(
timestamp = as.numeric(Sys.time())*1000,
value = data$value
)
self$events[[name]] <- new.data
}
print(shiny::isolate(self$events[[name]]))
}
}
),
public = list(
events = NULL,
input = NULL,
session = NULL,
initialize = function(input, session, ...) {
#session$manageInputs(list(shinyHack = TRUE))
#observeEvent(input$shinyHack, {
#})
self$input <- input
self$session <- session
self$events <- new.env()
if (!is.null(self$constructor)) {
self$constructor(...)
}
},
createEvent = function(name, value = NULL) {
if (!name %in% ls(self$events)) {
shiny::makeReactiveBinding(name, env = self$events)
if (is.logical(value) && value) {
self$events[[name]] <- TRUE
} else {
data <- list(
value = value,
timestamp = as.numeric(Sys.time())*1000
)
self$events[[name]] <- data
}
}
},
on = function(event, handler, init = FALSE, ...) {
self$createEvent(event)
uuid <- uuid::UUIDgenerate()
battery::observeEvent(self$events[[event]], {
data <- self$events[[event]]
## invoke handler function with only argument it accept
tryCatch({
if (is.null(data) || is.logical(data)) {
battery:::invoke(handler, NULL, NULL)
} else {
battery:::invoke(handler, data[["value"]], data[["target"]])
}
}, error = function(cond) {
if (!inherits(cond, "shiny.silent.error")) {
message(paste0("throw in ", self$id, "::on('", event, "', ...)"))
message(cond$message)
traceback(cond)
stop(cond)
}
})
}, observerName = uuid, ignoreInit = !init, ...)
}
)
)
Bar <- R6::R6Class(
"Bar",
inherit = Foo,
public = list(
constructor = function() {
self$events <- new.env()
},
working = function() {
shiny::makeReactiveBinding("foo", env = self$events)
self$events$foo <- 10
shiny::observeEvent(self$events$foo, {
print("<<<<< foo bar >>>>>>")
print(self$events$bar)
})
self$events$foo <- 20
},
not.working = function() {
self$on("bar", function(value) {
print(paste("<<<<", value, ">>>>"))
})
private$trigger("bar", list(value = "NORMAL"))
self$session$manageInputs(list(shinyHack = TRUE))
observeEvent(self$input$shinyHack, {
private$trigger("bar", list(value = "WITH HACK"))
})
}
)
)
#root <- Bar$new(input = NULL, session = NULL)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
## Root component that don't have parent need to be called with input output and session.
root <- Bar$new(input = input, session = session)
root$working()
root$not.working()
}
# Run the application
shinyApp(ui = ui, server = server)
This was first hack I've found.
Sorry forget about the package function:
#' Function call function fn with the only arguments it accept
#' @param fn - function to be called
#' @param ... - list of arguments
invoke <- function(fn, ...) {
if (!is.function(fn)) {
stop("invoke: argument need to be a function")
}
count <- length(formals(fn))
do.call(fn, utils::head(list(...), count))
}
This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.