Dev Faq
3
votes

Composition de la monade (état continu)

J'étudie la composition monade. Bien que je sache déjà comment composer, disons, Async et Result comme effectué ici J'ai du mal à composer la Continuation Monad et la State Monad.

À partir d'une implémentation de base de State Monad et d'un State-based-Stack à des fins de test: 

type StateK<'State,'Value,'r> = Cont<State<'State,'Value>,'r>

module StateK =

    let returnSK x :  StateK<'s,'a,'r> = x |> State.returnS |> Continuation.returnCont
    let bindSK (f : 'a ->  StateK<'s,'b,'r>) 
        (m : StateK<'s,'a,'r>) :  StateK<'s,'b,'r> =
        (fun cont ->
            m (fun (State xS) ->
                let run state =
                    let x, newState = xS state
                    (f x) (fun (State k) -> k newState)
                cont (State run)))

Puis ayant également une implémentation de base d'une Monade Continuation: 

module StackCont =
    open StateK

    type Stack<'a> = Stack of 'a list

    let popStack (Stack contents) =  stateK {
        match contents with
        | [] -> return failwith "Stack underflow"
        | head::tail ->     
            return head, (Stack tail) }

    let pushStack newTop (Stack contents) = stateK {
        return Stack (newTop::contents) }

    let emptyStack = Stack []

    let getValue stackM = stateK {
        return runSK stackM emptyStack |> fst }

    let pop() = stateK {
        let! stack = getSK
        let! top, remainingStack = popStack stack
        do! putSK remainingStack 
        return top }

    let push newTop = stateK {
        let! stack = getSK
        let! newStack = pushStack newTop stack
        do! putSK newStack 
        return () }

6 commentaires

Je peux vous dire que bindSK n'est pas correct. Le type de f est supposé être: 'a -> Cont ,' r> mais à la place c'est: ' a -> État <'s,' b>

merci @AMieres, j'ai refait mon implémentation, maintenant il semble que j'ai une contrainte indésirable. 'r a été contraint d'être ' b * '

Êtes-vous sûr qu'il est même possible de le faire? Il me semble que c'est paradoxal. Puisque la dernière continuation est la seule capable d'exécuter la monade d'état et que la valeur d'état détermine la continuation. Comment déterminer à l'avance la bonne continuation?

Je pense que oui, l'État est censé fonctionner à chaque continuation. Je vais en lire plus sur le sujet et essayer à nouveau

@AMieres Je suis venu avec une implémentation fonctionnelle, voir ma réponse ci-dessous. Qu'est-ce que tu penses?

@AMieres, je lui ai donné une autre chance, qu'en pensez-vous? Je suis convaincu que c'est effectivement un Cont · State mais je me trompe peut-être.

3 Réponses :

2
votes

Je n'ai pas pu non plus le résoudre.

Je ne peux que vous donner un conseil qui pourrait vous aider à mieux le comprendre. Remplacez les types génériques par les types réguliers, par exemple au lieu de: 

let bindSK (f : int ->  StateK<string,char,float>) 
    (m : StateK<string,int,float>) :  StateK<string,char,float> =
    (fun cont ->
        m (fun (State xS) ->
            let run state =
                let x, newState = xS state
                (f x) (fun (State k) -> k newState)
            cont (State run)))

remplacez par string , 'a avec int , ' b avec char et 'r avec float 

let bindSK (f : 'a ->  StateK<'s,'b,'r>) 
    (m : StateK<'s,'a,'r>) :  StateK<'s,'b,'r> =
    (fun cont ->
        m (fun (State xS) ->
            let run state =
                let x, newState = xS state
                (f x) (fun (State k) -> k newState)
            cont (State run)))

de cette façon est plus facile de voir que

  • k est chaîne -> char * chaîne
  • donc k newState est char * string
  • (f x) est (State -> float) -> float
  • et m est (State -> float) -> float

donc ils ne sont pas compatibles.

0 commentaires
2
votes

J'ai lu plus et il ressort que le type correct pour un "ContinuousState" est 's -> Cont

J'ai donc réimplémenté la monade StateK avec cette signature et tout a volé naturellement.

Voici le code (j'ai ajouté mapSK et applySK pour être complet): 

type Cont<'T,'r> = (('T -> 'r) -> 'r)

let returnCont x = (fun k -> k x)
let bindCont f m = (fun k -> m (fun a -> f a k))
let delayCont f = (fun k -> f () k)

type ContinuationBuilder() =
    member __.Return(x) = returnCont x
    member __.ReturnFrom(x) = x
    member __.Bind(m,f) = bindCont f m
    member __.Delay(f) = delayCont f
    member this.Zero () = this.Return ()

let cont = new ContinuationBuilder()

type StateK<'State,'Value,'r> = StateK of ('State -> Cont<'Value * 'State, 'r>)

module StateK =
    let returnSK x =
        let run state = cont {
            return x, state
        }
        StateK run

    let runSK (StateK fSK : StateK<'s,'a,'r>) (state : 's) : Cont<'a * 's, _> = cont {
        return! fSK state }

    let mapSK (f : 'a -> 'b) (m : StateK<'s,'a,'r>) : StateK<'s,'b,'r> =
            let run state = cont {
                let! x, newState = runSK m state
                return f x, newState  }
            StateK run

    let bindSK (f : 'a -> StateK<'s,'b,'r>) (xSK : StateK<'s,'a,'r>) : (StateK<'s,'b,'r>) =
        let run state = cont {
            let! x, newState = runSK xSK state
            return! runSK (f x) newState }
        StateK run

    let applySK (fS : StateK<'s, 'a -> 'b, 'r>) (xSK : StateK<'s,'a,'r>) : StateK<'s,'b,'r> =
        let run state = cont {
            let! f, s1 = runSK fS state
            let! x, s2 = runSK xSK s1
            return f x, s2 }
        StateK run        

    let getSK =
        let run state = cont { return state, state }
        StateK run

    let putSK newState =
        let run _ = cont { return (), newState }
        StateK run

    type StateKBuilder() =
        member __.Return(x) = returnSK x
        member __.ReturnFrom (x) = x
        member __.Bind(xS,f) = bindSK f xS
        member this.Zero() = this.Return ()

    let stateK = new StateKBuilder()

module StackCont =
    open StateK

    type Stack<'a> = Stack of 'a list

    let popStack (Stack contents) = 
        match contents with
        | [] -> failwith "Stack underflow"
        | head::tail ->     
            head, (Stack tail)

    let pushStack newTop (Stack contents) = 
        Stack (newTop::contents)

    let emptyStack = Stack []

    let getValueSK stackM = cont {
        let! f = runSK stackM emptyStack 
        return f |> fst }

    let pop() = stateK {
        let! stack = getSK
        let top, remainingStack = popStack stack
        do! putSK remainingStack 
        return top }

    let push newTop = stateK {
        let! stack = getSK
        let newStack = pushStack newTop stack
        do! putSK newStack 
        return () }

open StateK
open StackCont

let helloWorldSK = (fun () -> stateK {
    do! push "world"
    do! push "hello"
    let! top1 = pop()
    let! top2 = pop()
    let combined = top1 + " " + top2 
    return combined
})

let helloWorld = getValueSK (helloWorldSK ()) id
printfn "%s" helloWorld

8 commentaires

La fonction bind a la signature suivante: f: 'a -> Cont , State <' b, 'c >> -> xSK: Cont < State <'b,' a>, 'd> -> Cont ,' d> car vous exécutez la suite avec un id fonction, ce qui signifie essentiellement que vous avez fourni la suite et qu'elle ne fait rien. Cela équivaut à déballer la monade de continuation, à retirer la monade d'état, à la lier et à l'envelopper à nouveau avec une continuation. Ce qui vous fait vous demander pourquoi l'envelopper dans une monade de continuation en premier lieu?

oh, je vois ... eh bien c'est peut-être plus difficile que je pensais

Oui! Je pense que tu as raison. Ce n'est pas exactement une composition des monades État et Cont. Il s'agit plutôt d'une implémentation d'état utilisant la monade Cont. C'est définitivement la bonne chose.

Ensuite, je suggérerais d'étudier la monade Eff. C'est une monade qui vous permet d'utiliser toutes les monades dans un même état, lecteur, écrivain, résultat, etc. Pas besoin de combiner d'autres monades, celle-ci les fait toutes! \.

ok, merci, prochaine Eff Monad, peut-être que cela résoudrait mon vrai problème, j'essaie de passer un état sur Coroutines ... mais peut-être que je vais dans le mauvais sens et avoir juste un état mutable dans la classe Coroutine sera la seule solution.

@AMieres, j'ai trouvé un exemple d'Eff Monad, fssnip.net/7U2/title / La-Monade-Eff . C'est comme une composition automatique, néanmoins chaque monade doit être implémentée en fonction de la monade eff. J'irai certainement comprendre cela.

@AMieres vous avez dit que ce n'était pas une composition State et Cont, et je comprends cela, mais je me demandais si composer ce StateK avec Cont ne serait pas State · Cont, le type résultant serait le suivant: ((' s -> (('a *' s) -> 'r) ->' r) -> 'r) ->' r) qui est Cont ,' r> d'une manière ou d'une autre, State devrait continuer afin de pouvoir être composé avec Cont ... donc StateK étant une version Cont de State est facilement composable avec Cont mais est-ce que Cont · State?

C'est une version créée par Nick Palladinos, il a une implémentation plus complète ici: github.com/palladin/Eff et l'article vaut la peine d'être lu: okmij.org/ftp/Computation/free-monad. html

0
votes

Je lui ai donné une autre chance et je suis arrivé avec cela, pour autant que je sache, cela fonctionne et c'est effectivement un Cont  · State : 

type State<'State,'Value> = State of ('State -> 'Value * 'State)
type StateK<'s,'T> = ((State<'s,'T> -> 'T * 's) -> 'T * 's)

let returnCont x : StateK<'s,'a> = (fun k -> k x)

let returnSK x =
    let run state =
        x, state
    State run |> returnCont

let runSK (f : ((State<'s,'b> -> 'b * 's) -> 'b * 's)) state = f (fun (State xS) ->  xS state)

let bindSK (f : 'a -> StateK<'s,'b>) (xS :StateK<'s,'a>) : StateK<'s,'b> =
    let run state =
        let x, newState = runSK xS state
        runSK (f x) newState
    returnCont (State run) // is this right? as far as I cant tell the previous (next?) continuation is encapsulated on run so this is only so the return type conforms with what is expected of a bind

let getSK k =
    let run state = state, state
    State run |> k

let putSK newState =
    let run _ = (), newState
    State run |> returnCont

type StateKBuilder()=
    member __.Return(x) = returnSK x
    member __.Bind(xS,f) = bindSK f xS

let stateK = new StateKBuilder()

type Stack<'a> = Stack of 'a list

let popStack (Stack contents) = 
    match contents with
    | [] -> failwith "Stack underflow"
    | head::tail ->
        head, (Stack tail)

let pushStack newTop (Stack contents) = 
    Stack (newTop::contents)

let emptyStack = Stack []

let getValueS stackM = 
    runSK stackM emptyStack |> fst

let pop () = stateK {
    let! stack = getSK
    let top, remainingStack = popStack stack
    do! putSK remainingStack
    return top }

let push newTop = stateK {
    let! stack = getSK
    let newStack = pushStack newTop stack
    do! putSK newStack 
    return () }


let helloWorldSK = (fun k -> stateK {
    do! push "world"
    do! push "hello"
    let! top1 = pop()
    let! top2 = pop()
    let combined = top1 + " " + top2 
    return combined
})

let helloWorld =  getValueS (helloWorldSK id)
printfn "%s" helloWorld

p >

0 commentaires

Articles qui pourrait vous intéresser :

Qu'est-ce que l'homomorphisme monoïde exactement?
Comment renvoyer false si le numéro n'est pas trouvé dans la liste
Pouvez-vous me donner un exemple d'utilisation de l'ascenseur Ramda?
Swift: encapsulation paresseuse de chaînes de map, filter, flatMap