Asynchronous mapFold - asynchronous

For the following example, Array.mapFold produces the result ([|1; 4; 12|], 7).
let mapping s x = (s * x, s + x)
[| 1..3 |]
|> Array.mapFold mapping 1
Now suppose our mapping is asynchronous.
let asyncMapping s x = async { return (s * x, s + x) }
I am able to create Array.mapFoldAsync for the following to work.
[| 1..3 |]
|> Array.mapFoldAsync asyncMapping 1
|> Async.RunSynchronously
Is there a succinct way to achieve this without creating Array.mapFoldAsync?
I am asking as a way to learn other techniques - my attempts using Array.fold were horrible.

I don't think it would generally be of much benefit to combine mapFold with an Async function, because the expected result is a tuple ('values * 'accumulator), but using an Async function will at best give you an Async<'values * 'accumulator>. Consider the following attempt to make Array.mapFold work with Async:
let mapping s x = async {
let! s' = s
let! x' = x
return (s' * x', s' + x')
}
[| 1..3 |]
|> Array.map async.Return
|> Array.mapFold mapping (async.Return 1)
Even this doesn't work, because of the type mismatch: The type ''a * Async<'b>' does not match the type 'Async<'c * 'd>'.
You may also have noticed that while there is an Array.Parallel.map, there's no Array.Parallel.fold or Array.Parallel.mapFold. If you try to write your own mapFoldAsync, you may see why. The mapping part is pretty easy, just partially apply Array.map and compose with Async.Parallel:
let mapAsync f = Array.map f >> Async.Parallel
You can implement an async fold as well, but since each evaluation depends on the previous result, you can't leverage Async.Parallel this time:
let foldAsync f state array =
match array |> Array.length with
| 0 -> async.Return state
| length ->
async {
let mutable acc = state
for i = 0 to length - 1 do
let! value = f acc array.[i]
acc <- value
return acc
}
Now, when we try to combine these to build a mapFoldAsync, it becomes apparent that we can't leverage parallel execution on the mapping anymore, because both the values and the accumulator can be based on the result of the previous evaluation. That means our mapFoldAsync will be a modified 'foldAsync', not a composition of it with mapAsync:
let mapFoldAsync (f: 's -> 'a -> Async<'b * 's>) (state: 's) (array: 'a []) =
match array |> Array.length with
| 0 -> async.Return ([||], state)
| length ->
async {
let mutable acc = state
let results = Array.init length <| fun _ -> Unchecked.defaultof<'b>
for i = 0 to length - 1 do
let! (x,y) = f acc array.[i]
results.[i] <- x
acc <- y
return (results, acc)
}
While this will give you a way to do a mapFold with an async mapping function, the only real benefit would be if the mapping function did something with high-latency, such as a service call. You won't be able to leverage parallel execution for speed-up. If possible, I would suggest considering an alternative solution, based on your real-world scenario.

Without external libraries (I recommend to try AsyncSeq or Hopac.Streams)
you could do this:
let mapping s x = (fst s * x, snd s + x) |> async.Return
module Array =
let mapFoldAsync folderAsync (state: 'state) (array: 'elem []) = async {
let mutable finalState = state
for elem in array do
let! nextState = folderAsync finalState elem
finalState <- nextState
return finalState
}
[| 1..4 |]
|> Array.mapFoldAsync mapping (1,0)
|> Async.RunSynchronously

Related

Removing from a list of a tuples that contains an empty element in the second projection F#

