/dev/collective

This post is literate Haskell

Update: Almost immediately after posting this, I started receiving helpful comments that perhaps introducing multithreading is an overkill here. While I do like the notion of asynchronous message passing via MVars, the comments do have a strong point. Instead of changing the post, and thereby doing the commenters a disservice by invalidating their comments, I just put a non-threaded version of this on gist.github. Indeed, it is simpler than what is found on this page and even a little bit faster :)

I lurk on several mailing lists, one of them being the MochiKit list. One thing recently discussed there is a tool to let users of MochiKit create their own customized version of it. This entails a GUI that allows a user to select which module he or she needs, and the webapp takes care of including all the dependencies as well.

This led me to a fun exercise. Say we have a dependency graph, which by nature must by a directed acyclic graph (DAG), otherwise you could have circular dependencies. Now, if you have N modules with no interdependencies, then there are 2^N possible ways of choosing a subset. However, if you restrict yourself only to those subsets that work, i.e. those where all dependencies of included modules are also included, then that puts a limit on this number.

For example, if you have two modules Base and Sub, and the latter depends on the former, then you would not allow the set containing just Sub. In mathematical terms, you only allow closed subsets of modules, where closed means:

A subset S of modules is closed if and only if the following holds:

• If M is a module in S, and M depends on module P, then P is also in S

MochiKit contains around 15 modules and their dependency graph looks like this:

I wanted to know if it was feasible to pre-generate all legal combinations of modules, and the main factor of that is exactly how many are there. Clearly there are fewer than the roughly 16.000 which there would be if there were no dependencies. Generating all dependency-closed subsets seemed like a very classical graph theoretical problem so someone must have written an algorithm for it. I asked my friend and professor, Magnús Már, for some terms to put into Google. Instead he gave me a hint on how to solve this.

The hint is this: To every closed subset of modules, there is a distinct anti-chain of modules that represents that set. An anti-chain of modules is a collection of modules such that no two depend on each other, neither directly nor indirectly.

For example, say we want the modules Logging, DOM, Style, Selector and Visual. That means we have to take all the modules in the green area below. The anti-chain for this set of modules are the blue modules.

You can see how the set of the blue modules is the smallest set of modules needed to pull in all the modules that we want.

Since there is a one-to-one correspondence between anti-chains and legal subsets, then we need only find the anti-chains and we can generate the subsets.

First some preliminaries,

> module Main where
> 
> import Control.Concurrent (forkIO)
> import Control.Concurrent.MVar
> import Data.Maybe (fromJust)
> import Data.List (nub, intersect)

We then set up our data as a simple list of pairs, where the first element is the module name and the second is a list of its dependencies. This list must be ordered in topological order, meaning that a module may not appear before any of its dependencies. This is easy to do by hand by looking at the above picture.

> dependencies = [
>  ("Base",[]),
>  ("DateTime",["Base"]),
>  ("Format",["Base"]),
>  ("Iter",["Base"]),
>  ("Async",["Base"]),
>  ("DOM",["Base"]),
>  ("Style",["Base"]),
>  ("Color",["DOM", "Style"]),
>  ("Logging",["Base"]),
>  ("LoggingPane",["Logging"]),
>  ("Selector",["DOM", "Style"]),
>  ("Signal",["DOM", "Style"]),
>  ("Visual",["Color"]),
>  ("DragAndDrop",["Iter","Signal","Visual"]),
>  ("Sortable",["DragAndDrop"])
>  ]
> 
> -- For convenience, derive the list of module names 
> modules = map fst dependencies

The first thing we need to do is to generate all anti-chains. We will do this in a dedicated thread and feed the anti-chains as we find them, one by one, on an MVar. Note that the MVar holds a Maybe value, this is so that we can indicate the end by sending Nothing.

The algorithm is simple backtracking through recursion, we start with the empty set which is always an anti-chain. At each step, we do the following.

1. We check if the candidate element is dependent on any element in the anti-chain already. If it is not, we can add it and recurse.

2. Since the anti-chain is still valid without the element, we also recurse on the unchanged anti-chain but discard the candidate element.

The recursion bottoms up when there are no more candidate elements to consider. Note that the topological order of candidates is crucial here.

The helper function accepts determines if a candidate is allowed in a chain. This is simply done by closing the candidate (see later) and seeing if there is an overlap with the current anti-chain.

> antichains :: MVar (Maybe [String]) -> IO ()
> antichains channel = antichains' [] modules >> putMVar channel Nothing
>     where
>       antichains' :: [String] -> [String] -> IO ()
>       antichains' ac [] = putMVar channel (Just ac) >> return ()
>       antichains' ac (candidate:rest) =
>           do if ac `accepts` candidate
>                 then antichains' (candidate:ac) rest
>                 else return ()
>              antichains' ac rest
>       chain `accepts` candidate = null $ intersect (closure [candidate]) chain

