simple example of closures and a future in a an shiny observer - polled updates as an alternative to promises

shinyobserve.R

#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
#    http://shiny.rstudio.com/
#

library(shiny)
library(future)
library(tictoc)
library(stringr)
plan(multiprocess)



idSource <- function() {
  nextId <- 1
  list(
    nextID=function() {
      r <- nextId
      nextId <<- nextId + 1
      r
    },
    getID=function() {
      r <- nextId
      r
    }
  )
}

#f <- "" # add to name space
tic()

#isNewCall <- TRUE
getObserver <- function(input, output, session, taskletter){

    #these three variable have state maintained by in observe  - a use of closures.
    fred <- 0
    isNewCall <- TRUE # flag for whether waiting for future or not
    orderTrackingFuture    <- "" #  have future in namespace

    observe({
        fred <<- fred + 1
        toc()
        tic()
        print(str_c("observer ",taskletter," fired ",fred," ",Sys.getpid()))
        if (isNewCall) {
            print(str_c("starting new long running task ",Sys.getpid()))
            orderTrackingFuture <<- future({
                print(str_c("Future '",taskletter,"' ... started ",Sys.getpid()))
                Sys.sleep(10)
                print(str_c("Future '",taskletter,"' ... done ",Sys.getpid()))
                str_c("Future '",taskletter,"' ... done ",Sys.getpid())
            })
            print(str_c("long running task now started ",Sys.getpid()))
            isNewCall <<- FALSE
            invalidateLater(1000,session)
        } else {
            print(str_c("checking long running task ",Sys.getpid()))
            if (resolved(orderTrackingFuture)) {
                print(str_c("resolved long running task ",Sys.getpid()))
                isNewCall <<- TRUE
                runresult <- str_c(value(orderTrackingFuture), " ", fred)
                output[[str_c(taskletter,"taskComment")]] <- renderText(runresult)
                print(runresult)
                invalidateLater(7000,session)

            } else {
                print(str_c("not yet finished long running task ",Sys.getpid()))
                invalidateLater(1000,session)
            }
        }
        output[[str_c(taskletter,"observeComment")]] <- renderText(fred)
    })
}
# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Old Faithful Geyser Data"),

    # Sidebar with a slider input for number of bins
    sidebarLayout(
        sidebarPanel(
            sliderInput("bins",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30)
        ),

        # Show a plot of the generated distribution
        mainPanel(
           plotOutput("distPlot"),
           #some output from the observers
           textOutput("aobserveComment"),
           textOutput("ataskComment"),
           textOutput("bobserveComment"),
           textOutput("btaskComment")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output, session) {


    output$distPlot <- renderPlot({
        # generate bins based on input$bins from ui.R
        x    <- faithful[, 2]
        bins <- seq(min(x), max(x), length.out = input$bins + 1)

        # draw the histogram with the specified number of bins
        hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })

    observe({
        invalidateLater(1000,session)
        print(Sys.time())
    })

    getObserver(input, output, session,"a")
    getObserver(input, output, session,"b")


}

# Run the application
shinyApp(ui = ui, server = server)