Mad science, abstract data types, and objects

Mad science, and mad scientists, are always good to find. They represent guaranteed entertainment. But they do show up in the oddest places. How about this one: OOPSLA 2009, William Cook presents a talk entitled "No one listened! But I'll show them, I'll show them all!". And the weird part was, nobody noticed. Well, sure, it's actually a popular paper that gets referenced frequently and the title is really "On Understanding Data Abstraction, Revisited", but there's no real sign that the peasants went scurrying for their pitchforks and torches.

William Cook

So, what's the deal with Cook and his paper?

A little backstory

In 1990, Cook published "Object-Oriented Programming Versus Abstract Data Types" which is almost identical in content to, but somewhat longer than, "On Understanding Data Abstraction, Revisited". In both papers Cook describes the long-established, but little known, difference between objects and abstract data types. (For simplicity, the object-oriented side is limited to a subset of what I learned to call "object-based programming"; objects, as you might normally think of them, minus inheritance and also without modifications.)

Given those limitations, objects are data abstractions that "have a collection of methods, or procedures, that share access to private local state." Consider the type specimen of object-oriented programming: Smalltalk. In Smalltalk, objects have internal fields that contain the object's state, but this state is entirely unavailable to the outside world. Instead the object has a collection of messages that it responds to, exposing information potentially based on its internal state as necessary. Once an object is created, it is entirely encapsulated, isolated from any other code than that implementing its behavior. Because the interface of the data abstraction is the methods exposed by the object, Cook identifies objects as procedural data abstractions. The key feature of an object is that its interface is defined by its constructor: the collection of methods the object responds to and the semantics of those methods are defined by the construction of the object. In a sense, those methods are associated with the specific value or instance.

Abstract data types, on the other hand, have "a public name, a hidden representation, and operations to create, combine, and observe values of the abstraction." The classic examples of them are the primitive types in Java, C++, or most other common languages. A value has a defined type name, say "double", some representation (Do you really know, or care, what a double actually looks like? (Note: You should. Floating point numbers are a notoriously leaky abstraction.)), and operations like reading one or converting one from some other representation, adding or subtracting two of them, and converting one to another representation, such as a string of characters. The key feature of an ADT is that its interface is defined by a collection of operations that apply to a specific type.

	Constructors
Observations	[]	::
empty?	true	false
head	error	value

Let's say we create a matrix of operations on a data abstraction. My data abstraction is a list; it has two constructors, the Haskell-like "[]", or nil, building an empty list, and "::" or "cons", representing a constructor that takes a new element and an existing list and produces a new, combined list with the new element at the head. The list also has two "observation" operations, empty? which returns true for an empty list and false otherwise, and head, which produces some kind of error on an empty list, but returns the first value in the list otherwise. (This example is taken directly from "OOP Versus ADT".)

	Constructors
Observations	[]	::
empty?	true	false
head	error	value

Object-oriented

Suppose I want to create an object-oriented version of this data abstraction. I would divide up the operations by constructor, so that I had an implementation of empty? and head for an empty list and empty? and head for a cons cell. The details of each operation is divided among the objects created by each specific constructor. Adding a new constructor is easy, since it simply requires providing implementations of the observations on the new object. On the other hand, adding a new observation is difficult, since it requires modifying all of the existing constructors. This should sound familiar to anyone who has written code in almost any object oriented language.

	Constructors
Observations	[]	::
empty?	true	false
head	error	value

ADT

On the other hand, suppose I want an ADT version of this data abstraction. In this case, I would divide the operations by observation, so that I had an implementation of empty? and head that each covered all of the constructors. The details of each constructor is spread among the observation implementations. Adding new observation is easy; it just has to handle the individual cases of the constructors. Adding a new constructor is hard, though, because every observation needs to be modified. This option should be familiar to anyone who has used ML or Haskell, since it is how their algebraic data types work.

There are some less obvious consequences to these two styles of data abstraction. For one thing, the two approaches are almost duals; the advantages of one are the weaknesses of the other, and vice-versa. Both approaches do, in fact, provide data abstraction; objects by encapsulating the state of the data instance behind procedural abstractions, ADTs by encapsulating that state behind a type boundary. Both also describe (if you squint a bit) common data abstraction patterns. On the other hand, each approach has some peculiarities: because an object only has access to its own state, complex operations require weakening the encapsulation of objects. Cook calls "an operation 'complex' if it inspects multiple representations," like for example equality testing; I may not want to expose all of the implementation information necessary to compare two instances in the methods that an object responds to, yet I have no other option in order to implement some observations. Cook claims that object oriented, procedural abstractions are possible in dynamically typed languages but ADTs are not; "abstract data types depend upon a static type system to enforce type abstraction. It is not an accident that dynamic languages use objects instead of user-defined abstract data types. Dynamic languages typically support built-in abstract data types for primitive types; the type abstraction here is enforced by the runtime system."

I do not doubt the validity of this deconstruction of objects and abstract data types, if for no other reason than that it exactly covers Philip Wadler's "expression problem". Also, both ideas seem pretty productive, which is always the primary test of science on the hoof. If that was all there was to it, there would be no mad science involved.

The mad science part

Mad Science Tip #1: If you have to repeat the same message over 20 years, and no one seems to be listening to you, they're the crazy ones. They're the ones who don't see.

Mad Science Tip #2: A beautiful theory, one that explains everything, is obviously true. Even if reality doesn't seem to particularly agree. The ADT half of Cook's papers seems to be relatively uncontroversial, perhaps because no one actually uses the languages (like ML and Haskell) that have user-defined ADTs as the primary data abstraction scheme. On the other hand, Cook's minor point about the inability to use ADTs in dynamically typed languages doesn't seem particularly, well, true; most Lisps, for example, allow you to define structures (or write macros to build such structures) that have representations hidden from any functions other than a limited group. Such pseudo-ADTs may not be as encapsulated as Cook would like, but coupled with a common coding style rule, say "Don't do stupid things," they work well enough. Objects, likewise, do not actually seem to exist. It's been too long since I last used Smalltalk, but every other "object-oriented" language allows a method in a class to access the internals of more than one object of the same class, neatly avoiding (some cases of) the "complex" operation issue. (To avoid all of the difficulties presented by complex operations requires something like multimethods or other techniques that are even more rare.) Maybe some of the object systems for Scheme satisfy the requirements for objects, but Scheme doesn't have a standard anything, much less an object system; it is a toolkit for implementing other languages. Further, Cook's ideas on actually doing object-oriented programming in Java would likely horrify most Java-istas, even those that love interfaces as much as I do.

Mad Science Tip #3: You get extra points for hosting dinner parties where you torment your rivals.

What is the relationship between objects and abstract data types (ADTs)? I have asked this question to many groups of computer scientists over the last 20 years. I usually ask it at dinner, or over drinks. The typical response is a variant of “objects are a kind of abstract data type”.

Whereupon he goes all maniacal on them.

Last and possibly least, Mad Science Tip #4: Being a mad scientist is fun; you get to meet interesting people, there's nothing like the je ne sais quoi of carving your name in the moon with a giant laser. (For that matter, giant lasers are just plain cool no matter what you do with them.) But it may have detrimental effects on your social life.

Most groups eventually work through the differences between objects and ADTs, but I can tell they walk away feeling uneasy, as if some familiar signposts now point in different directions.

...or perhaps as if they're just glad to get away with all the right number of appendages.

Now, I'm not saying William Cook is going to destroy the world if Java 8 doesn't get objects right. But if you see him being followed by a giant tongue monster or psychopathic, hyper-intelligent gerbils, don't say I didn't warn you.

Equational programming

It is Christmas and Dr. McGuire is too busy watching snow fall to come up with a real post, so he is just rehashing a reply to a question on the haskell-beginners mailing list as if it were new. Typical.

Jun HU wrote:

My first language is C, and I've strong intention in learning a pure functional programming language. My very first question is how to think in the functional programming way, anyone has some ideas.

I cannot claim C as my first language, but I do say it is my "natural" language; I have written more code in C than I have in any other, and I've been using it for nigh on 20 years. I also cannot claim to think in the functional programming way, but using O'Caml and Haskell has definitely changed how I program in any language. In fact, I suspect functional programming has had a bigger effect than I had previously considered. But I am definitely not a Haskell guru.

