Combinators in Haskell

In this article, instead of continuing along my path of shoving Prolog (predicate logic) into Haskell, I'll take a break from that and shove Haskell into Haskell. This turn comes by way of my recent professional experience working with Prolog — I found myself oftentimes needing to write some purely functional code, but I found the Prolog semantics getting in my way, so, borrowing some of the ideas from my previous professional programming experiences with Mercury and Dylan (when Harlequin was still a going concern, and had picked up the Dylan ball that Apple, then CMU, dropped, making a really sweet Dylan programming environment), I implemented a set of libraries for Prolog, including basic ZF-set operations, propositional logic syntax, list/set/bag utilities, and the combinator logic of Schönfinkel.

"geophf!" You exclaim, horrified, "you don't really use combinators to write working production code, do you?"

Well, yes, and I also proposed a new one in addition to the ones covered by Smullyan in To Mock a Mockingbird, and have studied the make-up of the "void" combinator of Unlambda, so I'm one of those kinds of programmers.

In short, when I was working with Prolog, I shoe-horned a Haskell interpreter into to be able to write map and fold when I wished to write map and fold. Since Prolog has DCGs (Definite Clause Grammars), I lived a monad-free and worry-free life. Ah, yes, those were the days.

That was quite a trip down memory lane. Looking back, I marvel at my fortune, not only have I professionally programmed in those languages (and VisualWorks Smalltalk; that was fun when I presented the boss a solution in two weeks that he was expecting in two months — he was so impressed that he bought the VisualWorks system for the contract, made me mentor a junior programmer on Smalltalk (Chris Choe, a good guy to work with), and had me teach a brown bag course at work on Smalltalk, but I digress, again), but it looks like Haskell is now part of our solution at my current place of work.

Life is good.

Of course, it would be so much better if I had access to the primitive combinators in Haskell (did Miranda allow that kind of low-level access, I wonder). I mean, why should one write out 'const', a whole FIVE characters, when one simply wishes to use the K combinator. I felt that very pain all too recently. I had that freedom using my combinator library when I was working on Prolog ... goodness, even MITRE fabricated the Curry Chip.

So, I could not put it off any longer, I pulled out my dog-eared copy of Mockingbird and wrote the CL module, as I didn't see one in the Haskell standard library. It went surprisingly quickly and easily. There were a few snags, Prolog, being dynamically-typed, allowed me to define the reoccuring combinators of L, M, and U (definitions of the combinators are available in my combinator library or tabled form or as graphical notation (which includes a very nice write up of propositional logic in CL)), but Haskell's type system complains of an occur-check error. I have the hack to define the Y combinator ...

fix f = let x = f x in x

... but I'm having difficulty hacking the other self-applying combinators; any suggestions on how to implement those? I'm particularly interested in implementing Turings' universal combinator ...

Uxy = y(xxy)

... because of its interesting properties I'd like to explore.

Anyway, here's the ones I do have.

> module Smullyan where

It was pointed out to me in the comments that if you make the ((->) a) type a Monad, then some of the combinators simplify to monadic operators.

> import Monad
> import Control.Monad.Instances

These are some of the combinators presented in Smullyan's To Mock a Mockingbird. Some have direct Haskell equivalents, e.g.: I ≡ id, K ≡ const, C ≡ flip, B ≡ (.), but then that just makes my job easier here. I also admit a preference to the Schönfinkel combinators over the renamed Haskell equivalents, so here is the library.

We will not be defining combinators here that cause an occurs-check of the type system, e.g. L, M, U, but we can define some interesting ones, such as O and Y by using work-arounds.

If we wish to start with λ_I, then its basis is formed from the J and I combinators.

> -- identity (I have no idea to which species belongs the 'identity' bird)
> i :: a -> a
> i = id

> -- jay: jabcd = ab(adc)
> j :: (a -> b -> b) -> a -> b -> a -> b
> j a b c d = a b (a d c)

I actually spent quite a stretch of time building the other combinators from the JI-basis, e.g., the T combinator is JII, the Q1 combinator is JI, etc. When I attempted to define the K combinator, I ran into a brick wall for some time, until I reread the section in Mockingbird about how the noble basis has no way to define that abhorred combinator. Since that time I've fallen from grace and have used λ_K, but I've always wondered since if a complete logic could be reasonably expressed in λ_I, and if so, how would that logic be implemented? I haven't come across any papers that address these questions.

Musing again, let's define the basis of λ_K which is founded on the S and K combinators.

> -- starling: sfgx = fx(gx)
> s :: Monad m ⇒ m (a → b) → m a → m b
> s = ap

> -- kestrel: kab = a
> k :: a -> b -> a
> k = const

... okay, that wasn't too hard, so, SKK should be I, right?

--- :t (s k k) :: a -> a ... oh, yeah!

let's continue with some of the other combinators:

> -- bluebird: bfgx = f(gx)
> b :: (b -> c) -> (a -> b) -> a -> c
> b = (.)

> -- cardinal: cfgx = gfx
> c :: (a -> b -> c) -> b -> a -> c
> c = flip

Now we start defining combinators in terms of simpler combinators. Although, we could have started doing that once we've defined S and K, as all other combinators can be derived from those two.

> -- dove: dfghx = fg(hx)
> d :: (d -> b -> c) -> d -> (a -> b) -> a -> c
> d = b b

