Skip to content

Instantly share code, notes, and snippets.

@iskeld

iskeld/gist:10934747

Created Apr 16, 2014
Embed
What would you like to do?
trapped in the state monad
open System;
module StateMonad =
let (>>=) x f = (fun s0 ->
let a,s = x s0
f a s)
let kwik = (>>=)
let returnS a b = a, b
type StateBuilder() =
member m.Bind(x, f) = x >>= f
member m.Return a = returnS a
let state = new StateBuilder()
let getState = (fun s -> s, s)
let setState s = (fun _ -> (),s)
let Execute m s = m s |> fst
open StateMonad
type Tree<'a> =
| Leaf of 'a
| Branch of Tree<'a> * Tree<'a>
let tree =
Branch(
Leaf "Max",
Branch(
Leaf "Bernd",
Branch(
Branch(
Leaf "Holger",
Leaf "Ralf"),
Branch(
Leaf "Kerstin",
Leaf "Steffen"))))
/// labels a tree by using the state monad
/// (uses F#’s sugared syntax)
let rec labelTree t = state {
match t with
| Leaf l ->
let! s = getState
do! setState (s+1) // changing the state
return Leaf(l,s)
| Branch(oldL,oldR) ->
let! newL = labelTree oldL
let! newR = labelTree oldR
return Branch(newL,newR)}
let mutable state = 0
let rec treeLabeller t =
match t with
| Leaf a ->
state <- state + 1
Leaf (state, a)
| Branch (a, b) ->
let newA = treeLabeller a
let newB = treeLabeller b
Branch (newA, newB)
let treeLabellerNM t =
let rec treeLabellerInternal t s =
match t with
| Leaf a -> s + 1, Leaf(s, a)
| Branch (a, b) ->
let (sa, newA) = treeLabellerInternal a s
let (sb, newB) = treeLabellerInternal b sa
sb, Branch (newA, newB)
let _, r = treeLabellerInternal t 1
r
let printTree t =
let rec print t level =
let indent = new String(' ', level * 2)
match t with
| Leaf a -> printfn "%sLeaf: %A" indent a
| Branch (a, b) ->
printfn "%sBranch:" indent
print a (level + 1)
print b (level + 1)
print t 0
printTree tree
printfn "====="
printTree (treeLabeller tree)
printfn "====="
printTree (treeLabellerNM tree)
printfn "Labeled (monadic):"
let treeM = Execute (labelTree tree) 0
printTree treeM
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.