Recursively update a State Monad - f#

this question is related to this question
I have a state monad. An object provides an update function as in the OOD strategy pattern.
The choice of having a object is that in real, production code, the
class provides an array of operations, all sharing state through the
monad. Inheritance helped me extend the basic functionality and
further customizing the class providing the operations.
The choice of having a monad instead of a mutable property within the class is that the monad, through proper use of generics, is helping me abstracting and being more flexible on what variables/information must be carried along the computation as "state".
I have a simple toy example:
/////////////////////////////////////////////////////////////////////////////////////
// Definition of the state
/////////////////////////////////////////////////////////////////////////////////////
type StateFunc<'State, 'T> = 'State -> 'T * 'State
/////////////////////////////////////////////////////////////////////////////////////
// Definition of the State monad type
/////////////////////////////////////////////////////////////////////////////////////
type StateMonadBuilder<'State>() =
// M<'T> -> M<'T>
member b.ReturnFrom a : StateFunc<'State, 'T> = a
// 'T -> M<'T>
member b.Return a : StateFunc<'State, 'T> = ( fun s -> a, s)
// M<'T> * ('T -> M<'U>) -> M<'U>
member b.Bind(p : StateFunc<_, 'T>, rest : 'T -> StateFunc<_,_>) : StateFunc<'State, 'U> =
(fun s ->
let a, s' = p s
rest a s')
// Getter for the whole state, this type signature is because it passes along the state & returns the state
member b.getState : StateFunc<'State, _> = (fun s -> s, s)
// Setter for the state
member b.putState (s:'State) : StateFunc<'State, _> = (fun _ -> (), s)
let runState f init = f init
/////////////////////////////////////////////////////////////////////////////////////
// STRATEGY PATTERN
/////////////////////////////////////////////////////////////////////////////////////
let state = StateMonadBuilder<int> ()
// DoubleFunctOne defines standard operations that remain always the same
type Strategy (aFunction) =
member this.Update (x: int) = state {
let! currState = state.getState
let processedx = aFunction x
do! state.putState (currState + x) }
// Create a function that customizes the strategy
let myFunction x =
2 * x
// Customize the strategy with the desired function:
let strategy = Strategy (myFunction)
/////////////////////////////////////////////////////////////////////////////////////////////////////////
// Update recursively
/////////////////////////////////////////////////////////////////////////////////////////////////////////
// ?? How to run update recursively ??
let result initialCondition =
initialCondition
|> (for i = 10 to 100 do
yield state { do! strategy.Update i } )
My goal is to apply the initial conditions, fetch data and launch recursively (within a for or a while loop or even some functional operation) the functions provided by strategy. Working with the monad, I am not sure how to do this.
Thank you.
Computational Expression For
Inspired by #kvb answer, I have added a for method to the computational expression.
// Loops through seqnc of numbers that constitute an input to func
member b.For (seqnc:_ List, func) =
seqnc
|> List.map (fun item -> func item)
|> List.reduce (fun acc item ->
(fun s ->
let _, s' = acc s
item s' ) )
I run a few tests and I have the impression that this one works.
Thanks.

Something like this?
let result initialCondition =
let rec loop = function
| 101 -> state { return () }
| i ->
state {
do! strategy.Update i
do! loop (i+1)
}
initialCondition
|> runState (loop 10)
Alternatively, define a For member on your builder and write it the more imperative way:
let result initialCondition =
let f = state {
for i in 10 to 100 do
do! strategy.Update i
}
initialCondition
|> runState f
Also, note that there is likely a bug in your definition of Strategy.Update: processedx is bound but unused.

Related

FSharp Computation Expression: Cannot reference binding value in custom operation

I am trying to make a builder using FSharp Computation Expression, but get error FS0039:
type UpdatebBuilder() =
member this.Yield (x) = x
member this.Return (x) = x
member this.Bind (x, cont) = cont(x)
member this.Quote (x) = x
member this.For (x, a) = x
[<CustomOperation("set", MaintainsVariableSpace =true,AllowIntoPattern=true)>]
member this.Set (x, a, b) = x
let update = UpdatebBuilder()
let testUpdate () =
update {
for x in [| 1; 2 ; 3|] do
set x 123 // Compile Error FS0039: The value or constructor 'x' is not defined.
}
What I want to implement is something like query expression:
query {
for x in collection do
where x = 2 // Why no FS0039 error here?
select x
}
Also tried MaintainsVariableSpaceUsingBind=true, and get same error. What should I do to make it compile?
To me it looks like you are trying to define a State monad and implementing the Set operation as a custom operation.
I will admit I never fully got my head around custom operations in F# (and I used F# alot). IMHO it feels like custom operations had one purpose; enable a LINQ like syntax in F#. As time goes in it seems few C# developers are using the LINQ like syntax (ie from x where y select z) and few F# developers are using the query computation expression. I have no data here but just goes from example code I see.
This could explain why the documentation on custom operations are often succinct and hard to grasp. What does this even mean? MaintainsVariableSpaceUsingBind: Indicates if the custom operation maintains the variable space of the query or computation expression through the use of a bind operation.
Anyway, so in order to learn a bit more about custom operations I tried to implement the state monad with a custom operation for set and I got a bit farther but ran into a problem which I think is an intentional limitation of the compiler. Still thought I share it with the hope that it helps OP get a bit further.
I chose this definition for State<_>:
type [<Struct>] State<'T> = S of (Map<string, obj> -> 'T*Map<string, obj>)
State<_> is a function that given a global state (a map) produces a value (that could derive from the global state but not necessarily) and a potentially updated global state.
return or value as I tend to call it as return is an F# keyword is easy to define as we just return v and the non-updated global state:
let value v = S <| fun m -> v, m
bind is useful to bind several state computations together. First run t on the global state and from the returned value create the second computation and run the updated global state through it:
let bind uf (S t) = S <| fun m ->
let tv, tm = t m
let (S u) = uf tv
u tm
get and set are used to interact with the global state:
let get k : State<'T option> = S <| fun m ->
match m |> Map.tryFind k with
| Some (:? 'T as v) -> Some v, m
| _ -> None, m
let set k v = S <| fun m ->
let m = m |> Map.add k (box v)
(), m
I created some other methods as well but in the end the builder was created like this:
type Builder() =
class
member x.Bind (t, uf) = bind uf t
member x.Combine (t, u) = combine u t
member x.Delay tf = delay tf
member x.For (s, tf) = forEach s tf
member x.Return v = value v
member x.ReturnFrom t = t : State<'T>
member x.Yield v = value v
member x.Zero () = value ()
[<CustomOperation("set", MaintainsVariableSpaceUsingBind = true)>]
member x.Set (s, k, v) = s |> combine (set k v)
end
I used MaintainsVariableSpaceUsingBind because otherwise it doesn't see v. MaintainsVariableSpace yields strange errors asking for seq types which I vaguely suspect is an optimization for computations based around seq. Checking the generated code is seems to do the right thing in that it binds the custom operations together using my bind function in the proper order.
I am now ready to do define a state computation
state {
// Works fine
set "key" -1
for v in 0..2 do
// Won't work because: FS3086: A custom operation may not be used in conjunction with 'use', 'try/with', 'try/finally', 'if/then/else' or 'match' operators within this computation expression
set "hello" v
return! State.get "key"
}
Unfortunately the compiler stops me from using custom ops in conditional operations like if, try and also for (even though it's not in the list it's conditional in some sense). This seems to be an intentional limitation. It's possible to workaround it but it feels meh
state {
set "key" -1
for v in 0..2 do
// Meh
do! state { set "key" v }
return! State.get "key"
}
IMHO I prefer just using normal do!/let! over custom operations:
state {
for v in 0..2 do
do! State.set "key" v
return! State.get "key"
}
So not really a proper answer to the question from OP but perhaps it can help you get a bit further?
Full source code:
type [<Struct>] State<'T> = S of (Map<string, obj> -> 'T*Map<string, obj>)
module State =
let value v = S <| fun m -> v, m
let bind uf (S t) = S <| fun m ->
let tv, tm = t m
let (S u) = uf tv
u tm
let combine u (S t) = S <| fun m ->
let _, tm = t m
let (S u) = u
u tm
let delay tf = S <| fun m ->
let (S t) = tf ()
t m
let forEach s tf = S <| fun m ->
let mutable a = m
for v in s do
let (S t) = tf v
let (), tm = t m
a <- tm
(), a
let get k : State<'T option> = S <| fun m ->
match m |> Map.tryFind k with
| Some (:? 'T as v) -> Some v, m
| _ -> None, m
let set k v = S <| fun m ->
let m = m |> Map.add k (box v)
(), m
let run (S t) m = t m
type Builder() =
class
member x.Bind (t, uf) = bind uf t
member x.Combine (t, u) = combine u t
member x.Delay tf = delay tf
member x.For (s, tf) = forEach s tf
member x.Return v = value v
member x.ReturnFrom t = t : State<'T>
member x.Yield v = value v
member x.Zero () = value ()
[<CustomOperation("set", MaintainsVariableSpaceUsingBind = true)>]
member x.Set (s, k, v) = s |> combine (set k v)
end
let state = State.Builder ()
let testUpdate () =
state {
// Works fine
set "key" -1
for v in 0..2 do
// Won't work because: FS3086: A custom operation may not be used in conjunction with 'use', 'try/with', 'try/finally', 'if/then/else' or 'match' operators within this computation expression
// set "hello" v
// Workaround but kind of meh
// do! state { set "key" v }
// Better IMHO
do! State.set "key" v
return! State.get "key"
}
[<EntryPoint>]
let main argv =
let tv, tm = State.run (testUpdate ()) Map.empty
printfn "v:%A" tv
printfn "m:%A" tm
0

(How) can I make this monadic bind tail-recursive?

I have this monad called Desync -
[<AutoOpen>]
module DesyncModule =
/// The Desync monad. Allows the user to define in a sequential style an operation that spans
/// across a bounded number of events. Span is bounded because I've yet to figure out how to
/// make Desync implementation tail-recursive (see note about unbounded recursion in bind). And
/// frankly, I'm not sure if there is a tail-recursive implementation of it...
type [<NoComparison; NoEquality>] Desync<'e, 's, 'a> =
Desync of ('s -> 's * Either<'e -> Desync<'e, 's, 'a>, 'a>)
/// Monadic return for the Desync monad.
let internal returnM (a : 'a) : Desync<'e, 's, 'a> =
Desync (fun s -> (s, Right a))
/// Monadic bind for the Desync monad.
let rec internal bind (m : Desync<'e, 's, 'a>) (cont : 'a -> Desync<'e, 's, 'b>) : Desync<'e, 's, 'b> =
Desync (fun s ->
match (match m with Desync f -> f s) with
// ^--- NOTE: unbounded recursion here
| (s', Left m') -> (s', Left (fun e -> bind (m' e) cont))
| (s', Right v) -> match cont v with Desync f -> f s')
/// Builds the Desync monad.
type DesyncBuilder () =
member this.Return op = returnM op
member this.Bind (m, cont) = bind m cont
/// The Desync builder.
let desync = DesyncBuilder ()
It allows the implementation of game logic that executes across several game ticks to written in a seemingly sequential style using computation expressions.
Unfortunately, when used for tasks that last for an unbounded number of game ticks, it crashes with StackOverflowException. And even when it's not crashing, it's ending up with unwieldy stack traces like this -
InfinityRpg.exe!InfinityRpg.GameplayDispatcherModule.desync#525-20.Invoke(Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> _arg10) Line 530 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>>.Invoke(Nu.SimulationModule.World s) Line 24 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.DesyncModule.bind#20<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>.Invoke(Nu.SimulationModule.World s) Line 21 F#
Prime.exe!Prime.Desync.step<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit>(Prime.DesyncModule.Desync<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit> m, Nu.SimulationModule.World s) Line 71 F#
Prime.exe!Prime.Desync.advanceDesync<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit>(Microsoft.FSharp.Core.FSharpFunc<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Prime.DesyncModule.Desync<Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>,Nu.SimulationModule.World,Microsoft.FSharp.Core.Unit>> m, Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> e, Nu.SimulationModule.World s) Line 75 F#
Nu.exe!Nu.Desync.advance#98<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>.Invoke(Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> event, Nu.SimulationModule.World world) Line 100 F#
Nu.exe!Nu.Desync.subscription#104-16<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>.Invoke(Nu.SimulationModule.Event<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen> event, Nu.SimulationModule.World world) Line 105 F#
Nu.exe!Nu.World.boxableSubscription#165<Prime.EitherModule.Either<Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit>,Nu.SimulationModule.Screen>.Invoke(object event, Nu.SimulationModule.World world) Line 166 F#
I am hoping to solve the problem by making the Left case of the bind function tail-recursive. However, I'm not sure of two things -
1) if it can be done at all, and
2) how it would actually be done.
If it's impossible to make bind tail-recursive here, is there some way to restructure my monad to allow it to become tail-recursive?
EDIT 3 (subsumes previous edits): Here is additional code that implements the desync combinators I will use to demonstrate the stack overflow -
module Desync =
/// Get the state.
let get : Desync<'e, 's, 's> =
Desync (fun s -> (s, Right s))
/// Set the state.
let set s : Desync<'e, 's, unit> =
Desync (fun _ -> (s, Right ()))
/// Loop in a desynchronous context while 'pred' evaluate to true.
let rec loop (i : 'i) (next : 'i -> 'i) (pred : 'i -> 's -> bool) (m : 'i -> Desync<'e, 's, unit>) =
desync {
let! s = get
do! if pred i s then
desync {
do! m i
let i = next i
do! loop i next pred m }
else returnM () }
/// Loop in a desynchronous context while 'pred' evaluates to true.
let during (pred : 's -> bool) (m : Desync<'e, 's, unit>) =
loop () id (fun _ -> pred) (fun _ -> m)
/// Step once into a desync.
let step (m : Desync<'e, 's, 'a>) (s : 's) : 's * Either<'e -> Desync<'e, 's, 'a>, 'a> =
match m with Desync f -> f s
/// Run a desync to its end, providing e for all its steps.
let rec runDesync (m : Desync<'e, 's, 'a>) (e : 'e) (s : 's) : ('s * 'a) =
match step m s with
| (s', Left m') -> runDesync (m' e) e s'
| (s', Right v) -> (s', v)
Here is the Either implementation -
[<AutoOpen>]
module EitherModule =
/// Haskell-style Either type.
type Either<'l, 'r> =
| Right of 'r
| Left of 'l
And finally, here's simple a line of code that will yield a stack overflow -
open Desync
ignore <| runDesync (desync { do! during (fun _ -> true) (returnM ()) }) () ()
It seems to me your monad is a State with error handling.
It's basically ErrorT< State<'s,Either<'e,'a>>> but the error branch binds again which is not very clear to me why.
Anyway I was able to reproduce your Stack Overflow with a basic State monad:
type State<'S,'A> = State of ('S->('A * 'S))
module State =
let run (State x) = x :'s->_
let get() = State (fun s -> (s , s)) :State<'s,_>
let put x = State (fun _ -> ((), x)) :State<'s,_>
let result a = State(fun s -> (a, s))
let bind (State m) k = State(fun s ->
let (a, s') = m s
let (State u) = (k a)
u s') :State<'s,'b>
type StateBuilder() =
member this.Return op = result op
member this.Bind (m, cont) = bind m cont
let state = StateBuilder()
let rec loop (i: 'i) (next: 'i -> 'i) (pred: 'i -> 's -> bool) (m: 'i -> State<'s, unit>) =
state {
let! s = get()
do! if pred i s then
state {
do! m i
let i = next i
do! loop i next pred m }
else result () }
let during (pred : 's -> bool) (m : State<'s, unit>) =
loop () id (fun _ -> pred) (fun _ -> m)
// test
open State
ignore <| run (state { do! during (fun c -> true) (result ()) }) () // boom
As stated in the comments one way to solve this is to use a StateT<'s,Cont<'r,'a>>.
Here's an example of the solution. At the end there is a test with the zipIndex function which blows the stack as well when defined with a normal State monad.
Note you don't need to use the Monad Transformers from FsControl (now FSharpPlus), I use them because it's easier for me since I write less code but you can always create your transformed monad by hand.

How do I write a computation expression builder that accumulates a value and also allows standard language constructs?

I have a computation expression builder that builds up a value as you go, and has many custom operations. However, it does not allow for standard F# language constructs, and I'm having a lot of trouble figuring out how to add this support.
To give a stand-alone example, here's a dead-simple and fairly pointless computation expression that builds F# lists:
type Items<'a> = Items of 'a list
type ListBuilder() =
member x.Yield(()) = Items []
[<CustomOperation("add")>]
member x.Add(Items current, item:'a) =
Items [ yield! current; yield item ]
[<CustomOperation("addMany")>]
member x.AddMany(Items current, items: seq<'a>) =
Items [ yield! current; yield! items ]
let listBuilder = ListBuilder()
let build (Items items) = items
I can use this to build lists just fine:
let stuff =
listBuilder {
add 1
add 5
add 7
addMany [ 1..10 ]
add 42
}
|> build
However, this is a compiler error:
listBuilder {
let x = 5 * 39
add x
}
// This expression was expected to have type unit, but
// here has type int.
And so is this:
listBuilder {
for x = 1 to 50 do
add x
}
// This control construct may only be used if the computation expression builder
// defines a For method.
I've read all the documentation and examples I can find, but there's something I'm just not getting. Every .Bind() or .For() method signature I try just leads to more and more confusing compiler errors. Most of the examples I can find either build up a value as you go along, or allow for regular F# language constructs, but I haven't been able to find one that does both.
If someone could point me in the right direction by showing me how to take this example and add support in the builder for let bindings and for loops (at minimum - using, while and try/catch would be great, but I can probably figure those out if someone gets me started) then I'll be able to gratefully apply the lesson to my actual problem.
The best place to look is the spec. For example,
b {
let x = e
op x
}
gets translated to
T(let x = e in op x, [], fun v -> v, true)
=> T(op x, {x}, fun v -> let x = e in v, true)
=> [| op x, let x = e in b.Yield(x) |]{x}
=> b.Op(let x = e in in b.Yield(x), x)
So this shows where things have gone wrong, though it doesn't present an obvious solution. Clearly, Yield needs to be generalized since it needs to take arbitrary tuples (based on how many variables are in scope). Perhaps more subtly, it also shows that x is not in scope in the call to add (see that unbound x as the second argument to b.Op?). To allow your custom operators to use bound variables, their arguments need to have the [<ProjectionParameter>] attribute (and take functions from arbitrary variables as arguments), and you'll also need to set MaintainsVariableSpace to true if you want bound variables to be available to later operators. This will change the final translation to:
b.Op(let x = e in b.Yield(x), fun x -> x)
Building up from this, it seems that there's no way to avoid passing the set of bound values along to and from each operation (though I'd love to be proven wrong) - this will require you to add a Run method to strip those values back off at the end. Putting it all together, you'll get a builder which looks like this:
type ListBuilder() =
member x.Yield(vars) = Items [],vars
[<CustomOperation("add",MaintainsVariableSpace=true)>]
member x.Add((Items current,vars), [<ProjectionParameter>]f) =
Items (current # [f vars]),vars
[<CustomOperation("addMany",MaintainsVariableSpace=true)>]
member x.AddMany((Items current, vars), [<ProjectionParameter>]f) =
Items (current # f vars),vars
member x.Run(l,_) = l
The most complete examples I've seen are in §6.3.10 of the spec, especially this one:
/// Computations that can cooperatively yield by returning a continuation
type Eventually<'T> =
| Done of 'T
| NotYetDone of (unit -> Eventually<'T>)
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Eventually =
/// The bind for the computations. Stitch 'k' on to the end of the computation.
/// Note combinators like this are usually written in the reverse way,
/// for example,
/// e |> bind k
let rec bind k e =
match e with
| Done x -> NotYetDone (fun () -> k x)
| NotYetDone work -> NotYetDone (fun () -> bind k (work()))
/// The return for the computations.
let result x = Done x
type OkOrException<'T> =
| Ok of 'T
| Exception of System.Exception
/// The catch for the computations. Stitch try/with throughout
/// the computation and return the overall result as an OkOrException.
let rec catch e =
match e with
| Done x -> result (Ok x)
| NotYetDone work ->
NotYetDone (fun () ->
let res = try Ok(work()) with | e -> Exception e
match res with
| Ok cont -> catch cont // note, a tailcall
| Exception e -> result (Exception e))
/// The delay operator.
let delay f = NotYetDone (fun () -> f())
/// The stepping action for the computations.
let step c =
match c with
| Done _ -> c
| NotYetDone f -> f ()
// The rest of the operations are boilerplate.
/// The tryFinally operator.
/// This is boilerplate in terms of "result", "catch" and "bind".
let tryFinally e compensation =
catch (e)
|> bind (fun res -> compensation();
match res with
| Ok v -> result v
| Exception e -> raise e)
/// The tryWith operator.
/// This is boilerplate in terms of "result", "catch" and "bind".
let tryWith e handler =
catch e
|> bind (function Ok v -> result v | Exception e -> handler e)
/// The whileLoop operator.
/// This is boilerplate in terms of "result" and "bind".
let rec whileLoop gd body =
if gd() then body |> bind (fun v -> whileLoop gd body)
else result ()
/// The sequential composition operator
/// This is boilerplate in terms of "result" and "bind".
let combine e1 e2 =
e1 |> bind (fun () -> e2)
/// The using operator.
let using (resource: #System.IDisposable) f =
tryFinally (f resource) (fun () -> resource.Dispose())
/// The forLoop operator.
/// This is boilerplate in terms of "catch", "result" and "bind".
let forLoop (e:seq<_>) f =
let ie = e.GetEnumerator()
tryFinally (whileLoop (fun () -> ie.MoveNext())
(delay (fun () -> let v = ie.Current in f v)))
(fun () -> ie.Dispose())
// Give the mapping for F# computation expressions.
type EventuallyBuilder() =
member x.Bind(e,k) = Eventually.bind k e
member x.Return(v) = Eventually.result v
member x.ReturnFrom(v) = v
member x.Combine(e1,e2) = Eventually.combine e1 e2
member x.Delay(f) = Eventually.delay f
member x.Zero() = Eventually.result ()
member x.TryWith(e,handler) = Eventually.tryWith e handler
member x.TryFinally(e,compensation) = Eventually.tryFinally e compensation
member x.For(e:seq<_>,f) = Eventually.forLoop e f
member x.Using(resource,e) = Eventually.using resource e
The tutorial at "F# for fun and profit" is first class in this regard.
http://fsharpforfunandprofit.com/posts/computation-expressions-intro/
Following a similar struggle to Joel's (and not finding §6.3.10 of the spec that helpful) my issue with getting the For construct to generate a list came down to getting types to line up properly (no special attributes required). In particular I was slow to realise that For would build a list of lists, and therefore need flattening, despite the best efforts of the compiler to put me right. Examples that I found on the web were always wrappers around seq{}, using the yield keyword, repeated use of which invokes a call to Combine, which does the flattening. In case a concrete example helps, the following excerpt uses for to build a list of integers - my ultimate aim being to create lists of components for rendering in a GUI (with some additional laziness thrown in). Also In depth talk on CE here which elaborates on kvb's points above.
module scratch
type Dispatcher = unit -> unit
type viewElement = int
type lazyViews = Lazy<list<viewElement>>
type ViewElementsBuilder() =
member x.Return(views: lazyViews) : list<viewElement> = views.Value
member x.Yield(v: viewElement) : list<viewElement> = [v]
member x.ReturnFrom(viewElements: list<viewElement>) = viewElements
member x.Zero() = list<viewElement>.Empty
member x.Combine(listA:list<viewElement>, listB: list<viewElement>) = List.concat [listA; listB]
member x.Delay(f) = f()
member x.For(coll:seq<'a>, forBody: 'a -> list<viewElement>) : list<viewElement> =
// seq {for v in coll do yield! f v} |> List.ofSeq
Seq.map forBody coll |> Seq.collect id |> List.ofSeq
let ve = new ViewElementsBuilder()
let makeComponent(m: int, dispatch: Dispatcher) : viewElement = m
let makeComponents() : list<viewElement> = [77; 33]
let makeViewElements() : list<viewElement> =
let model = {| Scores = [33;23;22;43;] |> Seq.ofList; Trainer = "John" |}
let d:Dispatcher = fun() -> () // Does nothing here, but will be used to raise messages from UI
ve {
for score in model.Scores do
yield makeComponent (score, d)
yield makeComponent (score * 100 / 50 , d)
if model.Trainer = "John" then
return lazy
[ makeComponent (12, d)
makeComponent (13, d)
]
else
return lazy
[ makeComponent (14, d)
makeComponent (15, d)
]
yield makeComponent (33, d)
return! makeComponents()
}

State Monad - While-loops

This question has been inspired by this question.
I understand the example (ListBuilder) but I have not been able to create a while loop for my state monad. What is not clear to me is how to bind the body of the whileloop as the iterations follow one an another.
Thank you.
/////////////////////////////////////////////////////////////////////////////////////
// Definition of the state
/////////////////////////////////////////////////////////////////////////////////////
type StateFunc<'State, 'T> = 'State -> 'T * 'State
/////////////////////////////////////////////////////////////////////////////////////
// Definition of the State monad
/////////////////////////////////////////////////////////////////////////////////////
type StateMonadBuilder<'State>() =
// M<'T> -> M<'T>
member b.ReturnFrom a : StateFunc<'State, 'T> = a
// 'T -> M<'T>
member b.Return a : StateFunc<'State, 'T> = ( fun s -> a, s)
// M<'T> * ('T -> M<'U>) -> M<'U>
member b.Bind(p : StateFunc<_, 'T>, rest : 'T -> StateFunc<_,_>) : StateFunc<'State, 'U> =
(fun s ->
let a, s' = p s
rest a s')
member b.Zero() = fun s -> (), s
member b.Delay f = f
member b.Run f = f ()
// Getter for the whole state, this type signature is because it passes along the state & returns the state
member b.getState : StateFunc<'State, _> = (fun s -> s, s)
// Setter for the state
member b.putState (s:'State) : StateFunc<'State, _> = (fun _ -> (), s)
// (unit -> bool) * M<'T> -> M<'T>
member b.While (cond, body: StateFunc<'State, _>): StateFunc<'State, _> =
(fun s ->
if cond () then
let bind =
let _, s' = body s
fun s' -> body s'
b.While (cond, bind) // This is wrong
else
body s)
If you look at the different computation builders in ExtCore, there is one interesting thing to note - for any monad, the implementation of While (and also For) member is usually the same.
This is because you can always express the operation in terms of Bind, Zero and recursive uses of While. So if you are working with monads, you will always define something like this (Just replace M<_> with your monad):
// (unit -> bool) * M<'T> -> M<'T>
member this.While (guard, body : M<_>) : M<_> =
if guard () then
this.Bind (body, (fun () -> this.While (guard, body)))
else
this.Zero ()
This is not true for all computations - if the computation is more interesting in some way, then it may need a different implementation of While, but the above is a reasonable default.
Aside - I think that the need to define custom computation expressions in F# should be quite rare - idiomatic F# code does not use monads nearly as often as e.g. Haskell and most of the time, you should be fine with what the standard library has (or what ExtCore defines, if you are doing something more advanced). Perhaps you need a custom computation, but keep in mind that this might be a distraction leading you in a wrong direction...

merge multiple observables to an observable array

Hi I am trying to merge a number of observables to an observable array. Here an example that works in fsi. (sorry that it is lengthy)
#r "./bin/Debug/System.Reactive.dll"
open System
open System.Reactive.Linq
/// Subscribes to the Observable with all 3 callbacks.
let subscribeComplete next error completed (observable: IObservable<'T>) =
observable.Subscribe(
(fun x -> next x),
(fun e -> error e),
(fun () -> completed()))
/// Subscribes to the Observable with a next and an error-function.
let subscribeWithError next error observable =
subscribeComplete next error (fun () -> ()) observable
/// Subscribes to the Observable with a next-function
let subscribe (next: 'T -> unit) (observable: IObservable<'T>) : IDisposable =
subscribeWithError next ignore observable
/// Static method to generate observable from input functions
let ObsGenerate (initState: 'TS) (termCond: 'TS -> bool) (iterStep: 'TS -> 'TS)
(resSelect: 'TS -> 'TR) (timeSelect : 'TS -> System.TimeSpan) =
Observable.Generate(initState, termCond, iterStep, resSelect, timeSelect)
//maps the given observable with the given function
let obsMap (f: 'T -> 'U) (observable : IObservable<'T>) : IObservable<'U> =
Observable.Select(observable, Func<_,_>(f))
/// Merges two observable sequences into one observable sequence whenever one of the observable sequences has a new value.
let combineLatest (obs1: IObservable<'T>) (obs2: IObservable<'U>) : IObservable<'T * 'U> =
Observable.CombineLatest(
obs1, obs2, Func<_,_,_>(fun a b -> a, b))
/// Merges three observable sequences into one observable sequence whenever one of the observable sequences has a new value.
let combineLatest3 (obs1: IObservable<'T>) (obs2: IObservable<'U>) (obs3: IObservable<'V>) : IObservable<'T * 'U * 'V> =
let obs12 =obs1.CombineLatest(obs2, Func<_,_,_>(fun a b -> a, b))
obs12.CombineLatest(obs3, Func<_,_,_>(fun (a,b) c -> a, b, c))
/// Merges four observable sequences into one observable sequence whenever one of the observable sequences has a new value.
let combineLatest4 (obs1: IObservable<'T>) (obs2: IObservable<'U>) (obs3: IObservable<'V>) (obs4: IObservable<'W>) : IObservable<'T * 'U * 'V * 'W> =
let obsNew = combineLatest3 obs1 obs2 obs3
obsNew.CombineLatest(obs4, Func<_,_,_>(fun (a,b,c) d -> a, b, c, d))
// second section generating arrays
let combineLatestArray (obs1: IObservable<'T>) (obs2: IObservable<'T>) =
combineLatest obs1 obs2
|> obsMap (fun (a, b) -> [a; b] |> List.toArray)
let combineLatest3Array (obs1: IObservable<'T>) (obs2: IObservable<'T>) (obs3: IObservable<'T>) =
combineLatest3 obs1 obs2 obs3
|> obsMap (fun (a, b, c) -> [a; b; c] |> List.toArray)
let combineLatest4Array (obs1: IObservable<'T>) (obs2: IObservable<'T>) (obs3: IObservable<'T>) (obs4: IObservable<'T>) =
combineLatest4 obs1 obs2 obs3 obs4
|> obsMap (fun (a, b, c, d) -> [a; b; c; d] |> List.toArray)
let combineLatestListToArray (list: IObservable<'T> List) =
match list.Length with
| 2 -> combineLatestArray list.[0] list.[1]
| 3 -> combineLatest3Array list.[0] list.[1] list.[2]
| 4 -> combineLatest4Array list.[0] list.[1] list.[2] list.[3]
| _ -> failwith "combine latest on unsupported list size"
type FooType =
{ NameVal : string
IdVal : int
RetVal : float }
member x.StringKey() =
x.NameVal.ToString() + ";" + x.IdVal.ToString()
// example code starts here
let rnd = System.Random()
let fooListeners = Collections.Generic.Dictionary()
let AddAFoo (foo : FooType) =
let fooId = foo.StringKey()
if fooListeners.ContainsKey(fooId)
then fooListeners.[fooId]
else
let myObs = ObsGenerate {NameVal = foo.NameVal; IdVal = foo.IdVal; RetVal = foo.RetVal} (fun x -> true) (fun x -> {NameVal = (x.NameVal); IdVal = (x.IdVal); RetVal = (x.RetVal + rnd.NextDouble() - 0.5)}) (fun x -> x) (fun x -> System.TimeSpan.FromMilliseconds(rnd.NextDouble() * 2000.0))
fooListeners.Add(fooId,myObs)
myObs
let fooInit = [6..9]
|> List.map (fun index -> {NameVal = (string index + "st"); IdVal = index; RetVal = (float index + 1.0)})
|> List.map (fun foo -> AddAFoo foo)
let fooValuesArray = fooInit
|> List.map(fun x -> (x |> obsMap (fun x -> x.RetVal)))
|> combineLatestListToArray
let mySub =
fooValuesArray
|> subscribe (fun fooVals -> printfn "fooArray: %A" fooVals)
//execute until here to start example
// execute this last line to unsubscribe
mySub.Dispose()
I have two questions about this code:
Is there a smarter way of merging the observables to arrays? (it gets very lengthy as I need to merge larger arrays)
I want to throttle the updates. What I mean by that is that I want all updates that occur within (say) the same half a second window to be handled as one update on the array. Ideally, I want this window to open only when a first update comes in, i.e if no updates arrive in 2 seconds, then one update arrives, then we wait and include further updates for 0.5 seconds and then trigger the observable. I don't want it to publish periodically every 0.5 seconds although no observables are triggered. I hope this description is clear enough.
update: I have decided to accept one of the F# answers, but I haven't done the C# answers justice yet. I hope to be able to check them out properly soon.
For 1, an application of List.fold and List.toArray and a few Observable operators should work nicely. Something like:
let combineLatest observables =
Observable.Select(
(observables
|> List.fold (fun ol o
-> Observable.CombineLatest(o, ol, (fun t tl -> t :: tl))
) (Observable.Return<_>([]))
),
List.toArray)
Due to the nesting, you may end up with performance issues if you have a large list of Observables, but it's worth at least trying before you resort to writing it by hand.
For 2, I would agree with the other answers to apply Throttling to the result.
I'm sorry this isn't F# - I wish I had time to learn it - but here's a possible answer in C#.
Here are a set of extension methods that will combine the latest from an IEnumerable<IObservable<T>> to an IObservable<IEnumerable<T>>:
public static IObservable<IEnumerable<T>> CombineLatest<T>(this IObservable<T> first, IObservable<T> second)
{
if (first == null) throw new ArgumentNullException("first");
if (second == null) throw new ArgumentNullException("second");
return first.CombineLatest(second, (t0, t1) => EnumerableEx.Return(t0).Concat(EnumerableEx.Return(t1)));
}
public static IObservable<IEnumerable<T>> CombineLatest<T>(this IObservable<IEnumerable<T>> firsts, IObservable<T> second)
{
if (firsts == null) throw new ArgumentNullException("firsts");
if (second == null) throw new ArgumentNullException("second");
return firsts.CombineLatest(second, (t0s, t1) => t0s.Concat(EnumerableEx.Return(t1)));
}
public static IObservable<IEnumerable<T>> CombineLatest<T>(this IEnumerable<IObservable<T>> sources)
{
if (sources == null) throw new ArgumentNullException("sources");
return sources.CombineLatest(() => sources.First().CombineLatest(sources.Skip(1)), () => Observable.Empty<IEnumerable<T>>());
}
public static IObservable<IEnumerable<T>> CombineLatest<T>(this IObservable<T> first, IEnumerable<IObservable<T>> seconds)
{
if (first == null) throw new ArgumentNullException("first");
if (seconds == null) throw new ArgumentNullException("seconds");
return seconds.CombineLatest(() => first.CombineLatest(seconds.First()).CombineLatest(seconds.Skip(1)), () => first.Select(t => EnumerableEx.Return(t)));
}
public static IObservable<IEnumerable<T>> CombineLatest<T>(this IObservable<IEnumerable<T>> firsts, IEnumerable<IObservable<T>> seconds)
{
if (firsts == null) throw new ArgumentNullException("firsts");
if (seconds == null) throw new ArgumentNullException("seconds");
return seconds.CombineLatest(() => firsts.CombineLatest(seconds.First()).CombineLatest(seconds.Skip(1)), () => firsts);
}
private static IObservable<IEnumerable<T>> CombineLatest<T>(this IEnumerable<IObservable<T>> sources, Func<IObservable<IEnumerable<T>>> any, Func<IObservable<IEnumerable<T>>> none)
{
if (sources == null) throw new ArgumentNullException("sources");
if (any == null) throw new ArgumentNullException("any");
if (none == null) throw new ArgumentNullException("none");
return Observable.Defer(() => sources.Any() ? any() : none());
}
They may not be very efficient, but they do handle any number of observables that need to be combined.
I'd be keen to see these methods converted to F#.
As for your second question, I'm not sure I can answer with what you've said so far because CombineLatest and Throttle both lose values so it is probably prudent to understand your use case in more detail before attempting an answer.
Although Gideon Engelberth has answered your question with one of the possible way to solve the problem. Other possible way could be something like below, it doesn't use nesting.
let combineLatestToArray (list : IObservable<'T> list) =
let s = new Subject<'T array>()
let arr = Array.init list.Length (fun _ -> Unchecked.defaultof<'T>)
let cb (i:int,v:'T) =
arr.[i] <- v
s.OnNext(arr |> Array.toList |> List.toArray)
let main = list |> List.mapi (fun i o -> o.Select(fun t -> (i,t)))
|> Observable.Merge
main.Subscribe(new Action<int * 'T>(cb)
,new Action<exn>(fun e -> s.OnError(e))
,new Action(fun () -> s.OnCompleted()) ) |> ignore
s :> IObservable<'T array>
Let me know if this solved your problem as I haven't testing it much :)
NOTE: This is for the first part, for second part everyone has already mentioned what you need to do
UPDATE:
Another implementation :
let combineLatestToArray (list : IObservable<'T> list) =
let s = new Subject<'T array>()
let arr = Array.init list.Length (fun _ -> Unchecked.defaultof<'T>)
let main = list |> List.mapi (fun i o -> o.Select(fun t -> (i,t)))
|> Observable.Merge
async {
try
let se = main.ToEnumerable() |> Seq.scan (fun ar (i,t) -> Array.set ar i t; ar) arr
for i in se do
s.OnNext(i |> Array.toList |> List.toArray)
s.OnCompleted()
with
| :? Exception as ex -> s.OnError(ex)
} |> Async.Start
s :> IObservable<'T array>
Seems that Observable.Merge() which has overloads for variable number of IObservables is closer to what you want.
Observable.Buffer() with the time overloads will do what you want here. In the "no events" situation, Buffer will still OnNext() an empty list, letting you react to that stiuation.
This is the best I could come up with. I've been wanting to solve this for a while.
public static class Extensions
{
public static IObservable<IEnumerable<T>> CombineLatest<T>(this Observable observable, IEnumerable<IObservable<T>> observableCollection)
{
return observableCollection.CombineLatest();
}
public static IObservable<IEnumerable<T>> CombineLatest<T>(this IEnumerable<IObservable<T>> observables)
{
return observables.Aggregate<IObservable<T>, IObservable<IEnumerable<T>>>
(
Observable.Return(Enumerable.Empty<T>()),
(o, n) => o.CombineLatest
(
n,
(list, t) => list.Concat(EnumerableEx.Return(t))
)
);
}
}
So an example usage would be:
var obs = new List<IObservable<bool>>
{
Observable.Return(true),
Observable.Return(false),
Observable.Return(true)
};
var result = obs.CombineLatest().Select(list => list.All(x => x));
result.Subscribe(Console.WriteLine);
Console.ReadKey();
You would have to operate on the knowledge, though, that the resulting IObservable<IEnumerable<T>> will not fire until all observables have yielded a value. This is what I needed in my scenarios, but might not be appropriate for your scenario.
My worry with this is the performance of all of the .Concats. Might be more performant to deal in a mutable collection in the extension method. Not sure.
Sorry, I don't know F#. I'll get around to it one of these days.
Throttling is just done with the .Throttle operator after you get your final observable.
Edit: This answer is the iterative Ying to Enigmativity's recursive Yang.

Resources