{"id":889,"date":"2009-10-23T10:10:20","date_gmt":"2009-10-23T08:10:20","guid":{"rendered":"http:\/\/www.navision-blog.de\/2009\/10\/23\/using-monads-in-f-part-i-the-state-monad\/"},"modified":"2009-10-23T10:45:38","modified_gmt":"2009-10-23T08:45:38","slug":"using-monads-in-fsharp-part-i-the-state-monad","status":"publish","type":"post","link":"http:\/\/www.navision-blog.de\/blog\/2009\/10\/23\/using-monads-in-fsharp-part-i-the-state-monad\/","title":{"rendered":"Using monads in F# – Part I: The State Monad"},"content":{"rendered":"

Currently I\u2019m trying to implement some of the standard monads<\/a> in F#. If you want to read about the theory behind monads and their implementation (in Haskell) it\u2019s a good start to look into \u201cAll about Monads<\/a>\u201d on haskell.org<\/a>.<\/p>\n

In this blog post series I don\u2019t care about mathematical details. Instead I will try to show how monads can help to simplify our code.<\/p>\n

Motivation<\/h5>\n

We have a generic binary tree with some test data:<\/p>\n

\n

type<\/span> Tree<‘a> =<\/p>\n

| Leaf of<\/span> ‘a<\/p>\n

| Branch of<\/span> Tree<‘a> * Tree<‘a>  <\/p>\n

 <\/p>\n

let<\/span> tree =<\/p>\n

  Branch(<\/p>\n

    Leaf "Max"<\/span>,<\/p>\n

    Branch(<\/p>\n

      Leaf "Bernd"<\/span>,<\/p>\n

      Branch(<\/p>\n

        Branch(<\/p>\n

          Leaf "Holger"<\/span>,<\/p>\n

          Leaf "Ralf"<\/span>),<\/p>\n

        Branch(<\/p>\n

          Leaf "Kerstin"<\/span>,<\/p>\n

          Leaf "Steffen"<\/span>))))<\/p>\n<\/p><\/div>\n

If we want to print this tree we can use the following recursive function:<\/p>\n

\n

\/\/\/ prints a binary tree<\/span><\/p>\n

let<\/span> printTree t =<\/p>\n

  let<\/span> rec<\/span> print t level  =<\/p>\n

    let<\/span> indent = new<\/span> String(‘ ‘<\/span>, level * 2)<\/p>\n

    match<\/span> t with<\/span><\/p>\n

    | Leaf l -><\/span> printfn "%sLeaf: %A"<\/span> indent l<\/p>\n

    | Branch (left,right) -><\/span> <\/p>\n

        printfn "%sBranch:"<\/span> indent<\/p>\n

        print left (level+1)<\/p>\n

        print right (level+1)<\/p>\n

  print t 0<\/p>\n

 <\/p>\n

printfn "Unlabeled:"<\/span><\/p>\n

printTree tree  <\/p>\n<\/p><\/div>\n

And what we get is something like this:<\/p>\n

\n

Unlabeled:<\/p>\n

Branch:<\/p>\n

  Leaf: "Max"<\/p>\n

  Branch:<\/p>\n

    Leaf: "Bernd"<\/p>\n

    Branch:<\/p>\n

      Branch:<\/p>\n

        Leaf: "Holger"<\/p>\n

        Leaf: "Ralf"<\/p>\n

      Branch:<\/p>\n

        Leaf: "Kerstin"<\/p>\n

        Leaf: "Steffen"<\/p>\n<\/p><\/div>\n

Labeling the tree with mutable state<\/h5>\n

Now we want to give every tree a unique label. This can be easily done by another recursive function:<\/p>\n

\n

let<\/span> mutable<\/span> label = -1 <\/p>\n

let<\/span> rec<\/span> labelTreeMS t =<\/p>\n

  match<\/span> t with<\/span><\/p>\n

  | Leaf l -><\/span> <\/p>\n

      label <- label + 1 \/\/ changing the state<\/span><\/p>\n

      Leaf(l,label)  <\/p>\n

  | Branch(oldL,oldR) -><\/span> <\/p>\n

      let<\/span> newL = labelTreeMS oldL<\/p>\n

      let<\/span> newR = labelTreeMS oldR<\/p>\n

      Branch(newL,newR)         <\/p>\n

 <\/p>\n

let<\/span> treeMS = labelTreeMS tree<\/p>\n

printfn "Labeled (with global mutable state):"<\/span><\/p>\n

printTree treeMS      <\/p>\n<\/p><\/div>\n

And the output would look like this:<\/p>\n

\n

Labeled (with global mutable state):<\/p>\n

Branch:<\/p>\n

  Leaf: ("Max", 0)<\/p>\n

  Branch:<\/p>\n

    Leaf: ("Bernd", 1)<\/p>\n

    Branch:<\/p>\n

      Branch:<\/p>\n

        Leaf: ("Holger", 2)<\/p>\n

        Leaf: ("Ralf", 3)<\/p>\n

      Branch:<\/p>\n

        Leaf: ("Kerstin", 4)<\/p>\n

        Leaf: ("Steffen", 5)<\/p>\n<\/p><\/div>\n

The only problem with labelTreeMS<\/strong> is that it uses global state, which is very bad because we can\u2019t be sure if the mutable label variable is changed (from maybe another thread) or not.<\/p>\n

Labeling the tree without global state<\/h5>\n

If we want to remove this side effect, we can pass the state directly into the function:<\/p>\n

\n

\/\/ non-monadic version<\/span><\/p>\n

\/\/ passing the state around explicitly<\/span><\/p>\n

let<\/span> rec<\/span> labelTreeNM t s =<\/p>\n

  match<\/span> t with<\/span><\/p>\n

  | Leaf l -><\/span> s+1,Leaf(l,s)  \/\/ changing the state<\/span><\/p>\n

  | Branch(oldL,oldR) -><\/span> <\/p>\n

      let<\/span> stateL,newL = <\/p>\n

        labelTreeNM oldL s<\/p>\n

      let<\/span> stateR,newR = <\/p>\n

        labelTreeNM oldR stateL  \/\/ passing the state around<\/span><\/p>\n

      stateR,Branch(newL,newR)               <\/p>\n

 <\/p>\n

let<\/span> _,treeNM = labelTreeNM tree 0<\/p>\n

printfn "Labeled (non-monadic):"<\/span><\/p>\n

printTree treeNM<\/p>\n<\/p><\/div>\n

<\/h5>\n
Labeling the tree by using the State Monad<\/h5>\n

With the help of the State Monad we get a very similar function:<\/p>\n

\n

\/\/\/ labels a tree by using the state monad <\/span><\/p>\n

\/\/\/ (uses F#\u2019s sugared syntax)<\/span><\/p>\n

let<\/span> rec<\/span> labelTree t = state {<\/p>\n

   match<\/span> t with<\/span><\/p>\n

   | Leaf l -><\/span> <\/p>\n

       let!<\/span> s = getState<\/p>\n

       do!<\/span> setState (s+1)  \/\/ changing the state<\/span><\/p>\n

       return<\/span> Leaf(l,s)<\/p>\n

   | Branch(oldL,oldR) -><\/span><\/p>\n

      let!<\/span> newL = labelTree oldL <\/p>\n

      let!<\/span> newR = labelTree oldR <\/p>\n

      return<\/span> Branch(newL,newR)}<\/p>\n

 <\/p>\n

 <\/p>\n

printfn "Labeled (monadic):"<\/span><\/p>\n

let<\/span> treeM = Execute (labelTree tree) 0<\/p>\n

printTree treeM<\/p>\n<\/p><\/div>\n

Thanks to the F# sugared syntax this labelTree<\/strong> and labelTreeMS <\/strong>are visually nearly the same. Every time we are dealing with state we use the exclamation mark. There is only one point (in the Leaf case) where have to use (and change) the state. <\/p>\n

The nice thing is, that we can write the function like the first version, but we don\u2019t have to perform the side effect on the shared state.<\/p>\n

If we want to use the de-sugared version we have to write it like this:<\/p>\n

\n

\/\/\/ labels a tree and uses de-sugared syntax<\/span><\/p>\n

\/\/\/ (implementation looks different to labelTreeNM)<\/span><\/p>\n

let<\/span> rec<\/span> labelTreeDesugared t =<\/p>\n

   match<\/span> t with<\/span><\/p>\n

   | Leaf l -><\/span> (fun<\/span> s -><\/span> Leaf(l,s),(s+1))<\/p>\n

   | Branch(oldL,oldR) -><\/span> <\/p>\n

       labelTreeDesugared oldL >>=<\/p>\n

        (fun<\/span> newL -><\/span> <\/p>\n

           labelTreeDesugared oldR >>= <\/p>\n

             (fun<\/span> newR -><\/span> <\/p>\n

                 Branch(newL,newR) |> returnS))    <\/p>\n<\/p><\/div>\n

State monad implementation<\/h5>\n

In order to use the state monad, of course we have to implement it first. Here is my version, which allows to use the de-sugared and sugared version:<\/p>\n

\n

module<\/span> StateMonad<\/p>\n

 <\/p>\n

let<\/span> (>>=) x f = <\/p>\n

   (fun<\/span> s0 -><\/span> <\/p>\n

      let<\/span> a,s = x s0<\/p>\n

      f a s)       <\/p>\n

 <\/p>\n

let<\/span> returnS a = (fun<\/span> s -><\/span> a, s)<\/p>\n

 <\/p>\n

type<\/span> StateBuilder() =<\/p>\n

  member<\/span> m.Bind(x, f) = x >>= f<\/p>\n

  member<\/span> m.Return a = returnS a <\/p>\n

 <\/p>\n

let<\/span> state = new<\/span> StateBuilder()<\/p>\n

 <\/p>\n

let<\/span> getState = (fun<\/span> s -><\/span> s, s)<\/p>\n

let<\/span> setState s = (fun<\/span> _ -><\/span> (),s)  <\/p>\n

let<\/span> Execute m s = m s |> fst<\/p>\n

 <\/p>\n<\/p><\/div>\n

If you want to learn more about the State Monad I recommend watching Brian Beckman’s Channel 9 video \u201cThe Zen of Stateless State – The State Monad<\/a>".<\/p>\n","protected":false},"excerpt":{"rendered":"

Currently I\u2019m trying to implement some of the standard monads in F#. If you want to read about the theory behind monads and their implementation (in Haskell) it\u2019s a good start to look into \u201cAll about Monads\u201d on haskell.org. In this blog post series I don\u2019t care about mathematical details. Instead I will try to […]<\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":[],"categories":[448],"tags":[664,582,581],"_links":{"self":[{"href":"http:\/\/www.navision-blog.de\/blog\/wp-json\/wp\/v2\/posts\/889"}],"collection":[{"href":"http:\/\/www.navision-blog.de\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"http:\/\/www.navision-blog.de\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"http:\/\/www.navision-blog.de\/blog\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"http:\/\/www.navision-blog.de\/blog\/wp-json\/wp\/v2\/comments?post=889"}],"version-history":[{"count":12,"href":"http:\/\/www.navision-blog.de\/blog\/wp-json\/wp\/v2\/posts\/889\/revisions"}],"predecessor-version":[{"id":901,"href":"http:\/\/www.navision-blog.de\/blog\/wp-json\/wp\/v2\/posts\/889\/revisions\/901"}],"wp:attachment":[{"href":"http:\/\/www.navision-blog.de\/blog\/wp-json\/wp\/v2\/media?parent=889"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"http:\/\/www.navision-blog.de\/blog\/wp-json\/wp\/v2\/categories?post=889"},{"taxonomy":"post_tag","embeddable":true,"href":"http:\/\/www.navision-blog.de\/blog\/wp-json\/wp\/v2\/tags?post=889"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}