The Magic of Type Classes

Type classes are amazing.  Just wanted to point that out.  I don’t even mean magical stuff like multiparameter type classes or fancy newfangled nonsense kids these days are using.  (I will, however, use FlexibleInstances in this blog entry, just because it lets me avoid a bunch of type conversions.)  But really, I just mean ordinary old type classes.  Some of the least interesting uses of type classes in Haskell are, for example, the Num and Fractional and such classes and their instances in the standard library.  To be sure, they are sort of interesting — they take things that are part of the language definition in other languages (the “/” operator works on either single or double precision floats, for example), and describe them within the language itself.  That’s cool,but it’s nowhere near the limit of how cool type classes can be.

There’s a much better example of how cool type classes can be in a blog post I wrote some time ago (and the dozens of other people who have done the same thing, and probably blogged about it, too).  But I think this one, while a little more complicated, is even cooler.  Here’s the problem I’m working on this morning.  I’m going to oversimplify shamelessly, in hopes of getting to the point some time in the foreseeable future.  I hope no one reads this who knows the real mathematics involved, because I’ll get angry comments and corrections.

Some people in a branch of mathematics called symbolic dynamics are occasionally interested in certain square matrices of non-negative integers (if one feels like it, one could say they are interested in graphs, where the matrices are just the adjacency matrices of those graphs; it’s a distinction without a difference).  In particular, they are sometimes interested in whether it’s possible to change one of these matrices into a different one by making only certain kinds of changes, of which they are rather fond.  They’ve even given these changes cutesy nicknames: in-splitting, in-amalgamation, out-splitting, out-amalgamation, expansion, and contraction.  When matrices can be converted into each other using these operations, they are called “flow equivalent”.

These operations aren’t hard to implement.  Here are type signatures for functions to implement the operations.  If we represent matrices as lists of lists and allow the use of a few simple utility functions on lists, the actual implementations are all one or two lines long, but are not really relevant here.  The point is that that each of these operations takes some values, and a non-negative square integer matrix, and gives back another non-negative square integer matrix.

    type Vertex = Int

    outsplit   :: Vertex -> [Vertex] -> [Vertex] -> Matrix Int -> Matrix Int
    insplit    :: Vertex -> [Vertex] -> [Vertex] -> Matrix Int -> Matrix Int
    outamalg   :: Vertex -> Vertex -> Matrix Int -> Matrix Int
    inamalg    :: Vertex -> Vertex -> Matrix Int -> Matrix Int
    expand     :: Vertex -> Bool -> Matrix Int -> Matrix Int
    contract   :: Vertex -> Vertex -> Bool -> Matrix Int -> Matrix Int
    dropVertex :: Vertex -> Matrix Int -> Matrix Int

And those are called the “generators” of flow equivalence.  (I feel compelled, in the name of defending myself against the hordes of symolic dynamics researchers who will do doubt try me for crimes against their field, to put in here a disclaimer that deleting sources and sinks are not normally considered among the generators of flow equivalence… but for certain technical reasons, it is convenient to include them here.)

Now, here is where the problem arises.  My functions above will take a matrix, perform an in-amalgamation, for example, and tell me what matrix I’ve got back.  But it’s quite rare, actually, that I’m really interested in merely trying out an in-amalgamation to see what happens.  Actually, I’m far more interested in following someone’s construction.  For example, there are some constructions by some smart guys named John Franks and Danrun Huang that both do interesting things.  And here’s the interesting bit – by the very nature of the construction, I already know what the result is going to be.  What I really care about is what sequence of flow equivalence generators I used to get there.  And the functions I’ve written above simply can’t tell me that.

One thought might be to use the Writer monad.  I myself considered such a path, but it turns out that I would have been quite mistaken to do so.  Consider the following:

fiddleWith x = do
    a <- tryOneThing x
    b <- tryAnotherThing x
    if a `betterThan` b
        then return a
        else return b

See what’s going to happen here?  When I calculate the two candidates, I’ll produce the sequence of flow equivalence generators for each of them in turn, even though only one of them ends up coming back as the result of the computation.  This is quite wrong, and in fact will give me non-sensical results.  Since I anticipate eventually trying to optimize the constructions to try and get better flow equivalences, I certainly don’t want to create a situation where trying two different things will give nonsensical results!

