Why does it take so much time for the promise to complete in a mirai_map?

[olivier7121]

In the code below, the value of the progress bar is displayed only from approx. 750 / 1 000 onwards. Before that, only the initialization text 'Parallel calculation in progress - Starting...' is displayed.

Why so late?

library(shiny)
library(bslib)
library(mirai)
library(promises)
library(openxlsx)

TIMER_NOT_STARTED <- 0L
TIMER_RUNNING <- 1L
TIMER_FINISHED <- 2L

GenerateExcelFiles <- function(Row)
{
	Number <- paste0(paste0(rep("0", NCharTotalNRows - nchar(Row)), collapse = ""), Row)
	OutputFile_Individual <- file.path(OutputFolder, paste0("3 - mirai_map_", Number, ".xlsx"))
	Workbook_Individual <- createWorkbook()
	saveWorkbook(wb = Workbook_Individual, file = OutputFile_Individual, overwrite = TRUE)
	Sys.sleep(1)
}

ui <- fluidPage(
	
	titlePanel("3 - Mirai_map"),
	
	sidebarLayout(
		sidebarPanel(
			input_task_button(id = "run", "Run")
			#actionButton('run', 'Run')
		),
		
		mainPanel(
			textOutput("Timer"),
			#tableOutput("result")
		)
	)
)

server <- function(input, output, session) {
	Timer.Status <- reactiveVal(0)
	Timer.Start <- reactiveVal(0)
	Timer.End <- reactiveVal(0)
	Completed <- reactiveVal(0)
	
	x <- 1:1000
	
	# Handle button click
	observeEvent(input$run,{
		Timer.Status(TIMER_RUNNING)
		Timer.Start(as.integer(Sys.time()))
		Completed(0)
		
		NCharTotalNRows <<- nchar(length(x))
		OutputFolder <<- file.path(".", "Output")
		if(!dir.exists(OutputFolder))	dir.create(OutputFolder)
		
		progress <- Progress$new(session, min = 0, max = length(x))
		progress$set(message = "Parallel calculation in progress", detail = "Starting...")
		
		daemons(8)
		
		Variables2Share <- list("NCharTotalNRows" = NCharTotalNRows, "OutputFolder" = OutputFolder)
		everywhere({
			lapply(c("openxlsx"), library, character.only = TRUE)
			},
			as.environment(Variables2Share)
		)
		
		mirai_map(
			.x = x,
			.f = GenerateExcelFiles,
			#GenerateExcelFiles = GenerateExcelFiles,
			.promise = function(result){
				Row <- Completed() + 1
				# Completed(Row)
				progress$inc(1, detail = paste("Completed", Row, "/", length(x)))
			}
		) %...>% {
			print(unlist(.))
			Timer.End(as.integer(Sys.time()))
			Timer.Status(TIMER_FINISHED)
			update_task_button(id = "run", state = "ready")
			progress$close()
			daemons(0)
		}
		update_task_button(id = "run", state = "busy")
	})
	
	output$Timer <- renderText({
		Status <- Timer.Status()
		if(Status == TIMER_RUNNING)
		{
			invalidateLater(1000L)
			Timer.End(as.integer(Sys.time()))
			paste("Time elapsed:", format(as.POSIXct(Timer.End() - Timer.Start() - 3600L), "%H:%M:%S"))
		} else if(Status == TIMER_FINISHED)
		{
			paste("Time elapsed:", format(as.POSIXct(Timer.End() - Timer.Start() - 3600L), "%H:%M:%S"))
		}
	})
}

# Run the application
shinyApp(ui = ui, server = server)
#app <- shinyApp(ui, server)
#with(daemons(8), runApp(app))

[shikokuchuo]

If you're using Shiny 1.10, downgrading to 1.9 might solve this. There's a performance regression related to launching lots of promises at once, that will be corrected in the next release. It's not a mirai-specific issue.

[olivier7121]

Indeed, it is solved with Shiny 1.9.0, thank you very much!

[shikokuchuo]

As we're about to release Shiny 1.11, this is now resolved in that version.