I believe the biggest difference between functional and procedural programming is thinking equationally rather than operationally. With procedural programming as in C (and most object oriented languages, which in my experience are more procedural than not), the tendency is to think operationally: "First the program does this, then that happens, then that,...." Now, back at UT Austin (I grew up in the land of Dijkstra), at the time anyway, they were fond of teaching axiomatic thinking: "At this point in the program text, the state is this; at that point in the text, the state is that...." That is definitely a significant improvement, and I attribute what decent code I have written to that approach, but it definitely is not as natural as either operational or equational thinking.

Thinking operationally (or "pretending to be the computer") is problematic because there are typically an exponential number of paths through a program. As a result, it is impossible to completely understand even middling small program. Further, operational approaches provide no particularly good strategies for developing programs.

If you can get past the initial visceral revulsion at the thought of proving programs correct (Horrors!), thinking axiomatically has significant benefits. On one hand, it reduces the exponential number of paths through the program to a linear number of positions in the program text. For example, if you have a block of program text s which, in a program state p is guaranteed to arrive at another state q, and likewise program text t going from q to r, then you have s;t going from p to r; it doesn't matter what happens in the middle. Further, axiomatic thinking does provide some guidance to writing code: if you think you need a conditional statement, then you want to go from p to some narrow, definite state q; if you need a loop, then you can look for an invariant and a termination condition. Not easy, but there is something

On the other hand, in functional languages (and also when taking functional approaches in a non-functional language), it is very important to think equationally: "This means that; this other thing is that...." This is especially true in Haskell, which is not strict; if you try to think operationally or even axiomatically, you run into difficulties when the state of a non-strict program does not resemble the state of a strict program.

Equational thinking completely does away with the "number of paths" argument. A functional definition is, or should be, small enough to understand directly, based on any underlying definitions. Further, because the state does not change (in operational terms, or equivalently in axiomatic terms, there is only one state), it becomes less important to manipulate the program as a whole. Instead each definition can be dealt with separately.

Now, equational thinking is easy for stuff like

\[\textbf{add_one}\ n = n + 1\]