What I really want is for the sequence of flow equivalence generators to be carried along with the non-negative integer matrix as I perform the construction.  So I want:

    outsplit   :: Vertex -> [Vertex] -> [Vertex] -> ([FlowOp], Matrix Int) -> ([FlowOp], Matrix Int)
    insplit    :: Vertex -> [Vertex] -> [Vertex] -> ([FlowOp], Matrix Int) -> ([FlowOp], Matrix Int)
    outamalg   :: Vertex -> Vertex -> ([FlowOp], Matrix Int) -> ([FlowOp], Matrix Int)
    inamalg    :: Vertex -> Vertex -> ([FlowOp], Matrix Int) -> ([FlowOp], Matrix Int)
    expand     :: Vertex -> Bool -> ([FlowOp], Matrix Int) -> ([FlowOp], Matrix Int)
    contract   :: Vertex -> Vertex -> Bool -> ([FlowOp], Matrix Int) -> ([FlowOp], Matrix Int)
    dropVertex :: Vertex -> ([FlowOp], Matrix Int) -> ([FlowOp], Matrix Int)

But I anticipate needing to change some other things, as well.  Eventually, I might want to represent my non-negative integer matrices differently — perhaps as a graph, with labelled edges and vertices.  (It turns out I will want this!)  I may decide that lists of lists are quite inefficient, and I need some data structure better suited to my task.  I may have other needs that I can’t even predict.  So, at this point, I decide that instead of rewriting all my types for this particular variation, I could try a type class, so what I actually write is:

class FlowEquiv a where
    matrix     :: a -> Matrix Int
    size       :: a -> Int

    outsplit   :: Vertex -> [Vertex] -> [Vertex] -> a -> a
    insplit    :: Vertex -> [Vertex] -> [Vertex] -> a -> a
    outamalg   :: Vertex -> Vertex -> a -> a
    inamalg    :: Vertex -> Vertex -> a -> a
    expand     :: Vertex -> Bool -> a -> a
    contract   :: Vertex -> Vertex -> Bool -> a -> a
    dropVertex :: Vertex -> a -> a

This is great, because it allows me to proceed with my implementation in little steps.  I’m actually going to build myself four (yes, four!) little instances of my type class, and they are going to look like the following.

instance FlowEquiv (Matrix Int) where
    matrix a = a
    ...

I am still refusing to give you the implementation of this one, not because it’s a secret, but because it would obscure the point.  If you care, feel free to ask me.  But then adding the logging that I need is simple enough.  First, I need a data type to represent these operations.

data FlowOp = OutSplit   Vertex [Vertex] [Vertex]
            | InSplit    Vertex [Vertex] [Vertex]
            | OutAmalg   Vertex Vertex
            | InAmalg    Vertex Vertex
            | Expand     Vertex Bool
            | Contract   Vertex Vertex Bool
            | DropVertex Vertex
    deriving Show

I’ll now define a new wrapper type to add such a list to some other FlowEquiv type.

newtype WithFlowOps a = WithFlowOps ([FlowOp], a) deriving Show

starting :: FlowEquiv a => a -> WithFlowOps a
starting a = WithFlowOps ([], a)

flowOps :: FlowEquiv a => WithFlowOps a -> [FlowOp]
flowOps (WithFlowOps (ops,_)) = ops

And finally, I’ll build myself an instance:

instance FlowEquiv a => FlowEquiv (WithFlowOps a) where
    matrix (WithFlowOps (_,a)) = matrix a
    size   (WithFlowOps (_,a)) = size a

    outsplit v r1 r2 (WithFlowOps (ops,a))
        = WithFlowOps (ops ++ [ OutSplit v r1 r2 ], outsplit v r1 r2 a)
    insplit v c1 c2 (WithFlowOps (ops,a))
        = WithFlowOps (ops ++ [ InSplit v c1 c2 ],  insplit v c1 c2 a)
    outamalg v w (WithFlowOps (ops,a))
        = WithFlowOps (ops ++ [ OutAmalg v w ],     outamalg v w a)
    inamalg v w (WithFlowOps (ops,a))
        = WithFlowOps (ops ++ [ InAmalg v w ],      inamalg v w a)
    expand v d (WithFlowOps (ops,a))
        = WithFlowOps (ops ++ [ Expand v d ],       expand v d a)
    contract v w d (WithFlowOps (ops,a))
        = WithFlowOps (ops ++ [ Contract v w d ],   contract v w d a)
    dropVertex v (WithFlowOps (ops,a))
        = WithFlowOps (ops ++ [ DropVertex v ],     dropVertex v a)

