If you aren't familiar with Applicative Functors, they are somewhere in between the familiar and simple Functor class and the Monad class; an abstraction for function application with a context. Check out here for more.

Away from the computer I got out a pad of paper and went about trying to figure out how the < *> method was defined over functions. Here are the types:

The polymorphic type:
(< *>) :: (Applicative f) => f (a -> b) -> f a -> f b

Substitute (x -> ...) for f to get the type for the functions instance:
(< *>) :: (x -> a -> b) -> (x -> a) -> (x -> b)

You can try defining the instance from the type definition; there seems to be only one sensical way. When I did it I was struck by something: the definition for the function above is the same as the S combinator in the SKI combinator calculus!

At that point I started looking for other connections to combinatory logic, and quickly noticed that the class method pure was essentially the K combinator!. Here is the actual instance definition:

instance Applicative ((->) a) where
        pure = const
        (< *>) f g x = f x (g x)

For those not familiar, the SK(I) Combinator Calculus is a formal system for modelling computation, much like the lambda calculus; one can express any computable function using only the three (actually only S and K are necessary) symbols and parentheses. I've written about and implemented the combinator calculus, and you can read more on the wikipedia page.

Exploring the Connection

It's pretty astounding to me that the only two methods required to define an Applicative instance turn out to be sufficient (the details of haskell's type system aside) to define a complete combinator base, capable of expressing any computable function.

At first I wondered whether this connection was the brainchild of some clever haskeller who defined the (->) instance, and therefore somewhat artificial. But it turns out that the definitions for pure and (< *>) fall out quit naturally from the type definitions. So naturally in fact that we can use djinn to automatically derive their definitions!:

Djinn> ? (< *>) :: (x -> a -> b) -> (x -> a) -> (x -> b)
(< *>) :: (x -> a -> b) -> (x -> a) -> x -> b
(< *>) a b c = a c (b c)
Djinn> ? pure :: a -> (x -> a)
pure :: a -> x -> a
pure a _ = a

Observe how the function definitions above could have been pulled right from an explanation of the S and K combinators.

Now let's play with this in GHCi. We'll first define our S and K combinators as the Applicative methods (giving type hints to keep the typechecker happy), then define the I combinator in terms of S and K, then we'll express a Church numeral:

Prelude> :m + Control.Applicative
Prelude Control.Applicative> let s = (< *>) :: (x -> b -> c) -> (x -> b) -> (x -> c)
Prelude Control.Applicative> let k = pure :: a -> (x -> a)
Prelude Control.Applicative> let i = s k k
Prelude Control.Applicative>
Prelude Control.Applicative> let two = s (s (k s) k) i
Prelude Control.Applicative>
Prelude Control.Applicative> two ('x':) []
"xx"

In the last last line above we sort of "render" the church numeral by applying it to a function and value that will construct a list; remember that church numerals represent integers as n-fold function composition; in the lambda calculus the numerical represenatations are more straightforward: two = \f x-> f (f x), but the idea is the same.

Conclusion

It makes a lot of sense that a general type class meant to aid programming in an "applicative" style would have some similarity with the combinator calculus (in which even data is function application), but I thought it was pretty exciting to see such a fundamental computer science concept seemingly emerge naturally out of a library designed to solve a very high-level problem.

I have no idea whether these observations are novel or old and obvious, but would love to hear from anyone who has any thoughts on this.

EDIT: After taking a closer look at Conor McBride and Ross Paterson's paper on Applicative Functor's, I see now that he labels his ((->) a) instance methods with "S" and "K", but does not explore the subject further. So I'm leaning towards obvious.

Thanks for reading :)

Normally this is fine, but what if we really wanted to use the mechanics of a state monad to pass some state value that changed type, e.g. some mutually-recursive tree structure we would like to traverse?:

data EvenBranch = EBranch OddBranch Int OddBranch

data OddBranch = OBranch EvenBranch EvenBranch
               | Nil

Well it turns out its not only possible, but relatively simple to use the existing MonadState types with something like a dynamically-typed state, thanks to a couple really fascinating standard Haskell libraries:

Introducing Typeable and Dynamic

The first piece of the puzzle is the Data.Typeable library. The library provides polymorphic functions for extracting type information (in the form of a data type called a TypeRep) from any object in the Typeable type class.

