Posts Tagged Category Theory

Comonads in everyday life.

July 9, 2008 at 11:45 am · Filed under Uncategorized ·Tagged , ,

This post is a literate haskell file. As is usual with such things, you can go ahead and paste it into a .lhs file and load it right up in ghci. As such, first some boring preliminaries.


> module CoMenu where
> import Control.Applicative; import Data.List; import Data.Tree; import Data.Maybe
> import Network.Frameworks.HVAC; import Network.Frameworks.HVAC.AltController

Anyway, say you’re serving up a website. And say this website has hierarchical menus. Maybe you want to display them with javascript, maybe statically, whatever. But of course, you also need some component of these menus to be generated server-side regardless, so that the structure matches up with the location of the current page in the hierarchy of content. One common way to do this, which isn’t all that bad actually, is to hardcode the whole menu, or to generate it from some list of sections/subsections, etc. that associates them with individual actions, be they .php or .jsp pages, or be they in servlet mappings or, you know, whatever. And in this menu, be it hardcoded or partly generated, there’s some additional code that conditionally displays subhierarchies (i.e. if you’re in the “About” section it will display the subsection selection as well, or etc.) or at a minimum disables the link to the current page, to give some indication of where the user currently is.

There are ways to fancy this up and reduce the overhead, but that’s the general notion — you have a dispatch system, and you have a menu system, and the information in the dispatch and menu systems don’t necessarily correspond. Or if you’re using “configuration by convention” maybe you’ve built something that relies on a correspondence, so that, e.g., a page can “autodiscover” its location in the hierarchy by introspection on its url.

So anyway, you’re describing the structure of your website twice, in perhaps very different formats, and the extent that you can improve on things is really improving the brevity of the formats and throwing some logic to the wind on the assumption that the descriptions really are rendundant.

The natural big little idea that I’m going to discuss then, is how we might use the same structure to describe both the dispatch and the menu, and so cut out all that nonsense. Now doing this is at least slightly trickier than it seems. That’s because in the typical imperative approach we’re thinking in passes from the top down — so even assuming we have a dispatch tree that we walk based on a url parse — and with, e.g., the hvac framework I’m working on, that’s a only a few lines — well, even assuming we have the dispatch down pat, consider the standard imperative approach to generating the menu itself.

For the purposes of this discussion the menu will be a horizontal one, with the top row containing the top level, the next row containing the paths of the selected sublevel, etc. The approach itself will generalize to any sort of menu, however. In any case, we start by rendering the top row. But wait! We have to distinguish the selected section. So, uh, on rendering the link to each section we check if it matches the first portion of the path. And then we react accordingly. And then, using the section we’ve found that matches that first portion we recurse into the next row and soforth.

But wait, that’s not how menus work! Generally, though not always, if you pick the a top section then it won’t show a special “top section” page but will show the page that you get if you “drill down” through first options until you eventually find a leaf. So we’re not talking about a rose tree here, but about a tree with content only at the leaf nodes, which is an irregular structure. On the other hand, maybe there’s content only at the leaf nodes 90% of the time, and 10% of the time there’s content elsewhere. So we’ll actually use a rose tree structure (from Data.Tree) with each node containing the following:


> data MItem a = MItem {
>       miName :: String,
>       miPath :: String,
>       miAction :: Maybe a } deriving Show

Of course with this there’s no guarantee that a leaf node contains a page action either, but it’ll do for the purposes of this discussion.

In any case, you see the issue — the dispatcher “drills down” to an action page, but the rendering of that page depends on the whole context of the menu, not just the initial path we were given. There are various ways to hack around this, but I won’t enumerate them all here. And then of course there’s the insight that even though the menu is “dynamic” on the page that it is rendered in, its static with regards to any given page and as such, a proper pre-traversal of the entire tree can (lazily, mind you) render the menus for every page at once.

So what we want is to traverse the tree in such a way that we preserve the context of the location we’re in with regards to everywhere else in the tree, so that we can render the menu properly, relative urls and all. And we want to do this entire traversal only once, rather than piecewise and repeatedly with each request. So what recursion scheme works? Well, fmap doesn’t, nor are any varients of traverse or mapAccum strong enough — they only tell us where we’ve been, not where we’re going. If only we could associate the context with each node beforehand — then a simple map would do the trick!

