first, here is the code:
let getCandlesFromAsync (exchange: IExchange) (instrument: Instrument) (interval: TimeSpan) (fromTime: DateTime) (toTime: DateTime) =
async {
let rec getAsync (c: CandleData list) (f: DateTime) (t: DateTime) =
async {
//info $"requesting {instrument}: {f} - {t}"
let! candles = exchange.GetCandlesAsync(instrument, interval, f, t)
if candles.IsError then
return (failwith candles.GetError.Describe)
else
//info $"received data {instrument}: {candles.Get.[0].Timestamp} - {candles.Get.[^0].Timestamp}"
let c = c # candles.Get
if c.[^0].Timestamp < t - interval then
return! getAsync c (c.[^0].Timestamp + interval) t
else
return c
}
let cache = DataCache.getCache instrument
let candlesFromCache = getCandlesFromCache cache interval fromTime toTime
let firstTimestamp =
match candlesFromCache.IsEmpty with
| true -> fromTime
| false -> candlesFromCache.[^0].Timestamp + interval
// check if we need some new data
let downloadedCandles =
async {
if firstTimestamp < toTime then
let! x = getAsync [] firstTimestamp toTime
putCandlesInCache cache x
return x
else
return []
}
let! d = downloadedCandles
return candlesFromCache # d
}
This code is supposed to download price candles from an exchange. It has to run at regular interval and catch up with the new data.
Since I need data from a range of timestamps, I try to cache the data that has previously been requested from the exchange. At the range is always moving forward, I only have to check how much data I already have in the range, and how much I need to get.
The code is split into several parts:
code that gets data from the cache for a time range (not posted here, but not relevant). It returns CandleData list.
code that requests data from a time range from the exchange (getAsync), it returns async<CandleData list>.
a small piece of code that determines what is missing and glues the pieces together (the second half of the function).
The issue here is that the whole function is expected to be async, but getAsync is recursive, so it has its own async block.
Then the code that glues things together has to call getAsync and attach the data to what comes from the cache, so the whole thing is wrapped in an async block as well...
There has to be a cleaner way to do this, but I'm not sure how. Any suggestions would be welcome!
Separating the functions is the best practice. It doesn't necessarily reduce the number of asyncs but it makes the code cleaner and easier to understand.
The function that downloads from exchange may be on its own:
let downloadFromExchange (exchange: IExchange) (instrument: Instrument) (interval: TimeSpan) (f: DateTime) (t: DateTime) =
let rec getAsync (previousCandles: CandleData list) (f: DateTime) =
async {
//info $"requesting {instrument}: {f} - {t}"
if f < t then return previousCandles else
let! candles = exchange.GetCandlesAsync(instrument, interval, f, t)
if candles.IsError then
return (failwith candles.GetError.Describe)
else
//info $"received data {instrument}: {candles.Get.[0].Timestamp} - {candles.Get.[^0].Timestamp}"
let c = previousCandles # candles.Get
match c.[^0].Timestamp + interval with
| fr when fr < t -> return! getAsync c fr
| _ -> return c
}
getAsync [] f
I changed the code a little bit to make it clearer for me. I could be wrong but it seems to me the expression c.[^0].Timestamp may result in an exception (or an infinite loop) if the list is empty either in the first call or in a recursive invocation.
let getCandlesFromAsync exchange (instrument: Instrument) (interval: TimeSpan) (fromTime: DateTime) (toTime: DateTime) =
async {
let cache = DataCache.getCache instrument
let candlesFromCache = getCandlesFromCache cache interval fromTime toTime
let firstTimestamp =
match candlesFromCache.IsEmpty with
| true -> fromTime
| false -> candlesFromCache.[^0].Timestamp + interval
let! x = downloadFromExchange exchange instrument interval firstTimestamp toTime
putCandlesInCache cache x
return candlesFromCache # x
}
I put the condition from < to in the download function, that way the code is cleaner.
Related
I'm trying to build Result Builder that accumulates Errors (in my case they are named Failures as I'm following some code from https://fsharpforfunandprofit.com/). It's current implementation returns first encountered Failure when ideally I'd prefer it to either return Success with desired value or a Failure with a list of all missing/corrupted values. Unfortunately current implementation it's a bit verbose.
Boilerplate code
module Rop
type RopResult<'TSuccess, 'TMessage> =
| Success of 'TSuccess * 'TMessage list
| Failure of 'TMessage list
/// create a Success with no messages
let succeed x =
Success (x,[])
/// create a Success with a message
let succeedWithMsg x msg =
Success (x,[msg])
/// create a Failure with a message
let fail msg =
Failure [msg]
/// A function that applies either fSuccess or fFailure
/// depending on the case.
let either fSuccess fFailure = function
| Success (x,msgs) -> fSuccess (x,msgs)
| Failure errors -> fFailure errors
/// merge messages with a result
let mergeMessages msgs result =
let fSuccess (x,msgs2) =
Success (x, msgs # msgs2)
let fFailure errs =
Failure (errs # msgs)
either fSuccess fFailure result
/// given a function that generates a new RopResult
/// apply it only if the result is on the Success branch
/// merge any existing messages with the new result
let bindR f result =
let fSuccess (x,msgs) =
f x |> mergeMessages msgs
let fFailure errs =
Failure errs
either fSuccess fFailure result
Builder code
module ResultComputationExpression
open Rop
type ResultBuilder() =
member __.Return(x) = RopResult.Success (x,[])
member __.Bind(x, f) = bindR f x
member __.ReturnFrom(x) = x
member this.Zero() = this.Return ()
member __.Delay(f) = f
member __.Run(f) = f()
member this.While(guard, body) =
if not (guard())
then this.Zero()
else this.Bind( body(), fun () ->
this.While(guard, body))
member this.TryWith(body, handler) =
try this.ReturnFrom(body())
with e -> handler e
member this.TryFinally(body, compensation) =
try this.ReturnFrom(body())
finally compensation()
member this.Using(disposable:#System.IDisposable, body) =
let body' = fun () -> body disposable
this.TryFinally(body', fun () ->
match disposable with
| null -> ()
| disp -> disp.Dispose())
member this.For(sequence:seq<_>, body) =
this.Using(sequence.GetEnumerator(),fun enum ->
this.While(enum.MoveNext,
this.Delay(fun () -> body enum.Current)))
member this.Combine (a,b) =
this.Bind(a, fun () -> b())
let result = new ResultBuilder()
Use case
let crateFromPrimitive (taskId:int) (title:string) (startTime:DateTime) : RopResult<SomeValue,DomainErrror> =
result {
// functions that, at the end, return "RopResult<TaskID,DomainError>" therefore "let! id" is of type "TaskID"
let! id = taskId |> RecurringTaskId.create |> mapMessagesR mapIntErrors
// functions that, at the end, return "RopResult<Title,DomainError>" therefore "let! tt" is of type "Title"
let! tt = title|> Title.create |> mapMessagesR mapStringErrors
// functions that, at the end, return "RopResult<StartTime,DomainError>" therefore "let! st" is of type "StartTime"
let! st = startTime|> StartTime.create |> mapMessagesR mapIntErrors
// "create" returns "RopResult<SomeValue,DomainErrror>", "let! value" is of type "SomeValue"
let! value = create id tt st
return value
}
I could possibly split it to first validate taskId, title and startTime and then eventually call create but is it possible to do in one go?
I found this answer but I have no idea how to translate it to my case or if it's even related.
UPDATE: Solution
Just like brainbers comment and solution says, and! solves my problem. What still troubles me is the idea of automatically de-toupling (namely, when does it happen and on what rules?). In any case, I expect people will be more than able to put two and two together but the working solution for my problem is:
Builder part
...
member _.MergeSources(result1, result2) =
match result1, result2 with
| Success (ok1,msgs1), Success (ok2,msgs2) ->
Success ((ok1,ok2),msgs1#msgs2 )
| Failure errs1, Success _ -> Failure errs1
| Success _, Failure errs2 -> Failure errs2
| Failure errs1, Failure errs2 -> Failure (errs1 # errs2) // accumulate errors
...
Use Case
let crateFromPrimitive taskId title startTime duration category description (subtasks:string list option) (repeatFormat:RepeatFormat option) =
result {
let strintToSubTask = (Subtask.create >> (mapMessagesR mapStringErrors))
let sListToSubtaskList value = List.map strintToSubTask value
|> RopResultHelpers.sequence
let! id = RecurringTaskId.create taskId |> mapMessagesR mapIntErrors
and! tt = Title.create title |> mapMessagesR mapStringErrors
and! st = StartTime.create startTime |> mapMessagesR mapIntErrors
and! dur = Duration.create duration |> mapMessagesR mapIntErrors
and! cat = Category.create category |> mapMessagesR mapStringErrors
and! desc = Description.create description |> mapMessagesR mapStringErrors
and! subtOption = someOrNone sListToSubtaskList subtasks |> RopResultHelpers.fromOptionToSuccess
//let! value = create id tt st dur cat desc subtOption repeatFormat
return! create id tt st dur cat desc subtOption repeatFormat
}
I searched around a bit and didn't find any validators that use the new and! syntax and accumulate errors, so I decided to write a quick one myself. I think this does what you want, and is much simpler. Note that I'm using Result<_, List<_>> to accumulate a list of errors, rather than creating a new type.
type AccumValidationBuilder() =
member _.BindReturn(result, f) =
result |> Result.map f
member _.MergeSources(result1, result2) =
match result1, result2 with
| Ok ok1, Ok ok2 -> Ok (ok1, ok2) // compiler will automatically de-tuple these - very cool!
| Error errs1, Ok _ -> Error errs1
| Ok _, Error errs2 -> Error errs2
| Error errs1, Error errs2 -> Error (errs1 # errs2) // accumulate errors
let accValid = AccumValidationBuilder()
And here it is in action:
let validateInt (str : string) =
match Int32.TryParse(str) with
| true, n -> Ok n
| _ -> Error [ str ]
let test str1 str2 str3 =
let result =
accValid {
let! n1 = validateInt str1
and! n2 = validateInt str2
and! n3 = validateInt str3
return n1 + n2 + n3
}
printfn "Result : %A" result
[<EntryPoint>]
let main argv =
test "1" "2" "3" // output: Ok 6
test "1" "red" "blue" // output: Error [ "red"; "blue" ]
0
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
Attempting to find anagrams in a list of words using F Sharps Async Sequences (I am aware there are better algorithms for anagram finding but trying to understand Async Sequneces)
From the 'runTest' below how can I
1. async read the collecion returned and output to screen
2. block until all results return & display final count/collection
open System
open System.ServiceModel
open System.Collections.Generic
open Microsoft.FSharp.Linq
open FSharp.Control
[<Literal>]
let testWord = "table"
let testWords = new List<string>()
testWords.Add("bleat")
testWords.Add("blate")
testWords.Add("junk")
let hasWord (word:string) =
let mutable res = true
let a = testWord.ToCharArray() |> Set.ofArray
let b = word.ToCharArray() |> Set.ofArray
let difference = Set.intersect a b
match difference.Count with
| 0 -> false
| _ -> true
let test2 (words:List<string>, (word:string)) : AsyncSeq<string> =
asyncSeq {
let res =
(words)
|> Seq.filter(fun x-> (hasWord(x)) )
|> AsyncSeq.ofSeq
yield! res
}
let runTest = test2(testWords,testWord)
|> //pull stuff from stream
|> // output to screen
|> ignore
()
So as you have the test2 function returning an asyncSeq. Your questions:
1. async read the collecion returned and output to screen
If you want to have some side-effecting code (such as outputting to the screen) you can use AsyncSeq.iter to apply a function to each item as it becomes available. Iter returns an Async<unit> so you can then "kick it off" using an appropriate Async method (blocking/non-blocking).
For example:
let processItem i =
// Do whatever side effecting code you want to do with an item
printfn "Item is '%s'" i
let runTestQ1 =
test2 (testWords, testWord)
|> AsyncSeq.iter processItem
|> Async.RunSynchronously
2. block until all results return & display final count/collection
If you want all the results collected so that you can work on them together, then you can convert the AsyncSeq into a normal Seq using AsyncSeq.toBlockingSeq and then convert it to a list to force the Seq to evaluate.
For example:
let runTestQ2 =
let allResults =
test2 (testWords, testWord)
|> AsyncSeq.toBlockingSeq
|> Seq.toList
// Do whatever you would like with your list of results
printfn "Final list is '%A' with a count of %i" allResults (allResults.Length)
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.
(Note I'm talking about pipelining as in running independent processes in parallel; not related to the |> operator).
So if I've got two functions
let incr x =
Thread.Sleep 1000
x + 1
let product x y =
Thread.Sleep 1000
x * y
would there be an easy way to write a workflow something like (pseudocode)
let productOfIncrements x y =
async {
let! x1 = incr x
let! y1 = incr y
let! result = product x1 y1
return result
}
that pipelines the first two independent operations and thus executes in two seconds, or are async workflows the wrong approach to this problem? If there is a good approach to the problem, is there a straightforward way to extend such an approach to do, say, recursive factorial calculation in N+1 seconds rather than 2N?
The easiest option is to use Async.StartChild. This primitve starts an asynchronous operation in background (in a thread pool) and returns a "token" that can be used to wait for a completion of the operation. This doesn't block the workflow, so you can then continue running other operations:
let productOfIncrements x y =
async {
// Start the 'incr x' operation in background
let! x1Op = async {return incr x} |> Async.StartChild
// Continue doing other work
// (synchronously since it takes the same time as the above.)
let y1 = incr y
// Now wait for the result of 'incr x' (if it is still running)
let! x1 = x1Op
// return the product (just call the function synchronously)
return product x1 y1
}
If the two operations return the same type, then you can also use Async.Parallel, which composes multiple operations to run in parallel.
If you're working with purely CPU-bound computations and you need to create a large number of them, then you can also use .NET Tasks directly (see for example this article). Tasks are more efficient, but are not as elegant to use (and don't support asynchronous waiting nicely).
As a side-note, the term pipeline is usually used (at least in F# or .NET world) for a more complicated thing - For example, say you have a series of steps that depend on each other. When processing multiple inputs, you can run the steps in parallel (and still limit the total paralellism). This can be done using F# async workflows too - see for example this article. There is also a framework named pipelets that implements the concept.
Okay, here's a solution to the recursive factorial problem based on Tomas's solution to the waiting problem. I'm still not 100% satisfied with it; I feel like the inner method should return some kind of continuation tuple or something; maintaining the running total seems somehow like "cheating", but anyway:
open System.Threading
open System
let decr x =
Thread.Sleep 1000
x - 1
let product x y =
Thread.Sleep 1000
x * y
let fact (n:int) :Async<int> =
let rec fact2 (x:int) (xMinus1Op:Async<int>) (runningProduct:Async<int>) :Async<int> =
async {
if x = 0 then
return! runningProduct
else
let! xMinus1 = xMinus1Op
let! xMinus2Op = async {return decr xMinus1} |> Async.StartChild
let! prod = runningProduct
let! runningProduct = async {return product x prod} |> Async.StartChild
// start both threads to execute simultaneously and feed them forward.
return! fact2 xMinus1 xMinus2Op runningProduct
}
fact2 n (async{return decr n}) (async{return 1})
let start = Environment.TickCount
let result = fact 10 |> Async.RunSynchronously
printfn "%A" <| result
printfn "%A" <| Environment.TickCount - start //runs in 11 seconds, not 20.
Edit: maybe it's more straightforward using tasks:
let fact (n:int) :int =
let rec fact2 (x:int) (xMinus1:int) (runningProduct:int) :int =
if x = 0 then
runningProduct
else
let xMinus2Op = new Task<int>(fun () -> decr xMinus1)
let runningProductOp = new Task<int>(fun () -> product x runningProduct)
xMinus2Op.Start()
runningProductOp.Start()
let xMinus2 = xMinus2Op.Result
let runningProduct = runningProductOp.Result
fact2 xMinus1 xMinus2 runningProduct
fact2 n (decr n) (1)
No workflows necessary, just plain imperative code; it might even translate into C# easily.