Above we mentioned closing a module, or more precisely a set of modules. This means to take a set of modules and adding all modules needed to make it closed with respect to dependencies. This is used both in the accepts helper above but also to map the anti-chains to what we ultimately want, the closed sets.

> closure :: [String] -> [String]
> closure ms = 
>     let missing = nub $ filter (not . flip elem ms) 
>                   $ concatMap (fromJust . flip lookup dependencies) ms
>     in
>       if null missing
>          then ms
>          else closure (ms ++ missing)

The anti-chain generator above feeds the anti-chains to an MVar. The following IO action is run in a second thread and it eats off the anti-chains from the MVar, closes them up and prints. We use a second MVar to notify the main thread when we are done.

> printer :: MVar () -> MVar (Maybe [String]) -> IO ()
> printer stop in_ = 
>     do v <- takeMVar in_
>        case v of
>          Just xs -> putStrLn $ show $ closure xs
>          Nothing -> putMVar stop ()
>        printer stop in_

Finally, to tie it all together, the main action creates the MVars for communication and sparks separate threads for the anti-chain generation and for the printing.

> main :: IO ()
> main = do chan <- newEmptyMVar
>           stop <- newEmptyMVar
>           forkIO $ printer stop chan
>           forkIO $ antichains chan
>           takeMVar stop
>           return ()

That’s it! The result: For the dependency graph of MochiKit above, there are only 817 legal combinations of modules. Actually - 816 if you discount the empty one :)

I’ll leave it up to someone else to answer the original question about feasibility of generating and storing that number of files.

I want to show you a neat trick method when constructing parsers with Haskell and Parsec.

While writing a parser for CCS, a process description language (don’t worry too much about it), I found I needed to parse constructs with a suffix operator. To provide a little context, the relevant grammar is this.

P ::= 0 | a.P | ... | P[f] | P \ S

where … indicates I’ve omitted some irrelevant stuff. Here, P is a process - the entity CCS is meant to describe. a is a so-called action label, just think of it as a generic label. a.P stands for a process that can perform an a action and then become the process specified after the dot. 0 (zero) stands for a special process that cannot do anything, the deadlocked process.

f is a mapping from such labels to labels, called a relabelling and is commonly specified with a list of pairs b/a,d/c,... which indicates that a maps to b, c to d etc. S is a set of such labels, represented in the normal manner with curly braces {a,b,c,...}. The construct P \ S is called a restriction, informally it means P cannot perform any of the actions in S.

In summary,

• a.a.0 is a process that can do two a actions and then stop
• P [b/a] is whatever P is, except any a performed by P will be changed to a b
• P \ {a,b} is whatever P is, except a or b actions are not allowed

Now, [f] and \ S can be considered postfix unary operators on processes, with some additional structure, the f and the S. Since they are postfix there is no need to define their relative precedence, their order is enough. I.e.

a.0 [b/a] \ {b} [d/c,e/d] \ {e,g}

is unambiguous. Our Haskell ADT to represent the abstract syntax tree looks like this,

type Action = String
type Relabeling = Map.Map Action Action
type Restriction = Set.Set Action
 
data Process
    = Null
    | Prefix Action Process
    | ...
    | Relabel Process Relabeling
    | Restrict Process Restriction
    deriving (Eq, Show, Ord)

We want the example above to be parsed into this value (indented for clarity),