> -- thrush: txf = fx
> t :: a -> (a -> b) -> b
> t = c i

> -- vireo (pairing/list): vabf = fab
> -- e.g. v 1 [2] (:) -> [1,2]
> v :: a -> b -> (a -> b -> b) -> b
> v = b c t

> -- robin: rxfy = fyx
> r :: a -> (b -> a -> c) -> b -> c
> r = b b t

> -- owl: ofg = g(fg)
> o :: ((a -> b) -> a) -> (a -> b) -> b
> o = s i

> -- queer: qfgx = g(fx)
> q :: (a -> b) -> (b -> c) -> a -> c
> q = c b

-- mockingbird: mf = ff
m = s i i

... ah, well, it was worth a try ...

> -- warbler: wfx = fxx
> w :: Monad m ⇒ m (m a) → m a
> w = join

> -- eagle: eabcde = ab(cde)
> e :: (a -> b -> c) -> a -> (d -> e -> b) -> d -> e -> c
> e = b (b b b)

With the above definitions, we can now type-check that my JI-basis is correct: the type of I already checks, and the type of J should be equivalent to B(BC)(W(BCE))), ...

:t (b (b c) (w (b c e)))
(b (b c) (w (b c e))) :: (d -> e -> e) -> d -> e -> d -> e

and it is ... yay!

-- lark (ascending): lfg = f(gg)
l = ((s ((s (k s)) k)) (k (s i i)))

l :: (a -> b) -> (c -> a) -> b
a b = a (b b)

... ah, well, another one bites the dust ...

but we can define Y, albeit with a let-trick, thanks to Dirk Thierbach, responding to the thread "State Monad Style" on comp.lang.haskell:

> fix :: (a -> a) -> a
> fix f = let x = f x in x

> -- sage/why: yf = f(yf)
> y :: (a -> a) -> a
> y = fix

So, there you go, 15 combinators to get you started; now you can program a functionally pure and mathematically sound version of Unlambda (which exists and is called Lazy-K, by the way) using your very own Haskell system.

After all, why should someone ever be forced to write \x -> x^2 when they have the option, and privilege, to write w (*) instead?

Apologies for late Spring cleaning

It was pointed out to me that the colour cyan is difficult to read against a white background; my syntax highlighter outputs Haskell keywords as cyan, so I understand that reading the code here can be bothersome. So, I'm in the process of converting the cyan to a darker colour (which first involved me converting every <font color='cyan'> to <font color='#00c8c8'>, but then, part way through that process, I moved all font metadata to the stylesheet and now simply mark code, keywords and data types with appropriate metadata tags).

A bit of a long-winded apology for what you may see as several (and repeated) repostings from this blog.

Legal Disclaimer

Parties:

"I", "me", "my", "mine", the author, geophf, aka Douglas M. Auclair
"You", "your", the reader, user, coder, redistributor, referencer. Some non-exhaustive examples of "You" include, J. Random Coder, J. Random Corporation, J. Random Defense Agency, J. Random Financial Institute, J. Random Blog, J. Random for-profit corporation/LLC, J. Random Sovereignty, or http://planet.haskell.org ... just as examples.
"This blog", http://logicaltypes.blogspot.com, its content and entries originating from me.

License:

The words of this blog, http://logicaltypes.blogspot.com, are freely available to be read, to be commented on, to be referenced, or to be copied. I, the author, would like attribution, either to this site (an URL as reference is appropriate) or to the author, geophf, aka Douglas M. Auclair, but do not require it. I would also like to know if you find the topics discussed here useful, by either leaving a comment on this blog in the standard fashion, or by sending me an email at the scrambled email address of doug.at.cotilliongroup.dot.com. Descramble in the standard way.

The code in this blog is also free and freely available for commercial, noncommercial, academic or non-academic (if you happen to be a maraudering visigoth coder) use. Attribute is requested as above, but not required. Notification, as above, is also requested, but not required.

Limitation of Liability:

Note that, although the code and words are free and freely available for use and redistribute, no guarantee is made for any word or code sample published here. Some non-comprehensive examples include the following: if you use this code in a missile guidance system, and that missile falls in a populated area of friendly forces and civilians, I, my words, and my code are not to be held responsible for the resulting damage to life and to property. Or, if you implement systems published in this blog in a clustered system, and that system becomes self-aware, like Cyberdyne or the Matrix, and decides either to wipe humanity off the face of the Earth by triggering an all-out global thermonuclear war or by constructing power plants composed of the now-enslaved human population, I, my words and my code are not to be held responsible for the loss of life, freedom or property. Or, if you use this code or the ideas explored here in a Mars rover, and it offends the space alien natives, and the descend in force, 'War of the Worlds'-style, I, my words, and my code are not to be held responsible for the resulting loss of life and damage to property. Or, if you implement this system in a new Qbit supercomputer, and it results in either a singularly, sucking up the world Donnie Darko-style, or it results in a readjustment of space-type causing a complete quantum collapse of the universe, then I, my words, and my code are not to be held responsible for the early onset of the rapture. The examples enumerated above serve only to illustrate that I, my words and my code may be used but any and all damage resulting from such use, no matter how small or how catastrophic, may not be held responsible for that damage, legally, financially, or otherwise.

Exemption from obligation:

Conversely, should you use this code, or the words of this blog, and the use results in making, earning or saving money, property or life, such as, non-exhaustively, making profit in the stock market, or gaining a strategic or tactical advantage on the battlefield, or locating 3 missing teenagers, or saving 150 sailor's lives at sea, or seizing 26 million USD-worth of illegal narcotics per month, you are under no obligation to recompense me for profits or property gained or seized, lives saved, or other benefits merited. If possible and desired, I would like attribution in the code or words used and notification of the positive result of said use, but I also understand whims of corporate and personal desires as well as restrictions of non-disclosure agreements and concerns of national/world security, so attribution and notification are desired, as above, but not required. The examples above illustrating exemption from your obligation are neither exhaustive, meaning any gain is covered in this exemption clause, nor are they meant to illustrate implied or real events that have occurred in the past, present or future: I make no claim as the efficacy of me, my words, or my code in any of the above illustrations, nor do I make a claim that the above illustrations are based on any past, present or future events that may or may not have occurred.

Of course, I will not be uncivil, either. And gratuities are gratefully accepted (but, as per above, neither required nor expected). If, in gratitude, you do wish to recompense me for beneficial use of my words or code, please contact me at (scrambled) doug.at.cotilliongroup.dot.com to discuss methods of renumeration.

Coverage:

This license is put into effect for all entries posted by me. All comments by me are also covered by this license. Comments published by others are at the risk of the originators: I bear no risk nor liability of words published by others on this blog. This license is put into effect immediately, August 2, 2008, and covers all entries from the first entry ("Trivial Monad solutions" dated May 14, 2008) to all entries and content following it until such time that it may be superseded by a new license from me.

Difference Lists in Haskell!

Oooh! Scrumptious!

I've discovered while exploring one of my Tangents, the Comonad.Reader, that a member of the Galois team, Don Stewart, has developed a Difference List library ... in Haskell. My initial scan of the library is that it is simple, elegant and practical. Three feathers in his cap!

Excuse me while, initially, I replace in my code the 'cons then reverse' list-building pattern with Don's DList. I also can't wait to find other applications for this type.

While I'm away doing that, you can read sigfpe's blog, particularly his clever implementation of the Fibonacci series as a comonad.

Don't know; don't care: Whatever

The Maybe Monad type (covered in this blog in May) is a practical data type in Haskell and is used extensively. Since it is also a MonadPlus type, it is also immediately useful for logic programming, particularly of the semideterministic variety. Personal, I view Maybe as a second-order Boolean type, which, in itself, is a very powerful mode of expression, as George Boole demonstrated. Do yourself a favor, reread his works on algebra, or perhaps some musings from others, such as Dijkstra. Just as Donald Knuth showed that any n-tree could be transformed into an equivalent binary tree, and Paul Tarau put that to good, ahem, clause and effect, the Boolean algebra can model many other forms of algebras ... and does, for, after all, last I checked all my calculations are reduced to boolean representations (some call them binary digits).

Yes, Maybe's all well and good (and for the most part, it is — it's very well-suited to describe a large class of problems). But, as a dyed-in-the-wool logic programmer, Haskell has a bit of a nagging problem capturing the concept of logic variables ... that is, a thing that either may be grounded to a particular value (which Maybe already has when the instance is Just x) or may be free (which Maybe does not have). In short, the problem is with Nothing. And what is the problem? Values resolving to Nothing in a monadic computation, because they represent mzero, or failure, propagate throughout the entire (possibly chained) computation, forcing it to abort. Now, under the Maybe protocol, this is the desired result, but, when doing logic programming, it is often desirable to proceed with the computation until the value is grounded.

Now, deferred computation in Haskell is not a novel concept. In fact, there are several approaches to deferred, or nondeterministic, assignment, including my own unification recipe as well as the credit card transformation (which the author immediately disavows). The problem with these approaches is that they require resolution within that expression. What we need is a data type that captures succinctly this decided or undecided state. This we do with the Whatever data type:

data Whatever x = Only x | Anything

Just like Mabye, Whatever can be monadic:

instance Functor Whatever where
    fmap f (Only x) = Only (f x)
    fmap f Anything = Anything

instance Monad Whatever where
    return x = Only x
    Only x >>= f = f x
    Anything >>= f = Anything

You'll note that the monadic definition of Whatever is the same as Maybe, with the exception that Maybe defines fail on Nothing, whereas Whatever has no such semantics.

Even though Whatever is monadic, the interesting properties of this data type come to the fore in its more ordinary usage ...

instance Eq x ⇒ Eq (Whatever x) where
    Only x ≡ Only y = x ≡ y
    Anything ≡ _    = True
    _ ≡ Anything    = True

... and with that definition, simple logic puzzles, such as the following, can be constructed:

In a certain bank the positions of cashier, manager, and teller are held by Brown, Jones and Smith, though not necessarily respectively.

The teller, who was an only child, earns the least.
Smith, who married Brown's sister, earns more than the manager.

What position does each man fill?¹

An easy enough puzzle solution to construct in Prolog, I suppose, and now given the Whatever data type, easy enough in Haskell, too! Starting from the universe of pairs that contain the solution ...

data Man = Smith | Jones | Brown deriving (Eq, Show)
data Position = Cashier | Manager | Teller deriving (Eq, Show)
type Sibling = Bool
type Ans = (Position, Man)

universe :: [Ans]
universe = [(pos, man) | pos ← [Cashier, Manager, Teller],
                         man ← [Smith, Jones, Brown]]