I need to learn the right way to do pattern matching on Pair types:
let pairToBeFiltered = Ok ([(1,[]);(2,[3;4]);(5,[6;7;8]);(9,[]);(10,[])])
let filterEmpty (pair: int * int list) =
match pair with
| (x,y) when y <> [] -> (x,y) //This gives error because of incomplete pattern matching!
let filtering = List.map(filterEmpty) pairToBeFiltered
Desired output:
Ok([(2,[3;4]);(5,[6;7;8])])
This should do it:
let pairsToBeFiltered = Ok ([(1,[]);(2,[3;4]);(5,[6;7;8]);(9,[]);(10,[])])
let filterEmpty pairs =
List.where (fun (_, y) -> y <> []) pairs // pattern match on pair occurs here
let filtering : Result<_, string> =
pairsToBeFiltered
|> Result.map filterEmpty
printfn "%A" filtering // Ok [(2, [3; 4]); (5, [6; 7; 8])]
There are a number of issues here:
For clarity, I modified filterEmpty so it processes the entire list, rather than a single pair. This is where we apply the filtering function, List.where, using pattern matching. (In your code, note that List.map with a match expression doesn't filter anything.)
Since your list is wrapped in a Result, you need to unwrap it via Result.map in order to process it. (Since you didn't specify a 'TError type, I assumed string to pacify the compiler.)
Three more versions:
(* using match statement *)
module Version1 =
let pairsToBeFiltered : Result<_, string> =
Ok [(1,[]);(2,[3;4]);(5,[6;7;8]);(9,[]);(10,[])]
let myWhere (pair : int * List<int>) =
match pair with
| _, [] -> false
| _, _ -> true
let myFilter l0 = l0 |> Result.map (List.filter myWhere)
let result = pairsToBeFiltered |> myFilter
(* using lambda functions and List.isEmpty *)
module Version2 =
let pairsToBeFiltered : Result<_, string> =
Ok [(1,[]);(2,[3;4]);(5,[6;7;8]);(9,[]);(10,[])]
let myFilter l0 =
l0
|> Result.map (fun l1 ->
l1 |> List.filter (fun (_, l2) ->
l2 |> List.isEmpty |> not))
let result = pairsToBeFiltered |> myFilter
(* shortening Version2 (point free style - take care, can be confusing) *)
module Version3 =
let pairsToBeFiltered : Result<_, string> =
Ok [(1,[]);(2,[3;4]);(5,[6;7;8]);(9,[]);(10,[])]
let myFilter = Result.map (List.filter (snd >> List.isEmpty >> not))
let result = pairsToBeFiltered |> myFilter

F# rewrite computation expression

I'm studying continuations because I want to make some interesting use of coroutines... anyway, I want to better understand one implementation I found.
To do so I want to rewrite the implementation without using the computation expression (continuation Monad), but I'm not quite able to do it.
I have this:
type K<'T,'r> = (('T -> 'r) -> 'r)
let returnK x = (fun k -> k x)
let bindK m f = (fun k -> m (fun a -> f a k))
let runK (c:K<_,_>) cont = c cont
let callcK (f: ('T -> K<'b,'r>) -> K<'T,'r>) : K<'T,'r> =
fun cont -> runK (f (fun a -> (fun _ -> cont a))) cont
type ContinuationBuilder() =
member __.Return(x) = returnK x
member __.ReturnFrom(x) = x
member __.Bind(m,f) = bindK m f
member this.Zero () = this.Return ()
let K = new ContinuationBuilder()
/// The coroutine type from http://fssnip.net/7M
type Coroutine() =
let tasks = new System.Collections.Generic.Queue<K<unit,unit>>()
member this.Put(task) =
let withYield = K {
do! callcK (fun exit ->
task (fun () ->
callcK (fun c ->
tasks.Enqueue(c())
exit ())))
if tasks.Count <> 0 then
do! tasks.Dequeue() }
tasks.Enqueue(withYield)
member this.Run() =
runK (tasks.Dequeue()) ignore
// from FSharpx tests
let ``When running a coroutine it should yield elements in turn``() =
// This test comes from the sample on http://fssnip.net/7M
let actual = System.Text.StringBuilder()
let coroutine = Coroutine()
coroutine.Put(fun yield' -> K {
actual.Append("A") |> ignore
do! yield' ()
actual.Append("B") |> ignore
do! yield' ()
actual.Append("C") |> ignore
do! yield' ()
})
coroutine.Put(fun yield' -> K {
actual.Append("1") |> ignore
do! yield' ()
actual.Append("2") |> ignore
do! yield' ()
})
coroutine.Run()
actual.ToString() = "A1B2C"
``When running a coroutine it should yield elements in turn``()
So, I want rewrite the Put member of the Coroutine class without using the computation expression K.
I have read of course this and this and several other articles about catamorphisms but it is not quite easy to rewrite this continuation monand as it is to rewrite the Write Monad for example...
I try several ways, this is one of them:
member this.Put(task) =
let withYield =
bindK
(callcK (fun exit ->
task (fun () ->
callcK (fun c ->
tasks.Enqueue(c())
exit ()))))
(fun () ->
if tasks.Count <> 0
then tasks.Dequeue()
else returnK ())
tasks.Enqueue(withYield)
Of course it does not work :(
(By the way: there is some extensive documentation of all rules the compiler apply to rewrite the computation in plain F#?)
Your version of Put is almost correct. Two issues though:
The bindK function is being used backwards, the parameters need to be swaped.
task should be passed a Cont<_,_> -> Cont<_,_>, not a unit -> Cont<_,_> -> Cont<_,_>.
Fixing those issues it could look like this:
member this.Put(task) =
let withYield =
bindK
(fun () ->
if tasks.Count <> 0
then tasks.Dequeue()
else returnK ())
(callcK (fun exit ->
task (
callcK (fun c ->
tasks.Enqueue(c())
exit ()))))
tasks.Enqueue(withYield)
Of course it is not too elegant.
When using bind it is better to declare an operator >>=:
let (>>=) c f = bindK f c
that way
do! translates to putting >>= fun () -> after
let! a = translates to putting >>= fun a -> after
and then your code will look a little bit better:
member this.Put2(task) =
let withYield =
callcK( fun exit ->
task( callcK (fun c ->
tasks.Enqueue(c())
exit())
)
) >>= fun () ->
if tasks.Count <> 0 then
tasks.Dequeue()
else returnK ()
tasks.Enqueue withYield

F# async workflow / tasks combined with free monad

I'm trying to build pipeline for message handling using free monad pattern, my code looks like that:
module PipeMonad =
type PipeInstruction<'msgIn, 'msgOut, 'a> =
| HandleAsync of 'msgIn * (Async<'msgOut> -> 'a)
| SendOutAsync of 'msgOut * (Async -> 'a)
let private mapInstruction f = function
| HandleAsync (x, next) -> HandleAsync (x, next >> f)
| SendOutAsync (x, next) -> SendOutAsync (x, next >> f)
type PipeProgram<'msgIn, 'msgOut, 'a> =
| Act of PipeInstruction<'msgIn, 'msgOut, PipeProgram<'msgIn, 'msgOut, 'a>>
| Stop of 'a
let rec bind f = function
| Act x -> x |> mapInstruction (bind f) |> Act
| Stop x -> f x
type PipeBuilder() =
member __.Bind (x, f) = bind f x
member __.Return x = Stop x
member __.Zero () = Stop ()
member __.ReturnFrom x = x
let pipe = PipeBuilder()
let handleAsync msgIn = Act (HandleAsync (msgIn, Stop))
let sendOutAsync msgOut = Act (SendOutAsync (msgOut, Stop))
which I wrote according to this article
However it's important to me to have those methods asynchronous (Task preferably, but Async is acceptable), but when I created a builder for my pipeline, I can't figure out how to use it - how can I await a Task<'msgOut> or Async<'msgOut> so I can send it out and await this "send" task?
Now I have this piece of code:
let pipeline log msgIn =
pipe {
let! msgOut = handleAsync msgIn
let result = async {
let! msgOut = msgOut
log msgOut
return sendOutAsync msgOut
}
return result
}
which returns PipeProgram<'b, 'a, Async<PipeProgram<'c, 'a, Async>>>
In my understanding, the whole point of the free monad is that you don't expose effects like Async, so I don't think they should be used in the PipeInstruction type. The interpreter is where the effects get added.
Also, the Free Monad really only makes sense in Haskell, where all you need to do is define a functor, and then you get the rest of the implementation automatically. In F# you have to write the rest of the code as well, so there is not much benefit to using Free over a more traditional interpreter pattern.
That TurtleProgram code you linked to was just an experiment -- I would not recommend using Free for real code at all.
Finally, if you already know the effects you are going to use, and you are not going to have more than one interpretation, then using this approach doesn't make sense. It only makes sense when the benefits outweigh the complexity.
Anyway, if you did want to write an interpreter version (rather than Free) this is how I would do it:
First, define the instructions without any effects.
/// The abstract instruction set
module PipeProgram =
type PipeInstruction<'msgIn, 'msgOut,'state> =
| Handle of 'msgIn * ('msgOut -> PipeInstruction<'msgIn, 'msgOut,'state>)
| SendOut of 'msgOut * (unit -> PipeInstruction<'msgIn, 'msgOut,'state>)
| Stop of 'state
Then you can write a computation expression for it:
/// A computation expression for a PipeProgram
module PipeProgramCE =
open PipeProgram
let rec bind f instruction =
match instruction with
| Handle (x,next) -> Handle (x, (next >> bind f))
| SendOut (x, next) -> SendOut (x, (next >> bind f))
| Stop x -> f x
type PipeBuilder() =
member __.Bind (x, f) = bind f x
member __.Return x = Stop x
member __.Zero () = Stop ()
member __.ReturnFrom x = x
let pipe = PipeProgramCE.PipeBuilder()
And then you can start writing your computation expressions. This will help flush out the design before you start on the interpreter.
// helper functions for CE
let stop x = PipeProgram.Stop x
let handle x = PipeProgram.Handle (x,stop)
let sendOut x = PipeProgram.SendOut (x, stop)
let exampleProgram : PipeProgram.PipeInstruction<string,string,string> = pipe {
let! msgOut1 = handle "In1"
do! sendOut msgOut1
let! msgOut2 = handle "In2"
do! sendOut msgOut2
return msgOut2
}
Once you have described the the instructions, you can then write the interpreters. And as I said, if you are not writing multiple interpreters, then perhaps you don't need to do this at all.
Here's an interpreter for a non-async version (the "Id monad", as it were):
module PipeInterpreterSync =
open PipeProgram
let handle msgIn =
printfn "In: %A" msgIn
let msgOut = System.Console.ReadLine()
msgOut
let sendOut msgOut =
printfn "Out: %A" msgOut
()
let rec interpret instruction =
match instruction with
| Handle (x, next) ->
let result = handle x
result |> next |> interpret
| SendOut (x, next) ->
let result = sendOut x
result |> next |> interpret
| Stop x ->
x
and here's the async version:
module PipeInterpreterAsync =
open PipeProgram
/// Implementation of "handle" uses async/IO
let handleAsync msgIn = async {
printfn "In: %A" msgIn
let msgOut = System.Console.ReadLine()
return msgOut
}
/// Implementation of "sendOut" uses async/IO
let sendOutAsync msgOut = async {
printfn "Out: %A" msgOut
return ()
}
let rec interpret instruction =
match instruction with
| Handle (x, next) -> async {
let! result = handleAsync x
return! result |> next |> interpret
}
| SendOut (x, next) -> async {
do! sendOutAsync x
return! () |> next |> interpret
}
| Stop x -> x
First of all, I think that using free monads in F# is very close to being an anti-pattern. It is a very abstract construction that does not fit all that great with idiomatic F# style - but that is a matter of preference and if you (and your team) finds this way of writing code readable and easy to understand, then you can certainly go in this direction.
Out of curiosity, I spent a bit of time playing with your example - although I have not quite figured out how to fix your example completely, I hope the following might help to steer you in the right direction. The summary is that I think you will need to integrate Async into your PipeProgram so that the pipe program is inherently asynchronous:
type PipeInstruction<'msgIn, 'msgOut, 'a> =
| HandleAsync of 'msgIn * (Async<'msgOut> -> 'a)
| SendOutAsync of 'msgOut * (Async<unit> -> 'a)
| Continue of 'a
type PipeProgram<'msgIn, 'msgOut, 'a> =
| Act of Async<PipeInstruction<'msgIn, 'msgOut, PipeProgram<'msgIn, 'msgOut, 'a>>>
| Stop of Async<'a>
Note that I had to add Continue to make my functions type-check, but I think that's probably a wrong hack and you might need to remote that. With these definitions, you can then do:
let private mapInstruction f = function
| HandleAsync (x, next) -> HandleAsync (x, next >> f)
| SendOutAsync (x, next) -> SendOutAsync (x, next >> f)
| Continue v -> Continue v
let rec bind (f:'a -> PipeProgram<_, _, _>) = function
| Act x ->
let w = async {
let! x = x
return mapInstruction (bind f) x }
Act w
| Stop x ->
let w = async {
let! x = x
let pg = f x
return Continue pg
}
Act w
type PipeBuilder() =
member __.Bind (x, f) = bind f x
member __.Return x = Stop x
member __.Zero () = Stop (async.Return())
member __.ReturnFrom x = x
let pipe = PipeBuilder()
let handleAsync msgIn = Act (async.Return(HandleAsync (msgIn, Stop)))
let sendOutAsync msgOut = Act (async.Return(SendOutAsync (msgOut, Stop)))
let pipeline log msgIn =
pipe {
let! msgOut = handleAsync msgIn
log msgOut
return! sendOutAsync msgOut
}
pipeline ignore 0
This now gives you just plain PipeProgram<int, unit, unit> which you should be able to evaluate by having a recursive asynchronous functions that acts on the commands.

Optimizing syntax for mapped async sequences in F#

I am trying to figure out efficient syntax for the following F# expression. Let's say I have an F# async computation:
let asyncComp n = async { return n }
It has a signature 'a -> Async<'a>. Now I define a sequence of those:
let seqOfAsyncComps =
seq {
yield asyncComp 1
yield asyncComp 2
yield asyncComp 3
}
Now I have an item of seq<Async<int>>. What if I want to asynchronously map the elements from seq<Async<int>> to seq<Async<int>>. This won't work:
let seqOfAsyncSquares =
seqOfAsyncComps |> Seq.map (fun x -> x * x) // ERROR!!!
Of course, x is Async<int>, I have to extract an int first, so I can do the following instead:
let seqOfAsyncSquares =
seqOfAsyncComps |> Seq.map (fun x -> async {
let! y = x
return y * y }) // OK
This works fine but the syntax is clumsy. It takes away F# compactness, and if I want to chain several seq processing I have to do the same trick in every map, filter or iter.
I suspect there might be a more efficient syntax to deal with sequences that consist of async computations.
You could use Async.map (that I've only now blatantly stolen from Tomas Petricek):
module Async =
let map f workflow = async {
let! res = workflow
return f res }
let seqOfAsyncSquares' =
seqOfAsyncComps |> Seq.map (Async.map (fun x -> x * x))
If you evaluate it, you'll see that it seems to produce the expected outcome:
> seqOfAsyncSquares' |> Async.Parallel |> Async.RunSynchronously;;
val it : int [] = [|1; 4; 9|]

Combine F# async and maybe computation expression

Say i want to return an Option while in an async workflow:
let run =
async {
let! x = doAsyncThing
let! y = doNextAsyncThing x
match y with
| None -> return None
| Some z -> return Some <| f z
}
Ideally I would use the maybe computation expression from FSharpx at the same time as async to avoid doing the match. I could make a custom builder, but is there a way to generically combine two computation expressions? It might look something like this:
let run =
async {
let! x = doAsyncThing
let! y = doNextAsyncThing x
return! f y
}
Typically in F# instead of using generic workflows you define the workflow by hand, or use one that is ready available as in your case async and maybe but if you want to use them combined you will need to code a specific workflow combination by hand.
Alternatively you can use F#+ which is a project that provides generic workflows for monads, in that case it will be automatically derived for you, here's a working example, using your workflow and then using OptionT which is a monad transformer:
#r "nuget: FSharpPlus, 1.2"
open FSharpPlus
open FSharpPlus.Data
let doAsyncThing = async {return System.DateTime.Now}
let doNextAsyncThing (x:System.DateTime) = async {
let m = x.Millisecond
return (if m < 500 then Some m else None)}
let f x = 2 * x
// then you can use Async<_> (same as your code)
let run = monad {
let! x = doAsyncThing
let! y = doNextAsyncThing x
match y with
| None -> return None
| Some z -> return Some <| f z}
let res = Async.RunSynchronously run
// or you can use OptionT<Async<_>> (monad transformer)
let run' = monad {
let! x = lift doAsyncThing
let! y = OptionT (doNextAsyncThing x)
return f y}
let res' = run' |> OptionT.run |> Async.RunSynchronously
The first function has to be 'lifted' into the other monad, because it only deals with Async (not with Option), the second function deals with both so it only needs to be 'packed' into our OptionT DU.
As you can see both workflows are derived automatically, the one you had (the async workflow) and the one you want.
For more information about this approach read about Monad Transformers.
A simple way to do so is to use Option module:
let run =
async {
let! x = doAsyncThing
let! y = doNextAsyncThing x
return Option.map f y
}
I suppose you don't have to deal with option in context of async so often. FSharpx also provides many more high-order functions for option type. Most of the cases, I think using them is enough.
To get the feeling of using these functions, please take a look at this nice article.
type MaybeMonad() =
member __.Bind(x, f) =
match x with
| Some v -> f v
| None -> None
member __.Return(x) =
Some x
let maybe = MaybeMonad()
let run = async {
let! x = doAsyncThing
let! y = doNextAsyncThing x
return maybe {
let! y_val = y
return f y_val
}
}
just use f# Computation expressions inside.

Resources