Restrict (
    Relabel (
        Restrict (
            Relabel (
                Prefix "a" Null
            ) (Map.fromList [("a","b")])
        ) (Set.fromList ["b"])
    ) (Map.fromList [("c","d"),("d","e")]
) (Set.fromList ["e", "g"])

My initial attempt at writing a parser for these constructs was ugly and complex. I was trying in one rule to parse a bunch of relabellings and restrictions and construct the appropriate value from the process that had already been parsed, cluttering the rules for other constructs with this logic. I thus went to the best documentation of Haskell, the #haskellirc channel, and asked for opinions. Christophe Poucet (vincenz) showed me the light and pointed out that a parser could well return a function,

April 13th, 2008
15:24 < vincenz> Arnar: what about...
15:24 < vincenz> process_adapter :== relabeling | restriction
15:24 < vincenz> and have those return the type
15:24 < vincenz> Process -> Process

And therein lies the trick. Instead of constructing the correct value, I simply parse a sequence of adapters, each of which can be a relabeling or a restriction, in each step returning the function that wraps a process in the relevant constructors.

relabeling :: Parser Relabeling
relabeling = do rs <- brackets $ commaSep1 rename
                return $ Map.fromList rs
                where
                  rename :: Parser (Action,Action)
                  rename = do s1 <- lexeme action
                              symbol "/"
                              s2 <- lexeme action
                              return (s2,s1)
 
restriction :: Parser Restriction
restriction = do symbol "\\"
                 ss <- braces $ commaSep1 action
                 return $ Set.fromList ss
 
process_adapter :: Parser (Process -> Process)
process_adapter = do restr <- restriction
                     return (\p -> Restrict p restr)
                  <|>
                  do rel <- relabeling
                     return (\p -> Relabel p rel)

Very simple, very clean. Now, parsing a process followed by a sequence of such adapters is trivial. We then feed the process through the adapter functions in order, i.e.

adaptedProcess :: Parser Process
adaptedProcess = do p <- simpleProcess
                    adapters <- many process_adapter
                    return $ foldr (flip (.)) id adapters p

I especially like that last line, foldr (flip (.)) id adapters p. Remember adapters has the type [Process -> Process], i.e. a list of adapters. If this list is [f1,f2,...,fN], then

foldr (flip (.)) id adapters

will give us the composition of these in the correct order, namely

\x -> fN ( ... (f2 (f1 (id x))) ...)

All that’s left to do is to apply this on the original process and out pops a correctly wrapped one.

I think this is very neat and it showcases the power of first-class functions. If you don’t see the beauty here, feel absolutely free to write me off as eccentric ;o)

You can find the complete code and a PDF writeup of the CCS project right here.

I love Haskell. I love many things about it, but one of its main attractions for me is that it is lazy. I guess I like that because I’m lazy myself.

Lazyness in Haskell means that we get infinite lists (or streams) for free - i.e. they don’t need any special handling over finite lists. Granted, other languages have infinite lists, but in Haskell any regular list has the natural potential of being infinite so we don’t need any specific syntax or constructors for them.

So, when I read about a Rutgers graduate student named Eric Rowland that recently discovered a simple prime-number generating formula, I decided to try it out in Haskell. Turns out it is extremely simple.

The generating formula is based on the sequence a(n) that you get by setting a(1) = 7 and then for n ≥ 2:

a(n) = a(n-1) + gcd(n,a(n-1))

In Haskell, running in interactive mode (GHCi), we define this by

Prelude> let a' = (1,7) : (map ( \(n,x) -> (n+1, x + (gcd (n+1) x))) a')
Prelude> take 10 a'
[(1,7),(2,8),(3,9),(4,10),(5,15),(6,18),(7,19),(8,20),(9,21),(10,22)]
Prelude> let a = map snd a'
Prelude> take 23 a
[7,8,9,10,15,18,19,20,21,22,33,36,37,38,39,40,41,42,43,44,45,46,69]

Note that each element of a’ is a tuple of the index n and the value a(n). By taking differences between successive values of this sequence, you always get either the number 1 or a prime number (proving this is Rowland’s contribution).

Prelude> let d = zipWith (-) (tail a) a
Prelude> take 23 d
[1,1,1,5,3,1,1,1,1,11,3,1,1,1,1,1,1,1,1,1,1,23,3]

So far, so good. Now in one step we remove the 1-s by using filter and get rid of duplicates by using nub (which is defined in the List module).

Prelude> :m +List
Prelude List> let primes = nub $ filter (/= 1) d
Prelude List> take 23 primes
[5,3,11,23,47,101,7,13,233,467,941,1889,3779,7559,15131,53,30323,60647,121403,242807,19,37,17]

Neat! The list primes is of course infinite and we could pluck the values off it as long as we like, and Haskell’s laziness will make sure values are only computed on demand. Rowland’s paper contains the details of the math.

Note: This post is literate Haskell, you can copy the whole text to a .lhs file and compile it with GHC.

A friend of mine was showing me a very simple and elegant parser for JSON, written in Scala. As an excercise, I decided to write one in Haskell, using the Parsec parser combinator library. Here’s a quick walkthrough.

First we need some imports,

> import qualified Data.Map as Map
> import Control.Monad (liftM)
> import Text.ParserCombinators.Parsec
> import qualified Text.ParserCombinators.Parsec.Token as T
> import Text.ParserCombinators.Parsec.Language

Now, to represent a JSON value, we use an algebraic data type. For simplicity, we’ll only worry about integers and not floating point numbers. The definition of the type is simple, to be concise we use single letter constructor names (not a good idea if you want to publish a proper library).

> data JSON = S String 
>           | I Integer 
>           | B Bool 
>           | L [JSON] 
>           | O (Map.Map String JSON)
>           deriving Show