Try this out:

Prelude Data.Dynamic> :t typeOf
typeOf :: (Typeable a) => a -> TypeRep
Prelude Data.Dynamic> typeOf 1
Integer
Prelude Data.Dynamic> typeOf 1 == typeOf 'a'
False
Prelude Data.Dynamic> typeOf 1 == typeOf 2
True

The magic of bringing bits of the abstract type system into the world of data is known as “reification”.

Typeable also provides a method of “casting” any Typeable value as a fixed type, in the Maybe monad. Observe:

Prelude Data.Dynamic> cast 'a' :: Maybe Int
Nothing
Prelude Data.Dynamic> cast 'a' :: Maybe Char
Just 'a'

By using cast the programmer is essentially saying “Compiler, I take it upon myself to deal with any runtime type errors in my code. Take the afternoon off.”

The other component is Data.Dynamic, which uses Typeable (and in fact exports the entire Typeable module) to create a new data type called Dynamic. Thanks goes to Luke Palmer for pointing out the existence of this library to me.

This Dynamic type is like a magic bag for Typeable values:

Prelude Data.Dynamic> :t toDyn
toDyn :: (Typeable a) => a -> Dynamic
Prelude Data.Dynamic> :t fromDynamic
fromDynamic :: (Typeable a) => Dynamic -> Maybe a
Prelude Data.Dynamic> fromDynamic (toDyn 'c') :: Maybe Char
Just 'c'

So by encapsulating an arbitrary Typeable value in a Dynamic, it becomes a monomorphic value that we can use in lists, functions, etc.

A final interesting thing to note is that the existence of Typeable and Dynamic do not in any way change haskell’s static typing. For example, if the compiler cannot infer the type of a value that we cast it will complain of the ambiguity:

Prelude Data.Dynamic> cast 'a' :: (Typeable a)=>Maybe a

    Ambiguous type variable `a' in the constraint:
      `Typeable a'
        arising from an expression type signature at :1:0-32
    Probable fix: add a type signature that fixes these type variable(s)

Furthermore the compiler will not allow you to do something fancy like define a function that says “if the value is an Int pass it to foo, if it is a String, pass it to bar, else return Nothing”.

Defining the Dynamic State Monad

Okay, now let’s get to the fun part and define our new state monad with dynamic state.

module DynamicState
    where

import Control.Monad.State
import Data.Dynamic

type DynamicState a = StateT Dynamic Maybe a

As you can see our new monad is simply the StateT monad transformer, where the state type is a Dynamic (meaning we’ll be able to marshall in and out whatever state types we like), and the inner monad is Maybe for catching any type threading errors.

-- Dynamic 'get' and 'put' functions:
putD :: (Typeable a)=> a -> DynamicState ()
putD = put . toDyn

getD :: (Typeable a)=> DynamicState a
getD = get >>= lift . fromDynamic

Above we define our special getter and setter functions. You can see that they are both very simple: putD simply takes a Typeable state value, converts it to a Dynamic and pushes it; getD gets the Dynamic state, casts it into our requested type, and lifts this Maybe value back into the StateT transformer.

That’s about all there is to it, but a couple more functions are useful if we want to completely hide Dynamic from the user:

-- Compiler will complain if we ignore the returned final state since
-- its type is ambiguous:
runDState :: (Typeable s, Typeable s')=> DynamicState a -> s -> Maybe (a, s')
runDState c = (liftTypState =<<) . runStateT c . toDyn
    where liftTypState (a,s) = fmap ((,)a) $ fromDynamic s

-- ...instead, use this if we want to discard the final state:
evalDState :: (Typeable s)=> DynamicState a -> s -> Maybe a
evalDState c =  evalStateT c . toDyn

Testing it Out

Let’s use the example we presented above (passing a mutually-recursive data type as state) to demonstrate our new state monad.

To begin with, we must make our EvenBranch/OddBranch type an instance of the Typeable class. This is really easy in GHC with the DeriveDataTypeable extension. Just add this to the top of the file:

{-# LANGUAGE DeriveDataTypeable #-}

…and add “deriving Typeable” to the data declarations for those two types.

Now let’s see an example of a correct computation in the DynamicState monad (I’m sorry this is such a bad example, but I hope it demonstrates the point):

 -- a non-sensical and contrived example:
traverseGood :: DynamicState String
traverseGood = do
     -- we "get" a state value of type EvenBranch
    (EBranch l i r) <- getD
     -- ...and here we "put" a different type (OddBranch)!
    if i == 2     then putD r
                  else putD l
    (OBranch l' _)  <- getD
     -- ...and the state type changes back once more:
    putD l'
    (EBranch _ i' _) <- getD
    if i' == 3 then return "found 3 in tree"
               else return "3 not found"

Now we can define a little helper function to test our computation and a test EvenBranch tree we can pass as state:

tree = EBranch Nil 2 (OBranch (EBranch Nil 3 Nil) (EBranch Nil 4 Nil))

test :: DynamicState String -> Maybe String
test c = evalDState c tree

And testing it out with GHCi:

*DynamicState> test traverseGood
Just "found 3 in tree"

Cool! It seems like we got the threading of the state types correct and the algorithm did… what we wanted it to do.

Now let’s intentionally screw up the state, in a slight variation to the code above:

-- sae as above but with a programmer error:
traverseBad :: DynamicState String
traverseBad = do
    (EBranch l i r) <- getD
    if i == 2     then putD r
                  else putD l
     -- Oops! This is not the type of our state at this point!:
    (EBranch l' _ _)  <- getD
    putD l'
    (EBranch _ i' _) <- getD
    if i' == 3 then return "found 3 in tree"
               else return "3 not found"

And testing running this computation:

*DynamicState> test traverseBad
Nothing

This time a casting error was caught in our inner Maybe monad and running the computation simply returned Nothing.

Philosophical Conclusion

The existence of Data.Dynamic allows for library designers to implement some pretty cool things that wouldn’t normally be possible in a statically-typed language. But I wonder to what extent its use is not simply “passing the buck” so to speak.

In other words to what extent can a haskell programmer really handle potential type failure at runtime? If Nothings raised by cast et al. failing eventually simply percolate up into an error message thrown in the user’s face, then Typeable seems not much more than a shim to work around haskell’s type system.

I noticed that in the previous version, the function foldThrist was essentially a foldr with a type signature that was overly restrictive.

For instance, one could not define an identity function on Thrists in terms of the foldThrist function, the way one can with regular lists, e.g.:

foldr (:) [] [1..4] == [1,2,3,4]

Other additions followed as I tried to define the Thrist equivalent of many useful list functions. For example I wanted to define a foldl-like function that we could use to reverse a Thrist.

Check out the release announcement on Gabor’s blog, along with his draft paper on Thrists.

A Brief Thrist Primer

A Thrist is a type-threaded list. This is easiest explained with an example:


*Data.Thrist> :t Cons (True,'z')$ Cons ('a',"bar")$ Cons ("foo",3.14) Nil
Cons (True,'z')$ Cons ('a',"bar")$ Cons ("foo",3.14) Nil
:: (Fractional c) => Thrist (,) Bool c


As you can see, unlike the regular haskell list type which takes a single type for each element, the Thrist takes a single binary type (in the case above we have the tuple type: (,)) for each element, whose type arguments are chained together. So the second type argument of one cell must be the same type as the first type argument of the following cell, and so on.

The two arguments that are visible in the outer Thrist type itself are the first argument of the first cell, and the second argument of the last cell. In the example above those would be Bool (taken from the True value fst of the head of our Thrist), and some as-yet-undetermined Fractional type (our 3.14 value).

This type of cool data structure is only possible because of GADTs which let us enforce the type-threading and allow us to have all these types inside the Thrist without having them show up in the type signature.

Here is how the Thrist GADT is defined:

data Thrist :: (* -> * -> *) -> * -> * -> * where
  Nil :: Thrist (~>) a a
  Cons :: (a ~> b) -> Thrist (~>) b c -> Thrist (~>) a c

Here is another example of a Thrist in which the binary type element is a function:

*Data.Thrist> :t Cons head $ Cons fst $ Cons not Nil
Cons head $ Cons fst $ Cons not Nil
    :: Thrist (->) [(Bool, b)] Bool

It might look odd to see (->) used by itself as an argument to a type signature, but a Thrist of functions is actually pretty cool. We can actual fold the Thrist using function composition:

*Data.Thrist> :t foldl1Thrist (flip (.)) $ Cons head $ Cons fst $ Cons not Nil
foldl1Thrist (flip (.))$ Cons head $ Cons fst $ Cons not Nil
:: [(Bool, b)] -> Bool

Notice how similar the Thrist definition is to the composed function. You can see how the Thrist generalizes function composition to a certain extent.

Here I show how we can use Haskell’s type classes and other language features to model the Combinator Calculus. The goals of this module were:

1. don’t force any one evaluation strategy
2. allow users to define new combinators without exposing the implementation
3. allow new combinators to be defined in terms of other already-defined combinators.
4. discourage creation of non-sensical combinator expressions, or possible mis-use of the module
5. hide existential types and anything else exotic

If you want to play with it, you can do a:

$> darcs get http://coder.bsimmons.name/code/CombinatorCalculus

A Quick Combinator Calculus Primer

A Combinatory Logic expression consists of a sequence of combinator terms and sub-expressions. Combinator terms are like functions which consume some arguments (themselves combinators or sub-expressions), and return a particular re-arrangement of those arguments. When no term can consume enough arguments to be “evaluated” any further, the expression is said to be in normal form.

The SKI Combinator Calculus is a system that uses only three combinators (‘S’, ‘K’ and ‘I’) and forms a Turing Complete system. This means we can express any computation with expressions that look like SK(SSS)I(S(KS)K)I. It can even server as the basis of a turing complete programming language!

It’s a really fascinating topic, and you can get a great overview from wikipedia’s excellent Combinatory Logic article.

The Design of the Module

All terms in combinatory logic take some arguments and form a new expression from them, but different combinators transform their arguments in different ways.

We can express this in Haskell by creating a typeclass with methods that describe the behavior of a combinator. Then we can make a type (corresponding to a specific Combinator term) an instance of our class to define its behavior.

The Combinator Class

Here is how we define our Combinator class:

 -- a Class for combinators. Its methods represent a combinator's behavior on
 -- its arguments:
class (Show c)=> Combinator c where
    takesArgs :: c -> Int

    applyArgs :: c -> [Term] -> Expr
    
     -- HIDDEN METHOD: EXPORTED AS A FUNCTION:
     -- if a combinator takes 0 args, we assume it can be evaluated and we
     -- say it is not in Normal Form:
    isNormal :: c -> Bool
    isNormal = (> 0) . takesArgs
    
     -- HIDDEN METHOD: user defined combinators are placed in a black box:
    toTerm :: c -> Term
    toTerm = Term

The first two methods are the only ones exported to users of the module to define an instance of Combinator. takesArgs is used to indicate how many arguments this particular combinator requires before it can be evaluated.

applyArgs actually performs the transformation of those arguments; it is given a list of terms (of length equal to `takesArgs`) and returns a new expression (type Expr).

The third method is used to check if an expression is in normal form. It is exported as a regular function, meaning that users can use it in their code but cannot use it in their own instance declarations. Instead the default value would apply.

The fourth method `toTerm` is used internally to encapsulate some Combinator class item in a `Term` data type. We use this when composing combinator expressions, in order to preserve the tree structure of the expression. (see below for more on this)

The Term and Expr types

The module defines two new datatypes, both of which are instances of `Combinator`.

`Expr` is a newtype wrapper around Seq Term, but we don’t export the implementation so we can change this if we don’t want to use Sequences:

newtype Expr = Expr { combSeq :: Seq Term }

It simply represents a CL expression as a sequence of terms. Making it an instance of `Combinator` expresses the notion that an expression can be thought of as a combinator term whenever the need arises. In fact the distinction is simply one of evaluation strategy.

`Term` is a wrapper for Combinator terms and sub-expressions. It is mutually-recursive with `Expr` and the two together form the tree structure of a combinator expression:

data Term = forall c. Combinator c => Term { unbox :: c }
          | SubExpr   { subExpr :: Expr }
          | NamedExpr { subExpr :: Expr,
                        name    :: String }

All three constructors are hidden from the user. `SubExpr` simply holds an `Expr` type and represents a parenthesized sub-expression within the top level combinator sequence. `NamedExpr` is identical except that it also contains a String, which will be returned when `show` is called on that constructor. Here is the `Show` instance for `Term`:

instance Show Term where
    show (NamedExpr _ n) = n
    show (SubExpr e)     = "("++ show e ++")"
    show (Term t)        = show t

The remaining constructor is the most interesting: the `Term` constructor houses an existentially-quantified type and can hold any type value of the `Combinator` class.

Notice that the type variable does not appear on the left side of the = in the type declaration. What this means in practical terms is that the `Term` constructor becomes a “black box”; once a value is inside, the only things we can “do with it” are to apply polymorphic Combinator class functions and methods.

And that’s why we have the internal `toTerm` method; it allows us to wrap sub-expressions in the `SubExpr` constructor, preserving the tree structure of an expression as we compose it. Without it we would either need to export multiple functions for composing a term with an expression, an expression with an expression, a term with a term, and an expression with a term. Ugly!

Exported functions

Our types and classes allow us to do some neat stuff. As mentioned above, we can compose expressions using a single haskell infix function. Since all the nice ASCII combinators were taken (and since I’m the only one using this) I decided to go with a Unicode symbol, the middle dot, for composition:

 -- operator for composing combinator expressions. This is the Middle Dot,
 -- unicode character 00B7. It is easily inserted in vim using the digraph:
 --       Ctrl-K '.' 'M'
infixl 7 ·

…and the implementation:

 -- for composing Combinator expressions:
(·) :: (Combinator c1,Combinator c2)=> c1 -> c2 -> Expr
c1 · (toTerm->t2) = 
     case toTerm c1 of                                                                
          (SubExpr e) -> e `appendTerms` singleton t2                                
           -- named expression or bare Term start a new sub-expression:              
          t1          -> Expr (singleton t1 |> t2)

We also have the ability to define new combinators in terms of other combinators using the `named` function. Here is an example showing how `I` can be defined in terms of `S` and `K` and used to form a Combinator Calculus equivalent of the Church Numeral 2:

60 two = S·(S·(K·S)·K)·cI
61     where cI = (S · K · K)  `named` "I"

Playing with it

The evaluation function exported in the module was written fairly hastily, but it is good enough to let us play with evaluating expressions.

I’ve run out of time on this post, but you can grab the darcs repo above and run the ‘main’ function in `Examples.hs` and check out the source for more info. I’ll maybe show some cool examples in a later post.

Thanks for reading!

Note: this is part of a series of posts is related to the “17×17 Challenge” posted by Bill Gasarch. The goal is to color cells of a 17 by 17 grid, using only four colors, such that no rectangle is formed from four cells of the same color.

Just a few follow-ups to my previous post in which I use a simulated annealing-type algorithm to find a good (hopefully complete) cover of a grid by swapping rows and columns from four identical sub-grids of 74 colors.

Easing into new thresholds

I modified my algorithm so that the likelihood of jumping into the highest permitted energy level is decreased over time; thus instead of having an abrupt transition to a new threshold, resulting in a steep dive, we instead ease into the new energy level.

Here is a graph of a run with the adjusted meta-heuristic (in blue) alongside a previous abrupt threshold transition run (in black). You can check compare it to the graph from the previous post:

Unfortunately this change didn’t cause any improvement in the solutions generated. They still seem to flatten at a grid with 19 – 22 uncolored cells.

Testing a combination of sub-grids with known good solution

I wondered if the lower bound I was smacking into was caused by the fact that I was trying to find a combination of four permutations of the same subset, and perhaps this particular subset didn’t mesh all that well with itself.

In the original blog posting laying out this challenge there is four-coloring of 17×17 with only one cell left un-colorable in a truly painful refactoring process, I modified my script to take four separate and distinct sub-grids and perform the same shuffling procedure.

Rather than find the original arrangement of the colored subsets or one nearly as good, the program settles on a solution with around 30 uncolored cells. That is worse than my original version, corresponding to the fact that there are fewer cells to work with in this latter set of colored subsets: 288 vs. 296.

Conclusion

This doesn’t say anything about whether a full-cover can likely be obtained by permuting four overlapping copies of a single subset of colors. It does tell us that either my code is flawed, this isn’t a particularly effective method for this kind of search, or it needs to be tuned better.