... we restrict that universe under the constraint of the first rule ("The teller, who was an only child...") by applying "only child"ness to both the Teller and to the Man holding that Position (as obtained from the fact: "... Brown's sister ..."), but, importantly, abstaining from defining a sibling restriction on the other Positions ...

-- first rule definition: The teller must be an only child
sibling :: Position → Whatever Sibling
sibling Teller = Only False
sibling _      = Anything

-- fact: Brown has a sibling
hasSibling :: Man → Whatever Sibling
hasSibling Brown  = Only True
hasSibling _      = Anything

-- seed: the universe constrained by the sibling relation
seed :: [Ans]
seed = filter (λ(pos, man).sibling pos ≡ hasSibling man) universe

And, given that, we need define the rest of the rules. The first implied rule, that each Position is occupied by a different Man is straightforward when implemented by the choose monadic operator defined elsewhere, the other rule concerns the pecking order when it comes to earnings: "The teller ... earns the least" (earnings rule 1) and "Smith, ..., earns more than the manager." (earnings rule 2). This "earnings" predicate we implement monadically, to fit in the domain of choose ...

-- the earnings predicate, a suped-up guard
makesLessThan :: Ans → Ans → StateT [Ans] [] ()

-- earning rule 1: the teller makes less than the others
(Teller, _) `makesLessThan` _ = StateT $ λans. [((), ans)]
_ `makesLessThan` (Teller, _) = StateT $ λ_. []

-- and the general ordering of earnings, allowed as long as it's
-- different people and positions
(pos1, man1) `makesLessThan` (pos2, man2) = StateT $ λans.
        if pos1 ≡ pos2 ∨ man1 ≡ man2 then  []
        else [((), ans)]

... we then complete the earnings predicate in the solution definition:

rules :: StateT [Ans] [] [Ans]
rules = do teller@(Teller, man1) ← choose
           mgr@(Manager, man2) ← choose
           guard $ man1 ≠ man2
           cashier@(Cashier, man3) ← choose
           guard (man1 ≠ man3 ∧ man2 ≠ man3)

           -- we've extracted an unique person for each position,
           -- now we define earnings rule 2: 
           --      "Smith makes more than the manager"
           -- using my good-enough unification2 to find Smith

           let k = const3
           let smith = (second $ k Smith)∈[teller,mgr,cashier]
           mgr `makesLessThan` smith
           return [teller, mgr, cashier]

... and then to obtain the solution, we simply evaluate the rules over the seed:

evalStateT rules seed

The pivotal rôle that the Whatever data type is in the sibling relation (defined by the involuted darts sibling and hasSibling). We can abduce the derived fact that Brown is not an only child, which, with this fact reduces the universe, removing the possibility that Brown may be a Teller ...

universe \\ seed ≡ [(Teller,Brown)]

... but what about the other participants? For Jones, when we are doing the sibling/hasSibling involution, we don't know his familial status (we eventually follow a chain of reasoning that leads us to the knowledge that he is an only child) and, at that point in the reasoning we don't care. For Smith, we never have enough information derived from the problem to determine if he has siblings, and here again, we don't care. That is the power that the Whatever data type gives us,⁴ we may not have enough information reachable from the expression to compute the exact value in question, but we may proceed with the computation anyway. Unlike Maybe's resolution to one of the members of a type (Just x) or to no solution (Nothing), the Whatever data type allows the resolution (Only x), but it also allows the value to remain unresolved within the type constraint (Anything).⁵ So, I present to you, for your logic problem-solving pleasure, the Whatever data type.

---

Endnotes

1	Problem 1 from 101 Puzzles in Thought and Logic, by C. R. Wylie, Jr. Dover Publications, Inc. New York, NY, 1957.
2	f ∈ list = head [x|x ← list, f x ≡ x] When x is atomic, of course f ≡ id, but when x is a compound term, then there are many definitions for f for each data type of x that satisfy the equality f x ≡ x and that do not equate to id. We see one such example in the code above.
3	I really must define a library of combinators for Haskell, à la Smullyan's To Mock a Mockingbird, as I've done for Prolog.
4	This semantic is syntactically implement in Prolog as anonymous logic variables.
5	I find it ironic that Maybe says everything about the resolution of a value, but Whatever allows you to say Nothing about that value's resolution.

My Top-"10" Movie List

The following article is presented as a literate (literal) Haskell program. You can read it, and you can just as easily feed it to a Haskell interpreter, such as ghci or hugs.

I often get into conversations with acquaintances about movies, and when a (really) good movie is mentioned, I exclaim, "That's on my Top '10' list!", because, well, it is. After about 17 of these exclamations in a (series of) conversations, I'm often called on my assertions: "Well, what are your top 10 favorite movies then?" So, I've been forced to show my hand. Which language, though, to display this (ever-changing) list? HTML, no? XML? No, dreck, and no-no-no (been there, done that; barely survived to tell the tale). Haskell, of course. What follows is my top "10" movies as a program as activated data. If you need to see the movies in something other than code, I've posted the run result: voilà.

> module Movies where

The philosophy of this system, other than the fact that I count to 10 accurately, but I appear to have difficulty stopping there (just as the protagonist (?) in the movie "High Fidelity" has in counting to 5), is that I use the State monad to control how the output of the database is formatted. The resulting movie database is a tabled-HTML output.

