f# - 具有状态 monad 的代理(异步)

Question

我有一系列操作。这些操作被建模为 state monads .

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)


    // 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    

这些操作被设计为并行运行。在大多数应用程序中，操作都是独立执行的。可能存在操作必须从一个环境实体接收状态更新的用户案例。理论上，环境实体携带自己的状态，可以将其建模为状态单子(monad)本身。

我想知道如何以函数式风格解决这个问题。我读过一些关于 monad trasnformers 的内容，但我不确定这是要走的路。

(我正在尝试做一个例子，但我不确定是否是正确的玩具问题)

编辑 3

根据下面的评论和建议，我尝试构建一个代理。我的目标是将 State Monad 安装在代理上。这将使我能够重用已经构建的代码。我还想了解并解决这个问题，以便深入了解 F# 的工作原理。

我准备了以下玩具示例:

/////////////////////////////////////////////////////////////////////////////////////
// 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 : unit -> StateFunc<_,_>) : StateFunc<'State, 'T> =
        b.Bind (b.Return (), 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 this.While (guard, body : StateFunc<_,_>) : StateFunc<'State, unit> =
        if guard () then
            this.Bind (body, (fun () -> this.While (guard, body)))
        else
            this.Zero ()





/////////////////////////////////////////////////////////////////////////////////////
// The agent
/////////////////////////////////////////////////////////////////////////////////////

let state = StateMonadBuilder<int> ()

type SonM (sonName: string) =
    let name = sonName
    member this.GetMoneyFromDad (x: int) = state {
        printfn " I am getting money from dad"
        let! currState = state.getState
        do! state.putState (currState + x)  
        do! this.ToConsole () }
    member this.GoShopping (x: int) = state {
        printfn " I am taken to the mall"
        let! currState = state.getState   
        do! state.putState (currState - x) 
        do! this.ToConsole () }
    member this.TellDad = state {
        printfn " I'll tell dad my balance "
        return! state.getState }
    member this.ToConsole () = state {
        let! mystate = state.getState
        printfn " Balance: %i" mystate }

type Agent<'T> = MailboxProcessor<'T>

type message = 
    | Shopping of int
    | Allowance of int
    | GetBalance
    | Stop

let setupAgent iv = Agent.Start (fun inbox ->   

    let aSon = new SonM ("Paul")

    let processMsg msg = state {
        match msg with
        | Shopping money ->
            printfn "Go shopping with %i " money
            do! (aSon.GoShopping money)
        | Allowance money -> 
            printfn " I got some money for you, son"
            do! (aSon.GetMoneyFromDad money) 
        | GetBalance -> 
            printfn " Calling: TellDad"
            let! balance = aSon.TellDad
            printfn " Current Balance: %i" balance 
            printfn " The balance should have been printed"
        | _ -> do printfn "Nothing to do.." }

    let rec loop () = 
        let getMsgAsync () = async {
            let! msg = inbox.Receive() 
            return  processMsg msg } 
        let p = 
            (fun s -> 
                let _, s' = (getMsgAsync () |> Async.Start) s
                getMsgAsync s')
        state.Bind ( /// ??? WIP HERE ??? )

    iv |> loop () ) 





let agent = setupAgent 100
agent.Post (GetBalance)    
agent.Post(Allowance 15)
agent.Post (GetBalance)    
agent.Post (Shopping 10)
agent.Post (Stop)

我不确定如何在定义代理的 async 递归循环中继续“绑定(bind)”状态。谢谢。

Answer 1

下面这段代码有效。

这个想法是将每个步骤的计算视为一个状态单子(monad)。但是，状态 monad 未绑定(bind)到代理的异步 loop 中。相反，状态从状态 monad 中展开并在 loop 中提出。

我不知道这是否是一个好的解决方案，但结果似乎是正确的。

/////////////////////////////////////////////////////////////////////////////////////
// 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 : unit -> StateFunc<_,_>) : StateFunc<'State, 'T> =
        b.Bind (b.Return (), 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 this.While (guard, body : StateFunc<_,_>) : StateFunc<'State, unit> =
        if guard () then
            this.Bind (body, (fun () -> this.While (guard, body)))
        else
            this.Zero ()





/////////////////////////////////////////////////////////////////////////////////////
// The agent
/////////////////////////////////////////////////////////////////////////////////////

let state = StateMonadBuilder<int> ()

type SonM (sonName: string) =
    let name = sonName
    member this.GetMoneyFromDad (x: int) = state {
        printfn " I am getting money from dad"
        let! currState = state.getState
        do! state.putState (currState + x)  
        do! this.ToConsole () }
    member this.GoShopping (x: int) = state {
        printfn " I am taken to the mall"
        let! currState = state.getState   
        do! state.putState (currState - x) 
        do! this.ToConsole () }
    member this.TellDad = state {
        printfn " I'll tell dad my balance "
        return! state.getState }
    member this.ToConsole () = state {
        let! mystate = state.getState
        printfn " Balance: %i" mystate }

type Agent<'T> = MailboxProcessor<'T>

type message = 
    | Shopping of int
    | Allowance of int
    | GetBalance
    | Stop

let setupAgent iv = Agent.Start (fun inbox ->   

    let aSon = new SonM ("Paul")

    let processMsg msg = state {
        match msg with
        | Shopping money ->
            printfn "Go shopping with %i " money
            do! (aSon.GoShopping money)
        | Allowance money -> 
            printfn " I got some money for you, son"
            do! (aSon.GetMoneyFromDad money) 
        | GetBalance -> 
            printfn " Calling: TellDad"
            let! balance = aSon.TellDad
            printfn " Current Balance: %i" balance 
        | _ -> do printfn "Nothing to do.." }

    let rec loop s = async {
            let! msg = inbox.Receive() 
            let processedMsg = processMsg msg 
            let _, s' = s |> processedMsg
            return! loop s' }
    loop iv )


let agent = setupAgent 100
agent.Post (GetBalance)    
agent.Post(Allowance 15)
agent.Post (GetBalance)    
agent.Post (Shopping 10)
agent.Post (Stop)