Last week, I had to async a part of the code because it was freezing the entire application. For those who don’t know, Shiny works synchronously, meaning it executes code in sequence. If you click a button that triggers a long operation, the entire application waits until the operation ends.

If you’re reading this, you already know the power and beauty of Shiny, so I won’t spend your time explaining it.

The problem
#

To illustrate the issue, I created a simple app with two extensive operations. The data includes the distance between pairs of cities in the State of Paraná, Brazil, along with geographic coordinates and sf objects for map creation. We’ll use the Traveling Salesman Problem to demonstrate. The app calculates all possible routes between the cities you select, with the first city as the origin, and determines the shortest route.

You can select a pool of cities, with a minimum of three and a maximum of seven. Less than three doesn’t make sense, and more than seven takes too much time.

After selecting your cities, a distance matrix between pairs of cities will appear along with two spinners. The left spinner shows all possible routes in a DT (datatable), with the first one being the shortest route. The second spinner, below the distance matrix, displays a moving plot. With seven cities, this scenario generates 720 plots (6!), since the first city is our origin.

We have two async operations: the first generates all possible routes, and the second depends on the first to generate all the plots. This ensures that elements appear in Shiny dependably, eliminating freezing problems.

The code
#

Before diving into the details, you can run the app directly:

shiny::runGitHub("Andryas/shiny-async")

The code can be found here, but I need to highlight a few points. Below is a part of server.R. Note that I placed a NULL at the end of the async blocks inside the observer function and created two reactiveVals. The NULL is necessary for responsiveness, as Shiny would otherwise follow its synchronous execution path. The reactiveVals are used to allocate the future_promise created.

# ...
# wait for information about the cities selected then apply tsp.
observe({
    req(tb_cities_distance())

    tb <- tb_cities_distance()
    result_val(NULL)
    waiter_show(
        id = "cities_results_spinner",
        html = waiter::spin_3(),
        color = waiter::transparent(.5)
    )
    waiter_show(
        id = "cities_plot_spinner",
        html = waiter::spin_3(),
        color = waiter::transparent(.5)
    )

    future_promise({
        tsp_naivy(tb)
    }) %...>%
        result_val()

    # Return something other than the promise
    # so shiny remains responsive
    NULL
})

# after calculate all the possible routes generate 
# all the possible plots
observe({
    req(result_val())

    d <- result_val() |>
        arrange(cost)

    plots <- list()

    future_promise({
        library(sf)

        for (i in 1:nrow(d)) {
            map <- d[i, ]

            routes <- simplify(strsplit(map$routes, ";"))

            map2 <- tibble::as_tibble(tb_map) |>
                left_join(
                    tibble(name_muni = routes) |>
                        mutate(direction = 1:n(), fill = "1"),
                    by = "name_muni"
                ) |>
                mutate(fill = replace_na(fill, "0"))

            title <- paste0(
                "Path traveled: ",
                formatC(map$cost / 1000,
                    format = "f",
                    big.mark = ",",
                    digits = 2
                ),
                " km"
            )

            p <- map2 |>
                ggplot() +
                geom_sf(aes(geometry = geom, fill = fill)) +
                geom_path(
                    data = map2 |>
                        filter(!is.na(direction)) |>
                        arrange(direction),
                    aes(x = longitude, y = latitude)
                ) +
                geom_point(
                    data = map2 |>
                        filter(
                            !is.na(direction) & 
                            direction == 1
                        ),
                    aes(x = longitude, y = latitude), size = 3
                ) +
                theme_minimal() +
                theme(legend.position = "none") +
                scale_fill_manual(
                    values = c("#834d29", "#251ac5")
                ) +
                labs(
                    x = "",
                    y = "",
                    title = title
                )
            plots <- append(plots, list(p))
        }

        plots
    }) %...>%
        result_plot()

    # Return something other than the promise so 
    # shiny remains responsive
    NULL
})

output$cities_layout_plot <- renderUI({
    req(result_plot())

    waiter_hide("cities_plot_spinner")

    fluidRow(
        sliderInput(
            inputId = "cities_routes_plot", 
            label = "",
            min = 1, 
            max = length(result_plot()), 
            value = 1, 
            step = 1,
            animate = animationOptions(1000)
        )
    )
})

output$cities_plot <- renderPlot({
    req(result_plot(), input$cities_routes_plot)
    result_plot()[[input$cities_routes_plot]]
})

output$cities_distance <- renderDT({
    req(tb_cities_distance())

    waiter_show(
        id = "cities_distance", 
        html = waiter::spin_3(), 
        color = waiter::transparent(.5)
    )

    tb_cities_distance() |>
        datatable(
            rownames = FALSE,
            options = list(
                dom = "t"
            )
        )
})
# ...

Thank you for reading and hasta la vista muchachos.

To know more about async things in Shiny check out

Long Running Tasks With Shiny: Challenges and Solutions

Async programming in R and Shiny

The problem #

The code #

The problem
#

The code
#