Quite simply, the State monad contains a (modular) counter, and when my logic determines, then things happen at each cycle.

The Reader transformer monad carries the constant of when I wish to do these things, so the net result is a State monad counter wrapped in a Reader (constant) transformer. This article is not about the (very useful) topic of monad transformers, so I recommend the excellent article that covers that material.

> import Control.Monad.State
> import Control.Monad.Reader

> data Cat a = Cat String [a]

... unfortunately, the type-class system balks at using bare or aliased types, such as string, so here I wrap String in the "S" data type and provide my HTML representation against that.

> type Caddy = Cat (S Int)   -- quite the cad, indeed!

> data S s = S s String 

> instance Show (S s) where 
>     show (S s str) = cdata str []

Not particularly happy with the cdata transformation, either, but it's a quick and dirty implementation to handle a problem of character data in the database that would muck up an HTML representation.

> cdata [] ans = reverse ans 
> cdata (a:b) ans = cdata b ((if a == '&' then 'n' else a) : ans)

The typeclass Html is a pretty printer that generates HTML from the data set.

> class Html a where
>    asHtml :: a → ReaderT Int (State Int) String

Here, when the typeclass is given an instance of "String" (wrapped in the S data type), it pretty prints columns, wrapping every n columns were n is the constant held by the ReaderT transformer monad.

> instance Html (S s) where
>    asHtml x = do pre ← prefix
>                  post ← postfix
>                  return (pre ++ "<td>" ++ show x
>                          ++ "</td>" ++ post)
>         where prefix = do idx ← get
>                           return (if idx == 0 then "<tr>" else "")
>               postfix = do sz ← ask
>                            idx ← get
>                            put ((idx + 1) `mod` sz)
>                            return (if idx + 1 == sz 
>                                    then "</tr>\n" else "")

This is the engine control of the pretty printer. When given a category, it prints the title, resets the counter to zero, and then hands off the printing of columns to either itself (if the category (e.g. "Top 10 movies") contains categories (such as the genres)) or to the "String" printer (if the category just contains the movie list).

> instance Html a => Html (Cat a) where
>    asHtml (Cat title list) 
>          = do rows ← ask
>               put 0
>               cells ← mapM asHtml list
>               rest ← get
>               return ("\n<tr><th colspan='"
>                       ++ show rows ++ "'>" ++ title
>                       ++ "</th></tr>\n" ++ foldl (++) "" cells
>                       ++ closeCells ((rows - rest) `mod` rows))
>           where closeCells 0 = ""
>                 closeCells x = foldl 
>                                (λx y → x ++ "<td>&nbsp;</td>")
>                                "" [1..x]
>                                ++ "</tr>\n"

The database of movies follows:

> scifi, documentary, ferrn, romcom :: Caddy
> western, musicals, comedy :: Caddy
> horror, brit, oldies, sitcom, indie, drama :: Caddy

> movies :: Cat Caddy
> movies = Cat "My Top 10 Movies" 
>               [scifi, ferrn, romcom, musicals, 
>                comedy, indie, documentary,
>                horror, brit, sitcom, drama, oldies,
>                western, anime]

> anime = Cat "Animation" 
>             (map (S 1) ["Emporer's New Groove", "Wallace & Gromit", 
>                         "Shrek"])
> scifi = Cat "Science Fiction" 
>             (map (S 2) ["Solaris", "Blade Runner", "Galaxy Quest",
>                         "Donnie Darko", "Fight Club"])
> ferrn = Cat "Foreign"
>             (map (S 3) ["Le Placard", "Yojimbo", "Bleu, Blanc, Rouge", 
>                         "Siti no Samurai", "Sanjuro", "Eiron Shimbum", 
>                         "Schultze gets the Blues", "Eat Drink Man Woman", 
>                         "Legend of Drunken Master", "Shaolin Soccer", 
>                         "Kung Fu (Hustle)", "Cronos"])
> romcom = Cat "Romantic Comedy" 
>              (map (S 4) ["George of the Jungle", "Charade", "Bull Durham",
>                          "Bride and Prejudice", "L.A. Story",
>                          "Moonstruck", "My Big, Fat Greek Wedding", 
>                          "Bullets Over Broadway", "Clueless", "Ocean's 11",
>                          "Whole Nine Yards", "Princess Bride"])
> musicals = Cat "Musical"
>                (map (S 5) ["Guys and Dolls", "Singin' in the Rain", 
>                            "Mary Poppins"])
> brit = Cat "Brit"
>            (map (S 6) ["Cold Comfort Farm", "Importance of Being Earnest",
>                        "Hot Fuzz"])
> oldies = Cat "Ole Timey"
>              (map (S 7) ["O Brother, Where art Thou?",
>                          "To Have and Have Not", "Hopscotch"])
> western = Cat "Western" 
>               (map (S 8) ["Shanghai Noon", "Pale Rider",
>                           "Dances with Wolves"])
> comedy = Cat "Comedy" 
>              (map (S 9) ["Blazing Saddles", "Arsenic and Old Lace",
>                          "Dodgeball", "Young Frankenstein",
>                          "Harold & Kumar go to White Castle",
>                          "Revenge of the Pink Panther"])
> sitcom = Cat "Sitcom"
>              (map (S 10) ["Addams Family", "Addams Family Values", 
>                           "State and Main", "Rushmore"])
> horror = Cat "Horror/Suspense" 
>              (map (S 11) ["Jacob's Ladder", "Silence of the Lambs",
>                           "Shawn of the Dead"])
> drama = Cat "Drama" 
>             (map (S 12) ["Grave of the Fireflies", "Village", "Payback",
>                          "Shadowlands", "Station Agent", "Pleasantville",
>                          "Shoot 'em up", "Searching for Bobby Fischer"])
> indie = Cat "Indies" 
>             (map (S 13) ["Bagdad Cafe", "Ghost World", 
>                          "Living in Oblivion", "My New Gun"])
> documentary = Cat "Documentaries" 
>                   (map (S 14) ["Good Night and Good Luck",
>                                "thirty two short films about Glenn Gould",
>                                "Koyaanisqatsi", "Unzipped", "Ed Wood"])

