The following code
let doWork n = async {
[1..5]
|> Seq.iter(fun i ->
System.Threading.Thread.Sleep 1000 // Simulate working
printfn "%s runs %i seconds" n i
)
}
let f1 = async {
do! doWork "f1"
return 1
}
async {
let a = f1
do! doWork "main"
let! i = a
} |> Async.RunSynchronously
And it prints the following result. It shows that the two doWork calls run sequentially.
main runs 1 seconds
main runs 2 seconds
main runs 3 seconds
main runs 4 seconds
main runs 5 seconds
f1 runs 1 seconds
f1 runs 2 seconds
f1 runs 3 seconds
f1 runs 4 seconds
f1 runs 5 seconds
However, I want the doWork called by f1 and the main code be running in parallel?
Try it like this:
let computation () = async {
printfn "Start work"
do! Async.Sleep(100)
printfn "Finished work"
}
let s = seq {
for i in 1 .. 10 do
let c = computation()
yield c
}
s |> Async.Parallel |> Async.Ignore |> Async.Start
Async.Parallel converts the Async<unit> list to Async<unit []> which can be run in parallel then.
Related
The following code takes about 20 seconds to run. However, it took less than a second after uncommenting the do!. Why there is such a huge difference?
Update:
it takes 9 seconds when using ag.Add. I've updated the code.
open FSharpx.Control
let test () =
let ag = new BlockingQueueAgent<int option>(500)
let enqueue() = async {
for i = 1 to 500 do
//do! ag.AsyncAdd (Some i) // less than a second with do!
ag.AsyncAdd (Some i) // it takes about 20 seconds without do!
//ag.Add (Some i) // This one takes about 9 seconds
//printfn "=> %d" i
}
async {
do! [ for i = 1 to 100 do yield enqueue() ]
|> Async.Parallel |> Async.Ignore
for i = 1 to 5 do ag.Add None
} |> Async.Start
let rec dequeue() =
async {
let! m = ag.AsyncGet()
match m with
| Some v ->
//printfn "<= %d" v
return! dequeue()
| None ->
printfn "Done"
}
[ for i = 1 to 5 do yield dequeue() ]
|> Async.Parallel |> Async.Ignore |> Async.RunSynchronously
0
Without the do!, you're not awaiting the results of AsyncAdd. That means that you're kicking off five hundred AsyncAdd operations as fast as possible for each call to enqueue(). And although each AsyncAdd call will block if the queue is full, if you don't await the result of AsyncAdd then your enqueue() code won't be blocked, and it will continue to launch new AsyncAdd operations.
And since you're launching 100 enqueue() operations in parallel, that's potentially up to fifty thousand AsyncAdd operations that will be trying to run at the same time, which means 49,500 blocked threads being handled by the thread pool. That's a LOT of demand to put on your system. In practice, you won't launch 100 enqueue() operations in parallel at the same time, but you'll launch as many enqueue() operations as you have logical CPUs. For the rest of this answer, I'm going to assume that you have a quad-core processor with hyperthreading (as your F# Async.Parallel |> Async.RunSynchronously only uses one of the eight CPU core? question seems to suggest), so that's 8 logical CPUs so you'll launch eight copies of enqueue() before anything blocks, meaning you'll have 4,000 AsyncAdd threads running, 3,500 of which will be blocked.
When you use do!, on the other hand, then if AsyncAdd is blocked, your enqueue() operation will also block until there's a slot open in the queue. So once there are 500 items in the queue, instead of (8*500 - 500 = 3500) blocked AsyncAdd threads sitting in the thread pool, there will be 8 blocked AsyncAdd threads (one for each of the eight enqueue() operations running on each of your eight logical CPUs). Eight blocked threads instead of 3,500 means that the thread pool isn't making 3,500 allocations, using much less RAM and much less CPU time to process all those threads.
As I said in my answer to your previous question, it really seems like you need a deeper understanding of asynchronous operations. Besides the articles I linked to in that answer (this article and this series), I'm also going to recommend reading https://medium.com/jettech/f-async-guide-eb3c8a2d180a which is a pretty long and detailed guide to F# async operations and some of the "gotchas" you can encounter. I'd strongly suggest going and reading those articles, then coming back and looking at your questions again. With the deeper understanding you've gained from reading those articles, you just might be able to answer your own questions!
Continued from this question. Here is the experiment based on your code:
// Learn more about F# at http://fsharp.org
module Test.T1
open System
open System.Collections.Generic
open System.Diagnostics
type Msg<'T> =
| AsyncAdd of 'T * AsyncReplyChannel<unit>
| Add of 'T
| AsyncGet of AsyncReplyChannel<'T>
let sw = Stopwatch()
let mutable scanned = 0
let mutable scanTimeStart = 0L
let createQueue maxLength = MailboxProcessor.Start(fun inbox ->
let queue = new Queue<'T>()
let rec emptyQueue() =
inbox.Scan(fun msg ->
match msg with
| AsyncAdd(value, reply) -> Some(enqueueAndContinueWithReply(value, reply))
| Add(value) -> Some(enqueueAndContinue(value))
| _ -> None )
and fullQueue() =
scanTimeStart <- sw.ElapsedMilliseconds
inbox.Scan(fun msg ->
scanned <- scanned + 1
match msg with
| AsyncGet(reply) ->
Some(dequeueAndContinue(reply))
| _ -> None )
and runningQueue() = async {
let! msg = inbox.Receive()
scanTimeStart <- sw.ElapsedMilliseconds
match msg with
| AsyncAdd(value, reply) -> return! enqueueAndContinueWithReply(value, reply)
| Add(value) -> return! enqueueAndContinue(value)
| AsyncGet(reply) -> return! dequeueAndContinue(reply) }
and enqueueAndContinueWithReply (value, reply) = async {
reply.Reply()
queue.Enqueue(value)
return! chooseState() }
and enqueueAndContinue (value) = async {
queue.Enqueue(value)
return! chooseState() }
and dequeueAndContinue (reply) = async {
let timestamp = sw.ElapsedMilliseconds
printfn "[AsyncGet] messages cnt/scanned: %d/%d, timestamp/scanTime: %d/%d" inbox.CurrentQueueLength scanned timestamp (timestamp - scanTimeStart)
scanned <- 0
reply.Reply(queue.Dequeue())
return! chooseState() }
and chooseState() =
if queue.Count = 0 then emptyQueue()
elif queue.Count < maxLength then runningQueue()
else fullQueue()
emptyQueue())
let mb = createQueue<int option> 500
let addWithReply v = mb.PostAndAsyncReply(fun ch -> AsyncAdd(v, ch))
let addAndForget v = mb.Post(Add v)
let get() = mb.PostAndAsyncReply(AsyncGet)
[<EntryPoint>]
let main args =
sw.Start()
let enqueue() = async {
for i = 1 to 500 do
//do! ag.AsyncAdd (Some i) // less than a second with do!
addWithReply (Some i) // it takes about 20 seconds without do!
//addAndForget(Some i)
//ag.Add (Some i) // This one takes about 9 seconds
//printfn "=> %d" i
}
async {
do! [ for i = 1 to 100 do yield enqueue() ]
|> Async.Parallel |> Async.Ignore
for i = 1 to 5 do addAndForget None
} |> Async.Start
let rec dequeue() =
async {
let! m = get()
match m with
| Some v ->
//printfn "<= %d" v
return! dequeue()
| None ->
printfn "Done"
}
[ for i = 1 to 5 do yield dequeue() ]
|> Async.Parallel |> Async.Ignore |> Async.RunSynchronously
sw.Stop()
printfn "Totally ellapsed: %dms" sw.ElapsedMilliseconds
0
addWithReply is AsyncAdd. When we run without do! the output is (part of it):
...
[AsyncGet] messages cnt/scanned: 48453/48450, timestamp/scanTime: 3755/6
[AsyncGet] messages cnt/scanned: 48452/48449, timestamp/scanTime: 3758/3
[AsyncGet] messages cnt/scanned: 48451/48448, timestamp/scanTime: 3761/3
[AsyncGet] messages cnt/scanned: 48450/48447, timestamp/scanTime: 3764/3
...
So as you can see, without do! you basically add all 50000 enqueue requests to message queue of mailbox. Dequeue threads are slower here and put their requests only at the end of the messages. Last line of outputstates that we have 48450 message in mailbox, item queue is full (500 items) and in order to free one space we need to scan 48447 messages - because all of them are AsyncAdd, not AsyncGet. scanTime is 2-3ms (on my machine) - approximate time from MailboxProcessor.Scan.
When we add do!, the message queue has different shape (see the output):
[AsyncGet] messages cnt/scanned: 98/96, timestamp/scanTime: 1561/0
[AsyncGet] messages cnt/scanned: 96/96, timestamp/scanTime: 1561/0
[AsyncGet] messages cnt/scanned: 104/96, timestamp/scanTime: 1561/0
[AsyncGet] messages cnt/scanned: 102/96, timestamp/scanTime: 1561/0
The number of messages in message queue ~ # of enqueue threads, because each of them wait now.
What I cannot understand from the experiment yet is when you change AsyncAdd to Add, you still spam the MailboxProcessor:
[AsyncGet] messages cnt/scanned: 47551/47548, timestamp/scanTime: 3069/1
[AsyncGet] messages cnt/scanned: 47550/47547, timestamp/scanTime: 3070/1
[AsyncGet] messages cnt/scanned: 47549/47546, timestamp/scanTime: 3073/3
[AsyncGet] messages cnt/scanned: 47548/47545, timestamp/scanTime: 3077/2
but avg time spent on scan is ~1ms - faster then with AsyncReplyChannel. My thought - this is connected to how AsyncReplyChannel is implemented. It has dependency on ManualResetEvent, so internally there could be another queue of such events per process and each AsyncGet should scan this queue when AsyncReplyChannel is created.
I created a dotnet core application and run the following code of release build. However, the total CPU usage of the PC is around only 20% and process dotnet run takes only 12% (I have eight logical CPUs and I don't see any one of it use 100% either). Isn't the CPU the bottleneck of the code?
open FSharpx.Control
[<EntryPoint>]
let main argv =
let ag = new BlockingQueueAgent<int option>(500)
let enqueue() = async { for i = 0 to 1000 do ag.Add (Some i) }
async {
do! [ for i = 0 to 1000 do yield enqueue() ]
|> Async.Parallel |> Async.Ignore
ag.Add None
} |> Async.Start
let mutable x = 0
let rec dequeue() =
async {
let! m = ag.AsyncGet()
match m with
| Some v ->
//x <- x ^^^ v
for z = 0 to 10000 do x <- x + z
return! dequeue()
| None ->
printfn "Done %d" x
}
[ for i = 0 to 100 do yield dequeue() ]
|> Async.Parallel |> Async.Ignore |> Async.RunSynchronously
0
Here is the source code of BlockingQueueAgent:
https://github.com/fsprojects/FSharpx.Async/blob/master/src/FSharpx.Async/BlockingQueueAgent.fs
Update:
Added more complex code (repaced x <- x ^^^ v). Now it uses a CPU core a lot. Still 13% though. Why it doesn't use multiple core?
You're synchronously enqueueing all of your Add operations before you start dequeuing any messages. This means that when the agent is choosing what to do next it will always Add a new item to the queue if it isn't full. When it is full, it will search for the first AsyncGet operation and process that, but then will immediately Add (synchronously) the next item to the queue before allowing another message to be dequeued. This effectively only allows you to dequeue one message at a time because the agent is always switching back and forth between Add and AsyncGet operations.
If you do an AsyncAdd instead of an Add then both enqueuing and dequeueing can happen asynchronously and you get the desired behaviour, i.e.
let enqueue() = async { for i = 0 to 1000 do do! ag.AsyncAdd (Some i) }
I've some routine that I want to repeat calling every 24 hours, how can this be done in F#
module Program
let private someRoutine =
printfn "someRoutine"
let setInterval =
printfn "repeating"
someRoutine. // call repeatedly every 24 hour
My Attempt
Task.Delay 1000 setInterval
Not sure what you mean by "out of idiomatic world of functional programming".
The example you cite is using Mailboxprocessor with a cancellation token. It covers a general use case and probably can be adopted to your needs.
There is a Timer class which you might find useful. See the examples there.
Here's timer that sleeps for 5 seconds then prints out the time:
open System
[<EntryPoint>]
let main argv =
let timer = new Timers.Timer(5000.)
let event = Async.AwaitEvent (timer.Elapsed) |> Async.Ignore
printfn "%A" DateTime.Now
timer.Start()
printfn "%A" "A-OK"
while true do
Async.RunSynchronously event
printfn "%A" DateTime.Now
printfn "%A" argv
0 // return an integer exit code
λ .\AsyncTimer2.exe
2018/03/11 10:35:24
"A-OK"
2018/03/11 10:35:29
2018/03/11 10:35:34
2018/03/11 10:35:39
2018/03/11 10:35:44
2018/03/11 10:35:49
The typical Pause monad implementation that I see looks like this (based on Chapter 5 from Friendly F# by Giulia Costantini and Giuseppe Maggiore).
open System
type Process<'a> = unit -> 'a Step
and Step<'a> =
| Continue of 'a
| Paused of 'a Process
type PauseMonad () =
member this.Return x = fun () -> Continue x
member this.ReturnFrom x = x
member this.Bind (result, rest) =
fun () ->
match result () with
| Continue x -> rest x ()
| Paused p -> Paused (this.Bind (p, rest))
let yield_ () =
fun () ->
Paused (fun () ->
Continue ())
let get_process_step process_ step = do printfn "Process %d, step %d." process_ step
let get_last_process_step process_ = do printfn "Process %d finished." process_
let rec get_process process_ step_count =
PauseMonad () {
do! yield_ ()
if step_count = 0 then
do get_last_process_step process_
return ()
else
do get_process_step process_ step_count
return! get_process process_ <| step_count - 1
}
let rec race p1 p2 =
match p1 (), p2 () with
| Continue _, _ -> do printfn "Process 1 finished first."
| _, Continue _ -> do printfn "Process 2 finished first."
| Paused p1_, Paused p2_ -> race (p1_) (p2_)
[<EntryPoint>]
let main _ =
let process_1 = get_process 1 5
let process_2 = get_process 2 7
do race process_1 process_2
0
Here is a similar implementation in Haskell.
However, it seems simpler to get rid of the mutually recursive types Process and Step, and just use a single recursive type, Process, as follows.
open System
type Process<'a> =
| Continue of 'a
| Paused of (unit -> 'a Process)
type PauseMonad () =
member this.Return x = Continue x
member this.ReturnFrom x = x
member this.Bind (result, rest) =
match result with
| Continue x -> Paused (fun () -> rest x)
| Paused p -> Paused (fun () -> this.Bind (p (), rest))
let yield_ () =
Paused (fun () ->
Continue ())
let get_process_step process_ step = do printfn "Process %d, step %d." process_ step
let get_last_process_step process_ = do printfn "Process %d finished." process_
let rec get_process process_ step_count =
PauseMonad () {
do! yield_ ()
if step_count = 0 then
do get_last_process_step process_
return ()
else
do get_process_step process_ step_count
return! get_process process_ <| step_count - 1
}
let rec race p1 p2 =
match p1, p2 with
| Continue _, _ -> do printfn "Process 1 finished first."
| _, Continue _ -> do printfn "Process 2 finished first."
| Paused p1_, Paused p2_ -> race (p1_ ()) (p2_ ())
[<EntryPoint>]
let main _ =
let process_1 = get_process 1 5
let process_2 = get_process 2 7
do race process_1 process_2
0
Either of these implementations gives me the same output:
Process 1, step 5.
Process 2, step 7.
Process 1, step 4.
Process 2, step 6.
Process 1, step 3.
Process 2, step 5.
Process 1, step 2.
Process 2, step 4.
Process 1, step 1.
Process 2, step 3.
Process 1 finished.
Process 2, step 2.
Process 1 finished first.
I've made the two implementations as similar as possible to facilitate differencing. As far as I can tell, the only differences are these:
In the first version, yield_, PauseMonad.Return, and PauseMonad.Bind add delays to the return values. In the second version, PauseMonad.Return adds the delay inside the Paused wrapper.
In the first version, PauseMonad.Bind runs one step of the result process to see whether the return value matches Continue or Paused. In the second version, PauseMonad.Bind runs one step of the result process only after determining that it matches Paused.
In the first version, race runs one step of each process, checks that both results match Paused, and recurses with the remaining processes. In the second version, race checks that both processes match Paused, then runs one step of each process, and recurses with the return values of these steps.
Is there a reason the first version is better?
Converting code from Haskell to F# is a bit tricky, because Haskell is lazy and so whenever you see any value, say 'a in Haskell, you could interpret it as unit -> 'a (or more precisely, as Lazy<'a>) - so everything is delayed implicitly.
But let's just compare the two definitions in F#:
// Process is always delayed
type Process1<'a> = unit -> 'a Step1
and Step1<'a> = Continue1 of 'a | Paused1 of 'a Process1
// Process is a value or a delayed computation
type Process2<'a> = Continue2 of 'a | Paused2 of (unit -> 'a Process2)
The key difference is that when you want to represent a computation that produces a value immediately, this has to be a fully evaluated value in the first case, but it can be a function that does something and returns a value in the second case. For example:
let primitive1 : Process1<int> = fun () ->
printfn "hi!" // This will print when the computation is evaluated
Continue1(42) )
let primitive2 : Process2<int> =
printfn "hi!" // This will print immediately and returns a monadic value
Continue2(42)
This becomes interesting when you add Delay member to the computations, which lets you write things like the following without evaluating the side-effects:
process {
printfn "Hi" // Using Process1, we can easily delay this
// Using Process2, this is trickier (or we run it immediately)
return 42 }
There is lot to be said about this and you can find more information in a recent article I wrote about computation expressions.
Are the results from F#'s Async.Parallel operation guaranteed to arrive in the order jobs were submitted? My sample code returns the results in order, but I can't find any mention in the MSDN docs, or the F# spec, assuring this must be the case -- that it's not a coincidence.
Here is my sample code:
let r = System.Random()
Async.Parallel [
for i in 0..10 ->
async {
let rand_num = r.Next(10)
do! Async.Sleep(rand_num) (* Simulate jobs taking a variable amount of time *)
printfn "%i %i" i rand_num
return i
}
]
|> Async.RunSynchronously
|> printfn "%A"
And here's the output.
0 0
5 1
4 1
3 3
10 6
9 4
7 5
2 5
1 5
8 7
6 9
[|0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10|]
You can see that, in this run, the async functions complete in indeterminate order, yet the resulting array is sorted. Is this behavior guaranteed?
At the moment, the source of the function is written so that this guarantee is enforced. Looking at control.fs around line #1300 for the definition, we can see the function that puts the results into the output array is
let recordSuccess i res =
results.[i] <- res;
finishTask(Interlocked.Decrement count)
this function is called in this segment
tasks |> Array.iteri (fun i p ->
queueAsync
innerCTS.Token
// on success, record the result
(fun res -> recordSuccess i res)
where tasks has the original tasks in sorted order. This guarantees that the output list is in the same order as the input.
UPDATE
The spec at least seems to imply that the order is fixed - it contains this code:
let rec fib x = if x < 2 then 1 else fib(x-1) + fib(x-2)
let fibs =
Async.Parallel [ for i in 0..40 -> async { return fib(i) } ]
|> Async.RunSynchronously
printfn "The Fibonacci numbers are %A" fibs //I changed this line to be accurate
System.Console.ReadKey(true)
If the spec didn't guarantee the output order, this code would be incorrect.