Create a gist now

Instantly share code, notes, and snippets.

@simoneb /StateMonad.cs Secret
Created Feb 28, 2013

What would you like to do?
Brian Beckman's State Monad in C#
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
// We demonstrate three ways of labeling a binary tree with unique
// integer node numbers: (1) by hand, (2) non-monadically, but
// functionally, by threading an updating counter state variable
// through function arguments, and (3) monadically, by using a
// partially generalized state-monad implementation to handle the
// threading via composition. To understand this program, it may be
// best to start with Main, seeing how the various facilities are
// used, then backtrack through the code learning first the
// non-monadic tree labeler, starting with the function Label, then
// finally the monadic tree labeler, starting with the function
// MLabel. At the very end of this file are several exercises for
// generalizing the constructions further.
namespace StateMonad
{
public static class Extensions
{
// Define an extention method and a default implementation
// here so as to treat built-in types similarly to
// user-defined types as regards the "Show" method. Anything
// can be "Shown"
public static void Show<a>(this a thing, int level)
{
Console.Write("{0}", thing.ToString());
}
}
// Never explicitly use the "set" property accessors of any of our
// types. This means our classes are immutable by convention. Put
// values in properties at construction time, and then never
// change them.
public class Program
{
// Example "binary-tree" data structure. In exercises at the
// bottom of this file, generalize this in two ways: to an
// n-ary tree, and to something with a rich state, that does a
// more substantial calculation, such as tracking scaling
// parameters or 4x4 transformation matrices for geometric
// objects.
// The following "region" is a C# translation of the following
// Haskell:
//
// A tree containing data of type "a" is either a Leaf
// containing an instance of type a, "Lf a", or a Branch
// containing two trees recursively containing data of type a:
//
// > data Tr a = Lf a | Br (Tr a) (Tr a)
// > deriving Show
#region "generic tree"
public const int indentation = 2; // for pretty-printing.
public abstract class Tr<T>
{
public abstract void Show(int level);
}
// A Tr<a> is either a Lf<a> or a Br<a>.
public class Lf<a> : Tr<a>
{
public a contents { get; set; }
public override void Show(int level)
{
Console.Write(new String(' ', level * indentation));
Console.Write("Leaf: ");
contents.Show(level);
Console.WriteLine();
}
}
public class Br<a> : Tr<a>
{
public Tr<a> left { get; set; }
public Tr<a> right { get; set; }
public override void Show(int level)
{
Console.Write(new String(' ', level * indentation));
Console.WriteLine("Branch:");
left.Show(level + 1);
right.Show(level + 1);
}
}
#endregion // "generic tree"
// Our C# translation of the labeled tree, this bit of Haskell
//
// "Lt" stands for "Labeled tree," and it's just an ordinary
// tree, as defined above, but containing a pair of a variable
// of type S for state and a variable of type a, where S, the
// type of state, is a just an Int.
//
// > type Lt a = (Tr (S, a))
// > type S = Int -- State, or "S", is just an Int
//
// The Label is the stateful bit we thread through the
// labeling machinery.
//
// In another exercise, make this completely general,
// generalizing over the type of the state variable with
// another generic type parameter. For now, a state is an
// integer, pure and simple, and a label is a state.
#region "non-monadically labeled tree"
// The plan is to convert trees containing "content" data into
// trees containing pairs of contents and labels.
// In Haskell, just construct the type "pair of state and
// contents" on-the-fly as a pair-tuple of type (S, a). In
// C#, create a class such pairs since tuples are not
// primitive as they are in Haskell.
// The first thing we need is a class or type for
// state-content pairs, call it Scp. Since the type of the
// state is hard-coded as "Int," Scp<a> has only one type
// parameter, the type a of its contents.
public class Scp<a> // State-Content Pair
{
public int label { get; set; }
public a lcpContents { get; set; } // New name; don't confuse
// with the old "contents"
public override string ToString()
{
return String.Format("Label: {0}, Contents: {1}", label, lcpContents);
}
}
// Here's the Haskell for labeling a tree by manually
// threading state through function arguments. Later, we
// derive a generic state monad by abstracting parts of this
// definition.
//
// Reminder: a labeled tree, Lt<a>, is a tree with an Scp<a>
// as its contents. The following function, Label, takes a
// Tr a and returns a Lt a = Tr (S, a), by calling a helper
// function, Lab, keeping only the second element of the
// tuple that Lab returns:
//
// > label :: Tr a -> Lt a
// > label tr = snd (lab tr 0)
// > where ...
// Here is our C# manual-labeling function, Label, which takes
// a Tr<a> as input and returns a Tr<Scp<a>> (for which we
// have a new type in the Haskell version.) All this does is
// call the helper function with a starting value for the
// labels, namely 0, and then keep only the labeled-tree part
// of the return value, which has both a label and a labeled
// tree. Internally, Lab threads the label part of its return
// value to recursive calls of Lab, but Label does not need
// this value, even though it happens to be the value of the
// next label that would be applied to a tree node..
public static Tr<Scp<a>> Label<a>(Tr<a> t)
{
var r = Lab<a>(t, 0); // helper function
return r.lltpTree; // keep only the tree part when done.
}
// Label's helper function threads the label (i.e., the state)
// around. It's easiest to create a new data structure to
// hold a pair of a current Label and a partially labeled
// Tr<Scp<a>> = Lt a because we build up the fully labeled tree
// recursively.
// LLtP<a> = Label-LabeledTree Pair; the return type of the
// helper function, Lab.
private class LLtP<a>
{
public int lltpLabel { get; set; }
public Tr<Scp<a>> lltpTree { get; set; } // "label" in Scp<T>
}
// "Lab" takes an old tree and a state value, and returns a
// pair of state and new tree, which is, itself, a tree of
// pairs:
// > lab :: Tr a -> S -> (S, Lt a)
// > lab (Lf contents) n = ((n+1), (Lf (n, contents))) -- returned pair
// > lab (Br trs) n0 = let (n1, l') = lab l n0 -- pat match in
// > (n2, r') = lab r n1 -- recurive calls
// > in (n2, Br l' r') -- returned pair
// Direct transcription into C#:
private static LLtP<a> Lab<a>(Tr<a> t, int lbl)
{
if (t is Lf<a>)
{
var lf = (t as Lf<a>);
return new LLtP<a>
{
lltpLabel = lbl + 1, // bump the label for recursion
lltpTree = new Lf<Scp<a>>
{
contents =
new Scp<a>
{
label = lbl, // label this Leaf node
lcpContents = lf.contents // copy the contents
}
}
};
}
else if (t is Br<a>)
{
var br = (t as Br<a>);
var l = Lab<a>(br.left, lbl); // recursive call
var r = Lab<a>(br.right, l.lltpLabel); // threading
return new LLtP<a>
{
lltpLabel = r.lltpLabel,
lltpTree = new Br<Scp<a>>
{
left = l.lltpTree,
right = r.lltpTree
}
};
}
else
{
throw new Exception("Lab/Label: impossible tree subtype");
}
}
#endregion // non-monadically labeled tree
#region "monadically labeled tree"
// A "S2Scp" is a function from state to state-contents pair
// (or label-contents pair). An instance of the state monad
// will have one member: a function of this type. Where is
// such a function to get the contents part? Obviously not
// from its argument list, therefore from the environment --
// the closure about the function.
// This is the generalization of the state monad type: it
// doesn't care what type the contents are. The state monad
// just says "if you give me a function from a state to a
// state-contents pair, I'll thread the state around for you."
public delegate Scp<a> S2Scp<a>(int state);
// Here is a type for functions that takes an input of type a
// and puts it in an instance of the state monad containing an
// instance of type b. In other words, it both transforms an a
// to a b and lifts the b into the state monad.
public delegate SM<b> Maker<a, b>(a input);
// The following is actually general, aside from the hard-coding
// of the type of label as int. This is the type of a State Monad
// with contents of any type A.
public class SM<a>
{
// Here is the meat: the only data member of this monad:
public S2Scp<a> s2scp { get; set; }
// Any monad -- the state monad, the continuation monad,
// the list monad, the maybe monad, etc. must implement
// the two operators @return and @bind, which we represent
// here as instance methods.
//
// (footnote: At-sign lets me use the "return" keyword
// as an identifier, and it's benign to use it on
// "bind" for stylistic and syntactic
// parallelism. These two operators are required and
// must satisfy the monad laws. Alternative: misspell
// "return" as in "retern" or what-not.)
//
// Exercise 3 asks you to create an abstract class with
// these operators and to derive SM from that
// class. Exercise 8 asks you to promote them into an
// interface.
// @return takes some contents as an argument and returns
// an instance of the monad. For the state monad, this
// instance contains, as required, a closure over a
// function from state to state-contents pair.
// @bind takes two arguments: an instance of monad M<a>,
// something of type a already in the monad; and a Maker
// function of type "from a to instance of M<b>". @bind
// returns an instance of M<b>. Imagine wrapping a call
// of @bind(M<a>, a->M<b>) in a function that takes an
// instance of type c, and see that @bind effects a
// composition of a c->M<a> and an a->M<B> to create a
// c->M<b>. Look up "Kleisli composition."
// @return and @bind must satisfy the monad laws:
//
// Left-identity:
//
// @bind(@return(anything), k) == k(anything)
//
// Right-identity:
//
// @bind(m, @return) == m
//
// Associativity:
//
// @bind(m, (x => @bind(k(x), h))) ==
//
// @bind(@bind(m, k), h)
//
// In exercise 7, verify the monad laws for this
// implementation.
// Here are the particular implementations of @return
// and @bind for the state monad:
// > return contents = Labeled (\st -> (st, contents))
// No wiggle room, here: put the contents in the contents
// slot and put the state in the state slot. The new
// state-monad instance contains a new function closed
// over the contents, which are supplied in the argument
// list of @return. The function is implemented as a C#
// lambda expression:
public static SM<a> @return(a contents)
{
return new SM<a>
{
s2scp = (st => new Scp<a>
{
label = st,
lcpContents = contents
})
};
}
// ">>=" is the infix notation for "@bind" from
// Haskell. Here, take an instance of monad x and a
// function (x -> monad y) and returns an instance of
// monad y. No wiggle room here, either: much easier
// to show in pictures:
//
// +---------+
// .-->| fany1 |
// | +---------+
// | |
// | |
// | v
// | ===
// +--------+ any1 | +---------+
// | |---------' | |---------->
// | fst0 | | fst1 |
// st0 | | st1 | |
// ------->| |------------>| |---------->
// +--------+ +---------+
//
// fst0 produces a state-contents pair. Feed the contents
// produced by fst0 into fany1, which produces a function
// from state to state-contents pair. Feed the state
// produced by fst0 into the function produced by
// fany1. Get a new state-contents pair. Make the whole
// thing just a function from st0, and the final result is
// a function from state to state-contents pair.
// Recognize this as the signature of the final, resulting
// monad instance. The pattern is also obvious chainable.
//
// > M fst0 >>= fany1 = -- fst0 :: st->(st, any)
// > M $ \st0 -> -- return new monad instance: a func of st0
// > let (st1, any1) = fst0 st0 -- pat match new st1 and contents
// > M fst1 = fany1 any1 -- shove contents into fany1,
// > -- getting new monad inst fst1.
// > in fst1 st1 -- feed st1 into new monad inst, return (st, any)
// > -- and that's what we needed, a function from
// > -- st0 to (st->any) implemented through the new
// > -- monad instance returned by fany1.
public static SM<b> @bind<b>(SM<a> inputMonad, Maker<a, b> inputMaker)
{
return new SM<b>
{
// The new instance of the state monad is a
// function from state to state-contents pair,
// here realized as a C# lambda expression:
s2scp = (st0 =>
{
// Deconstruct the result of calling the input
// monad on the state parameter (done by
// pattern-matching in Haskell, by hand here):
var lcp1 = inputMonad.s2scp(st0);
var state1 = lcp1.label;
var contents1 = lcp1.lcpContents;
// Call the input maker on the contents from
// above and apply the resulting monad
// instance on the state from above:
return inputMaker(contents1).s2scp(state1);
})
};
}
}
// Here's a particular state monad instance we need to update
// state. We're going to @bind -- that is, compose -- an
// instance of this with leaves of the labeled tree:
// > updateState :: Labeled S
// > updateState = Labeled (\n -> ((n+1),n))
private static SM<int> UpdateState()
{
return new SM<int>
{
s2scp = (n => new Scp<int>
{
label = n + 1,
lcpContents = n
})
};
}
// Here's a helper that composes UpdateState with Leaf and
// Branch in the original unlabeled tree. This looks very
// hairy in C#, but in Haskell it's quite short. Here's what
// we do with leaves:
//
// > mkm :: Tr anytype -> Labeled (Lt anytype)
// > mkm (Lf x)
// > = do n <- updateState -- call updateState; "n" is of type "S"
// > return (Lf (n,x)) -- "return" does the heavy lifting
// > -- of creating the Monad from a value.
//
// The "do" notation is just Haskell syntactic sugar for
// precisely the following call of @bind:
//
// updateState >>= \n -> return (Lf (n, x))
//
// which says "call update state, which returns an instance of
// the state monad, then @bind it to the variable n in a
// function that returns a leaf node labeled by the given
// state value." We translate this directly into C# below.
//
// The Branch case is a trivial recursion. Notice that
// updateState only gets called on leaves.
//
// > mkm (Br l r)
// > = do l' <- mkm l
// > r' <- mkm r
// > return (Br l' r')
//
// Notice this is private:
private static SM<Tr<Scp<a>>> MkM<a>(Tr<a> t)
{
if (t is Lf<a>)
{
// Call UpdateState to get an instance of
// SM<int>. Shove it (@bind it) through a lambda
// expression that converts ints to SM<Tr<Scp<a>>
// using the "closed-over" contents from the input
// Leaf node:
var lf = (t as Lf<a>);
return SM<int>.@bind
( UpdateState(),
(n => SM<Tr<Scp<a>>>.@return
(new Lf<Scp<a>>
{ contents = new Scp<a>
{ label = n,
lcpContents = lf.contents
}
}
)
)
);
}
else if (t is Br<a>)
{
var br = (t as Br<a>);
var oldleft = br.left;
var oldright = br.right;
return SM<Tr<Scp<a>>>.@bind
( MkM<a>(oldleft),
(newleft => SM<Tr<Scp<a>>>.@bind
( MkM<a>(oldright),
(newright => SM<Tr<Scp<a>>>.@return
(new Br<Scp<a>>
{
left = newleft,
right = newright
}
)
)
)
)
);
}
else
{
throw new Exception("MakeMonad/MLabel: impossible tree subtype");
}
}
// Here's our final function: takes an unlabled tree and
// returns a monadically labeled tree.
// Same signature as non-monadic "Label" above
public static Tr<Scp<a>> MLabel<a>(Tr<a> t)
{
// throw away the label, we're done with it.
return MkM(t).s2scp(0).lcpContents;
}
#endregion // "monadically labeled tree"
static void Main(string[] args)
{
Console.WriteLine("Unlabeled Tree:");
var t = new Br<string>
{
left = new Lf<string> { contents = "a" },
right = new Br<string>
{
left = new Br<string>
{
left = new Lf<string> { contents = "b" },
right = new Lf<string> { contents = "c" }
},
right = new Lf<string> { contents = "d" }
},
};
t.Show(2);
Console.WriteLine();
Console.WriteLine("Hand-Labeled Tree:");
var t1 = new Br<Scp<string>>
{
left = new Lf<Scp<string>>
{
contents = new Scp<string>
{
label = 0,
lcpContents = "a"
}
},
right = new Br<Scp<string>>
{
left = new Br<Scp<string>>
{
left = new Lf<Scp<string>>
{
contents = new Scp<string>
{
label = 1,
lcpContents = "b"
}
},
right = new Lf<Scp<string>>
{
contents = new Scp<string>
{
label = 2,
lcpContents = "c"
}
}
},
right = new Lf<Scp<string>>
{
contents = new Scp<string>
{
label = 3,
lcpContents = "d"
}
}
},
};
t1.Show(2);
Console.WriteLine();
Console.WriteLine("Non-monadically Labeled Tree:");
var t2 = Label<string>(t);
t2.Show(2);
Console.WriteLine();
Console.WriteLine("Monadically Labeled Tree:");
var t3 = MLabel<string>(t);
t3.Show(2);
Console.WriteLine();
}
// Exercise 1: generalize over the type of the state, from int
// to <S>, say, so that the SM type can handle any kind of
// state object. Start with Scp<T> --> Scp<S, T>, from
// "label-content pair" to "state-content pair".
// Exercise 2: go from labeling a tree to doing a constrained
// container computation, as in WPF. Give everything a
// bounding box, and size subtrees to fit inside their
// parents, recursively.
// Exercise 3: promote @return and @bind into an abstract
// class "M" and make "SM" a subclass of that.
// Exercise 4 (HARD): go from binary tree to n-ary tree.
// Exercise 5: Abstract from n-ary tree to IEnumerable; do
// everything in LINQ! (Hint: SelectMany).
// Exercise 6: Go look up monadic parser combinators and
// implement an elegant parser library on top of your new
// state monad in LINQ.
// Exercise 7: Verify the Monad laws, either abstractly
// (pencil and paper), or mechnically, via a program, for the
// state monad.
// Exercise 8: Design an interface for the operators @return
// and @bind and rewrite the state monad so that it implements
// this interface. See if you can enforce the monad laws
// (associativity of @bind, left identity of @return, right
// identity of @return) in the interface implementation.
// Exercise 9: Look up the List Monad and implement it so that
// it implements the same interface.
// Exercise 10: deconstruct this entire example by using
// destructive updates (assignment) in a discipline way that
// treats the entire CLR and heap memory as an "ambient
// monad." Identify the @return and @bind operators in this
// monad, implement them explicitly both as virtual methods
// and as interface methods.
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment