I don't know how adaptable this is to your current scenario, but here's a way to have four things running in parallel, get their return value, and then trigger a fifth expression/function.
The premise is using callr::r_bg
for running the individual files. This actually runs a function
, not a file, so I'll modify the expectation of what these files look like a little.
I'll write an ancillary script that is intended to mimic one of your four scripts. I'll guess that you also want to be able to source this normally (run it directly instead of as a function), so I'll generate the script file so that it "knows" if it's being sourced or run directly (based on Rscript detect if R script is being called/sourced from another script). (If you know python
, this is analogous to python's if __name__ == "__main__"
trick.)
The ancillary script named somescript.R
.
somefunc <- function(seconds) {
# put the contents of a script file in this function, and have
# it return() the data you need back in the calling environment
Sys.sleep(seconds)
return(mtcars[sample(nrow(mtcars),2),1:3])
}
if (sys.nframe() == 0L) {
# if we're here, the script is being Rscript'd, not source'd
somefunc(3)
}
As a demo, if source
'd on the console, this just defines the function (or multiple, if you desire), it does not execute the code within the last if
block:
system.time(source("~/StackOverflow/14182669/somescript.R"))
# # <--- no output, it did not return a sample from mtcars
# user system elapsed
# 0 0 0 # <--- no time passed
but if I run this with Rscript
in a terminal,
$ time /c/R/R-4.0.2/bin/x64/Rscript somescript.R
mpg cyl disp
Merc 280C 17.8 6 167.6
Mazda RX4 Wag 21.0 6 160.0
real 0m3.394s # <--- 3 second sleep
user 0m0.000s
sys 0m0.015s
Back to the premise. Instead of four "scripts", rewrite your script files like my somescript.R
above. If done correctly, they can be Rscript
ed as well as source
d with different intentions.
I'm going to use this one script four times instead of four scripts. Here's a manual run-through of what we want to automate:
# library(callr)
tasks <- list(
callr::r_bg(somefunc, args = list(5)),
callr::r_bg(somefunc, args = list(1)),
callr::r_bg(somefunc, args = list(10)),
callr::r_bg(somefunc, args = list(3))
)
sapply(tasks, function(tk) tk$is_alive())
# [1] TRUE FALSE TRUE FALSE
### time passes
sapply(tasks, function(tk) tk$is_alive())
# [1] FALSE FALSE TRUE FALSE
sapply(tasks, function(tk) tk$is_alive())
# [1] FALSE FALSE FALSE FALSE
tasks[[1]]$get_result()
# mpg cyl disp hp drat wt qsec vs am gear carb
# Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4
# Chrysler Imperial 14.7 8 440.0 230 3.23 5.345 17.42 0 0 3 4
We can automate that with
source("somescript.R")
message(Sys.time(), " starting")
# 2020-08-28 07:45:31 starting
tasks <- list(
callr::r_bg(somefunc, args = list(5)),
callr::r_bg(somefunc, args = list(1)),
callr::r_bg(somefunc, args = list(10)),
callr::r_bg(somefunc, args = list(3))
)
# some reasonable time-between-checks
while (any(sapply(tasks, function(tk) tk$is_alive()))) {
message(Sys.time(), " still waiting")
Sys.sleep(1) # <-- over to you for a reasonable poll interval
}
# 2020-08-28 07:45:32 still waiting
# 2020-08-28 07:45:33 still waiting
# 2020-08-28 07:45:34 still waiting
# 2020-08-28 07:45:35 still waiting
# 2020-08-28 07:45:36 still waiting
# 2020-08-28 07:45:37 still waiting
# 2020-08-28 07:45:38 still waiting
# 2020-08-28 07:45:39 still waiting
# 2020-08-28 07:45:40 still waiting
# 2020-08-28 07:45:41 still waiting
message(Sys.time(), " done!")
# 2020-08-28 07:45:43 done!
results <- lapply(tasks, function(tk) tk$get_result())
str(results)
# List of 4
# $ :'data.frame': 2 obs. of 3 variables:
# ..$ mpg : num [1:2] 24.4 32.4
# ..$ cyl : num [1:2] 4 4
# ..$ disp: num [1:2] 146.7 78.7
# $ :'data.frame': 2 obs. of 3 variables:
# ..$ mpg : num [1:2] 30.4 14.3
# ..$ cyl : num [1:2] 4 8
# ..$ disp: num [1:2] 95.1 360
# $ :'data.frame': 2 obs. of 3 variables:
# ..$ mpg : num [1:2] 15.2 15.8
# ..$ cyl : num [1:2] 8 8
# ..$ disp: num [1:2] 276 351
# $ :'data.frame': 2 obs. of 3 variables:
# ..$ mpg : num [1:2] 14.3 15.2
# ..$ cyl : num [1:2] 8 8
# ..$ disp: num [1:2] 360 304
And now run your fifth function/script.