This function calls the monadic system to print the movie database.

> showMovies :: Int → String
> showMovies cols = "<table>\n"
>                   ++ evalState (runReaderT (asHtml movies) cols) 0
>                   ++ "\n</table>\n"

> test = putStrLn (showMovies 3)

You can download it and see the embedded HTML in a code browser, such as eclipse. At any rate, executing test will get the above movie database in a tabled-HTML form.

What's the payoff?

Ah, yes. Well, if I had encoded my movie list in one of the currently popular metadata formats, such as HTML or XML/XSTL, then changing the number of columns per row would be prohibitively difficult with the former (HTML), and getting the metadata output as a properly formatted set of table rows would have been prohibitively difficult with the latter (XSTL). The Haskell program demonstrates both: you've seen how (relatively) easy it is to output the structured data as table rows of three columns per row, to change the number of columns (e.g.: to two columns per row), it's as simple as rewriting the test function to ...

test = putStrLn (showMovies 2)

... paid off; or, if you prefer, Q.E.D.

Alternative Implementations

Using the Reader monad is one of the ways to pass around "global" values, defining a ("global") constant function is another, sigfpe discusses those, as well as using the Reader Comonad, in an article on comonadic plumbing. I chose the Reader transformer monad instead of the Reader comonad for this article, because combining a comonad with a monad introduces arrows as the glue. Another article will explore comonads first before we dive into the thick of monad/comonad/arrow plumbing.

A Haskell Rule Engine

Those of you who have read other entries on this blog know that the title does not contain a (semantic) typo. Those of you new to this discourse may wonder, "Rule Engine? Not Haskell; Prolog! End of discussion, right?"

Well, yes and no.¹

Prolog is nearly perfectly situated, semantically, for building rule engines. In fact, the Prolog interpreter is a rule engine, so making one's own rule engine amounts simply to adding rules (as rules are native-language constructs in Prolog) to the interpreter (which are then compiled into the Prolog system). What could be simpler? Well, nearly nothing, and that's why Prolog is the language of choice for these kinds of systems (and for knowledge bases, and for work-flow analysis, and for resource scheduling systems, and for ... etc).

The problem, however, is the Prolog offers a little too little and a little too much -- a little too little in typing and a little too much side-effects (à la assert, retract, and the ! (pron: "red cut")) -- and this abundance (of side effects) and dearth (of typing) both seriously hamper confidence in the correctness, or provability, of the rule system.

Let's take a moment to consider how a rule-based system works. The system is fed data; it then forms a supposition from those data, and the rules contribute, to a greater or lesser extent, to proving or disproving that supposition. Rule-based systems often, but not always, have a dynamic element to them -- rules may be added or removed (or activated or passivated) while the system is running to deal with emergent situations. Furthermore, rule-based systems often have a collaborative element to them: it is often desirable that rule-findings (or their antithesis) affect other rules in the same or similar category. Contribution, dynamism, and collaboration: these are the ingredients for successful rule-based systems. For these ingredients to work with any success, however, the supposition must have a well-understood structure as it is tested from rule to rule. Furthermore, findings that contribute to the strength of the supposition must be adjoined in well-defined ways.

Caveat: if you're looking for objectivity, read Ayn Rand. However, even though the next section is anything but even-tempered, it is indeed tempered by years of experience on real systems really in production. YMMV

The Prolog programmer writing the rule-based system may render the structure of the supposition either implicitly (by testing the dynamic structure of the supposition in the goals of each rule) or explicitly (by pattern matching in the head of each rule with tagged terms of the supposition). Either approach requires uniformity, which is just a euphemism for typing. In short, the Prolog programmer must type the supposition, but the Prolog system has no built-in check guaranteeing correctness of that type from rule to rule. This places the burden of typing on the Prolog programmer, and this often results in the programmer accidentally building an ad hoc type system extension, and often poorly enforcing that discipline from rule to rule. The result: an ill-typed supposition is allowed to pass through the rule engine generating false positives or failing to recognize real positives from the base data set.

So much for the need-for-typing screed.

Now, as for the side-effecting (a.k.a. "extra-logical") constructs in Prolog (assert, retract, and !), the literature is resplendent with caveats, so I will leave that discussion for your discovery (which would simply be to read the latter part of chapter 1 of any introductory Prolog text). I will add one bit of personal professional experience: a rule-based system built on the foundation of these extra-logical constructs (each rule issued more than a few asserts which then their duals later retracted [fingers crossed]). What happened when an unusual finding surfaced? Well, what didn't happen was a felicity in the debugger, even with a complete trace it was well nigh impossible to sort out which lemmas were asserted and at what points. Were there detritus lemmas from the previous transaction that were never retracted due to a ! or an unexpected failure resulting in backtracking? These questions were hard enough to answer in that system, but the difficulty was often compounded by the inconsistency between different findings on the exact same input data. In short, if you are a Prolog programmer who uses the extra-logical features of the language to build your rule-based system, you may have something that works from time to time, but you've also sacrificed consistency and confidence in the results. Please, for my sake,² find a way to code the system relying on the logical features of the language as the mainstay.³

