Search code examples
rshinyshiny-reactivity

Performing an action in Shiny after an output is rendered


I am attempting to perform an action in Shiny after an output is rendered. Since I try to scroll to the output's location, it is crucial the output exists before I try to do so. How can I check for the existence of the output object (it is created with renderUI), or for the completion of the output rendering from the server? I haven't found anything online or on SO about that.

EDIT MWE: The silly layout is to help showcase what I want. The idea is to generate some output when clicking the button, and then, after the output has been generated, to scroll to the bottom of this output. It never works on the first generation of the output, despite using the priority field.

ui <- function(id){
    fluidPage(
        tags$head(
            tags$script(
                "Shiny.addCustomMessageHandler('scroll_to_item', function(button) {
                    document.getElementById(button).scrollIntoView({
                      alignToTop: false,
                      behavior: 'smooth'
                    });
                  });"
            )
        ),
        fluidRow(
            column(2,
                fluidRow(
                    div(HTML(stringi::stri_rand_lipsum(10))),
                    actionButton("create_plot", label = "Create plot", icon = icon("picture", library = "glyphicon"))
                ),
            ),
            column(10)
        ),
        uiOutput("show_output")
    )
}

server <- function(input, output, session){
    show_aggregations <- eventReactive(input$create_plot, ignoreInit = TRUE, label = "Output to be displayed", {
        message(whereami::whereami())
        return(fluidRow(HTML(stringi::stri_rand_lipsum(1))))
    })

    output$show_output <- renderUI({
        message(whereami::whereami())
        return(show_aggregations())
    })
    outputOptions(output, "show_output", priority = 100)

    observeEvent(show_aggregations(), label = "Scroll once the output has rendered", {
        message(whereami::whereami())
        session$sendCustomMessage("scroll_to_item", "show_output")
    }, priority = 1)
}

shinyApp(ui, server)

Solution

  • I solved this issue by using R / JavaScript communication functions (Shiny.addCustomMessageHandler and session$sendCustomMessage), as well as session$onFlushed. The latter is used to collect the value of output in interest in JavaScript (in my case, I'm interested in any change in the HTML code of the output) after Shiny flushed the reactive system, which is the right timing in this case:

    session$onFlushed(function() session$sendCustomMessage("flush_message", ""), once = FALSE) # R Shiny server
    
    Shiny.addCustomMessageHandler('flush_message', function(value) {
        Shiny.setInputValue('flush', $('#show_output')[0].innerHTML);
    }); // JS script
    

    Shiny.setInputValue sends back the contents of the outputs as input$flush in the Shiny session. An observer invalidating on any change on input$flush then triggers the scrolling event

    observeEvent(input$flush, ignoreNULL = TRUE, label = "Scroll once the output has rendered", {
            message(whereami::whereami())
            if(rv_local$scroll) session$sendCustomMessage("scroll_to_item", "show_output")
            rv_local$scroll <- FALSE
        })
    

    rv_local$scroll is a reactive value that works as a switch set to TRUE when the output is updated, and FALSE once the scrolling has been performed; it ensures scrolling is performed only when I intend it to, and not after each flush.

    Shiny app

    ui <- function(id){
        fluidPage(
            includeScript(path = "www/myscript.js"), # The JS script HAS to be stored in a directory named www
            fluidRow(
                column(2,
                    fluidRow(
                        div(HTML(stringi::stri_rand_lipsum(10))),
                        actionButton("create_plot", label = "Create plot", icon = icon("picture", library = "glyphicon"))
                    ),
                ),
                column(10)
            ),
            uiOutput("show_output")
        )
    }
    
    server <- function(input, output, session){
    
        rv_local <- reactiveValues(scroll = FALSE)
    
        show_aggregations <- eventReactive(input$create_plot, ignoreInit = TRUE, ignoreNULL = TRUE, label = "Output to be displayed", {
            message(whereami::whereami())
            return(fluidRow(HTML(stringi::stri_rand_lipsum(1))))
        })
    
        output$show_output <- renderUI({
            message(whereami::whereami())
            req(show_aggregations())
            rv_local$scroll <- TRUE
            return(show_aggregations())
        })
    
        observeEvent(input$flush, ignoreNULL = TRUE, label = "Scroll once the output has rendered", {
            message(whereami::whereami())
            if(rv_local$scroll) session$sendCustomMessage("scroll_to_item", "show_output")
            rv_local$scroll <- FALSE
        })
    
        session$onFlushed(function() session$sendCustomMessage("flush_message", ""), once = FALSE)
    
    }
    
    shinyApp(ui, server)
    

    JS script

    Shiny.addCustomMessageHandler('scroll_to_item', function(button) {
        document.getElementById(button).scrollIntoView({
          alignToTop: false,
          behavior: 'smooth'
        });
    });
    
    Shiny.addCustomMessageHandler('flush_message', function(value) {
        Shiny.setInputValue('flush', $('#show_output')[0].innerHTML);
    });