A whirlwind tour of Haskell, day 8

Day 8, functionally: pattern-matching

Today's puzzle involves parsing: we are given a string literal containing escape sequences, and we must interpret those escape sequences into the characters they represent. Or at least into the correct number of characters, whatever.

In my puzzle solutions so far, I have always pattern-matched at most one level deep, meaning that the pattern if any was always of the form (Constructor arg1 arg2 ...). Instead of binding those arguments to variables, I can also choose to nest more constructors. When pattern-matching on the list of characters of a string, nesting multiple patterns allows me to match on several characters at once, making it easy to recognize each of the three escape sequences specified in the puzzle using one pattern each.

import Data.Char

-- |
-- >>> print (parse "\"(\x20\\\"\x20)\"")
-- "( \" )"
parse :: String -> String
parse ('"':xs0) = go xs0
  where
    go []                  = error "unterminated string literal"
    go ('"'           :[]) = []
    go ('\\':'\\'     :xs) = '\\'      : go xs
    go ('\\':'"'      :xs) = '"'       : go xs
    go ('\\':'x':x1:x2:xs) = hex x1 x2 : go xs
    go (x             :xs) = x         : go xs
parse _ = error "not a string literal"

hex :: Char -> Char -> Char
hex c1 c2 = chr (16 * digitToInt c1 + digitToInt c2)

If we were writing an imperative implementation, we would probably have some kind of current index into the string which we would increment by 1, 2, or 4 characters depending on the pattern. It would be easy to accidentally increment that index by the wrong number of characters. By contrast, notice how the pattern-matching approach is less error-prone, as it naturally encourages us to give a name to the part of the string which isn't covered by each pattern.

Day 8.5, combinatorially: invertible-syntax

Once the second part is revealed, we can see that the complete puzzle consists of two related tasks: parsing a string literal into a string value, and pretty-printing a string value into a string literal. Whether imperative or functional, functions convert inputs to outputs, and so it would be natural to implement both directions as two separate functions. But why restrict ourselves to functions? While Haskell is best known for being a purely functional programming language, "functional" programming does not imply that everything is a function. In fact, we regularly construct other abstractions, new kinds of building blocks which can be composed into larger ones: the "combinator libraries" I briefly mentioned on Day 1. So let's put on our combinatorial glasses, step away from functions for a bit, and ask ourselves: What kind of building blocks would be useful for this problem? How can those building blocks be composed into larger building blocks?

The invertible-syntax library proposes the following approach: each building block shall know how to parse and to pretty print a value of a particular type, for example a character, and those building blocks can be combined into larger building blocks that know how to parse and pretty-print more complicated values, for example a string.

As usual, I'll write doctest comments above each definition to demonstrate what each building block does. Since I almost always want to demonstrate that a string s parses into a value x and that this same value x pretty-prints into the same string s, I'll use the following helper function to test both directions at once.