We now return to our regularly-scheduled programming...

Haskell, being a typed and pure functional programming language, has its own strengths and weaknesses.⁴ The type system requires the program to be well-typed and consistent ("proofs-as-types"), otherwise the program is rejected by the Haskell system. Conversely, foundational operations of logical programming are not to be found as part of Haskell's base syntax nor semantics. Unification? Backtracking? Neither are available in "plain" Haskell. In Prolog, what are the operators for unification and backtracking? There are none, as these concepts are fundamental parts of Prolog's semantics -- they are as invisible and as necessary as the air, permeating the entire system down to every goal in each rule clause.

If not addressed, these deficiencies of plain Haskell would stop the show. However, previous articles have demonstrated typed, concise, and natural representations of choice (backtracking). So, the rest of this article will develop a rule-based system using those tools, and along the way demonstrate how "good-enough" unification may be achieved with monads in Haskell.

Before diving in to building a rule-based system in Haskell, let's pause again to consider how rule findings should be captured. Some systems are implemented where rules return a score, and the summation of all the rule findings determine if the supposition holds. Many such systems exist using this approach. The problem with this approach is that it makes defining the special cases (which always crop up in these kinds of systems) difficult. For example, a special rule finding would be: "whenever these preconditions are met, then the supposition is true, no matter what other findings occur." How does one encode this in a points-based system? "Obviously, that rule finding is alloted enough points to tip the scales in support of the supposition," you answer. However, this answer, although it works today, will no longer work as, inevitably, new rules are added (and old rules removed). When this change occurs, new thresholds are set, and the value assigned to this "ultimate" rule finding no longer triggers the expected result. Of course, one can use indirection, where the rule finding's point value is a reference to the threshold's value, but then this introduces additional housekeeping that the "simplification" of "rule findings are points" was supposed to avoid. These factors -- the paradigm broken (a rule finding is not a point result but a reference to one) and the additional housekeeping -- are an open invitation to introduce logic errors into the system during the maintenance phase of the system's life cycle.

And, what about the rule findings that monitor the users of the rule-based system? An integral part of every rule-based system (or expert assistance system) is the monitoring of the experts using the system. And, in every one of these kinds of systems, there are one or more experts who consistently subvert the system and there are certain experts who consistently and markedly outperform the system. For example, in the banking industry, the system may make recommendations that the current customer move funds over $10,000.00 out of the savings account into longer term investments, but it may also observe that the current teller is consistently successful in upselling certain profitable instruments successfully (and therefore recommend awards, promotions, or raises for that teller or may recommend pulling that teller in for interviews to enhance the system with their experience and know-how). On the other side, there may be tellers who consistently report totals that are different than what the daily transaction report shows, and so the system may recommend to managers to bring additional supervision, training, or legal action against that teller.

This subversion or excellence may be unconscious, but whatever the motive, it is imperative that this expert not be notified that their activities are being monitored. Such a rule finding ("expert in dereliction" or "expert outperforming") would, in a point-based system, result in adding 0 points, as it doesn't affect the supposition, but it does have importance elsewhere.

In short, a point-based system may work for the "normal" rules, but is unsatisfactory for any real-world system that must include special cases, such as ultimatums and rules that deal with issues not concerning proof of the supposition.

Well, if points are not the way to go, what about having the rule findings immediately trigger the appropriate action? I don't know what to call that kind of application, but it certainly isn't a rule-based system. A system such as this immediately disintegrates into incoherency. Let's examine an example to demonstrate, e.g.: a rule-based system for surveying banking customers has a rule that runs as follows: "A male, usually wearing a red shirt, and waving a pistol is a robber; call the police." So, under a ruling precipitates action system, the next person (male or female) who walks in wearing a red shirt (one of the triggers) would have the SWAT team come barrelling in, weapons free. This may impact customer satisfaction and disrupt business operations.

No, part of the raison d'être of rule-based system is that first a case must be build for, or against, a supposition with findings that are either sufficient or overwhelming in number, then, only after a compelling case is built does the system render a decision or recommendation with associated actions. The product of such systems is not only a recommendation, but also a coherent model, a "why", in support of that recommendation.

Okay, rules-as-points are out, and the imperative model ("ready-fire-aim!") is out, so what is left? The coherent model; and a very simple model is just the set of rule findings, themselves. With those findings, the arbiter subsystem may use any method for reaching a recommendation (points or winner-take-all or dispatch or monte carlo, etc), or even change its methodology, but the rule finding process does not need to change with each change of the arbiter.

Sometimes, loose coupling is good.

What better way to represent rule findings than as terms of a type? We use this representation in our example rule-based system that follows (which is the poker hand classifier developed earlier). We already have the rules for straights, flushes, straight flushes and royal flushes:

type Query = [Card] → [(Rank,Int)] → Maybe Type