Well, the contents of a node plus all the associated context of a node have a common representation — the zipper, which is precisely the “one-hole context” of a datastructure. By definition, the zipper, or derivative, of any data structure, will contain enough information to reconstruct both the structure as well as an indext to a node within it. So here’s a simple and partial implementation of a zipper over a Tree. The included functions actually take it to and from a Forest, which is really just an alias for [Tree a].


> data Zipper a = Zipper {
>       prevLevels :: [Zipper a],
>       leftForest :: Forest a,
>       rightForest :: Forest a } deriving Show

> instance Functor Zipper where
>     fmap f (Zipper p l r) = Zipper (fmap f <$> p) (fmap f <$> l) (fmap f <$> r)

> forest2zip :: Forest a -> Zipper a
> forest2zip ts = Zipper [] [] ts

> zip2forest :: Zipper a -> Forest a
> zip2forest z = case prevLevels z of
>                  [] -> rightForest z
>                  pl -> rightForest . head . reverse $ pl

Now actually we’d typically include a host of functions for “walking around” within the zipper, including generalized depth-first traversal, etc. But it turns out that for our purposes we only ever need to step down, so the rest is ommited for brevity.


> zDown :: Zipper a -> Maybe (Zipper a)
> zDown x = case rightForest x of
>             [] -> Nothing
>             (t:_) -> case subForest t of
>                      (t':ts) -> Just $ Zipper {
>                                         prevLevels = x : prevLevels x,
>                                         leftForest = [],
>                                         rightForest = t':ts }
>                      _ -> Nothing

This gives us a representation of each node and its context. But still, how to associate them with each node, so as to preserve the overall structure? We could concievably turn our entire menu into a zipper, and then step through it, at each location replacing the action by one which includes the proper menu. But this would mean introducing another irregularity — holding 

Either (Zipper a, a) a

or some equivalent (c.f. Conor McBride’s Clowns and Jokers). Yeesh! We want to do it all at once. I.e. we want a signature of 

Zipper a -> Zipper (Zipper a)

. Wait! Hang on! That’s a specialization of “duplicate” which is to a comonad as “join” is to a monad! And in fact, as any fule kno, The dual of (monadic) substitution is (comonadic) redecoration. Oh, and it gets better! Behind every zipper is a comonad. And better yet! We also know that a rose tree is a cofree comonad over the list functor, which should somewhat help to tie this all together in terms of why and how a zipper is a comonad.

In any case, we provide the basic comonad class, and an instance for our zipper:


> class Functor w => Comonad w where
>         extract :: w a -> a
>         duplicate :: w a -> w (w a)
>         extend :: (w a -> b) -> w a -> w b
>         extend f = fmap f . duplicate
>         duplicate = extend id
>
> instance Comonad Zipper where
>     extract = rootLabel . head . rightForest
>     duplicate z@(Zipper p l r) = Zipper p' l' r'
>        where p' = fmap duplicate p
>              (l',r') = splitAt (length l) fs
>              lrs = l ++ r
>              fs = map (go p) $ zip3 (inits lrs) (tails lrs) lrs
>              go :: [Zipper a] -> ([Tree a],[Tree a],Tree a) -> Tree (Zipper a)
>              go ls (i,t,tr) =
>                         let z = Zipper {prevLevels = ls,
>                                         leftForest = i,
>                                         rightForest = t}
>                             sf' = subForest tr
>                         in tr {rootLabel = z,
>                                subForest = map (go (z:ls)) $
>                                            zip3 (inits sf') (tails sf') sf'}

Ok, so that duplicate code isn’t the easiest to write. Nonetheless, the beautiful thing is you only have to write it once. And it’s not that painful once you realize that we’ve really just got a generalization of the list comonad. But with all that traversal out of the way, a function to render menus almost writes itself. This one is parameterized over the function that draws the actual menu, and includes a little tweak to deal with irregular trees — if there’s no action at the given node, it traverses down until it finds a node that does provide an action.


> renderMenu ::
>     (Zipper (MItem (String -> a)) -> String)
>     -> Forest (MItem (String -> a)) -> Forest (MItem a)
> renderMenu renderRows = zip2forest . extend go . forest2zip
>     where
>       drillToAct :: Zipper (MItem a) -> Zipper (MItem a)
>       drillToAct z = case rightForest z of
>                        [] -> z
>                        (t:ts) -> case miAction . rootLabel $ t of
>                                    Nothing -> case zDown z of
>                                                 Nothing -> z
>                                                 Just z' -> drillToAct z'
>                                    _ -> z
>       go z = (extract z) {miAction = ($ renderRows z) <$>
>                           miAction (extract . drillToAct $ z)}

And here’s one example of a function that turns that zipper into a rendered menu. It makes lots of controversial design choices, has some quirks, and is really just hacked up for the purposes of this discussion, but the main point is that the legwork we did before lets us abstract the rendering from the traversal, so we can swap in whatever we want with no hassle.


> menuRows :: Zipper (MItem a) -> String
> menuRows z = concatMap (renderRow curDepth "") (reverse $ prevLevels z) ++
>              renderRow curDepth "" z ++
>              (case zDown z of
>                         Just z' -> renderRow curDepth ((miPath . extract) z ++ "/") z'
>                         Nothing -> "")
>     where curDepth = (length . prevLevels) z
>           renderRow curDepth prevPath z =
>                     "<div>" ++
>                     intercalate " | " (map mkLink (leftForest z)) ++
>                     (if null prevPath
>                        then " | " ++ (miName . extract) z ++ " | " ++
>                             intercalate " | "
>                                (map mkLink (tail . rightForest $ z))
>                        else " | " ++ intercalate " | "
>                                (map mkLink (rightForest z))) ++
>                     "</div>"
>               where mkLink x = "<a href='" ++ concat (replicate depth "../") ++
>                                prevPath ++
>                                (miPath . rootLabel) x ++ "/'>" ++
>                                (miName . rootLabel) x ++ "</a>"
>                     depth = curDepth - (length . prevLevels $ z)

And to round out the picture, the promised simple dispatch function, and below it, some sample data.


> menu2dispatch :: Forest (MItem (String -> HCGI q s CGIResult))
>                 -> HCGI q s CGIResult
> menu2dispatch mis' = endPath *>
>                        (fromJust . miAction . rootLabel . head) renderedMenu
>                      <|> go renderedMenu
>     where renderedMenu = renderMenu menuRows mis'
>           hasPath t pth = (miPath . rootLabel) t == pth
>           go mis = do
>             p <- takePath
>             case find (`hasPath` p) mis of
>               Nothing -> continue
>               Just mi -> endPath *> (fromJust . miAction . rootLabel) mi
>                          <|> go (subForest mi)
>
> foo = [
>        Node 2 [Node 10 [Node 11 []], Node 23 []],
>        Node 4 [Node 5 [], Node 7 []],
>        Node 8 [Node 9 [], Node 13 []],
>        Node 25 []
>       ]
>
> bar = map (fmap (\x -> MItem {
>                       miName = show x,
>                       miPath = show x,
>                       miAction = if even x
>                                  then Nothing
>                                  else Just $
>                                        \y -> y ++ "\n" ++ "body: " ++ show x}))
>       foo

> {-
> *CoMenu> fromJust . miAction . rootLabel . head $ renderMenu menuRows bar
> "<div> | 2 | <a href='4/'>4</a> | <a href='8/'>8</a> | <a href='25/'>25</a></div><div> | <a href='2/10/'>10</a> | <a href='2/23/'>23</a></div>\nbody: 11"
> -}

So yeah, comonads in practical day-to-day programming. Not as rare as you would suspect, and occasionally just what the doctor ordered.

Comments (3)

On Monoids

February 14, 2008 at 3:17 pm · Filed under Uncategorized ·Tagged , ,

So HStringTemplate was built around a simple notion: Everything takes an environment, which is a data structure holding attributes and some other good stuff, and eventually returns a string. This was abstracted later on, but we’ll come back to that. Plan text? That returns a string. A reference to an attribute? It returns a string. A nested template? It returns a string. So when we parse/interpret any template, we end up with a list of functions of type Env -> String. Simple enough to get going with.

So how do we execute this template? We need a function of type [Env -> String] -> Env -> String. If we weren’t thinking functionally, we’d have to write a loop. Create an empty string, and for each function in the list, apply it to our environment, append it to the string, and repeat:

function render(template, env) {
	str = "";
	foreach (func in template) {
		str += func(env);
	}
	return str;
}

In functional terms we can write (ignoring stack and efficiency issues) a fold:
render tmp env = foldr (flip (++) . ($ env)) [] tmp

If we think about it a bit, this is actually concat $ map ($env) tmp, or simpler still concatMap ($env) tmp

Step back from the function signature again, and think of it one type at a time and we get an additional abstraction. Instead of ([Env -> String], Env) -> String. we can view it as [Env -> String] -> (Env -> String). But our code doesn’t really represent this, as it explicitly asks for the env parameter. But then again, we could rewrite it as render tmp = \env -> concatMap ($env) tmp, and then pointfreeing the lambda expression we get (tmp >>=) . flip ($) or (concatMap tmp) . flip ($) depending if we want the in this case useless obfuscation of using the list monad.

Good enough, right? Well, imagine that we’ve got our perfect-abstractionometer turned really high for some reason today. There’s a flip and a ($). It looks a bit ugly. It looks a bit obscure. We’ve got compression sure, but not necessarily any more clarity than when we started with. Well, instead of starting from the imperative mindset of how we want this function to work, let’s look at the type signature again and start thinking about what could produce what we’re describing. First, let’s desugar String back to its underlying type, [Char]. That gives us [Env -> [Char]] -> Env -> [Char]. Now since we’re thinking of Env and Char here as abstract atomic types, we can ask, what gives us [a -> [b]] -> a -> [b]? Well, this might be a job for the unwrapped reader monad, since the sequence operation (Monad m => [m a] -> m [a]) resembles what we want. Substitute in (e->) for the m, and we get [e -> a] -> e -> [a], which in our case becomes [Env -> [Char]] -> Env -> [[Char]]. Almost there! Throw in a concat and we get: (concat .) . sequence of type [a -> [b]] -> a -> [b]. And now, not only is our code short, pointfree, and elegant, but it expresses what we wanted all along more clearly than any previous construct.

And yet.. and yet… some nagging bit of our brain says that this isn’t a compound operation, but an elementary one, for a proper algebra. The only question is what that algebra is. Enter monoids. The Data.Monoid library isn’t extensively documented, but the types almost explain themselves. A monoid is about the simplest algebraic structure that one can imagine. In category theory, a monoid can be viewed as a category with one object.

Ok yeah, but what is it? A monoid is a set of elements, an associative binary operator between them, and an identity element. So, you might have a monoid (Integers,+,0) because + is associative between all integers, and X + 0 = X. Integers also give rise to another monoid: (Integers,*,1). And indeed the Sum and Product monoids are both defined in Data.Monoid. We also get other simple ones for booleans. And, of course, we get, for all a, ([a],++,[]). In fact, the list monoid is also known as the free monoid, essentially because, as best I (sorta) understand it, it comes without any constraints. I.e. if for the integers we have [1,4,2,3] we have “1423” (from the monoid on integers derived by turning them to strings and appending them) and we have 24 from the product monoid and we have 10 from the sum monoid and etc. Thus, the free monoid keeps all information that goes into it, and therefore, so to speak freely arises (without constraints) for any set of objects.

What does all this get us? Well, it gets us generality, especially when we throw higher-order functions back in the mix. In particular, we can now notice that Data.Monoid gives us, for instance the monoid of endomorphisms. So we can conceptually “add” (or rather, mappend), for example, a whole set of functions of type “String -> String” into one big “String -> String” function.

Well, that looks helpful, but it’s not exactly what we want. There is, however, an even cooler Monoid: The reader monoid. Monoid b => Monoid (a -> b). Conceptually, there’s only one way its mappend function can work: feed the value a into two functions, yielding two bs. Now, given that these bs are, by definition, Monoids as well, we mappend their results.

Along with mappend, which is the associative element, we of course got mconcat for free, which is defined by default as foldr mappend mempty, and as such is the obvious generalization of concat. So now we can look at the type of mconcat specialized to the reader monoid: Monoid b => [a -> b] -> a -> b. And that, ladies and gentlemen, is what we’ve been looking for all along. (concat .) . sequence becomes simply mconcat! Without a lick of coding on our part.

Oh yeah, here’s the icing: we get an even more general type signature. The function as we initially defined it worked for Strings, and by extension, other lists. But it didn’t work for values of, for example, type ShowS (i.e. String -> String, which is a common hack to avoid stack issues with concatenation by encoding strings as functions). But look! Even if ShowS isn’t a list, it is, after all, an endomorphism! And we know by our discussion above endomorphisms are monoids too. And you know what else is a monoid? Oh yeah, a bytestring! And soforth.

I eventually took this idea even further in the HStringTemplate library, and also found another nice use of monoids that I’ll blog about later. The lesson I got out of this though: sometimes, it turns out the simplest abstractions are the most powerful.

Comments (1)