But it is not immediately apparent how that extends to something that needs recursion, say. The big "Ah-ha!" moment for me was the realization that recursion and mathematical induction are the same thing (ok, it's not a surprise for anyone; the big deal was when I internalized it enough to use the idea to naturally write code). With that, you can deal with anything programmatically equational and recursive as mathematically equational and inductive. The change in thinking is as big as the difference between operational and axiomatic.

Equational thinking extends beyond basic function definitions; I think it is the key to the type system, classes, and most of the other neat language features. At this point, I am still struggling with category theory, although I have been able to make use of monads reasonably elegantly (in my (humble) opinion, of course). I think there is another step there, although I haven't made it.

This is all rather fuzzy and exceptionally difficult to put into words. However, I am willing to change my traditional definition, Programming is applied formal logic, to include at least abstract algebra and category theory at this point, though.

Variations on the theme of monadic regular expressions: Back references

Adding the capability of matching previously-matched input, or back references, completely changes the power of a regular expression engine. In fact, as a result the engine is strictly more powerful than the class of regular expressions. The key reason why is that back references add a storage capability.

This module reinforces that key difference by showing an implementation of a monadic regular expression engine that includes back references, by building on the previous Pattern module and by explicitly implementing the state.

> module BackrefPattern (PatternState, newState, matched, remain,
>                        Pattern, runPattern', runPattern, done, end,
>                        any, litc, lits, cls, ncls, seq, or, kst,
>                        stor, ref) where
> 
> import qualified Pattern as P
> import qualified Data.Map as M
> import qualified List as L
> import Prelude hiding (or,seq,any)
> import Control.Monad.State

The storage facility is represented by the bak element of this module's PatternState record. The bak element is a mapping from integers to strings, where the integer is the "number" of the reference and the string is the previously matched text. The cur element is used to record the number of matching references the engine has seen.

This module does not implement most of the regular expression combinators. Instead, it uses the previous Pattern module, and thus incorporates that module's state, in the form of the st :: P.PatternState element.

> data PatternState = PS {
>       cur :: Int,
>       bak :: M.Map Int String,
>       st :: P.PatternState
>     } deriving Show

The newstate function is a utility used to simplify constructing a PatternState value.

> newState :: String -> PatternState
> newState str = PS { cur = 0, bak = M.empty, st = P.newState str }

The matched and remain functions make accessing the elements of the st element easier, in effect flattening the accessors to the contained record. An alternative way of looking at this is that the lower-level P.matched and P.remain functions are lifted into this module by first applying the st accessor to get the lower-level state.

> matched, remain :: PatternState -> String
> matched = P.matched . st
> remain  = P.remain  . st

The next declaration is where things get exciting.

Heretofore, the regular expression engines have passed their own states around directly, which works acceptibly becaues those states are relatively simple. With the addition of the new state elements, I thought it worthwhile to add a State monad, which controls access to the PatternState while the engine is being evaluated.

In fact, since this engine is based on the lower-level monad m, I use the StateT monad transformer. Monad transformers act as "layerable" monads: a transformer applied to an underlying monad based on the underlying monad but adding the new capabilities of the transformer.

StateT is a transformer which adds a modifyable state to the computation. Picking apart the type declaration below, StateT s m a is a monad transformer, carrying a state of type s through its computation. m is the type of the underlying monad, and a is the result of the current computation. (For example, in the IO monad, the getChar function has the type IO Char; Char is the type of the result of a getChar computation.) In this case, the state is a PatternState and the result of the computations will always be (). (All of the information necessary for regular expression matching is carried through the PatternState.)

> type Pattern m = StateT PatternState m ()

The runPattern' function is similar to the similarly named function in the Pattern module. In this case, the StateT monad transformer provides a runStateT function, which accepts a Pattern m and an initial PatternState and which executes the computation described by the Pattern m in a similar way to the use of runPattern' in the Pattern module, In that case, runPattern' exposed the function contained in the P.Pattern value and subsequently applied it to an initial P.PatternState value. In this module, runStateT works similarly (if I understand it correctly) and returns a value of the form m ((), PatternState); that value is then forwarded to the second expression in runPattern', which discards the unnecessary ().

> runPattern' :: Monad m => Pattern m -> PatternState -> m PatternState
> runPattern' pat ps = runStateT pat ps >>= return . snd

The runPattern function is a utility which constructs an initial PatternState from the input String and then calls runPattern'. It forms the basic interface to this regular expression engine.

> runPattern :: Monad m => Pattern m -> String -> m PatternState
> runPattern pat = runPattern' pat . newState

The following collection of functions implement the base combinators of the regular expression engine. They do it by lifting the corresponding function from the Pattern module into this module. The idea of lifting a function from one computational context into another is very important, particularly when dealing with monad transformers. Since transformers organize monads into layers, operations in the lower-level monad must be lifted into the higher-level layer in order to be used there. For more examples of monad transformer layers and lifting and the hideous, hideous code needed (in addition to the boilerplate pasted over records), see Chapter 7 and Chapter 8 of Software Tools in Haskell. You'll probably regret it.

> done, end, any :: MonadPlus m => Pattern m
> done = runP P.done
> end  = runP P.end
> any  = runP P.any
> 
> litc :: MonadPlus m => Char -> Pattern m
> litc c = runP $ P.litc c
> 
> lits :: MonadPlus m => String -> Pattern m
> lits c = runP $ P.lits c
> 
> cls, ncls :: MonadPlus m => String -> Pattern m
> cls  set = runP $ P.cls set
> ncls set = runP $ P.ncls set

The actual lifting is done by the runP function. This function takes a pattern combinator from the Pattern module and uses it to create a Pattern in this module with similar behavior. The actual definition of runP below is a bit of a one-liner, but it expands into the following function:

-- runP pat = do
--   pps <- gets st
--   pps' <- P.runPattern' pat pps
--   modify (\ps -> ps { st = pps' })

The basic idea is that the current lower-level engine state, pps (think, P.ps), is recovered from the StateT, then this lower-level state is used to run the lower-level pattern, creating a new lower-level state, pps'. The new lower-level state is then injected into the PatternState maintained by StateT.

The one-line version is:

> runP pat = gets st >>= P.runPattern' pat >>= \pps' -> modify $ \ps -> ps { st = pps' }

I would like to provide a type for runP, really I would. In fact, I would like to provide this type for it:

-- runP :: MonadPlus m => P.Pattern m -> Pattern m

Unfortunately, that type makes ghc unhappy:

Occurs check: cannot construct the infinite type:
      m = StateT PatternState m
    When generalising the type(s) for `runP'

That is, in spite of the fact that runP acts as if it had that type.

According to ghci, runP actually has the type:

-- runP :: MonadState PatternState m => P.Pattern m -> m ()

which seems to be to be very wrong. As if to complete my confusion, ghc returns the following error. (I chose not to use any extensions to Haskell, so I do not know what would happen if I used -XFlexibleContexts.)

Non type-variable argument
      in the constraint: MonadState PatternState m
    (Use -XFlexibleContexts to permit this)
    In the type signature for `runP':
      runP :: (MonadState PatternState m) => P.Pattern m -> m ()

If anyone can help resolve my confusion, I would greatly appreciate it.

Fortunately, runP works even if I am not sure why.

The remainder of the regular expression combinators are more straightforward to implement directly.

> seq :: Monad m => Pattern m -> Pattern m -> Pattern m
> seq p1 p2 = p1 >> p2
> 
> or :: MonadPlus m => Pattern m -> Pattern m -> Pattern m
> or p1 p2 = p1 `mplus` p2
> 
> kst :: MonadPlus m => Pattern m -> Pattern m
> kst p = (p `seq` (kst p)) `or` done

We are now getting to the meat of this module. In addition to the normal regular expression combinators, it adds stor and ref. The stor function is similar to kst in that it takes as an argument a Pattern m and produces another Pattern m. When evaluated, stor runs its contained pattern and, if the pattern matches, stores the matched text in the bak map under the next back reference number.

Specifically, it increments cur, reserving a position in the map. Then, it runs the pattern with a new lower-level state. When the runPattern completes, the matched text will be the text to record; this is safe because the matched text is not relevant to the behavior of the pattern on the input. Finally, it records the matched text and new lower-level state via put.

> stor p = do
>   modify $ \ ps -> ps { cur = (cur ps) + 1 }
>   ps <- get
>   ps' <- runPattern' p $ ps { st = P.newState (remain ps) }
>   put $ ps {
>             bak = M.insert (cur ps) (matched ps') (bak ps'),
>             st = P.PS ((matched ps) ++ (matched ps')) (remain ps')
>           }

The implementation of stor as a combinator causes a bit of odd behavior. Consider the regular expression "((a)*)", or as represented by combinators, "stor (kst (stor (litc 'a')))", on the string "aa"; most engines would produce two mappings, { 1 => "aa", 2 => "a" }. This engine will potentially produce three: { 1 => "aa", 2 => "a", 3 => "a" }. The 1 value represents the outer stor matching a*, and the 2 represents the inner stor matching against the first a, while the 3 represents the inner stor matching against the second a. Bizzare, but probably fixable.

stor, however, has two bigger issues: first, like runP, it doesn't type right, and second, it does not correctly backtrack unless m is the List monad.

First, the type I would like to assing to stor is Monad m => Pattern m -> Pattern m; the type that ghci gives it is (MonadState PatternState m) => Pattern m -> m ().

Second, stor does not actually backtrack at all. If the lower-level monad m is Maybe then this function runs normally, recording the first text matched by the pattern p. If subsequent combinators fail, the recorded text is never revised, meaning that a PatternState which could succeed is never examined. Fortunately, everything works correctly if the lower-level monad is List.

*BackrefPattern> runPattern (stor (kst $ litc 'a') `seq` (ref 1) `seq` end) "aa" :: Maybe PatternState
Nothing
*BackrefPattern> runPattern (stor (kst $ litc 'a') `seq` (ref 1) `seq` end) "aa" :: [PatternState]
[PS {cur = 1, bak = fromList [(1,"a")], st = PS {matched = "aa", remain = ""}}]

The ref combinator, on the other hand, is fairly simple and acts much like the lits combinator.

> ref :: MonadPlus m => Int -> Pattern m
> ref n = do
>   ps <- get
>   r <- gets remain
>   m <- gets matched
>   case M.lookup n (bak ps) of
>     Nothing -> mzero
>     Just s | s `L.isPrefixOf` r -> put $ ps { st = P.PS (m ++ s) (drop (length s) r) }
>            | otherwise -> mzero

Now, for the real reason I did this, and the reason the bugs and type issues don't matter: the world's most (maybe) inefficient primality test (described in Avinash Meetoo: Blog and in detail in Perl tricks by Neil Kandalgaonkar and originally seen in Ruby).

The plu combinator is the + regular expression special character: it causes the pattern to match one or more times, rather than kst's zero or more times. The opt combinator is the ? special character, which matches zero or one times.

> plu :: MonadPlus m => Pattern m -> Pattern m
> plu pat = pat `seq` (kst pat)
> 
> opt :: MonadPlus m => Pattern m -> Pattern m
> opt pat = pat `or` done

The one function is a Pattern matching a literal '1'.

> one :: MonadPlus m => Pattern m
> one = litc '1'

The primePattern is the regular expression that will check if a number is prime or not.

> primePattern :: MonadPlus m => Pattern m
> primePattern = ((opt (litc '1')) `or` (stor (one `seq` (plu one))) `seq` (plu (ref 1))) `seq` end

isPrime attempts to match the primePattern against a sequence of n '1' characters. If it matches, n is not prime, otherwise n is prime. Yay!

> isPrime n = null $ runPattern primePattern sequence
>     where
>       sequence = replicate n '1'

In practice:

*BackrefPattern> take 10 $ filter isPrime [0..]
[2,3,5,7,11,13,17,19,23,29]

Seems pretty snappy until I get up to 650 or so. The non-greedy version of kst might be useful.

But no! This is the last post on monadic regular expressions for a while! Really! Something completely different, if not more interesting, is coming.

Variations on the theme of monadic regular expressions: Records

Like the previous very abstract pattern module, this implementation of a regular expression engine has very little reason to exist. Mostly it demonstrates the use of Haskell records rather than the pair (of Strings and other things) used in previous versions. As it turns out, I do not particularly like the record syntax, for reasons that should become clear as I go through this monstrosity.

However, this module is used as the basis of the next version, which provides back-references in patterns, making that module strictly stronger than typical regular expressions. Since that version uses records and is considerably more complex, it seemed like a good idea to start simpler here.

> module Pattern (PatternState(PS), newState, remain, matched,
>                 Pattern, runPattern, runPattern', any, end, done,
>                 litc, lits, cls, ncls, seq, or, kst) where
> 
> import Prelude hiding (or,seq,length,drop,elem,any)
> import qualified List as L
> import Control.Monad
> import Control.Monad.State

A PatternState replaces the pair. Although this example is isomorphic to the pair and obviously gratuitous, records in general are useful to bind together more elements than a tuple could reasonably manage.

Records in Haskell are very similar to tuples: they contain a fixed number of values of any type, where the types within a given tuple are heterogeneous. To access the elements of the record, it generates accessor functions named after the record elements. These functions take a record value and project out the element value corresponding to the function name. In this case, since both elements are Strings, the two functions are, effectively,

matched :: PatternState -> String
remain :: PatternState -> String

Records are always immediately preceded by a type constructor, in this case PS. In fact, the record is tightly connected to the type constructor, which has a type of String -> String -> PatternState.

In the case of records, there is an alternative syntax to construct a value:

PS { matched = "abc", remain = "def" }

This syntax, like records themselves, is more applicable when there are many fields in the record. I have generally used the function syntax to create PatternState values because it is marginally shorter in this instance.

Updates are the other record peculiarity. ("Update" is perhaps a misnomer since these records are purely functional.) Rather than actually updating a record value, the idea is to create a new record value, based on an existing value with specified differences. The syntax is:

ps { matched = "ghi" }

where ps is an existing PatternState value.

> data PatternState = PS { matched :: String, remain :: String } deriving Show

The next few functions are utilities for PatternState values.

• newState creates a PatternState from a String.
• empty is a predicate which is true when all of the input text has been matched.
• next returns the next character in the input. It is not total, and unsafe to use if the PatternState is empty.
• advance moves the first character from the input to the end of the matched string. It to is not total
• advanceN does the same for n characters.

> newState :: String -> PatternState
> newState str = PS "" str
> 
> empty :: PatternState -> Bool
> empty ps = remain ps == ""
> 
> next :: PatternState -> Char
> next ps = head $ remain ps
> 
> advance :: PatternState -> PatternState
> advance ps = PS ((matched ps) ++ [h]) t
>     where
>       (h:t) = remain ps
> 
> advanceN :: PatternState -> Int -> PatternState
> advanceN ps n = PS ((matched ps) ++ pre) suf
>     where
>       (pre,suf) = splitAt n $ remain ps

If you followed the discussion of records, you know how the Pattern extractor thing works. P is a type constructor that takes a function PatternState -> m PatternState (where m will be the underlying monad) and produces a Pattern. runPattern' is a function taking a Pattern and returning the original function, which can be applied to evaluate the pattern.

> newtype Pattern m = P { runPattern' :: PatternState -> m PatternState }

The function runPattern is a utility that constructs an initial PatternState and then executes the given Pattern.

> runPattern :: Pattern m -> String -> m PatternState
> runPattern pat s = runPattern' pat $ PS "" s

Because it is a very common operation in the pattern combinators below, madvance is separated out as a function. It calls advance on a PatternState and then returns the PatternState into the monad m.

> madvance :: Monad m => PatternState -> m PatternState
> madvance = return . advance

The majority of the combinators are very similar to their previous incarnations, with the exception that these functions do not use pattern matching to deconstruct their inputs but instead use the record and utility functions from above.

> done :: (Monad m) => Pattern m
> done = P return
>
> end :: (MonadPlus m) => Pattern m
> end = P $ \ps -> if empty ps then return ps else mzero
>
> any :: (MonadPlus m) => Pattern m
> any = P $ \ps -> if empty ps then mzero else madvance ps
> 
> litc :: (MonadPlus m) => Char -> Pattern m
> litc c = P $ \ps -> if empty ps || (next ps) /= c then mzero else madvance ps
> 
> lits :: (MonadPlus m) => String -> Pattern m
> lits s = P $ \ps -> if empty ps || not (s `L.isPrefixOf` (remain ps))
>                        then mzero
>                        else return $ advanceN ps (L.length s)
> 
> cls :: (MonadPlus m) => String -> Pattern m
> cls set = P $ \ps -> if empty ps || not ((next ps) `L.elem` set)
>                         then mzero
>                         else madvance ps
> 
> ncls :: (MonadPlus m) => String -> Pattern m
> ncls set = P $ \ps -> if empty ps || (next ps) `L.elem` set
>                          then mzero
>                          else madvance ps

On the other hand, the combining operations, seq, or, and kst, are almost identical to their corresponding previous versions.

> seq :: (Monad m) => Pattern m -> Pattern m -> Pattern m
> seq p1 p2 = P $ \ps -> runPattern' p1 ps >>= runPattern' p2
> 
> or :: (MonadPlus m) => Pattern m -> Pattern m -> Pattern m
> or p1 p2 = P $ \ps -> (runPattern' p1 ps) `mplus` (runPattern' p2 ps)
> 
> kst :: MonadPlus m => Pattern m -> Pattern m
> kst p = (p `seq` (kst p)) `or` done

The resulting engine runs as expected. Yay.

*Pattern> runPattern done "abc" :: [PatternState]
[PS {matched = "", remain = "abc"}]
*Pattern> runPattern end "abc" :: [PatternState]
[]
*Pattern> runPattern end "" :: [PatternState]
[PS {matched = "", remain = ""}]
*Pattern> runPattern (litc 'a') "" :: [PatternState]
[]
*Pattern> runPattern (litc 'a') "a" :: [PatternState]
[PS {matched = "a", remain = ""}]
*Pattern> runPattern (litc 'a') "b" :: [PatternState]
[]
*Pattern> runPattern ((litc 'a') `seq` (litc 'b')) "b" :: [PatternState]
[]
*Pattern> runPattern ((litc 'a') `seq` (litc 'b')) "a" :: [PatternState]
[]
*Pattern> runPattern ((litc 'a') `seq` (litc 'b')) "ab" :: [PatternState]
[PS {matched = "ab", remain = ""}]
*Pattern> runPattern ((litc 'a') `or` (litc 'b')) "b" :: [PatternState]
[PS {matched = "b", remain = ""}]
*Pattern> runPattern ((litc 'a') `or` (litc 'b')) "a" :: [PatternState]
[PS {matched = "a", remain = ""}]
*Pattern> runPattern ((litc 'a') `or` (litc 'b')) "ab" :: [PatternState]
[PS {matched = "a", remain = "b"}]
*Pattern> runPattern (kst (litc 'a')) "b" :: [PatternState]
[PS {matched = "", remain = "b"}]
*Pattern> runPattern (kst (litc 'a')) "ab" :: [PatternState]
[PS {matched = "a", remain = "b"},PS {matched = "", remain = "ab"}]
*Pattern> runPattern (kst (litc 'a')) "aab" :: [PatternState]
[PS {matched = "aa", remain = "b"},PS {matched = "a", remain = "ab"},PS {matched = "", remain = "aab"}]

Variations on the theme of monadic regular expressions: Abstraction

Regular expressions are a more general tool than appears in normal usage. They can be used to specify any finite state machine, although without extensions to the expressions such machines would have no visible behavior beyond accepting or rejecting. (They're also both a floor wax and a dessert topping, but are artificial whipped cream and a some kind of very lame floor wax, if such a thing is possible.)

In any case, it might be useful to have a regular expression engine that can operate on different collections than Haskell's List and on elements of a different type than Char. (In Haskell, a String is a List of Char's.) That is the purpose of this variation on the monadic regular expression engine.

> module AbstractEngine where
> 
> import Prelude hiding (or,seq,length,drop,elem)
> import Control.Monad
> import List as L hiding (or,drop,elem)

In addition to the underlying monad and the base element type, the Pattern type must be parameterized by the type of the collection of elements, s. As with the previous iteration, the two elements of the pair are the previously matched text and the yet-to-be-examined text.

> newtype Pattern m s a = P { runPattern :: (s a, s a) -> m (s a, s a) }

Most of the regular expression operations are very similar to their counterparts in the previous version. Certainly, done is.

> done :: Monad m => Pattern m s a
> done = P return

The end function is different in two respects. First, it adds a type class, Q, which must be instanced by the collection s. Second, instead of using pattern matching to examine the state of the input, it uses the isEmpty predicate, part of the Q type class.

> end :: (Q s, MonadPlus m) => Pattern m s a
> end = P $ \ (m,e) -> if isEmpty e then return (m,e) else mzero

Likewise, any uses the isEmpty predicate in addition to the deq function to decompose the input and the enq function to re-compose the matched output. The next function, lit, adds prefix, append, drop, and len.

> any :: (Q s, MonadPlus m) => Pattern m s a
> any = P $ \ (m,s) -> let (hd,tl) = deq s in
>                          if isEmpty s then mzero else return (m `enq` hd, tl)
> 
> lit :: (MonadPlus m, Q s, Eq a) => s a -> Pattern m s a
> lit l = P $ \ (m,s) -> if l `prefix` s then return (m `append` l, drop (len l) s) else mzero

The cls and ncls functions are made up of a plethora of functions from the Q type class. Part of the reason is that, for simplicity, I chose to represent the set arguments to cls and ncls as values of the type of the collections.

> cls :: (Q s, MonadPlus m, Eq a) => s a -> Pattern m s a
> cls set = P cls'
>     where
>       cls' (m,s) | (isEmpty s) || not (hd `elem` set)  = mzero
>                  | otherwise                           = return (m `enq` hd, tl)
>                  where
>                    (hd,tl) = deq s
> 
> ncls :: (Q s, MonadPlus m, Eq a) => s a -> Pattern m s a
> ncls set = P ncls'
>     where
>       ncls' (m,s) | (isEmpty s) || (hd `elem` set)  = mzero
>                   | otherwise                       = return (m `enq` hd, tl)
>                  where
>                    (hd,tl) = deq s

The seq, or, and kst combinators are identical to the previous version, with the exception of the additional type parameter.

> seq :: Monad m => Pattern m s a -> Pattern m s a -> Pattern m s a
> seq p1 p2 = P $ \ cur -> runPattern p1 cur >>= runPattern p2
> 
> or :: MonadPlus m => Pattern m s a -> Pattern m s a -> Pattern m s a
> or p1 p2 = P $ \ cur -> (runPattern p1 cur) `mplus` (runPattern p2 cur)
> 
> kst :: MonadPlus m => Pattern m s a -> Pattern m s a
> kst p = (p `seq` (kst p)) `or` done

The type class Q is the key to this version of the regular expression engine. Q is used as a constraint on the collection type of the input, and is named somewhat appropriately, Any instance of this class must supply the basic functions isEmpty, enq, and deq.

• isEmpty is a simple predicate, true if the collection has no contents and false otherwise.,/li>
• enq takes a collection and an additional element and adds the element to the end of the collection.
• deq takes a collection and decomposes it into the first element and the remainder of the collection. This function will always be called safely (in some cases by the magic of lazy evaluation).

> class Q s where
>     isEmpty :: s a -> Bool
>     enq     :: s a -> a -> s a
>     deq     :: s a -> (a, s a)

The remaining functions in the type class are provided with implementations based on the previous functions. For the most part, they are fairly simple exercises in basic Haskell, if of limited style, given their reliance on only the three base Q functions.

>     len :: s a -> Int
>     len s | isEmpty s  = 0
>           | otherwise  = 1 + (len tl)
>           where
>           (_,tl) = deq s
> 
>     prefix :: Eq a => s a -> s a -> Bool
>     prefix s t | isEmpty s   = True
>                | isEmpty t   = False
>                | hds == hdt  = prefix tls tlt
>                | otherwise   = False
>                where
>                (hds, tls) = deq s
>                (hdt, tlt) = deq t
> 
>     drop :: Int -> s a -> s a
>     drop 0 s = s
>     drop i s = let (_,tl) = deq s in
>                    if isEmpty s then s else drop (i-1) tl
> 
>     elem :: Eq a => a -> s a -> Bool
>     elem a set | isEmpty set  = False
>                | a == elt     = True
>                | otherwise    = elem a rem
>                where
>                (elt,rem) = deq set
> 
>     append :: s a -> s a -> s a
>     append s t | isEmpty t  = s
>                | otherwise  = (s `enq` elt) `append` rem
>                where
>                (elt,rem) = deq t

The instance declaration of Q for Lists allows the engine to handle Strings as well as potentially other structures, and illustrates how to develop a suitable instance for another collection type.

> instance Q [] where
>     isEmpty = L.null
>     enq l a = l ++ [a]
>     deq q   = (L.head q, L.tail q)

The point of this article is not necessarily to present the wondrous generic regular expression parser. If there is any point to it at all, it is the technique of using a type class to parameterize a module and to require, and supply, the minimal set of features for necessary functionality. The same technique is applicable to almost any language.

Monads and regular expressions

The thing that makes Software Tools, by Brian W. Kernighan and P. J. Plauger, a classic among programming books is that it begins with a minimal set of very basic operations and uses them to implement a good collection of the standard Unix tool set, while demonstrating good design and development principles and good coding techniques. This is in spite of being more than thirty years old, being written around languages that have not been widely used in decades (Pascal, in one version of the book) or that most readers have never heard of (Ratfor, in the other version), and containing some (rare) ideas that thirty years of programming experience have shown to be ill-advised.

As for basic operations, Software Tools begins with literally nothing more than reading a character from the standard input stream. From that, it presents file manipulation tools, an archiver, an editor (ok, a very simple one), and some text processing and source-to-source compiling tools. In doing so, it shows the use of the command-line-level tools that are being developed as well as the re-use of code tools built for previous programs.

The range of the book, from the simple to the complex if not comprehensive, is the reason I chose it as a tool for learning Haskell. As I mentioned on the pages I wrote about the project, I had previously bounced off Haskell precisely because all of the tutorials I found were built around topics that I was already familiar with from LISP, ML and O'Caml, while none of them dealt with the kind of grubby programming that Software Tools presents and that is so different in Haskell. (No, I have not read Real World Haskell yet. Soon, I promise.)

Anyway, one of the software tools presented in Software Tools is a simple nondeterministic regular expression engine, used as the basis of the sed- and grep-like tools, as well as used in the ed-like editor. While reimplementing it, dividing the work into an expression parser and the actual engine itself was easiest. I based the engine on the Maybe data type, allowing me to return "Just String" in the case where a regular expression component matched (and the string value was the remainder of the input) and "Nothing" where the component did not match.

It was at that point that I remembered that Maybe was a monad.

Note: This post is not a monad tutorial. I do not know enough category-theoretical mathematics to understand what the heck a monad is, so I am completely unqualified to write a meaningful one. Sorry.

However, what I do know about monads is that they are a way of sequencing operations and that they are not anything new. If you have written any code in an imperative language like Java, C, C#, C++, FORTRAN, Pascal, etc., then you have used a monad. In particular, you have used what Haskell calls the IO monad, because Haskell uses the monad structure to sequence I/O operations, a perennial problem for pure functional languages. Indeed, with Haskell's do notation and the IO monad, code is almost indistinguishable from any normal procedural language. What separates Haskell is that it goes further, exposing the monad as a general programming feature. And the neat thing is that there is more than one way to sequence operations.

The Maybe monad is one of those ways. Consider a series of operations each of which can succeed, passing its results on to the next operation, or fail, causing the entire series to fail. The Maybe monad exactly encapsulates this form of sequencing: a successful operation returns "Just x" where x is the result of the operation; a failing operation returns "Nothing", which is passed on through the remainder of the operations to be the result of the whole series. Operations after the failing one are not executed.

The thing is, expressing the regular expression engine using monadic notation was obviously better than expressing it using Maybe directly, since the latter required handling the Nothing cases that the former dealt with automatically. On the other hand, both forms meant the same thing. A similar effect is apparent when comparing, say, walking over a tree structure using a loop control structure, which requires manipulating a stack structure, with walking over the tree recursively, where the stack is implicit.

Anyway, while working on Software Tools, I realized the potential of monadic operations but did not immediately see how to go further to take advantage of them. That is the topic of that post.

> module Pattern where
> 
> import Prelude hiding (or,seq)
> import Control.Monad
> import List hiding (or)

A regular expression pattern is represented by an instance of the Pattern type, which is built from a constructor, P, and a function from a pair of lists to some type (which will be the monad) containing another pair of lists.

The definition of the Pattern type represents an instance of an "extractor" pattern (ahem) in Haskell; the contents of the P value is actually a record containing a single field, runPattern, which is the function. Because of the way that Haskell records work, applying the runPattern extractor to a record produces the function contained in the record, which can be immediately applied. Clever, no? But not especially interesting....

The two lists may require some explanation: the first represents the portion of the input that has already been matched by prior parts of the expression while the second represents the remainder of the input to be matched.

When I originally wrote this, the contents of the pairs were Strings, which happen to be lists of Chars. Subsequently, I realized I could generalize it further simply by removing the reference to the String type and using a plain list of elements. Further down, some operations add an Eq a requirement on the list elements, since they are compared. However, even with that change, the engine works on Strings as it did originally.

> newtype Pattern m a = P { runPattern :: ([a],[a]) -> m ([a],[a]) }

Most of the rest of the functions in the module represent specific types of regular expression elements. "done", for example represents the end of a pattern; whatever has already been matched is good enough, and whatever is left of the input string is will not be examined. The implementation of "done" is by the monadic "return" operation, which just passes the input pair into the result monad. The regular expression form of "done" is as the end of the pattern.

> done :: Monad m => Pattern m a
> done = P return

"end," on the other hand, requires the end of the input string. It also uses a MonadPlus type class constraint, since the concept of failure in monadic terms is represented by mzero; mzero is in turn represented by different special values for different MonadPlus instances: Nothing for the Maybe instance, the empty list for the list instance, and so on.. The regular expression form of "end" is as the metacharacter '$'.

> end :: MonadPlus m => Pattern m a
> end = P end'
>     where
>       end' (m,[]) = return (m,[])
>       end' _ = mzero

"any" is the opposite of "end." Where "end" requires the end of the input string, "any" requires any character of the input string. Note that the character matched is removed from the input string and added to the previously matched string. The regular expression form of "any" is the metacharacter '.'.

> any :: MonadPlus m => Pattern m a
> any = P any'
>     where
>       any' (m,(c:cs)) = return (m++[c],cs)
>       any' (_,[]) = mzero

"lit" is very similar to "any", except that it requires the input to match a given string, passed as an argument to create the Pattern. The regular expression form of "lit' is a non-metacharacter string.

This function is the first to add a constraint on the type a, Eq. The constraint is needed because the literal value must be compared to the input being matched. Fortunately, the String type is an alias for [Char], and there is an Eq Char instance.

> lit :: (MonadPlus m, Eq a) => [a] -> Pattern m a
> lit literal = P lit'
>     where
>       lit' (m,s) | literal `isPrefixOf` s = return (m++literal, drop len s)
>                  | otherwise = mzero
>       len = length literal

Positive ("cls") and negative ("ncls") character classes are also similar to "any" and "lit".

> cls :: (MonadPlus m, Eq a) => [a] -> Pattern m a
> cls set = P cls'
>     where
>       cls' (m,(c:cs)) | c `elem` set = return (m++[c], cs)
>                       | otherwise = mzero
>       cls' _ = mzero
> 
> ncls :: (MonadPlus m, Eq a) => [a] -> Pattern m a
> ncls set = P ncls'
>     where
>       ncls' (m,(c:cs)) | c `elem` set = mzero
>                        | otherwise = return (m++[c], cs)
>       ncls' _ = mzero

The remaining three functions are very different from the previous, base, pattern elements. The first two provide two ways of combining two Patterns to form a new Pattern, while the third modifies a Pattern to construct a new Pattern.

"seq" combines the two patterns sequentially, attempting the first pattern and then passing the result on to the second pattern. The regular expression form is just the concatenation of patterns.

"seq" is the first function to really use monadic capabilities, beyond the return function and mzero "failure" value. The monadic bind operator, "(>>=)," provides the primary sequencing in a regular expression, allowing the structure underlying the monad to do whatever it is that it does.

> seq :: Monad m => Pattern m a -> Pattern m a -> Pattern m a
> seq p1 p2 = P $ \ cur -> runPattern p1 cur >>= runPattern p2

Fundamentally, the "seq" operation tries the first pattern on the input pattern-matching state and then tries the second on the result. The "or" operation is significantly different. It applies the original, input pattern-matching state to both of the input patterns and combines the results using "mplus" rather than (>>=). If mzero represents failure and (>>=) represents sequencing, mplus represents alternation or a combination of the input patterns. If the first pattern fails, the second still has the chance to examine the input from the same state. The regular expression form of "or" is "|", as in "a|b", which matches "a..." or "b...".

> or :: MonadPlus m => Pattern m a -> Pattern m a -> Pattern m a
> or p1 p2 = P $ \ cur -> (runPattern p1 cur) `mplus` (runPattern p2 cur)

One of the downsides of nondeterministic regular expression engines such as this one is that some patterns and inputs can take exponential time to match. For example, consider the expression "a*aaa" and the input "aaa". Most nondeterministic regular expression engines will use the "a*" to match the entire string, then fail to find the "aaa" literal. The engine must then back up one character at a time until it can find the match for the whole string. The roots of the exponential explosion are the "or" operation above, which stores the current state for reuse, and the Kleene star operation, "kst", which uses "or" to implement recursive, depth-first search. The regular expression form of "kst" is "*", as in "a*".

"kst" implements greedy matching, like most regular expression engines. It attempts to match p, followed by a recursive call to (kst p); if either fails, kst calls "done", to indicate that it is happy to match whereever it is. [My original implementation here had the "done" call first, which implemented non-greedy matching. I blame operator error as to why I thought it had to be that way.]

> kst :: MonadPlus m => Pattern m a -> Pattern m a
> kst p = (p `seq` (kst p)) `or` done

So, how does it work?

*Pattern> runPattern done ("","abc") :: Maybe (String,String)
Just ("","abc")
*Pattern> runPattern end ("","abc") :: Maybe (String,String)
Nothing
*Pattern> runPattern end ("","") :: Maybe (String,String)
Just ("","")
*Pattern> runPattern (lit "a") ("","a") :: Maybe (String,String)
Just ("a","")
*Pattern> runPattern (lit "b") ("","a") :: Maybe (String,String)
Nothing
*Pattern> runPattern ((lit "a") `seq` (lit "b")) ("","a") :: Maybe (String,String)
Nothing
*Pattern> runPattern ((lit "a") `seq` (lit "b")) ("","ab") :: Maybe (String,String)
Just ("ab","")
*Pattern> runPattern ((lit "a") `seq` (lit "b")) ("","b") :: Maybe (String,String)
Nothing
*Pattern> runPattern ((lit "a") `or` (lit "b")) ("","ab") :: Maybe (String,String)
Just ("a","b")
*Pattern> runPattern ((lit "a") `or` (lit "b")) ("","ba") :: Maybe (String,String)
Just ("b","a")
*Pattern> runPattern (kst (lit "a")) ("","ba") :: Maybe (String,String)
Just ("","ba")
*Pattern> runPattern (kst (lit "a")) ("","aba") :: Maybe (String,String)
Just ("a","ba")
*Pattern> runPattern (kst (lit "a")) ("","aaba") :: Maybe (String,String)
Just ("aa","ba")

These examples show the output of the eengine in the Maybe monad, which provides the first match.

If Maybe were the only option, the monadic approach to the code would not have much to recommend it. Fortunately, it is not, and the List monad can be used to create a list of successes:

*Pattern> runPattern done ("","abc") :: [(String,String)]
[("","abc")]
*Pattern> runPattern end ("","") :: [(String,String)]
[("","")]
*Pattern> runPattern end ("","abc") :: [(String,String)]
[]
*Pattern> runPattern (lit "a") ("","abc") :: [(String,String)]
[("a","bc")]
*Pattern> runPattern (lit "b") ("","abc") :: [(String,String)]
[]
*Pattern> runPattern ((lit "a") `seq` (lit "b")) ("","abc") :: [(String,String)]
[("ab","c")]
*Pattern> runPattern ((lit "a") `seq` (lit "b")) ("","a") :: [(String,String)]
[]
*Pattern> runPattern ((lit "a") `seq` (lit "b")) ("","ba") :: [(String,String)]
[]
*Pattern> runPattern ((lit "a") `or` (lit "b")) ("","ab") :: [(String,String)]
[("a","b")]
*Pattern> runPattern ((lit "a") `or` (lit "b")) ("","ba") :: [(String,String)]
[("b","a")]
*Pattern> runPattern ((lit "b") `or` (lit "ba")) ("","ba") :: [(String,String)]
[("b","a"),("ba","")]
*Pattern> runPattern (kst (lit "a")) ("","ba") :: [(String,String)]
[("","ba")]
*Pattern> runPattern (kst (lit "a")) ("","aba") :: [(String,String)]
[("a","ba"),("","aba")]
*Pattern> runPattern (kst (lit "a")) ("","aaba") :: [(String,String)]
[("aa","ba"),("a","aba"),("","aaba")]

There are some small but very significant differences between the previous uses and the latest. For one thing, the result is a List rather than a Maybe value; an empty list for failure and a list of one or more pairs for success. The interesting bit is the "or more" part: the "or" operation can provide two potential matching patterns, in which case both appear in the output. Likewise, the Kleene star operation always succeeds at least once, but can succeed potentially many times.

As for the generalization to lists of type a rather than Strings, check out these interesting but not otherwise useful examples:

*Pattern> runPattern (lit ["a"]) ([],["a","b","c"]) :: [([String],[String])]
[(["a"],["b","c"])]
*Pattern> runPattern (lit ["a","b"]) ([],["a","b","c"]) :: [([String],[String])]
[(["a","b"],["c"])]
*Pattern> runPattern (lit [1,2]) ([],[1,2,3]) :: [([Int],[Int])]
[([1,2],[3])]

Postscript

I could not write a post about regular expressions without linking to The Prime That Wasn’t, just to show an extended regular expression (which is not supported by this current engine) that is more powerful than (non-extended) regular languages should be.

Quote o' the Week: Dragons

From wren ng thornton on Haskell-cafe:

Not all functors can be distributed over arbitrary monads, so "not a good idea" is more like "not always possible" or "here be dragons" (fluffy, intriguing, and pretty dragons to be sure; but probably deeper than the answer you were looking for).

I have no joke, I just like saying "Typeclassopedia".

Yes, yes it is, Joe

Quote o' the week from Joe Van Dyk on haskell-beginners:

It's like haskell is on a personal vendetta against me to make me feel dumb.

Followed by John Velman:

It's not personal.

I am familiar with that feeling.

Einstein's problem

Recently on the Haskell beginner's list, Patrick LeBoutillier posted a link to Einstein's problem, a logic puzzle attributed to Albert Einstein. Patrick requested comments on his solution, but because I had nothing better to do today other than watching the Star Wars films on Spike, I decided to come up with my own solution. (I did eventually look at his solution and at the excellent comments by Daniel Fischer, and the code I am presenting here includes changes based on those comments.)

According to the linked article, the puzzle is based on the following facts:

1. There are 5 houses (along the street) in 5 different colors: blue, green, red, white and yellow.


2. In each house lives a person of a different nationality: Brit, Dane, German, Norwegian and Swede.


3. These 5 owners
   
   
   
   1. drink a certain beverage: beer, coffee, milk, tea and water,
      
   2. smoke a certain brand of cigar: Blue Master, Dunhill, Pall Mall, Prince and blend, and
      
   3. keep a certain pet: cat, bird, dog, fish and horse.
      
   
   
4. No owners have the same pet, smoke the same brand of cigar, or drink the same beverage.
   

It also include the following hints:

1. The Brit lives in a red house.


2. The Swede keeps dogs as pets.


3. The Dane drinks tea.


4. The green house is on the left of the white house (next to it).


5. The green house owner drinks coffee.


6. The person who smokes Pall Mall rears birds.


7. The owner of the yellow house smokes Dunhill.


8. The man living in the house right in the center drinks milk.


9. The Norwegian lives in the first house.


10. The man who smokes blend lives next to the one who keeps cats.


11. The man who keeps horses lives next to the man who smokes Dunhill.


12. The owner who smokes Blue Master drinks beer.


13. The German smokes Prince.


14. The Norwegian lives next to the blue house.


15. The man who smokes blend has a neighbor who drinks water.

The question is: Who keeps fish?

My solution follows:

import Data.List
import Data.Maybe

data House = Blue | Green | Red | White | Yellow deriving (Eq, Show, Enum, Bounded)
data Nationality = Brit | Dane | German | Norwegian | Swede deriving (Eq, Show, Enum, Bounded)
data Beverage = Beer | Coffee | Milk | Tea | Water deriving (Eq, Show, Enum, Bounded)
data Cigar = BlueMaster | Dunhill | PallMall | Prince | Blend deriving (Eq, Show, Enum, Bounded)
data Pet = Cat | Bird | Dog | Fish | Horse deriving (Eq, Show, Enum, Bounded)

type Owner = (House, Nationality, Beverage, Cigar, Pet)

First, some preliminaries. I defined five types, each containing five values for each of the characteristics of the owners of the houses. Haskell is capable of automatically deriving instances of the typeclasses Eq, Show, Enum, and Bounded, automatically allowing the values of my types to be compared for equality, printed, and to act as enumerations (and bounded enumerations, which I will mention shortly). I also create a type to represent the characteristics of a given house.

My plan for finding the solution is significantly different from Patrick's; I decided naively to create a list of all possible combinations of the characteristics, filter out those that did not match the necessary hints, then create five-element permutations of the houses representing possible streets, and finally filter those streets to find the one satisfactory configuration. My goal was to make the simplest, clearest possible solution rather than the fastest.

Specifically, I did not want to encode any hint-specific details as structural elements of my code. What I wanted to do was to isolate things like "The Norwegian lives in the first house" to well-defined elements of the code rather than have them encoded as part of the system that generates the sequence of houses on the street.

To create the list of every possible Owner, I first needed lists of the possible values of each characteristic.

allValues :: (Enum a, Bounded a) => [a]
allValues = [ minBound .. maxBound ]

houses = allValues
nationalities = allValues
beverages = allValues
cigars = allValues
pets = allValues

This is where the Bounded typeclass comes in. allValues is a polymorphic list of all of the elements of a bounded enumeration; its actual value depends on the type that it has when it is evaluated. Since it is polymorphic (and the type declaration for it is necessary), I can use it multiple times with different types. As a result, the houses list is typed as [House], the nationalities list is typed as [Nationality], and the others likewise; each takes the list of values for the appropriate type. (I did not bother to provide type declarations for each because that would be a lot of work, and the types are fixed by the next value. Type inference is wonderful.)

possibilities :: [Owner]
possibilities = [ (house, nationality, beverage, cigar, pet)
   | house <- houses,
     nationality <- nationalities,
     beverage <- beverages,
     cigar <- cigars,
     pet <- pets ]

The value of possibilities is a list of all possible combinations of each of the characteristics. It is defined by a list comprehension. house takes one value from houses, nationality from nationalities, and so on, and the result is the five-tuple creating an Owner. In fact, house takes on each value from houses in turn. As a result, possibilities has 3125 elements.

The next question is how to filter the possibilities. Several of the hints (1, 2, and 3 for example) relate to properties of a single household (or Owner). Take a look at hint 2 for instance. It says that the Swede's household contains the Dog; or alternatively, if a household contains the Swede then it contains the Dog and if a household contains the Dog, then it contains the Swede. If the household does not contain either the Swede or the Dog, then this hint provides no information. When filtering the possibilities, this hint disallows those households containing the Swede or the Dog, but not both. That is a standard logical connective, pronounced "if and only if", and written "iff" or "<->" (normal implication would be only half of <->, so it would be written "->"). So, what I need are base-level predicates indicating "this house has the Swede" and combinators like <->. This is how I did that:

type Predicate = Owner -> Bool

house color (c,_,_,_,_) = color == c
nationality nat (_,n,_,_,_) = nat == n
beverage bev (_,_,b,_,_) = bev == b
cigar cig (_,_,_,c,_) = cig == c
pet pt (_,_,_,_,p) = pt == p

(<->) :: Predicate -> Predicate -> Predicate
(<->) l r owner = ((not lo) || ro) && ((not ro) || lo)
    where
      lo = l owner
      ro = r owner

A Predicate is a function which maps the five elements of an Owner (or household) to True, if the Owner matches the specific predicate, or False, if it does not. The following functions are used to define the base-level predicates: cigar accepts an argument, cig, which is one of the values of Cigar, and produces a Predicate (by virtue of Haskell's automatic currying). So, for example, "cigar Dunhill" results in a function which further takes an Owner and returns true if that Owner smokes Dunhill.

The <-> function takes two other predicates and uses them to compute a combined Predicate as in hint 6: (cigar PallMall) <-> (pet Bird), which indicates that any Owner which includes PallMall as a cigar should also include a Bird as a pet. <-> is defined using the two individual implications, adjusted by a standard transformation to use only negation and disjunction which are available in Haskell as standard operations. The only real complication of <-> is the additional Owner argument it takes and which it supplies to the lower-level Predicates.

How are these Predicates used? Here are the first group of hints:

hint1 = (house Red) <-> (nationality Brit)
hint2 = (nationality Swede) <-> (pet Dog)
hint3 = (nationality Dane) <-> (beverage Tea)
hint5 = (house Green) <-> (beverage Coffee)
hint6 = (cigar PallMall) <-> (pet Bird)
hint7 = (house Yellow) <-> (cigar Dunhill)
hintC = (beverage Beer) <-> (cigar BlueMaster)
hintD = (nationality German) <-> (cigar Prince)

(I broke into hexadecimal for hints greater than 9 so everything would line up.)

To make use of the hints to filter the possibilities, I created another Predicate that allows me to conjoin the hint predicates into a single test to be applied to the possibilities. (Actually, I created two; I'll use the second, disjunction, later.) These are basically the normal logical and (&&) and or (||) lifted to work as Predicates instead of simple boolean operations.

(/\),(\/) :: Predicate -> Predicate -> Predicate
(/\) l r o = (l o) && (r o)
(\/) l r o = (l o) || (r o)

possibilities' = filter (hint1 /\ hint2 /\ hint3 /\ hint5 /\ hint6 /\ hint7 /\ hintC /\ hintD) possibilities

If you are curious, /\ is "and" and \/ is "or" in the first logical notation I learned.)

These hints filter possibilities significantly; possibilities has 3125 elements and possibilities' has only 78. However, the remaining hints relate Owners together with their positions on a Street, which is another kettle of fish.

type Street = [Owner]

Since I know there are five houses on the street, a Street will be a five-element list. I could have used a better representation for this, one that would explicitly show the number of households, but I figured that would be an unnecessary complication that would better be left implicit.

For the moment, I intend to ignore how I get the Streets. Instead, I first focused on further, higher-level predicates that operate on Streets. To make these predicates simpler, I chose to represent a StreetPredicate as a function from a Street to a "Maybe Street"; this is a standard Haskell type containing either Just a Street, or Nothing. The first case indicates that the Street satisfies the predicate (which returns the Street instead of True) and the second case indicates the Street does not satisfy the predicate (which returns a special value Nothing).

type StreetPredicate = Street -> Maybe Street

My first StreetPredicate is from hint 4, which indicates that one household is immediately left of another.

leftOf :: Predicate -> Predicate -> StreetPredicate
leftOf o1 o2 st = do i <- (findIndex o1 st)
                     h <- if i < 4 then Just $ st !! (i+1) else Nothing
                     if o2 h then Just st else Nothing

Per the type declaration, this function takes two house-based Predicates and produces a StreetPredicate; it does so by finding the first Owner on the Street who satisfies the first Predicate, checks that it is possible to have a house to its right, and then checks that the Owner to the right satisfies the second Predicate. This function takes the form of a Haskell monadic operation, specifically the Maybe monad, which takes three steps in this function. If either of the first two returns Nothing, the overall function returns Nothing without evaluating the remainder. Assuming execution gets to the final if step, it directly produces either Just the Street st, or Nothing. (Behold the wonder of monads in Haskell!)

Another similar StreetPredicate checks whether two Owners on a Street identified by Predicates are next-door neighbors.

nextTo :: Predicate -> Predicate -> StreetPredicate
nextTo o p st = do i <- (findIndex o st)
                   j <- (findIndex p st)
                   if abs (i-j) == 1 then Just st else Nothing

Finally, I created a couple of StreetPredicates to definitively locate households by address. In this case, 0 is the address of the first house on the Street and 2 is the center house on the Street.

address :: Int -> Predicate -> StreetPredicate
address i p st = if p $ st !! i then Just st else Nothing

center = address 2
first = address 0

The remaining hints can be written as:

hint4 = (house Green) `leftOf` (house White)
hint8 = center $ beverage Milk
hint9 = first $ nationality Norwegian
hintA = (cigar Blend) `nextTo` (pet Cat)
hintB = (pet Horse) `nextTo` (cigar Dunhill)
hintE = (nationality Norwegian) `nextTo` (house Blue)
hintF = (cigar Blend) `nextTo` (beverage Water)

As above, I need a way to combine the individual hint StreetPredicates. That is the job of the /^\ operator, which is roughly equivalent to conjunction. (Think of it as a larger version of /\ with the top smushed down.)

(/^\) :: StreetPredicate -> StreetPredicate -> StreetPredicate
(/^\) l r s = do { ls <- l s; rs <- r s; return s }

This function is defined using the Maybe monad; it returns Just the Street s as long as both the two prior steps do not return Nothing.

Now I have gotten to the hairy part. I have a list of 78 possibly satisfactory households, and I wish to filter all possible permutations of five of those households to find the one Street which meets all of the requirements. Creating permutations is relatively simple in Haskell, but as it turns out there are over 2 million such permutations. That is far too many to handle. Continuing my tradition of being only as smart as necessary, I have to get a little smarter when creating my Street permutations (but only a little).

outOf :: Int -> [Owner] -> [Street]
outOf 0 _ = [[]]
outOf n xs = [ x:xs' | x <- xs, xs' <- (n-1) `outOf` (delete x xs) ]
    where
      delete (h,n,b,c,p) = filter (not . (house h \/ nationality n \/ beverage b \/ cigar c \/ pet p))

Think of outOf as being used infix, as in "2 `outOf` [1,2,3]", which produces all possible two element permutations from the three element list.

Using the normal definition of delete, this function would produce all 2 million-plus five element permutations ("delete x xs" returns a list of the elements of the list xs that are not equal to x). My minimal smartness is to notice that this is a list of Owners, and that only one Owner on the street can drink Coffee, for example. So, instead of merely removing those elements equal to x, I remove all of them which match it in any characteristic, using the \/ operator I created earlier, the basic Predicates, and a logical negation. ("delete" would normally be something like "delete x xs = filter (\y -> not (x == y)) xs".) The length of "5 `outOf` possibilities'" is only 54720 elements, which is enough of an improvement. I would argue that this is the one place where I have some part of the details of the problem hidden in the structure of my code, but boy do I need this one.

The final results are:

results = mapMaybe (hint4 /^\ hint8 /^\ hint9 /^\ hintA /^\ hintB /^\ hintE /^\ hintF) $ 5 `outOf` possibilities'

This uses mapMaybe, which is somewhat similar to filter except in using Maybes rather that Bools. results finally evaluates to a list containing a single Street, describing the single configuration which satisfies all of the hints.

Conclusions?

First I would like to note that hintF (number 15) is not necessary. The problem is actually over-determined; eliminating hint 15 still results in only one result. None of the other StreetPredicate hints can be removed; I did not check the Predicate hints.

Performance-wise, it is not actually horrible. Subsequent to the mailing list suggestions to Patrick's original solution, his code is somewhere between 5% (interpreted using runhaskell) and a third (compiled) faster than mine. Now, I do not make any claims that mine is particularly idiomatic Haskell, nor that it is in any way fast. However, it seems perfectly acceptable.

My last blog post was about Whitehead's comments on notation. Haskell in this instance has provided some incredible tools for notation. Specifically, I like the ability to define the hints clearly and independently and the ability to operate with multiple levels of logical predicates. In effect, what I have done with my <->, /\, \/, /^\, and so on, is to define a simplified domain-specific language for solving this specific problem.

I could think of implementing the same approach using Java, but the result would be much more verbose if possibly equally satisfactory. As I was discussing with a coworker recently, functional programming (closures in that instance, currying and combinators in this) do not necessarily provide features that cannot be lived without, but having them is much preferable to not having them.

I recently listened to a Software Engineering Radio podcast on the difference between Computer Science and Software Engineering. I will have more to write on that topic at some point soon, but I would like to point out that my solution to this problem (toy that it is) is pure Computer Science with a big C and big S. From Haskell, typeclasses, my idiotic filtering approach, to predicate calculus with custom domain specific predicates, nothing I have done in solving this problem has doodley squat to do with software engineering. Or, from the other side, nothing in my 100-ish lines of code would be apparent to a software engineer who was not interested in ivory-tower, high-falootin', theorem proving Computer Science. And that is bad. What I have done by deliberately avoiding encoding parts of the problem as structural elements in the code, by going out of my way to create as generic a domain specific language as I could, by using a collection of tools straight out of pure Computer Science, is better engineering than anything I would have come up with by going straight at the problem.

In fact, the major criticism I keep hearing in the back of my head about this code is that it is too advanced, too CS-y, too hard for a typical developer to support, understand, and maintain going forward. On the one hand, that criticism is something I understand, something I have to live with, since it is true. The typical developer I have worked with over the last 20-ish years is not going to want to deal with this kind of code. On the other hand, as a professional programmer myself, I find that criticism (and the daily situation) deeply offensive.

Haskell-cafe post of the week: finger nibbling

Haskell-cafe is a great source of entertainment. This from David Leimbach:

It's just that when I look at the implementation of >>= for [the State monad], I want to crawl into a corner and nibble my fingers.

Personally, I prefer feety pajamas.

Haskell-cafe message of the week

A recent post to haskell-cafe asked,

Where do you think Haskell can fit into the CERN Hadrian effort currently?

The immediate (well, 3 hours and 40 minutes, but it was 4:00 in the morning) answer from Dougal Stanton was,

Is that the experiment where Picts are accelerated to just short of the speed of light in order to smash through to the Roman Empire?

I have no possible follow-on for that.