Now, to make our life somewhat easier, we’ll make use of the facilities in the ParsecToken module. This module provides us with ways to create functions for generic lexers, which deal correctly with whitespace (and comments) in a language. The first step is to create a language definition, in our case it only specifies how JSON comments are delimited. From the definition we create a token parser which we call lexer.

> ldef = emptyDef { commentStart = "/*"
>                 , commentEnd = "*/"
>                 , commentLine = "//"
>                 }
> lexer = T.makeTokenParser ldef

We can now pass lexer to the convenience functions of ParsecToken. As is common with such parsers, we rebind their names in our module to spare us referring to lexer every time we use them.

> symbol        = T.symbol        lexer
> stringLiteral = T.stringLiteral lexer
> integer       = T.integer       lexer
> squares       = T.squares       lexer
> braces        = T.braces        lexer
> commaSep      = T.commaSep      lexer

And now the parser itself. The basic element is a JSON value. From now on I’ll include the type signatures to make things easier to follow, but they are of course not necessary.

> value :: Parser JSON
> value = liftM S stringLiteral
>     <|> liftM I integer
>     <|> liftM B boolean
>     <|> liftM L list
>     <|> liftM O object

A value is simply a choice between each of the basic types, a string, an integer, a boolean, a list of values or an object (which is simply a mapping from strings to values). We defer each to its own parser, and simply lift the value constructors to the parser monad. We get parsing of strings and integers completely for free from the ParsecToken module, but the other three we need to handle ourselves. The boolean case is simple,

> boolean :: Parser Bool
> boolean = do symbol "true"
>              return True
>       <|> do symbol "false"
>              return False

Surprisingly, the list is even simpler, due to the helpers from ParsecToken.

> list :: Parser [JSON]
> list = squares $ commaSep value

Parsing objects is also fairly simple, basically just like list except that instead of parsing a comma seperated list of values, we parse a comma seperated list of key/value pairs. Such a pair is handled by the nested keyValue parser.

> object :: Parser (Map.Map String JSON)
> object = liftM Map.fromList $ braces $ commaSep keyValue
>          where
>              keyValue = do key <- stringLiteral
>                            symbol ":"
>                            val <- value
>                            return (key, val)

And that’s it! To test this easily, we finally add a main action that simply parses a JSON value from standard input.

> main = getContents >>= parseTest value

Testing the parser

A simple test, including a comment in the middle:

arnarb-macbook:tmp arnarb$ runhaskell json.hs 
[1,"two",false,{"one":1, /* a comment here */ "two":2, "list":[]}]
< here I pressed ctrl-d to insert an EOF, rest is output >
L [I 1,S "two",B False,O (fromList [("list",L []),(”one”,I 1),(”two”,I 2)])]

As an more complex test, we run it on the first example from json.org (newlines and indent added to the output for clarity).

arnarb-macbook:tmp arnarb$ runhaskell json.hs 
{
  "glossary": {
    "title": "example glossary",
    "GlossDiv": {
      "title": "S",
      "GlossList": {
        "GlossEntry": {
          "ID": "SGML",
          "SortAs": "SGML",
          "GlossTerm": "Standard Generalized Markup Language",
          "Acronym": "SGML",
          "Abbrev": "ISO 8879:1986",
          "GlossDef": {
            "para": "A meta-markup language, used to create markup languages such as DocBook.",
            "GlossSeeAlso": ["GML", "XML"]
          },
          “GlossSee”: “markup”
        }
      }
    }
  }
}
< here I pressed ctrl-d to insert an EOF, rest is output >
O (fromList [
    ("glossary",O (fromList [
        ("GlossDiv",O (fromList [
            ("GlossList",O (fromList [
                ("GlossEntry",O (fromList [
                    ("Abbrev",S "ISO 8879:1986"),
                    ("Acronym",S "SGML"),
                    ("GlossDef",O (fromList [
                        ("GlossSeeAlso",L [S "GML",S "XML"]),
                        (”para”,S “A meta-markup language, used to create markup languages such as DocBook.”)
                    ])),
                    (”GlossSee”,S “markup”),
                    (”GlossTerm”,S “Standard Generalized Markup Language”),
                    (”ID”,S “SGML”),
                    (”SortAs”,S “SGML”)
                ]))
            ])),
            (”title”,S “S”)
        ])),
        (”title”,S “example glossary”)
    ]))
])

Finally, we should note that many people have done this before :)

Edits:

• Added link to Scala version.
• Small revisisons, thanks to kpreid on #haskell for pointing out braces and squares.
• Stop lugging lexer around, thanks to Paczesiowa on reddit for useful suggestions.