Now, so matter what my FlowEquiv type, I can simply wrap it in WithFlowOps (typically using the “starting” function I’ve defined that starts with an empty list of flow ops), and then perform my construction!  When I get back the result, I can ask it for its list of flow equivalence generators, and peruse them as I like.

But, as television infomercials are fond of saying, THAT’S NOT ALL!  It also turns out that there are some preconditions for performing many of the flow equivalence generating operations. I can only delete a vertex if it’s a source or a sink.  I can only contract an edge if it’s the only edge leaving its source, and the only edge entering its target.  There are more.  So far, I’ve neglected to check those, so that if I do things correctly, everything is fine; but if ‘be made a mistake, I may just get the wrong answer.  I sure don’t like that!  No problem, I’ll just make another instance:

newtype WithErrorChecks a = WithErrorChecks { unwrapErrorChecks :: a } deriving Show

instance FlowEquiv a => FlowEquiv (WithErrorChecks a) where
    matrix (WithErrorChecks a)           = matrix a
    size   (WithErrorChecks a)           = size a

    outsplit v r1 r2 (WithErrorChecks a)
      | outsplitIsOkay           = WithErrorChecks (outsplit v r1 r2 a)
      | otherwise                = error "Invalid outsplit"

    insplit v c1 c2 (WithErrorChecks a)
      | insplitIsOkay            = WithErrorChecks (insplit v c1 c2 a)
      | otherwise                = error "Invalid insplit"

    ...

You get the idea.  Well, that’s sort of cool, too.  I’m able to perform my error checking in one place, rather than having to build it into every possible representation I might try to implement this for.  But here’s something really cool!  It turns out there’s an operation, well known to those symbolic dynamics sorts, called a Franks row move.  It’s really just a sequence of four of those generators… and not hard to express, but it takes some thinking.  The hardest part, really, is keeping track of the indices of all those vertices.

primitiveRowMove :: FlowEquiv a => Vertex -> Vertex -> a -> a
primitiveRowMove v w a = let r1   = replacenth w 1 (replicate (size a) 0)
                             r2   = modifynth  w (subtract 1) (matrix a !! v)
                             a'   = outsplit v r1 r2 a
                             w'   = if w > v then w + 1 else w
                             c1   = replacenth v 1 (replicate (size a') 0)
                             c2   = modifynth  v (subtract 1) (map (!! w') (matrix a'))
                             a''  = insplit w' c1 c2 a'
                             v'   = if v > w then v + 1 else v
                             a''' = contract v' w' False a''
                         in  outamalg v (v+1) a'''

There it is (using some utility functions from elsewhere… don’t worry about the details of what’s going on, unless you like worrying).

Now there’s another operation, called a Franks column move.  This is a pattern that will show up again and again, though.  Every time I can do something to a matrix, I can also do the same thing to the transpose of that matrix!  That simply amounts to replacing in-splitting with out-splitting, in-amalgamations with out-amalgamations, and so on.  I don’t want to implement everything twice, so I’ll automate this process with yet another instance of FlowEquiv.

newtype Transposed a = Transposed { untranspose :: a } deriving Show

instance FlowEquiv a => FlowEquiv (Transposed a) where
    matrix (Transposed a) = transpose (matrix a)
    size   (Transposed a) = size a
    outsplit v r1 r2 (Transposed a) = Transposed (insplit  v r1 r2     a)
    insplit  v c1 c2 (Transposed a) = Transposed (outsplit v c1 c2     a)
    outamalg v w     (Transposed a) = Transposed (inamalg  v w         a)
    inamalg  v w     (Transposed a) = Transposed (outamalg v w         a)
    expand   v d     (Transposed a) = Transposed (expand   v (not d)   a)
    contract v w d   (Transposed a) = Transposed (contract w v (not d) a)
    dropVertex v     (Transposed a) = Transposed (dropVertex v         a)

Now implementing the Franks column move is a piece of cake!

primitiveColMove :: FlowEquiv a => Vertex -> Vertex -> a -> a
primitiveColMove v w = untranspose . primitiveRowMove w v . Transposed

And that is indisputably cool.  In addition to implementing this type class for the underlying type, Matrix Int, we’ve managed to craft three different secondary instances, each of which is solved a very different problem, and each of which saves a fair amount of work by removing some secondary task from the things we need to think about, instead separating it cleanly into a wrapper type.