{-# LANGUAGE RankNTypes #-}
import Prelude hiding (print, pure, (<$>), (<*), (<*>), (*>))
import Text.Syntax
import Text.Syntax.Parser.Naive
import Text.Syntax.Printer.Naive

-- |
-- >>> test (pure 42) "" 42
-- True
-- >>> test (text "foo") "foo" ()
-- True
test :: Eq a => (forall f. Syntax f => f a) -> String -> a -> Bool
test block s x = (parsedValue == x) && (printedString == Just s)
  where
    parsedValue = head (parse block s)
    printedString = print block x

The two primitive building blocks I have demonstrated in the doctest comment are dual to each other: pure consumes no characters when parsing and always produces the same value, while text always consumes the same characters and doesn't produce anything useful as its value. They can be combined to describe "atoms", that is, a particular value which is represented using a particular string. Useful atoms for this puzzle include the backslash and double quote characters, which are represented using their respective escape sequences.

atom :: (Eq a, Syntax f) => String -> a -> f a
atom s x = pure x <* text s

-- |
-- >>> test backslash "\\\\" '\\'
-- True
backslash :: Syntax f => f Char
backslash = atom "\\\\" '\\'

-- |
-- >>> test doubleQuote "\\\"" '\"'
-- True
doubleQuote :: Syntax f => f Char
doubleQuote = atom "\\\"" '\"'

The hexadecimal escape sequence is a bit more complicated. I'll build it out of smaller atoms, one for each hexadecimal digit:

type Word4 = Int
type Word8 = Int

-- |
-- >>> test (hexDigits !! 12) "c" 12
-- True
hexDigits :: Syntax f => [f Word4]
hexDigits = [atom [intToDigit i] i | i <- [0..15]]

oneOf :: Syntax f => [f a] -> f a
oneOf = foldr (<|>) empty

-- |
-- >>> test hexDigit "a" 10
-- True
hexDigit :: Syntax f => f Word4
hexDigit = oneOf hexDigits

I've used the binary choice combinator (<|>) from invertible-syntax to construct an n-ary choice operator oneOf acting on lists, and I used it to combine my atoms into a more useful building block hexDigit which can parse and pretty-print any hex digit.

Next, I'd like to combine two of those into a full byte, but with only the invertible-syntax combinators, I can only combine them into a pair of nibbles (a number between 0 and 15):

-- |
-- >>> test nibbles "6f" (6, 15)
-- True
nibbles :: Syntax f => f (Word4, Word4)
nibbles = hexDigit <*> hexDigit

Given a pair of nibbles, I can easily compute the value of the corresponding byte. However, since our building blocks are going in both directions, we will also need a formula for splitting a byte into a pair of nibbles. This way, the parsing process will extract two nibbles and merge them into a byte, and the pretty-printing process will split the byte into two nibbles and will pretty-print each one.

import Control.Isomorphism.Partial.Prim
import Control.Isomorphism.Partial.Unsafe

iso :: (a -> b) -> (b -> a) -> Iso a b
iso f g = Iso (Just . f) (Just . g)

mergeNibbles :: Iso (Word4, Word4) Word8
mergeNibbles = iso (\(x,y) -> x * 16 + y) (`divMod` 16)

-- |
-- >>> test byte "6f" 111
-- True
byte :: Syntax f => f Word8
byte = mergeNibbles <$> nibbles

-- |
-- >>> test hexChar "\\x6f" 'o'
-- True
hexChar :: Syntax f => f Char
hexChar = iso chr ord <$> text "\\x" *> byte

invertible-syntax has a companion library called partial-isomorphisms for constructing such pairs of inverse functions. It is a combinator library in its own right, with many primitives and combinators ensuring that the resulting functions really are inverses of each other, but in this case I prefer to use the unsafe portion of the library, which allows me to specify an arbitrary pair of functions and to tell the library to trust me that those are inverses of each other.

Now that we have covered all the escape sequences, the last kind of character which could occur in a string is a non-escaped character.

-- |
-- >>> test otherChar "o" 'o'
-- True
otherChar :: Syntax f => f Char
otherChar = subset (`notElem` ['\\','\"']) <$> token

subset builds a partial isomorphism by taking the identity isomorphism which doesn't change the value in either direction, and restricting its domain to the values satisfying a predicate. In this case, we don't want backslash and double quote characters to be included in the domain of non-escaped characters, because those characters do need to be escaped.

So far I've been talking about functions going in two directions as if the two functions were true inverses of each other, but in fact as the name implies, partial isomorphisms are only partial inverses. The reason we don't need the functions to be exact inverses is that a given value may have several different, equally valid textual representations. For example, the character 'o' can be represented either as "o" or as "\x6f", and both encodings are valid. But when we convert those two representations to the single value 'o' and then back to a string, the function which converts 'o' into a string can only choose one answer! Suppose it chooses "o": the other value, "\x6f", demonstrates that the functions are not inverses, because applying one function to "\x6f" yields 'o' but applying the other function to 'o' does not yield back "\x6f".

Now that we have building blocks for every kind of character, we can combine them into one more complicated building block which knows how to parse and pretty-print any character.

-- |
-- >>> test char "o" 'o'
-- True
-- >>> head (parse char "\x6f")
-- 'o'
-- >>> print char 'o'
-- Just "o"
char :: Syntax f => f Char
char = oneOf [backslash, doubleQuote, otherChar, hexChar]

While parsing, escaped backslashes and double quotes will be parsed into backslashes and double quotes, non-escaped characters will be parsed into themselves, and escaped hexadecimal codes will be parsed into the corresponding ascii character. When pretty-printing, however, no characters will be printed in hexadecimal, because every character is either a backslash, a double quote, or in the domain of otherChar. So the pretty printer will never fall back to hexChar, and 'o' will be printed as "o", not "\x6f". We could of course have chosen otherwise by ordering the list of building blocks differently.

Now that we can handle characters, we're finally ready to describe how to handle an entire string.

-- |
-- >>> test string "\"( \\\" )\"" "( \" )"
-- True
-- >>> head (parse string "\"(\x20\\\"\x20)\"")
-- "( \" )"
-- >>> print string "( \" )"
-- Just "\"( \\\" )\""
string :: Syntax f => f String
string = between (text "\"") (text "\"") (many char)

This approach ended up requiring much more code than simply writing separate functions for parsing and pretty-printing strings. It is, however, much less error-prone: if we end up changing the way in which strings can be represented, for example by supporting more kinds of escape sequences, we will only have to modify the code once. In contrast, with two separate functions, it would be easy to forget to update the other function, or to accidentally modify the functions in a way which causes them to no longer be partial inverses.

Navigation

• About this series
• Previous day: laziness-based caching and meta-programming

A whirlwind tour of Haskell, day 7

Day 7, functionally: bit fiddling, Map, and recursion

Today's puzzle is quite interesting, and will allow me to demonstrate several Haskell techniques! We're given the description of an electronic circuit consisting of a bunch of constants and bitwise operations, and we need to simulate it. The bitwise operations are fairly standard, here's what they look like in Haskell:

import Data.Word
import Data.Bits

opAND :: Word16 -> Word16 -> Word16
opAND = (.&.)

opOR :: Word16 -> Word16 -> Word16
opOR = (.|.)

opLSHIFT :: Word16 -> Int -> Word16
opLSHIFT = shiftL

opRSHIFT :: Word16 -> Int -> Word16
opRSHIFT = shiftR

opNOT :: Word16 -> Word16
opNOT = complement

Like before, I'll skip the parsing details and I'll represent the operations using a precise type.

type WireName = String

data Expr
  = Number Word16
  | Wire   WireName
  | AND    Expr Expr
  | OR     Expr Expr
  | LSHIFT Expr Int
  | RSHIFT Expr Int
  | NOT    Expr
  deriving (Show, Eq)

-- (wire, expression producing its value)
type Assignment = (WireName, Expr)

Since numbers and wires are allowed both at the top-level (for example 123 -> a and w -> a) and nested inside a single operation (for example 1 OR b -> a), I found it slightly easier to allow operations to be nested into arbitrarily deep expressions. This way, I don't have to repeat my number and wire logic in two separate places.

Anyway, the tricky part of this puzzle is that those expressions aren't meant to be evaluated in the order in which they are given, as some of the wire names are used as input much earlier than the expressions which give a value to those wires. Instead, we should take our list of assignments and store them in a Map, so we'll be able to easily get the expression which produces the value of each wire.

import Data.Map (Map)
import qualified Data.Map as Map

type Env = Map WireName Expr

mkEnv :: [Assignment] -> Env
mkEnv = Map.fromList

lookupEnv :: Env -> WireName -> Maybe Expr
lookupEnv = flip Map.lookup

-- throws an exception if the name is not found
lookupEnv' :: Env -> WireName -> Expr
lookupEnv' = (Map.!)

Now that I can lookup the expression for each wire, I can evaluate expressions using a recursive solution: if the expression is a number (the base case), I'm done, if the expression depends on another wire, I lookup its expression and evaluate it using a recursive call, and if it's an operation, I recursively evaluate its operands and perform the operation. Easy!

eval :: Env -> Expr -> Word16
eval _   (Number   n) = n
eval env (Wire  name) = eval env (lookupEnv' env name)
eval env (AND    x y) = opAND    (eval env x) (eval env y)
eval env (OR     x y) = opOR     (eval env x) (eval env y)
eval env (LSHIFT x i) = opLSHIFT (eval env x) i
eval env (RSHIFT x i) = opRSHIFT (eval env x) i
eval env (NOT    x  ) = opNOT    (eval env x)

Using this solution, we can easily evaluate each of the wires given in the sample circuit:

-- |
-- >>> :{
-- let assignments = [ ("d", AND (Wire "x") (Wire "y"))
--                   , ("e", OR  (Wire "x") (Wire "y"))
--                   , ("f", LSHIFT (Wire "x") 2)
--                   , ("g", RSHIFT (Wire "y") 2)
--                   , ("h", NOT (Wire "x"))
--                   , ("i", NOT (Wire "y"))
--                   , ("x", Number 123)
--                   , ("y", Number 456)
--                   ]
--     wireNames   = map fst assignments
--     wireValues  = map (day7 assignments) wireNames
-- in forM_ (zip wireNames wireValues) print
-- :}
-- ("d",72)
-- ("e",507)
-- ("f",492)
-- ("g",114)
-- ("h",65412)
-- ("i",65079)
-- ("x",123)
-- ("y",456)
day7 :: [Assignment] -> WireName -> Word16
day7 assignments name = eval env (lookupEnv' env name)
  where
    env :: Env
    env = mkEnv assignments

However, if we try it on the puzzle's larger circuit, the algorithm gets stuck! What happens is that many of the wires are used more than once, and yet are re-evaluated each time they are encountered. Consider the expression b AND c -> a. If operands b and c both end up depending on the same wire d, evaluating a will end up evaluating d's expression twice, and if a has to be evaluated twice, d will end up being evaluated four times. Since the number of evaluations doubles each time a new element is added to such a chain, it doesn't take many elements for the number of evaluations to become astronomical, causing our algorithm to get stuck re-evaluating the same expressions over and over.

Day 7, imperatively: caching

Clearly, we should cache the result of each wire in order to avoid evaluating the same expression more than once. Here is an imperative implementation of that idea: keep a map of the results computed so far, and each time we encounter a wire name, look inside the map to see if we already have a result for this wire. If we do, use it, otherwise recursively compute the answer and store it in the map.

type Cache = Map WireName Word16

lookupCache :: Cache -> WireName -> Maybe Word16
lookupCache = flip Map.lookup

lookupCache' :: Cache -> WireName -> Word16
lookupCache' = (Map.!)

eval :: Env -> Expr -> State Cache Word16
eval _   (Number   n) = return n
eval env (Wire  name) = do
    cache <- get
    case lookupCache cache name of
      Just x  -> return x
      Nothing -> do
          x <- eval env (lookupEnv' env name)
          modify (Map.insert name x)
          return x
eval env (AND    x y) = opAND    <$> eval env x <*> eval env y
eval env (OR     x y) = opOR     <$> eval env x <*> eval env y
eval env (LSHIFT x i) = opLSHIFT <$> eval env x <*> pure i
eval env (RSHIFT x i) = opRSHIFT <$> eval env x <*> pure i
eval env (NOT    x  ) = opNOT    <$> eval env x

Day 7, lazily: laziness-based caching and MemoTrie

Haskell has another way to cache results which is built into the language: its implementation of laziness.

In the previous days, I pointed out a few situations in which laziness improves the performance by skipping over the part of a pure computation whose result does not end up being used. If the result does end up being used, the computation must be performed. If the result ends up being used multiple times, the computation must also be performed, but only once, not multiple times. The way in which this is implemented is that the memory in which the result would normally be stored can point to either a thunk describing which computation needs to be forced to obtain the result, or it can point to the result itself if it has already been computed. In other words, laziness caches the results of computations so that each computation only has to be performed at most once.

Another aspect of laziness is that it allows us to define infinite data structures, by only constructing the portion of the data which ends up being needed, and also circular data structures, because by the time the structure loops back to the beginning, the beginning's thunk has already been expanded into a value.

-- |
-- >>> take 10 circular
-- [1,2,3,1,2,3,1,2,3,1]
circular :: [Int]
circular = 1 : 2 : 3 : circular

Here is a trickier example in which instead of directly looping back to the beginning, we examine the portion of the data structure which has been constructed so far and we produce a modified version.

-- |
-- >>> take 10 nats
-- [1,2,3,4,5,6,7,8,9,10]
nats :: [Int]
nats = 1 : map (+1) nats

Those two examples are both referring to earlier parts of the list, but it's also possible to refer to a later part of the list.

-- |
-- >>> backwards
-- [7,8,9,10]
backwards :: [Int]
backwards = [ (backwards !! 1) - 1
            , (backwards !! 2) - 1
            , (backwards !! 3) - 1
            , 10
            ]

Here is what happens while backwards is being printed. First, ((backwards !! 1) - 1)'s thunk is forced. This causes (backwards !! 2) - 1 to be forced, which in turn causes (backwards !! 3) - 1 to be forced as well. This yields the result 9, so the (backwards !! 3) - 1 thunk is replaced with the value 9, and similarly for 8 and 7. The first element 7 can finally be printed, and we move on to print the next elements, which have already been evaluated to 8, 9 and 10. As you can see, each thunk is only evaluated once, and if there are dependencies between the thunks, the dependencies are evaluated first.

I hope it is now clear how laziness can help us with today's puzzle: instead of writing an imperative computation to manually cache the results and traverse the dependencies, we can simply construct a data structure whose elements are defined in terms of each other. This way, evaluating any element of the data structure will automatically force its dependencies while caching the results.

day7 :: [Assignment] -> WireName -> Word16
day7 assignments name0 = lookupCache' cache name0
  where
    cache :: Cache
    cache = Map.fromList (map (second eval) assignments)
    
    eval :: Expr -> Word16
    eval (Number   n) = n
    eval (Wire  name) = lookupCache' cache name
    eval (AND    x y) = opAND    (eval x) (eval y)
    eval (OR     x y) = opOR     (eval x) (eval y)
    eval (LSHIFT x i) = opLSHIFT (eval x) i
    eval (RSHIFT x i) = opRSHIFT (eval x) i
    eval (NOT    x  ) = opNOT    (eval x)

Here I am constructing cache, a map from each wire name to its computed value, by applying eval to the corresponding expressions. eval is itself defined in terms of the cache, in which it looks up the values computed for the dependencies. We didn't have to write any special code to do so, but this cache lookup will either return immediately with the result if it has already been computed, or it will find and force a thunk, calling eval on the dependency and caching the result.

Another way to achieve the same result is to use a memoization library. Here I use MemoTrie to memoize the result of looking up and evaluating the expression corresponding to a wire name. This way, when evalExpr calls evalWire on a dependency, it will use the cached value if there is one. The implementation uses laziness under the hood.

import Data.MemoTrie

day7 :: [Assignment] -> WireName -> Word16
day7 assignments name0 = evalWire name0
  where
    env :: Env
    env = mkEnv assignments
    
    evalWire :: WireName -> Word16
    evalWire = memo (evalExpr . lookupEnv' env)
    
    evalExpr :: Expr -> Word16
    evalExpr (Number   n) = n
    evalExpr (Wire  name) = evalWire name
    evalExpr (AND    x y) = opAND    (evalExpr x) (evalExpr y)
    evalExpr (OR     x y) = opOR     (evalExpr x) (evalExpr y)
    evalExpr (LSHIFT x i) = opLSHIFT (evalExpr x) i
    evalExpr (RSHIFT x i) = opRSHIFT (evalExpr x) i
    evalExpr (NOT    x  ) = opNOT    (evalExpr x)

If you'd like to read more about using laziness for caching, I have written a post explaining when caches do and do not get reused between calls.

Day 7, meta-programmatically: Template Haskell

I know this post is getting quite long already, but I'd like to point out one last way in which the puzzle could be solved. Consider the following Haskell code:

d = opAND x y
e = opOR x y
f = opLSHIFT x 2
g = opRSHIFT y 2
h = opNOT x
i = opNOT y
x = 123
y = 456

Even though some of the above values are used before being defined, the thunk forcing mechanism makes sure that evaluating any of those values will first evaluate and cache its dependencies. So if we could generate similar Haskell code from the circuit description, we could efficiently obtain the value of any wire.

One way of generating code which is available in any language is to construct a string containing the code we want:

import Text.Printf

validName :: String -> String
validName "do" = "do'"
validName "id" = "id'"
validName "if" = "if'"
validName "in" = "in'"
validName name = name

exprS :: Expr -> String
exprS (Number   n) = show n
exprS (Wire  name) = validName name
exprS (AND    x y) = printf "opAND    %s %s" (exprS x) (exprS y)
exprS (OR     x y) = printf "opOR     %s %s" (exprS x) (exprS y)
exprS (LSHIFT x i) = printf "opLSHIFT %s %d" (exprS x) i
exprS (RSHIFT x i) = printf "opRSHIFT %s %d" (exprS x) i
exprS (NOT    x  ) = printf "opNOT    %s"    (exprS x)

-- |
-- >>> assignmentS ("g", RSHIFT (Wire "y") 2)
-- "g = opRSHIFT y 2"
assignmentS :: Assignment -> String
assignmentS (name, e) = printf "%s = %s" name (exprS e)

This works, but generating strings is quite error-prone, in the sense that the compiler is not going to prevent you from generating code which doesn't compile.

A more principled approach is to use Template Haskell. Instead of manipulating strings, we manipulate quasiquotations which fail at compile time if the quoted code does not parse.

{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.TH

validName :: String -> Name
validName "do" = mkName "do'"
validName "id" = mkName "id'"
validName "if" = mkName "if'"
validName "in" = mkName "in'"
validName name = mkName name

exprE :: Expr -> Q Exp
exprE (Number   n) = [| n |]
exprE (Wire  name) = varE (validName name)
exprE (AND    x y) = [| opAND    $(exprE x) $(exprE y) |]
exprE (OR     x y) = [| opOR     $(exprE x) $(exprE y) |]
exprE (LSHIFT x i) = [| opLSHIFT $(exprE x) i          |]
exprE (RSHIFT x i) = [| opRSHIFT $(exprE x) i          |]
exprE (NOT    x  ) = [| opNOT    $(exprE x)            |]

-- >>> let assignment = ("g", RSHIFT (Wire "y") 2)
-- >>> decls <- runQ $ assignmentD assignment
-- >>> ppr decls
-- g = opRSHIFT y 2
assignmentD :: Assignment -> Q [Dec]
assignmentD (name, e) = [d| $(var) = $(val) |]
  where
    var :: Q Pat
    var = varP (validName name)
    
    val :: Q Exp
    val = exprE e

For extra safety, there is also a variant of [| ... |] which detects type errors at compile time:

import Language.Haskell.TH.Syntax

exprE :: Expr -> Q (TExp Word16)
exprE (Number   n) = [|| n ||]
exprE (Wire  name) = unsafeTExpCoerce $ varE (validName name)
exprE (AND    x y) = [|| opAND    $$(exprE x) $$(exprE y) ||]
exprE (OR     x y) = [|| opOR     $$(exprE x) $$(exprE y) ||]
exprE (LSHIFT x i) = [|| opLSHIFT $$(exprE x) i           ||]
exprE (RSHIFT x i) = [|| opRSHIFT $$(exprE x) i           ||]
exprE (NOT    x  ) = [|| opNOT    $$(exprE x)             ||]

Since we're generating variable names dynamically from the wire names, Template Haskell cannot know at compile time whether those variables have the correct type, so we have to use unsafeTExpCoerce to tell it to trust us that this piece will work out.

To complete the puzzle, I write a small wrapper which loads the circuit description from a file and concatenates all the generated declarations:

circuit :: FilePath -> Q [Dec]
circuit filename = do
    Right assignments <- runIO
                       $ parseFromFile (many assignment) filename
    decls <- forM assignments assignmentD
    return (concat decls)

I can finally load this circuit into my main program (for technical reason, the definitions above must be in a different file from the code below) and access the variables it defines.

-- defines "a" and many other variables
$(circuit "input.txt")

day7 :: Word16
day7 = a

Navigation

• About this series
• Previous day: precise types, arrays, and in-place updates
• Next day: invertible parsers

A whirlwind tour of Haskell, day 6

Day 6: precise types, arrays, and ST

This puzzle asks us to parse and execute a sequence of instructions. The instructions are represented as text strings, so in a dynamic language I would probably use regular expressions to determine which instruction I'm looking at, using capturing groups like the following to extract the instruction's parameters.

/^command1 ([0-9]+) ([0-9]+)$/

In Haskell, however, I prefer to define a data type describing the set of all possible instructions, like this:

data Rectangle = Rectangle (V2 Integer) (V2 Integer)
  deriving (Show, Eq)

data Operation = TurnOn | TurnOff | Toggle
  deriving (Show, Eq)

data Instruction = Instruction Operation Rectangle
  deriving (Show, Eq)

The above says that an Instruction consists of an Operation, which can either be TurnOn, TurnOff or Toggle, followed by a Rectangle consisting of two 2D coordinates (two opposite corners). I prefer this representation over a simple string because it is more precise, in the sense that the set of values of this type more closely ressembles the set of valid operations than the set of strings does. There are tons of strings such as "flubberdoodle" which do not represent a valid instruction at all, while with this precise representation, the worse I can do is a value like Instruction TurnOn (V2 0 1000) (V2 50 1050), which at least looks like an instruction, and is only invalid because those coordinates are outside the bounds of the grid specified by the puzzle.

The advantage of having a precise representation is in making sure that we handle all the possibilities. If I was implementing the puzzle's instructions using a function taking a string as input, I'd have to write something like this:

runInstruction :: String -> ...
runInstruction s
  | "turn on"  `isPrefixOf` s = ...
  | "turn off" `isPrefixOf` s = ...
  | "toggle"   `isPrefixOf` s = ...
  | otherwise                 = error "unrecognized instruction"

And then if a new instruction was added, it would be easy to forget to add a handler for it in runInstruction, especially if there were many other functions to update throughout the codebase. By using a more precise algebraic type, I can write runInstruction like this instead:

runInstruction :: Instruction -> ...
runInstruction (Instruction TurnOn  ...) = ...
runInstruction (Instruction TurnOff ...) = ...
runInstruction (Instruction Toggle  ...) = ...

And then if a new instruction gets added, I'll get a warning at compile-time instead of an "unrecognized instruction" error at runtime. Assuming you're compiling with warnings enabled, of course, which isn't the default with the .cabal file generated by cabal init. I always add the line ghc-options: -W -Wall to the end of the file it generates.

Anyway, the instructions are about flipping bits in a bit array, so let's talk about Haskell arrays. The array library defines many different kinds of arrays, and in this implementation I'll be using two different kinds, UArray (V2 Integer) Bool and STUArray s (V2 Integer) Bool.

import Data.Array.ST
import Data.Array.Unboxed

type Index = V2 Integer
type Grid     =   UArray   Index Bool
type STGrid s = STUArray s Index Bool

The Bool means that each cell of the array will contain a boolean, and the V2 Integer means that we'll be indexing into the array using 2D coordinates, so this is a 2D array. The U means "unboxed". Unboxed arrays are only defined for value types which can be tightly-packed; in our case for example, booleans can be efficiently packed as a sequence of bits.

The ST in STUArray comes from yet another monadic EDSL, called ST. If you were disappointed in Day 1 when I said that the State EDSL was limited to a single stateful variable, you'll be happy to hear that ST is a variant which allows you to allocate an arbitrary number of stateful references and to modify them in-place. This is also the EDSL we'll need to use in order to modify our array in-place.

The three operations requested by the puzzle are quite straightforward to implement: we simply read and write booleans to the array at the given index. The unboxed array implementation takes care of translating those boolean reads and writes into the corresponding bit-fiddling shifts and masks which will touch the correct bits.

import Control.Monad.ST

turnOn :: STGrid s -> Index -> ST s ()
turnOn g i = writeArray g i True

turnOff :: STGrid s -> Index -> ST s ()
turnOff g i = writeArray g i False

toggle :: STGrid s -> Index -> ST s ()
toggle g i = do
    b <- readArray g i
    writeArray g i (not b)

Each puzzle instruction requires executing one of our three operations on all the cells inside a particular rectangular area. This is straightforward as well, using the range method. This method comes from a type class named Ix, short for "index", because a type needs to have an Ix instance in order for its values to be used as indices into an array. The Ix instance for Integer, used for 1D arrays, has a range method which simply lists all the integers between two bounds. The Ix instance for V2 Integer, used for 2D arrays, has a range method which enumerates all the 2D coordinates between the corners of a rectangle, which is exactly what we want.

Since ST implements the Monad type class, we can use our trusty forM_ to execute our chosen instruction on every index in the resulting list of indices.

listIndices :: Rectangle -> [Index]
listIndices (Rectangle c1 c2) = range (c1,c2)

runInstruction :: STGrid s -> Instruction -> ST s ()
runInstruction g = go
  where
    go (Instruction TurnOn  r) = forM_ (listIndices r) (turnOn  g)
    go (Instruction TurnOff r) = forM_ (listIndices r) (turnOff g)
    go (Instruction Toggle  r) = forM_ (listIndices r) (toggle  g)

Now that we can run a single instruction, we can run the entire list of instructions in order to obtain the final light pattern. To do this, I allocate a new array of the dimensions described in the puzzle, I execute each of the instructions, and I returned a frozen copy of the STUArray. This converts the STUArray, which cannot outlive the ST computation in which it was created, into an immutable UArray, which can live outside of ST but can no longer be modified in-place.

runInstructions :: [Instruction] -> Grid
runInstructions instructions = runST $ do
    g <- newArray (V2 0 0, V2 999 999) False
    forM_ instructions (runInstruction g)
    freeze g

Finally, to solve the puzzle, I parse the instruction strings into a list of precisely-typed Instructions, I run those instructions to get a light pattern, I enumerate the bits, keep those which are True, and count how many there were.

day6 = parseInstructions
   >>> runInstructions
   >>> elems
   >>> filter id
   >>> length

I've omitted the code for parsing the instructions, it's an important topic but I'll keep it for later. I've also omitted Day 6.5 because it is too similar to Day 6.

Navigation

• About this series
• Previous day: list comprehensions and non-determinism
• Next day: laziness-based caching and meta-programming

A whirlwind tour of Haskell, day 5

Day 5: infix notation and list comprehensions

This puzzle lists a bunch of nonsense conditions on the characters of a string, and we must check whether the string satisfies all of them. This should be quite easy in any language, so it doesn't give me the opportunity to demonstrate another powerful Haskell library. Instead, I think I will try to make my implementation as readable as possible:

-- |
-- >>> numberOfTruePropositions [2+2 == 4, 3+3 == 10, 2*5 == 10]
-- 2
numberOfTruePropositions :: [Bool] -> Int
numberOfTruePropositions = filter (== True)
                       >>> length

-- |
-- >>> 2 `orMoreAreTrue` [True,True,False]
-- True
-- >>> 3 `orMoreAreTrue` [True,True,False]
-- False
orMoreAreTrue :: Int -> [Bool] -> Bool
orMoreAreTrue n = numberOfTruePropositions
              >>> (>= n)

-- |
-- >>> 2 `atMostAreTrue` [True,True,False]
-- True
-- >>> 1 `atMostAreTrue` [True,True,False]
-- False
atMostAreTrue :: Int -> [Bool] -> Bool
atMostAreTrue n = numberOfTruePropositions
              >>> (<= n)

-- |
-- >>> isVowel 'a'
-- True
-- >>> isVowel 'b'
-- False
isVowel :: Char -> Bool
isVowel c = c `elem` "aeiou"

-- |
-- >>> doubledLetter 'a'
-- "aa"
doubledLetter :: Char -> String
doubledLetter c = printf "%c%c" c c

-- |
-- >>> atLeastThreeLettersAreVowels "aaa"
-- True
-- >>> atLeastThreeLettersAreVowels "abc"
-- False
atLeastThreeLettersAreVowels :: String -> Bool
atLeastThreeLettersAreVowels s =
    3 `orMoreAreTrue` [ isVowel c
                      | c <- s                                 
                      ]                                        

-- |
-- >>> hasSomeDoubledLetter "aaa"
-- True
-- >>> hasSomeDoubledLetter "aba"
-- False
hasSomeDoubledLetter :: String -> Bool
hasSomeDoubledLetter s =
    1 `orMoreAreTrue` [ doubledLetter c `isInfixOf` s
                      | c <- ['a'..'z']
                      ]

-- |
-- >>> hasNoForbiddenSubstrings "aaa"
-- True
-- >>> hasNoForbiddenSubstrings "abc"
-- False
hasNoForbiddenSubstrings :: String -> Bool
hasNoForbiddenSubstrings s =
    0 `atMostAreTrue` [ cc `isInfixOf` s
                      | cc <- ["ab", "cd", "pq", "xy"]
                      ]

-- |
-- >>> day5 "ugknbfddgicrmopn"
-- True
-- >>> day5 "aaa"
-- True
-- >>> day5 "jchzalrnumimnmhp"
-- False
-- >>> day5 "haegwjzuvuyypxyu"
-- False
-- >>> day5 "dvszwmarrgswjxmb"
-- False
day5 s = atLeastThreeLettersAreVowels s
      && hasSomeDoubledLetter s
      && hasNoForbiddenSubstrings s

To make the implementation readable, I defined many helper functions with long meaningful names, I gave examples clarifying their meaning, I used backticks to turn a binary function into an infix operator, making the code closer to an English sentence, and I used list comprehension syntax ([... | x <- [1,2,3]]) to define a list of similar expressions. Since the above is supposed to be extra readable, I guess I won't bother explaining it further.

Instead, I'll give a few more examples of list comprehensions. Here's how to try every combination of x and y:

> [x + y | x <- [100,2000]
         , y <- [4,5,6]
         ]
[104,105,106,2004,2005,2006]

Here's an easy way to generate all the triples of distinct numbers between 1 and 4:

>  [(x,y,z) | x <- [1..4]
            , y <- [x+1..4]
            , z <- [y+1..4]]
[(1,2,3),(1,2,4),(1,3,4),(2,3,4)]

And here's a quick way to filter the results:

> [(x,y,z) | x <- [1..10]
           , y <- [x..10]
           , z <- [y..10]
           , x*x + y*y == z*z
           ]
[(3,4,5),(6,8,10)]

Day 5.5: non-determinism

This version of the puzzle is much harder, because instead of having to check whether particular substrings do or do not appear in the input, we have to find substrings which repeat later in the string. This is harder because whether the substring occurs later in the string depends both on the chosen substring and on the position in the original string in which the first copy of the substring appears.

The easiest way to solve this puzzle is probably to use back references in a perl-compatible regular expression. That's not very Haskell-specific, so instead, here's an approach which is more general, in the sense that it can find patterns even if the question has nothing to do with strings: non-determinism.

-- |
-- >>> repeatingPairs "aabbaabb"
-- [('a','a'),('a','b'),('b','b')]
repeatingPairs :: String -> [(Char,Char)]
repeatingPairs s = do
    i <- [0 .. length s - 2]
    (c1:c2:s') <- return (drop i s)
    let pair = printf "%c%c" c1 c2
    guard (pair `isInfixOf` s')
    return (c1, c2)

Here I am non-deterministically choosing the index i at which the desired pair of characters begins, and then I use guard to retro-actively eliminate the choices of i for which pair does not occur in the remainder of the string. You can think of it as trying all the possibilities at once, like a non-deterministic finite automaton. Except computers are deterministic, so while we are describing a non-deterministic computation, that computation is implemented by trying one possibility at a time and backtracking whenever a guard condition fails.

Here's another example in which guard eliminates the paths in which the chosen letter doesn't reoccur two characters later.

-- |
-- >>> repeatingLetters "aba-bcd-def"
-- "ad"
repeatingLetters :: String -> [Char]
repeatingLetters s = do
    i <- [0 .. length s - 1]
    (c:_:c':_) <- return (drop i s)
    guard (c == c')
    return c

The rest of the puzzle is easy: to check whether one of the patterns is present in the input string, list all the matching patterns and check if the list is non-empty. Thanks to laziness, the backtracking algorithm lists all the possibilities when we ask for them, but when we only ask if the list is non-empty, it behaves more efficiently by stopping after the first successful pattern is found.

-- |
-- >>> hasRepeatingPair "xyxy"
-- True
-- >>> hasRepeatingPair "aaa"
-- False
hasRepeatingPair :: String -> Bool
hasRepeatingPair = not . null . repeatingPairs

-- |
-- >>> hasRepeatingLetter "xyx"
-- True
-- >>> hasRepeatingLetter "xyz"
-- False
hasRepeatingLetter :: String -> Bool
hasRepeatingLetter = not . null . repeatingLetters

-- |
-- >>> day5_5 "qjhvhtzxzqqjkmpb"
-- True
-- >>> day5_5 "xxyxx"
-- True
-- >>> day5_5 "uurcxstgmygtbstg"
-- False
-- >>> day5_5 "ieodomkazucvgmuy"
-- False
day5_5 s = hasRepeatingPair s
        && hasRepeatingLetter s

Navigation

• About this series
• Previous day: external programs and streaming
• Next day: precise types, arrays, and in-place updates

A whirlwind tour of Haskell, day 4

Day 4: process and conduit

For the next puzzle, we need to compute a sequence of md5 hashes and to return the first one which satisfies a given property. Haskell does have a few libraries implementing md5 hashing, but using such a function wouldn't teach us anything new about Haskell. Instead, let's delegate the task to an external program.

$ echo -n "abcdef609043" | md5sum
000001dbbfa3a5c83a2d506429c7b00e

The md5sum program, which has nothing to do with Haskell, computes the md5 hash of its input. Let's run it from Haskell, using a command from the process library.

import System.Process

-- |
-- >>> md5 "abcdef609043"
-- ("abcdef609043","000001dbbfa3a5c83a2d506429c7b00e")
md5 :: String -> IO (String, String)
md5 input = do
    [output] <- lines <$> readProcess "md5sum" [] input
    return (input, output)

We will need to use this to compute the md5 hash of "abcdef1", "abcdef2", "abcdef3", and so on until we find an input string whose hash starts with "00000". Let's define the infinite list of all such input strings:

import Text.Printf

-- |
-- >>> take 3 ints
-- [1,2,3]
ints :: [Int]
ints = [1..]

-- |
-- >>> take 3 (inputs "abcdef")
-- ["abcdef1","abcdef2","abcdef3"]
inputs :: String -> [String]
inputs prefix = map (printf "%s%d" prefix) ints

I'd like to map our md5 function over this infinite list in order to obtain an infinite list of hashes, but Haskell thinks it's a mistake to do so:

-- Expected type: String -> (String,String)
--   Actual type: String -> IO (String,String)
-- In the first argument of ‘map’, namely ‘md5’
outputs :: [(String,String)]
outputs = map md5 inputs

The reason this is a mistake is because md5 performs I/O operations, as indicated by its output type IO (String,String). Exploiting Haskell's laziness to skip over some pure mathematical transformations is fine, but skipping over IO operations it a completely different thing. IO operations are usually executed for their side-effects, and so we probably don't want Haskell to optimize them away.

The fact that laziness doesn't work on IO computations is thus a good thing, but then how are we going to describe the rest of the algorithm? We could use an imperative approach, like we did in Day 1.5, by looping over the possible inputs and breaking out of the loop upon some condition. Or, we could learn something new by using a streaming library, in which we compose side-effecting computations along a stream in much the same way we've been composing mathematical functions with (>>>). Each piece decides when to perform side-effects, when to consume values from upstream, when to send some values downstream, and when to abort the entire streaming computation.

I've already explored the pipes streaming library in the past, so this time I will use the conduit library instead.

import Data.Maybe
import Data.Conduit
import qualified Data.Conduit.List as Conduit

-- |
-- >>> runConduit (day4 "abcdef")
-- ("abcdef3337","000a63ec2eecacd28b2a6592906fea34")
day4 :: String -> ConduitM input output IO (String, String)
day4 prefix = Conduit.sourceList (inputs prefix)
          =$= Conduit.mapM md5
          =$= Conduit.filter (snd >>> take 3 >>> (== "000"))
          =$= (fromJust <$> Conduit.head)

At the top of my stream, I use a source which will trickle each of the candidate input strings down the stream. Downstream, I execute our md5 computation on each input string as it flows down. Downstream from that, I filter the stream of results to only keep the ones which satisfy the criterion. The actual criterion is that the hash should begin with 5 zeroes, but with the overhead of spawning an external program for hundreds of thousands of candidate inputs, on my computer it takes almost 15 minutes to find a hash with 5 zeroes, so if you only want to check that the code runs and behaves as desired, save yourself some time and stop after 3 zeroes as in the code above. Despite the less restrictive predicate, very few values will pass this filter.

Once a value eventually makes it trough, Conduit.head aborts the computation using that value as the result. I added the fromJust bit because Conduit.head can either return Just x if x is the first value which makes it through the filter, or it can return Nothing if some other part of the stream aborts the computation before a value can reach Conduit.head. Since Conduit.head is the only piece in my stream which can abort the computation, I know that this will not happen, so I tell the compiler to assume that the output will have the form Just x for some x, and that the final result should be x.

Day 4.5 is omitted, because it is too similar to the version we just solved.

Navigation

• About this series
• Previous day: 2D vectors, sets, infinite lists, lenses, and constraints
• Next day: list comprehensions and non-determinism

A whirlwind tour of Haskell, day 3

Day 3: linear and containers

In this puzzle, we need to move a cursor in 2D space and count the number of distinct coordinates we visited.

import qualified Data.Set as Set
import Linear.V2

direction :: Char -> V2 Int
direction '<' = V2 (-1) 0
direction '>' = V2 1 0
direction '^' = V2 0 1
direction 'v' = V2 0 (-1)
direction _   = V2 0 0

-- |
-- >>> day3 ">"
-- 2
-- >>> day3 "^>v<"
-- 4
-- >>> day3 "^v^v^v^v^v"
-- 2
day3 = map direction
   >>> scanl (+) 0
   >>> Set.fromList
   >>> length

I use V2 from the linear library to represent the 2D coordinates, because its vector space addition allows me to add both coordinates at once. To get the list of visited coordinates, I use scanl (+) 0 again: it's still a running sum, but this time we're adding directional unit vectors to a coordinate which starts at "zero", the origin of the 2D plane. This works because (+) and 0 are obtained via methods of the Num type class, and Haskell infers that I want to use the Num instance for V2 Int.

Interestingly, this is a parameterized instance, which means that the Num instance for V2 Int delegates part of its implementation to the Num instance for Int, and similarly for V2 Float, etc. This mechanism allows type class instances to be automatically constructed for complex composed types which have never been seen before, without requiring the programmer to write a type class instance for this particular composition of types. For example, our MyEDSL from earlier was composed of four layers of monad transformers, each of which defined their own Monad instance, but we did not have to define a Monad instance for MyEDSL in order to be able to use forM_ and when.

Next, to obtain distinct coordinates from the list of all coordinates, I convert the list into a set, defined by the containers library. There is also a function called nub in the standard library which eliminates duplicates from a list, but for technical reasons nub executes in quadratic time while Set.fromList runs in O(n*log n). The containers library also has an even more efficient IntSet which can only contain Ints, but I rarely use it because Set Int is more versatile (I can easily switch to a Set Float if I need to) and it's fast enough for me.

Finally, I compute the number of elements in the set using length. It's the same length we used earlier to compute the size of a list because, you guessed it, length is part of yet another type class. It's a type class called Foldable, and its methods include or can be used to derive length, sum, forM_, and other functions which require iterating over the elements of a container without modifying them.

Day 3.5: infinite lists, lens, and constraints

For the second part of the puzzle, we now need to move two cursors, and the ASCII instructions alternate between giving a direction for the first cursor and giving a direction for the second. We need to count the number of distinct coordinates which at least one of the cursors has visited.

{-# LANGUAGE RankNTypes #-}

import Control.Lens
import Data.Set.Lens
import Data.List

day3_5 = map direction
     >>> zip [0..]
     >>> partition (fst >>> even)
     >>> over (both.mapped) snd
     >>> over both (scanl (+) 0)
     >>> setOf (both.folded)
     >>> length

The sequence of functions is getting a bit long, so let's split it into smaller helper functions.

-- |
-- >>> fromAlternating [1..6]
-- ([1,3,5],[2,4,6])
-- >>> fromAlternating "a1b2c3"
-- ("abc","123")
fromAlternating :: [a] -> ([a], [a])
fromAlternating = zip [0..]
              >>> partition (fst >>> even)
              >>> over (both.mapped) snd

This first helper splits the lists of instructions into two sublists, one for each cursor. To do that, we first number the elements of the list from 0 to n, then we partition the list into two sublists according to whether the element number is even or odd, and finally, we drop the element numbers and keep only the elements.

zip [0..] is a common Haskell idiom for numbering the elements of a list. The way it works is by creating the infinite list [0,1,2,...] and using zip to pair each element of this list with each element of the original list [x,y,z], resulting in the list of pairs [(0,x), (1,y), (2,z)]. The resulting list has only three elements, not an inifinite number, because zip stops after the shortest list is exhausted. Infinite structures are very common in Haskell, because they allow us to focus on the contents and not on the boundary conditions: in this case, we focus on the fact that the list contains an increasing list of integers, and we don't bother specifying that we need as many integers as there are elements in our original list. Haskell's laziness makes sure that it will not get stuck trying to allocate an infinite list, and will instead only allocate as much as is necessary to compute the resulting finite list of pairs.

partition is a function from the standard library which partitions a list into two sublists according to a predicate: one sublist contains the elements which satisfy the predicate, and the other sublist contains the elements which don't. In this case, our predicate is that the first element of the pair, that is, the element number, should be even. This causes the even-numbered pairs to end up in the first list, and the odd-numbered pairs to end up in the second.

As this point we have two lists of pairs, with each pair containing a number and an element. We'd rather have lists of elements, because the numbers are just an intermediate annotation we used for the partitioning. So we'd like to apply snd, the function which only keeps the second part of a pair, to all the elements of both lists. I could have writen (\(xs,ys) -> (map snd xs, map snd ys)), it would have done the job, but I'd rather to take the opportunity to demonstrate the lens library.

The lens library deals with nested structures, in this case a pair of lists of elements. I think the name comes from the fact that a real-world lens allows you to focus light on a smaller area, and that you can compose multiple lenses to focus the light on an even smaller area. Similarly, a Lens from the lens library allows you to manipulate a structure by focusing on manipulating a smaller part of that nested structure, and Lenses can be composed to allow you to focus on a deeply-nested element hidden deep inside a nested structure.

The lens library also offers a variety of other "optics", which can focus on something other than a single element. In this case, I am constructing a Setter, which allows multiple elements in a nested structure to be modified at the same time. I am constructing it by composing both, a setter which focuses on both halves of a pair simultaneously, with mapped, a setter which focuses on all the elements of a list. The net result is that I am focusing on all the elements of both of my lists, that is, I am focusing on all the pairs on which I want to apply snd.

-- |
-- >>> runningSum [1,2,3]
-- [0,1,3,6]
-- >>> runningSum (map direction "^>>v")
-- [V2 0 0,V2 0 1,V2 1 1,V2 2 1,V2 2 0]
runningSum :: Num a => [a] -> [a]
runningSum = scanl (+) 0

This second helper is our good friend scanl (+) 0, which we have used to produce running sums of integers and running sums of 2D coordinates. The Num a constraint in the type signature indicates that while this helper function can indeed work on list of elements of various types, it will only work if that element type has a Num instance.

-- |
-- >>> distinctCountOf folded [1,2,3,2,2,3]
-- 3
-- >>> distinctCountOf both (1,2)
-- 2
-- >>> distinctCountOf both (1,1)
-- 1
distinctCountOf :: Ord a => Fold s a -> s -> Int
distinctCountOf elems = setOf elems
                    >>> length

Our final helper is a generalization of the Set.fromList >>> length technique we've been using so far to count the distinct elements of a list. This time, however, the elements we want to count are distributed among two separate lists, so a simple Set.fromList is not going to work. Instead, I'm using setOf, a function from lens which takes a Fold and constructs a Set out of the elements on which the Fold focuses. A Fold is yet another kind of optic, one which also focuses on multiple elements simultaneously, but instead of modifying all of them at once like a Setter, it examines them using methods from Foldable.

-- |
-- >>> day3_5 "^v"
-- 3
-- >>> day3_5 "^>v<"
-- 3
-- >>> day3_5 "^v^v^v^v^v"
-- 11
day3_5 = map direction
     >>> fromAlternating
     >>> over both runningSum
     >>> distinctCountOf (both.folded)

Finally, we compose our helpers into one sophisticated function which solves the puzzle: we parse the directions into unit vectors, we split the alternating directions into one list for each of the two cursors, we list the visited coordinates for each, and we count how many distinct coordinates have been visited overall.

Navigation

• About this series
• Previous day: type inference and type classes
• Next day: external programs and streaming

A whirlwind tour of Haskell, day 2

Day 2: extra, type inference, and type classes

The next puzzle involves computing the area of the faces of a box. The equation to compute the area is provided, so the only slight complication is that the area of the smallest face needs to be added to the final answer.

import Data.List.Extra

-- |
-- >>> day2 "2x3x4"
-- 58
-- >>> day2 "1x1x10"
-- 43
day2 = wordsBy (== 'x')
   >>> map read
   >>> (\[l,w,h] -> [l*w, w*h, h*l])
   >>> sort
   >>> (\[x,y,z] -> 3*x + 2*y + 2*z)

The boxes are described by strings of the form "LxWxH", so I begin by splitting the string into three pieces using 'x' as the delimiter. To do this, I use wordsBy, a version of words which splits a string using a custom predicate to specify the delimiter characters instead of using whitespace like words does. The function words is in the standard library, but for some reason wordsBy isn't, it's provided by the extra library.

Next, I convert the resulting list of strings into a list of numbers by parsing each one using read. Notice that read has a rather generic name: why not parseInt like in other languages? Well, it turns out that read is not limited to parsing numbers. It does not look at the string it is parsing to figure out the type of the value it is parsing either. Instead, Haskell uses type inference to figure out that since we're about to multiply the parsed values together, we must want to parse the strings into numbers, and so it uses the version of read which behaves like parseInt. There is one such version of read for each parsable type, and Haskell uses the type of the expression in which read is used to figure out which implementation to use. This mechanism is called type classes: there is a type class called Read which defines read and a few other methods related to parsing, and each parsable type defines a Read instance implementing read and the other methods for this particular type.

As an aside, the Monad interface I have briefly mentioned earlier is also a type class, with one instance per EDSL. In the case of Monad, instances need to define two methods: one which constructs a computation that returns immediately without causing any side-effect (the side-effects we've seen so far include things like incrementing a counter and aborting the computation), and one which sequences two computations in such a way that the second computation can make use of the result computed by the first computation.

Anyway, once I have a list of numbers, the rest of the algorithm is straightforward: I compute the areas of the sides, I sort them so that I know which one has the smallest area, and I compute the sum of the areas, adding the smallest area 3 times instead of 2. I don't need to explain lambdas, do I? They're originally from functional languages, but all the mainstream languages have them too nowadays, same thing for higher-order functions like map and filter. I'm glad they did, but they shouldn't stop there: there is still more good stuff to copy :)

The full puzzle requires computing the sum of the answers for all the boxes, which is trivial and thus omitted. Day 2.5 is omitted as well, because my solution is almost the same as for Day 2.

Navigation

• About this series
• Previous day: monads, monad transformers, pattern-matching,
  composition, laziness, and higher-order functions
• Next day: 2D vectors, sets, infinite lists, lenses, and constraints

A whirlwind tour of Haskell, day 1

Day 1, imperatively: transformers and monads

The first puzzle asks us to increment and decrement a floor number every time an opening or closing parenthesis is encountered. In an imperative language, we'd probably begin by initializing a counter, then we'd iterate over the characters of the input string, incrementing or decrementing the counter depending on which character we encounted. Implementing such a solution in Haskell is possible, but is a bit verbose:

import Control.Monad
import Control.Monad.Trans.State

day1 :: String -> Int
day1 input = execState go 0       -- counter starts at 0
  where
    go :: State Int ()
    go = do
      forM_ [0 .. length input - 1] $ \i -> do
        when (input !! i == '(') $ do -- when we encounter '('...
          modify (+ 1)                -- ...increment the counter
        when (input !! i == ')') $ do -- when we encounter ')'...
          modify (subtract 1)         -- ...decrement the counter

Here I have used the transformers library to define a stateful computation. That's right, Haskell is such a pure functional language that it doesn't even have builtin syntax for declaring and incrementing a counter, you need to use a library in order to do that! I'll explain why the library is called "transformers" in the next section.

Haskell has tons of libraries like this defining specialized embeded domain specific languages (EDSLs). In fact, the word "monad" which is always brought up when discussing Haskell is the name of an interface implemented by many such EDSLs. This shared interface allows generic constructs like the above forM_ and when to work with any EDSL implementing the interface.

Day 1, functionally: pattern-matching and composition

A functional solution would instead transform the input using a series of mathematical functions, in such a way that the final transformation gives the desired result. Here, I'm using pattern-matching to map the two parenthesis characters to the numbers one and minus one, and the final result is the sum of all those numbers. Much more succinct!

delta '(' = 1
delta ')' = -1

day1 = sum . map delta

The mathematical transformations are applied from right to left: first, map delta transforms the input string (a list of characters) into a list of numbers, and then sum adds those numbers together.

It is customary to give type signatures to top-level definitions. This makes the code a bit less succinct, but it makes it much easier to understand functions in isolation.

delta :: Char -> Int
delta '(' = 1
delta ')' = -1

day1 :: String -> Int
day1 = sum . map delta

With those type signature, it is clearer that day1 is transforming a String into an Int, using two intermediate transformations map delta and sum. I happen to know that map takes a transformation from a to b and produces a transformation from a list of a to a list of b, so map delta transforms the String, which is also a [Char], into an [Int], which sum then transforms into an Int.

It is also customary to write total functions, meaning that if the signature of delta claims that it transforms Chars into Ints, it better be able to handle any Char. The above implementation of delta is only handling two possible characters, and so even though Advent of Code's input only uses those two characters, I feel compelled to complete my implementation so that it ignores non-parenthesis characters.

delta :: Char -> Int
delta '(' = 1
delta ')' = -1
delta _   = 0

Finally, while mathematicians like to write composition from right to left (f (g x) first applies g to x, and then applies f to the result, and so the composition is written f . g), in this case I find it more convenient to write down my transformations in the order in which they apply, so I'd rather have a left-to-right composition operator. Such an operator exists in the Control.Arrow module, along with a few other operators for combining and manipulating various kinds of transformations (Haskell supports more kinds of transformations than just mathematical functions).

import Control.Arrow

day1 = map delta
   >>> sum

Notice that I've dropped the type signature for day1. Its type is still String -> Int, but leaving the type out makes it easier for me to visualize intermediate results, using the following technique. I first write the first half of the implementation, day1 = map delta. The type of this transformation is String -> [Int], and so my ghcid setup will display the resulting list of numbers. After visually inspecting that the result seems correct so far, I add the second line, and ghcid updates its output to display the final result. Keeping the type signature would have discouraged this kind of incremental development, because ghcid would have displayed a type error instead of the intermediate result.

Day 1.5, imperatively: either and monad transformers

The next part of the puzzle asks us to count the number of steps until the counter reaches -1. An imperative solution would build on the previous one by using a second counter to track the number of steps, and by aborting the loop as soon as the floor number reaches -1.

Perhaps surprisingly, the EDSL we used earlier for expressing a stateful computation is intentionally limited to a single stateful variable, and so we cannot use it to express our new two-counters algorithm. Instead, we need to combine two instances of the EDSL, each tracking one of the two counters, with a third EDSL called either implementing the ability to abort the computation early. The fact that we can do that is why the library is named transformers: the EDSLs it provides are not only independent EDSLs each providing their own feature such as stateful computation, they also have the ability to transform an input EDSL into a slightly more complex EDSL by adding stateful operations to the list of operations supported by the input EDSL. This idea of building more complex systems out of simpler systems is pervasive in Haskell, and if you're interested in learning more, I made a video about combinator libraries which introduces the subject to non-Haskellers.

Now, using three EDSLs for such a simple problem might seem a bit overkill, and it is. As before, the imperative solution ends up being much more verbose in Haskell than the functional implementation. But let's take a look anyway, as building custom EDSLs is an important Haskell skill which becomes invaluable when structuring larger programs.

import Control.Arrow
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Either as EitherT
import Control.Monad.Trans.State
import Data.Functor.Identity

type MyEDSL = StateT Int (StateT Int (EitherT Int Identity))

runMyEDSL :: MyEDSL () -> Int
runMyEDSL = flip evalStateT 0  -- step counter starts at 0
        >>> flip evalStateT 0  -- floor number starts at 0
        >>> eitherT return (\() -> error "floor -1 never reached")
        >>> runIdentity

I first define my custom EDSL, which I name MyEDSL. To build it, I start (from right to left) with the Identity EDSL, which has no special operations. I combine it with EitherT Int, which adds the ability to abort the computation early. Finally, I add two layers of StateT Int, for the two counters. I also define a way to run MyEDSL computations, by running the operations of all three underlying layers (four if we count Identity).

getSteps :: MyEDSL Int
getSteps = get

incrSteps :: MyEDSL ()
incrSteps = modify (+1)

getFloor :: MyEDSL Int
getFloor = lift $ get

incrFloor :: MyEDSL ()
incrFloor = lift $ modify (+ 1)

decrFloor :: MyEDSL ()
decrFloor = lift $ modify (subtract 1)

returnEarly :: Int -> MyEDSL ()
returnEarly x = lift $ lift $ EitherT.left x

Next, I define operations which are specific to MyEDSL, in terms of the simpler EDSLs it is made of: get and modify are the stateful operations we've already seen in Day 1, and EitherT.left is an operator from either which aborts the computation early. The function lift is used to specify which layer the operation should run in: op runs in the outermost StateT Int layer, lift $ op runs in the second StateT Int layer, and lift $ lift $ op runs in the third layer, the EitherT Int one.

day1_5 :: String -> Int
day1_5 input = runMyEDSL go
  where
    go :: MyEDSL ()
    go = do
      forM_ [0 .. length input - 1] $ \i -> do
        incrSteps
        
        when (input !! i == '(') $ incrFloor
        when (input !! i == ')') $ decrFloor
        
        floorNumber <- getFloor
        when (floorNumber == -1) $ do
          steps <- getSteps
          returnEarly steps

Once all the operations are defined, I can describe my algorithm in terms of my custom operations: iterate through the input string, count the steps, increment and decrement the floor counter, and return early when floor -1 is reached.

Day 1.5, functionally: laziness and higher-order functions

As promised, the functional solution is much more succinct:

-- |
-- >>> day1_5 ")"
-- 1
-- >>> day1_5 "()())"
-- 5
day1_5 = map delta
     >>> scanl (+) 0
     >>> takeWhile (/= -1)
     >>> length

As before, I begin by converting the list of characters into a list of +1s and -1s. This time, however, instead of taking the sum of all the numbers, I use scanl to take a running sum, meaning I get a list of all the intermediate sums as each number is added to the total. I then cut that list short just before the first -1, and I count how many items are in that trimmed list. Oh, and thanks to laziness (Haskell only evaluates the part of the code which needs to be evaluated to obtain the answer), this implementation is just as efficient as the imperative version: even though it would seem like the running sum would need to produce its entire output list before takeWhile could begin to trim it, map and scanl actually stop consuming their input lists after the sum reaches -1, as if by magic.

map, scanl and takeWhile are three of many higher-order functions provided by Haskell's standard library. A "higher-order" function is simply one which takes another function as one of its inputs, in this case in order to produce a modified function. We've already seen how map converts a function on elements into a function on lists. The higher-order function scanl takes a binary function, in this case (+), and an initial value, in this case 0, and produces a function from a list of input elements to a list of outputs obtained by repeatedly applying the input function to the value so far and the next input element. So in this case, since the input function is addition, the result is a running sum. Our last higher-order function, takeWhile, takes a predicate (a function returning a boolean) and produces a function which trims its input list by keeping all the elements as long as they satisfy the predicate, and then dropping the rest of the elements as soon as it encounters one which doens't satisfy the predicate. In this case, we're keeping all the elements which are not -1, and then we're droping -1 and the rest of the elements.

High-order functions are another example of the principle of constructing more complex systems, in this case functions, by combining and transforming simpler systems, in this case simpler functions. The function (+) is quite simple, it simply adds two numbers. The number 0 is even simpler. By applying the higher-order function scanl to (+) and 0, we obtain a more sophisticated function which keeps a running sum. And by composing the four functions map delta, scanl (+) 0, takeWhile (/= 1) and length, we obtain a very specialized function which solves Day 1.5's puzzle.

Navigation

• About this series
• Next day: type inference and type classes

A whirlwind tour of Haskell, via Advent of code solutions

Advent of Code is a website listing 50 small programming challenges, revealing two per day from December 1st to December 25th. I'm currently going through the puzzles which have been revealed so far using my favorite programming language, Haskell. As the puzzles become slightly harder, I'm reaching for more and more sophisticated Haskell libraries, and this made me realize that the solutions to those puzzles would be a great way to showcase those libraries, and also to introduce a few basic Haskell idioms and workflows.

The intended audience is Haskell beginners, who might enjoy such a whirlwind tour of many different Haskell libraries. There is too much code for me to explain every single line, but that's fine: the idea is not to teach how to use all of those libraries, but to give a taste of the way in which we do things in Haskell.

Day 0: doctest and ghcid

Each puzzle comes with a few example inputs and outputs, as well as one larger input file for which we need to find the output. So after I write an algorithm, I'd like to run it on each of the example inputs in order to make sure that my algorithm's output matches the example outputs. If so, I then run my algorithm on the input file, and I submit the result. I automate most of those steps using the following setup.

import Test.DocTest

-- |
-- >>> day0 "advent"
-- 6
-- >>> day0 "of"
-- 2
-- >>> day0 "code"
-- 4
day0 :: String -> Int
day0 = length

main :: IO ()
main = do
    doctest ["src/Main.hs"]
    [input] <- lines <$> readFile "input.txt"
    print $ day0 input

This is not a puzzle from the Advent of Code website, instead it's a dummy example in which the algorithm simply computes the length of the input string. I write the example inputs and outputs in doctest format, and I run those tests on every execution. If the tests pass (doctest exits with an error message if one of the tests fails), I then run my algorithm on the input file and print the result. In this example and most of the Advent of Code puzzles I've seen so far, the test file consists of a single line of input, which is why I'm pattern-matching on a list of length one.

To further automate the process, I use ghcid to automatically run the above each time I save. Using ghcid requires a bit of setup, but no more than what you would need to compile a program normally using cabal. You need to create a .cabal file using cabal init, then modify the build-depends section of the generated file to include the comma-separated names of the libraries required by your program (so far, only the standard base library and doctest), and then run cabal install in order to install those dependencies (preferably inside a sandbox, by running cabal sandbox init first). In the sections below, I'll introduce new libraries, and you'll have to add each of them to build-depends, to run cabal install again, and to restart ghcid.

Once this setup is taken care of, I simply run ghcid --test=main, in a separate window which will be updated with compilation errors or with my program's output each time I save. Convenient!

Days 1 onwards

This post originally contained implementations for days 1 through 3, and was very long. I have now moved each day's implementation to its own post, which also makes it easier to share links to a particular day.

Here are all the posts in the series so far.

• Day 1: monads, monad transformers, pattern-matching,
  composition, laziness, and higher-order functions
• Day 2: type inference and type classes
• Day 3: 2D vectors, sets, infinite lists, lenses, and constraints
• Day 4: external programs and streaming
• Day 5: list comprehensions and non-determinism
• Day 6: precise types, arrays, and in-place updates
• Day 7: laziness-based caching and meta-programming
• Day 8: invertible parsers
• Day 9: skipped
• Day 10: skipped
• Day 11: skipped
• Day 12: skipped
• Day 13: skipped
• Day 14: skipped

I plan to continue this series as I go through the puzzles. I might skip a few if they don't involve interesting Haskell features or libraries I haven't covered yet, but otherwise, stay tuned for more!