royalFlush :: Query
royalFlush hand x = straightFlush hand x >>= highAce
      where highAce hand = RoyalFlush |-
           hand ≡ StraightFlush (High (Face Ace))

straightFlush :: Query
straightFlush hand _ = (run `conjoin` sameSuit) hand >>=
                       return . StraightFlush

flush :: Query
flush hand x = let (HighCard hc r1 r2 r3 r4) = fromJust $ highCard hand x
               in  sameSuit hand >> return (Flush hc r1 r2 r3 r4)

straight :: Query
straight hand _ = run hand >>= return . Straight

The second argument of the Query type, which is a bag representation of the hand -- the rank of the cards and the count for each rank, was not used in the above rules, but becomes indispensable for the other rule findings, starting with the full house (3 of a kind and 2 of a kind in one hand):

fullHouse _ bag = let (a,3) = head bag
                      (b,2) = head (tail bag)
                  in  return (FullHouse (Threes a) (Twos b))

No, that's not right. The let-expression is not an assignment, it's an unification! For, after all, if the hand is not a full house, then the "assignment" fails in its "pattern match", so, not only are we attempting to fix the values of a and b but we are also propagating a success or truth value through that process. Hm, the "success of an assignment", what type would that be? Ah! Monadic, of course, and list compression compactly captures the concept of essayed assignment which we then distill (my much less cumbersome name for the standard library's listToMaybe function):

fullHouse :: Query
fullHouse _ bag = distill [FullHouse (Threes a) (Twos b)
                                | (a,3) ← bag, (b,2) ← bag]

It is almost criminally embarrassing on how easy this rule is to translate from the specification: "A full house is the distillation of a hand into three a's and two b's."⁵ From this understanding, the other hands fall out naturally:

fourofakind :: Query
fourofakind _ bag = distill [FourofaKind (Fours a) (High b) 
                                  | (a,4) ← bag, (b,1) ← bag]

threeofakind :: Query
threeofakind _ bag = distill [ThreeofaKind (Threes a) (High b) c
                                  | (a,3) ← bag, (b,1) ← bag,
                                    (c,1) ← bag, b > c]

twopairs :: Query
twopairs _ bag = distill [TwoPair (Twos a) (Twos b) (High c)
                                  | (a,2) ← bag, (b,2) ← bag,
                                    a > b, (c,1) ← bag]

onepair :: Query
onepair _ bag = distill [OnePair (Twos a) (High b) c d
                                  | (a,2) ← bag, (b,1) ← bag,
                                    (c,1) ← bag, b > c,
                                    (d,1) ← bag, c > d]

... and finally there's the catch-all for the "I'd better be good at bluffing" hand:

highCard :: Query
highCard hand _ = let [hc,r1,r2,r3,r4] = map settleRank hand
                  in  return (HighCard (High hc) r1 r2 r3 r4)

settleRank :: Card → Rank
settleRank (Card rank _) = rank

Now that we have the rules, we need simply write the marshalling code, the rule-finding loop, and the arbiter to complete our rule engine.

The marshalling code pre-processes the hand into a bag in order to facilitate n-of-a-kind rule findings:

let groups = group $ map settleRank cards
    cards = reverse (sort hand)
    counts = map length groups
    bag = zipWith (curry (first head)) groups counts
    [...]

The rule-finding loop applies the rules to the (processed) hand in order:

    [...]
    rules = [royalFlush, straightFlush, fourofakind,
             fullHouse, flush, straight, 
             threeofakind, twopairs, onepair,
             highCard]
    findings = map (λf . f cards bag) rules6
    [...]

And, finally, the arbiter in this case is very simple: it takes the first (highest ordered) rule-finding as the result.

    [...]
in  fromJust (msum findings)

With that, we have built the kernel of a complete rule-based system.

In this article, we demonstrated that Haskell, with standard extensions, can follow a process that constructs rules. This process not only matches the ease and simplicity of rule-building in Prolog, but it also has the benefit that these rules in Haskell have the type-correctness that provides a stronger degree of confidence in the rule-finding results.

---

End notes
1	I must be getting older. Not too long ago, my refutation would have been more emphatic ... to the tune of: "Wrong!"
2	I say "for my sake" because I'm the guy you're going to be complaining about: "All I wanted him to do is just add this one rule set to the system, and he goes off and rewrites the entire system to do it!"
3	While you're at it, put all your debug statements into aspects (because nl should not even appear in core production code much less be the most frequently called "goal" in the system) and then have a complete(ly automated) unit test suite so that additions or deletions are entirely covered by this safety net, but those are whole ('nother) discussions onto themselves.
4	But why choose a functional programming language like Haskell? If Prolog nearly fits the bill, wouldn't a well-typed logic programming language, say, Mercury, or others, fair better than Haskell? The problems with most of these languages is that they fall into the research/academic ghetto. The user base is comprised of the language developers and maybe one or two others, and so the languages stagnate in their insularity. Haskell, and some other languages, including Prolog itself, have garnered enough outside attention and use to grow organically beyond their inventors' control, boundaries and strictures -- these languages retain their academic foundations but also gain a set of practical, useful, tools and extensions.
5	... cannot resist ... "or not two b's" *sigh*
6	The Applicative style (see this paper) would have the list of functions applied to the list of arguments thusly ... map uncurry rules <*> [(cards, bag)] ... but I suppose that, in itself, opens up a new topic of discussion, which I will currently shunt to another day.