WithProgressShiny won't increment in User-Defined Function executed in Parallel

[cmeuli07]

Hi,

I'm having trouble getting my progress bar to increment using the withProgressShiny within the progressr package. The progress bar will start and end, but no incremental steps will appear.

The end goal, as you can see by the commented out functions below, will be to have the code execute in parallel, but I've removed the parallelism for now to rule out that that isn't the cause of my issue.

Reprex and Session Info below. Any help will be greatly appreciated!

Reprex:

require(furrr)
require(future)
require(shiny)
require(tidyverse)
require(progressr)

#### DEFINE FUNCTIONS ####


fn_scrape <- function(.page_num) {
  
 p(sprintf("x=%d", .page_num))
 
   # stuff happens here that isn't important
  # to functionality that I'm reprexing

  # sleep to make the function take a while
  Sys.sleep(0.5)
  
  return(.page_num)
}  



#### DEFINE UI ####


ui <- fluidPage(
  textInput(inputId = "input_num", label = "Enter num:", value = '' ),
  actionButton(inputId = "do_thing", label = "Do Thing"),
  
)


#### DEFINE SERVER ####


server <- function(input, output, session) {
  #output$asin <- renderText(input$input_asin)
  
  observeEvent(input$do_thing, 
               {
               
               vec_max_page <<- input$input_num
               
               withProgressShiny(message = "Doing Thing",
                                 detail = "Starting . . .",
                                 value = 0,
                                 {
                 p <- progressor(along = 1:vec_max_page)
                 
                 #plan(multisession(workers = 2))
                 list_html1 <<- map(.x = 1:vec_max_page,
                                           .f = safely(~fn_scrape(.page_num = .x)))
                #plan(sequential)
                 })
               })
}

shinyApp(ui, server)

Session Info:

> sessionInfo()
R version 4.0.4 (2021-02-15)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 10 x64 (build 19044)

Matrix products: default

locale:
[1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252    LC_MONETARY=English_United States.1252 LC_NUMERIC=C                          
[5] LC_TIME=English_United States.1252    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] progressr_0.10.0 forcats_0.5.1    stringr_1.4.0    dplyr_1.0.8      purrr_0.3.4      readr_2.1.1      tidyr_1.2.0      tibble_3.1.6     ggplot2_3.3.5   
[10] tidyverse_1.3.1  furrr_0.2.3      future_1.23.0    shiny_1.7.1     

loaded via a namespace (and not attached):
 [1] Rcpp_1.0.7        lubridate_1.8.0   listenv_0.8.0     assertthat_0.2.1  digest_0.6.27     utf8_1.2.2        parallelly_1.30.0 mime_0.9         
 [9] R6_2.5.1          cellranger_1.1.0  backports_1.2.1   reprex_2.0.1      httr_1.4.2        pillar_1.6.4      rlang_1.0.1       readxl_1.3.1     
[17] rstudioapi_0.13   jquerylib_0.1.4   munsell_0.5.0     broom_0.7.10      compiler_4.0.4    httpuv_1.6.1      modelr_0.1.8      pkgconfig_2.0.3  
[25] globals_0.14.0    htmltools_0.5.2   tidyselect_1.1.2  codetools_0.2-18  fansi_0.4.2       crayon_1.4.1      tzdb_0.1.2        dbplyr_2.1.1     
[33] withr_2.4.1       later_1.1.0.1     grid_4.0.4        jsonlite_1.7.2    xtable_1.8-4      gtable_0.3.0      lifecycle_1.0.1   DBI_1.1.2        
[41] magrittr_2.0.2    scales_1.1.1      cachem_1.0.6      cli_3.0.1         stringi_1.5.3     fs_1.5.0          promises_1.1.1    bslib_0.3.1      
[49] xml2_1.3.3        ellipsis_0.3.2    generics_0.1.0    vctrs_0.3.8       tools_4.0.4       glue_1.4.2        hms_1.0.0         parallel_4.0.4   
[57] fastmap_1.1.0     colorspace_2.0-0  rvest_1.0.2       haven_2.3.1       sass_0.4.0   

[scottyd22]

I got your code to work by defining fn_scrape directly in the map() function. I'm not sure why defining it in the global section like you did does not work, so maybe someone else can respond with the reasoning.

list_html1 <<- map(.x = 1:vec_max_page,
                   .f = function(.x) {
                      p(sprintf("x=%d", .x))

                      # stuff happens here that isn't important
                      # to functionality that I'm reprexing
                                                          
                      # sleep to make the function take a while
                      Sys.sleep(0.5)
                                                          
                      return(.x)
                 }
               )

[cmeuli07]

Thanks! Could it have something to do with which environment the function is defined in? I don't know much about that side of R. . .

[scottyd22]

Yes, it has to do with scoping rules. Another option that works is leaving map() as you had it and moving your function inside the observeEvent() function.

observeEvent(input$do_thing, 
               {
                 vec_max_page <<- input$input_num
                 
                 #### DEFINE FUNCTIONS ####
                 fn_scrape <- function(.page_num) {
                   
                   p(sprintf("x=%d", .page_num))
                   
                   # stuff happens here that isn't important
                   # to functionality that I'm reprexing
                   
                   # sleep to make the function take a while
                   Sys.sleep(0.5)
                   
                   return(.page_num)
                 }  
                 
                 withProgressShiny(message = "Doing Thing",
                                   detail = "Starting . . .",
                                   value = 0,
                                   {
                                     p <- progressor(along = 1:vec_max_page)
                                     
                                     #plan(multisession(workers = 2))
                                     list_html1 <<- map(.x = 1:vec_max_page,
                                                        .f = safely(~fn_scrape(.page_num = .x)))
                                     #plan(sequential)
                                   })
               })

[cmeuli07]

That works, thank you very much!

[nirgrahamuk]

Its fine to define fn_scrape up top, but you need to allow the passing of a progressor param, like so:

fn_scrape <- function(.page_num,myprogressor) {
  
  myprogressor(sprintf("x=%d", .page_num))
  
  # stuff happens here that isn't important
  # to functionality that I'm reprexing
  
  # sleep to make the function take a while
  Sys.sleep(0.5)
  
  return(.page_num)
}  

then pass the p

ithProgressShiny(message = "Doing Thing",
                                   detail = "Starting . . .",
                                   value = 0,
                                   {
                                     p <- progressor(along = 1:vec_max_page)
                                     
                                     #plan(multisession(workers = 2))
                                     list_html1 <<- map(.x = 1:vec_max_page,
                                                        .f = safely(~fn_scrape(.page_num = .x,
                                                                               myprogressor = p)))
                                     #plan(sequential)
                                   })