Archive for Haskell

Project Euler up through Problem 78 in Haskell

For the past couple weeks I’ve been practicing Haskell by working through Project Euler’s problems. I just finished problem 78, which asks you to compute the number of ways to partition a collection of n coins, where n is large. In a way, I feel like I was forced to cheat on this one because I couldn’t do it without looking up the pentagonal number theorem. I hope that future Euler problems do not all degrade into a Google search, because although I learned some math trivia, it’s not a fun way to solve a problem.

In addition to brushing up on number theory, the puzzles have taught me a lot about programming in Haskell. My biggest takeaway is how to memoize. Typically this involves using a data structure such as a Map, constructed from a list of calls to a function that refers back to the data structure. For example:

How many routes are there through a 2020 grid?

> import Data.List
> import qualified Data.Map as Map
> import Data.Map (Map, (!))

> mbound = 1000

> routes = Map.fromList [ ((x,y), route (x,y)) | x <- [0..mbound], y <- [0..mbound] ]

> route (0, 0) = 0
> route (0, b) = 1
> route (a, b) | a > b     = route (b, a)
>              | otherwise = (routes ! ((a - 1), b)) + (routes ! (a, (b - 1)))

> main = do
>  print $ route (20,20)

Notice how ‘route’ refers to the ‘routes’ Map, which in turn refers to ‘route’. This works because of the Haskell’s lazy functional evaluation. How cool is that?

Another lesson is the frequent syntactic idiom of multiple function composition. For example, to create a sorted list of unique items from a list, you can write:

> mynub = map head .
>         group .
>         sort .
>         $ [1,2,5,3,3,1,3,2,4,5,2]

Notice how clean it looks to put each function on its own line, followed by (.). Then you always have to put a dollar sign before the final argument. This is surely obvious to Haskell pros, but it took me a bit to figure this out.

Haskell continues to delight me in its terse elegance. It’s laughable how short nearly every solution is. Now I’m on to Problem 79.

Leave a Comment

Lessons Learned: Parsing CSV in Haskell and Python

One of my best friends read my CSV post and said “So, you wrote a program that was a little slow, and then you wrote another one that was faster. That’s great.” Hard to disagree.

Over the past couple days, thousands of people have read my last two posts, and tens of people have made comments and offered advice. Thanks to Slarba, I now have a Haskell program that runs in about 1 second (which happens to be about 0.7 seconds faster than my Python program, although I haven’t tried to optimize the Python program at all).

Here’s what I learned in this odyssey:

  1. If you’re reading in a large text file, use Haskell’s ByteString instead of String. (thanks to Don Stewart, aka dons, for writing that module).
  2. To clean up your code that uses sorts, make your custom data type an instance of Ord instead of using the sortBy function.
  3. I had never used Haskell’s foreign function interface before. It’s amazing how simple it is to pull in a C function. It seems like you just need to abide by a few idioms, such as the NOINLINE pragma and the unsafePerformIO function.
  4. Clearly this is all a lot of effort and optimization simply to read in some basic CSV lines in Haskell. Hopefully the ASCII string parsing libraries will improve in time.
  5. The common optimization compiler flag ‘-O2′ is not the default. Several people suggested adding that flag, although I never noticed a speedup from it for this program.
  6. The Parsec module is very neat and clever, but its performance is hampered by Haskell’s String type.

For completeness, here’s the final version of the code.

> {-# OPTIONS -fffi -funbox-strict-fields #-}
> import qualified Data.ByteString.Char8 as BS
> import Data.ByteString.Unsafe (unsafeUseAsCString)
> import System
> import Data.List
> import Maybe
> import CForeign
> import Foreign.Ptr
> import System.IO.Unsafe

> data Row = Row {
>       ticker :: !BS.ByteString,
>       bid    :: !Double,
>       ask    :: !Double,
>       day    :: !BS.ByteString,
>       time   :: !BS.ByteString
>       }
> instance Eq Row where
>     a == b  = ticker a == ticker b && time a == time b
> instance Ord Row where
>     compare a b = case compare (ticker a) (ticker b) of
>                     EQ -> compare (time a) (time b)
>                     e  -> e

since ByteString library doesn't seem to have strtod-like function, we can
peek into the ByteString using useAsCString and calling C strtod on it.

> foreign import ccall "stdlib.h strtod" cstrtod :: CString->CString->IO CDouble
> {-# NOINLINE strtod #-}
> strtod :: BS.ByteString -> Double
> strtod bs = realToFrac . unsafePerformIO .
>             unsafeUseAsCString bs $ \cs -> cstrtod cs nullPtr

> data Result = Result {
>       tickerR :: !BS.ByteString,
>       openR   :: !Double,
>       highR   :: !Double,
>       lowR    :: !Double,
>       closeR  :: !Double,
>       dayR    :: !BS.ByteString
>       }
> instance Show Result where
>     show (Result ticker open high low close day) =
>         intercalate "," [BS.unpack ticker, show open, show high,
>                          show low, show close, BS.unpack day] ++ "\n"

> main :: IO ()
> main = do
>   (csvFile:outputFile:_) <- getArgs
>   rows <- doReadData csvFile
>   writeFile outputFile . concatMap show . computeResults $ groupToDays rows

> computeResults :: [[Row]] -> [Result]
> computeResults = map makeResult
>  where makeResult d = let openRow  = head d
>                           closeRow = last d
>                           highRow  = maximumBy comparePrice d
>                           lowRow   = minimumBy comparePrice d
>                       in Result (ticker openRow) (price openRow) (price highRow)
>                              (price lowRow) (price closeRow) (day openRow)
>        price r = (bid r + ask r) / 2
>        comparePrice a b = compare (price a) (price b)

> groupToDays :: [Row] -> [[Row]]
> groupToDays = concatMap (groupBy tickerDay) . groupBy tickerName
>  where tickerName a b = ticker a == ticker b
>        tickerDay a b  = day a == day b

> doReadData :: FilePath -> IO [Row]
> doReadData file = do
>     contents <- BS.readFile file
>     return . sort . mapMaybe parseRow . BS.lines $ contents

> parseRow :: BS.ByteString -> Maybe Row
> parseRow row = case BS.split ',' row of
>                  [ticker_,bid_,ask_,_,day_,time_] ->
>                      let (bidD, askD) = (strtod bid_, strtod ask_)
>                      in if (bidD == 0 || askD == 0)
>                         then Nothing
>                         else Just $ Row ticker_ bidD askD day_ time_
>                  _ -> Nothing

Thanks again to all the people who helped out. It’s humbling to think about other hackers spending their time commenting and optimizing my code.

Comments (11)

Followup: CSV Parsing in Haskell and Python

Tonight I tried improving the Haskell version of my CSV data analysis program. None of the changes made the Haskell program perform as well as the Python program. Still, I thought I’d share the results.

I first tried using the Parsec code discussed in the Real World Haskell book. The authors boil the CSV parsing down to 5 lines, which I incorporated into my program as:

> doReadDataParsec file = do
>     chars <- readFile file
>     let charRows = case parse csvFile "(unknown)" chars of
>                      Right r   -> r
>                      otherwise -> [[]]
>     let sortByTicker = sortBy $ comparing head `mappend` comparing (!!5)
>     let strRows = sortByTicker $ filter (\r -> (length r) > 0) charRows
>     return $ catMaybes $ map makeRowFromStrs strRows
>   where csvFile = endBy line eol
>         line    = sepBy cell (char ',')
>         cell    = many (noneOf ",\n")
>         eol     = char '\n'

I use the standard readFile function here, which reads the entire file in as a String, instead of a ByteString. The String is then parsed using Parsec. Using this function, the program executes in about 10 seconds. That’s up from about 7.5 seconds with my first implementation.

Next I tried to avoid the String type. In this version, I only unpack the ByteString when I need to convert the bid and ask to a Double. I then pack the Double back to a ByteString when the result is written to file. Everything else is left as a ByteString (except for the data types that I create — I’m not sure if that’s a problem). This approach shaves off a little over 3 seconds, executing in about 4.3 seconds.

Here is the complete program:

> import qualified Data.ByteString.Char8   as BS
> import Data.Ord
> import Data.Maybe
> import Data.Monoid
> import List
> import System.Environment

TICKER1,33,35,NULL,2007-09-28 00:00:00,2007-09-28 16:32:00
TICKER2,29.5,31,NULL,2007-03-07 00:00:00,2007-03-07 07:33:00
TICKER3,29.5,31,NULL,2007-03-07 00:00:00,2007-03-07 07:33:00

> data RowBytes = RowBytes {tickerB :: BS.ByteString,
>                           bidB :: Double,
>                           askB :: Double,
>                           dayB :: BS.ByteString,
>                           timeB :: BS.ByteString} deriving (Read, Show)
> data Result = Result {tickerR :: BS.ByteString,
>                       openR :: Double,
>                       highR :: Double,
>                       lowR :: Double,
>                       closeR :: Double,
>                       dayR :: BS.ByteString} deriving (Read, Show)

> main :: IO ()
> main = do
>   (csvFile:outputFile:_) <- getArgs
>   rows <- doReadData csvFile
>   let tickerGroups = groupBy (\a b -> (tickerB a) == (tickerB b)) rows
>   let oneTicker rs = map oneDay $ groupBy (\a b -> (dayB a) == (dayB b)) rs
>   let results = concat $ map oneTicker tickerGroups
>   let bytes r = [tickerR r,
>                  BS.pack $ show $ openR r,
>                  BS.pack $ show $ highR r,
>                  BS.pack $ show $ lowR r,
>                  BS.pack $ show $ closeR r,
>                  dayR r]
>   let pprow r = BS.concat $ intersperse (BS.singleton ',') $ bytes r
>   let txt = BS.unlines $ map pprow results
>   BS.writeFile outputFile txt
>   putStrLn "done"

create a Result row that encapsulates the open/high/low/close for
a single ticker on a single day

> oneDay rows =
>   let price r  = ((bidB r) + (askB r)) / 2
>       openRow  = head rows
>       closeRow = last rows
>       highRow  = maximumBy (\a b -> compare (price a) (price b)) rows
>       lowRow   = minimumBy (\a b -> compare (price a) (price b)) rows
>   in (Result (tickerB openRow)
>              (price openRow)
>              (price highRow)
>              (price lowRow)
>              (price closeRow)
>              (dayB openRow))

> maybeRead s = case reads s of
>                 [ (x, "")] -> Just (x::Double)
>                 _          -> Nothing

Convert a list of strings into a [Row]
We need to convert two of the strings to Doubles.

> makeRow r =
>   case (maybeRead (BS.unpack $ r !! 1), maybeRead (BS.unpack $ r !! 2)) of
>     ((Just a), (Just b)) -> Just (RowBytes (r !! 0) a b (r !! 4) (r !! 5))
>     _                    -> Nothing

Read in the CSV file, returning a [Row], sorted by ticker and day

> doReadData file = do
>   bytes <- BS.readFile file
>   let byteRows = map (BS.split ',') $ BS.lines bytes
>   let sortByTicker   = sortBy $ comparing head `mappend` comparing (!!5)
>   let sortedByteRows = sortByTicker $ filter (\r -> (length r) > 0) byteRows
>   return $ catMaybes $ map makeRow sortedByteRows

Finally, I tried adding the -O2 ghc compile flag, but that did not yield a speedup.

I’m not sure what to try next. Thanks to everybody who commented to my last post, both directly on this blog and on the Reddit thread.

Note that in the comments below, I’ve linked to a version of the Haskell code that runs in 1 second.  Thanks to Slarba for posting the solution, which I only modified slightly.

Comments (14)

CSV Parsing: Haskell versus Python

I recently wrote a fairly simple program to parse a CSV file containing some daily intraday prices for a number of tickers. The CSV file had roughly 160,000 lines, with each line containing a ticker, bid, ask, and timestamp. The goal is to produce a daily open, high, low, and close for each ticker.

First I wrote the program in Haskell using the Text.CSV library. It performed horrendously (I didn’t even bother waiting for the program to finish executing as I heard the CPU fan spin up to max). After chatting with ‘dons’ and others on #haskell, I rewrote the program using the Data.ByteString library. Unfortunately, it took about 7.5 seconds to process the input and produce a result.

Curious, I wrote an equivalent program in python. The python program finishes in about 1.7 seconds on my MacBook. That’s 1.7 seconds for python and 7.5 seconds for Haskell — not so good.

None of the superstars on #haskell had any immediate suggestions for what’s making Haskell perform poorly, but most suggestions pointed to my unpacking of the ByteStrings to Strings. I’ll investigate further if I have the time, and post the findings here.

Here is my Haskell code (http://hpaste.org/8928):

> import qualified Data.ByteString.Char8   as BS
> import Data.Maybe
> import Data.List
> import List
> import System.Environment
> import System.IO

TICKER1,33,35,NULL,2007-09-28 00:00:00,2007-09-28 16:32:00
TICKER2,29.5,31,NULL,2007-03-07 00:00:00,2007-03-07 07:33:00
TICKER3,29.5,31,NULL,2007-03-07 00:00:00,2007-03-07 07:33:00

> data Row = Row {ticker :: String,
>                 bid :: Double,
>                 ask :: Double,
>                 day :: String,
>                 time :: String} deriving (Read, Show)

> data Result = Result {tickerR :: String,
>                       openR :: Double,
>                       highR :: Double,
>                       lowR :: Double,
>                       closeR :: Double,
>                       dayR :: String} deriving (Read, Show)

> main :: IO ()
> main = do
>   (csvFile:outputFile:_) <- getArgs
>   rows <- doReadData csvFile
>   let tickerGroups = groupBy (\a b -> (ticker a) == (ticker b)) rows
>   let oneTicker rs = map oneDay $ groupBy (\a b -> (day a) == (day b)) rs
>   let results = concat $ map oneTicker tickerGroups
>   let pprow r = concat $ intersperse "," $ [tickerR r,
>                                             show $ openR r,
>                                             show $ highR r,
>                                             show $ lowR r,
>                                             show $ closeR r,
>                                             dayR r]
>   let txt = unlines $ map pprow results
>   writeFile outputFile txt
>   putStrLn "done"

create a Result row that encapsulates the open/high/low/close for
a single ticker on a single day

> oneDay rows =
>   let price r  = ((bid r) + (ask r)) / 2
>       openRow  = head rows
>       closeRow = last rows
>       highRow  = maximumBy (\a b -> compare (price a) (price b)) rows
>       lowRow   = minimumBy (\a b -> compare (price a) (price b)) rows
>   in (Result (ticker openRow)
>              (price openRow)
>              (price highRow)
>              (price lowRow)
>              (price closeRow)
>              (day openRow))

> maybeRead s = case reads s of
>                 [ (x, "")] -> Just (x::Double)
>                 _          -> Nothing

Convert a list of strings into a [Row]
We need to convert two of the strings to Doubles.

> makeRow r =
>   case (maybeRead (r !! 1), maybeRead (r !! 2)) of
>     ((Just a), (Just b)) -> Just (Row (r !! 0) a b (r !! 4) (r !! 5))
>     _                    -> Nothing

Read in the CSV file, returning a [Row], sorted by ticker and day

> doReadData file = do
>   bytes <- BS.readFile file
>   let byteRows = map (BS.split ',') $ BS.lines bytes
>   let sortByTicker   = sortBy (\a b -> case compare (head a) (head b) of
>                                          EQ -> compare (a !! 5) (b !! 5)
>                                          o  -> o)
>   let sortedByteRows = sortByTicker $ filter (\r -> (length r) > 0) byteRows
>   let strRows = map (\r -> map BS.unpack r) sortedByteRows
>   return $ catMaybes $ map makeRow strRows

And here is the python code:

import itertools as IT

def rowCompare(x,y):
    """comparison used for sorting our rows.
    Sort by ticker and then by time."""
    if cmp(x[0], y[0]) == 0:
        return cmp(x[5], y[5])
    else:
        return cmp(x[0], y[0])

def price(r):
    """Take the average of the bid and ask prices."""
    return (float(r[1]) + float(r[2])) / 2.0

# read in the data from a CSV file
f = open('IG_US.csv', 'r')
lines = sorted([line.strip().split(',') for line in f], rowCompare)

# create daily open/high/low/close for each ticker
results = []
for ticker, tickerIter in IT.groupby(lines, lambda x: x[0]):
    for day, dayIter in IT.groupby(tickerIter, lambda x: x[4]):
        dayRows = [d for d in dayIter if d[1] != "NULL" and d[2] != "NULL"]
        if not dayRows:
            continue
        highRow = dayRows[0]
        lowRow = dayRows[0]
        for row in dayRows:
            highRow = row if price(row) > highRow else highRow
            lowRow = row if price(row) < lowRow else lowRow
        results.append([ticker,
                        "%0.2f" % price(dayRows[0]),
                        "%0.2f" % price(highRow),
                        "%0.2f" % price(lowRow),
                        "%0.2f" % price(dayRows[-1]),
                        day])

# write out the result to a file
fw = open("./IG_US_python_output.csv", 'w')
fw.write("\n".join([",".join([str(c) for c in l]) for l in results]))

Please note that I’ve posted a followup here.

Comments (17)

My Answers to the Microsoft Interview Questions

I thought it would be fun to write up solutions to the Microsoft interview questions that Andrew Wagner (chessguy) posted to the Haskell Cafe mailing list. I read about his post in the Haskel Sequence weekly news of June 25, 2008. You can read his post here.

> module Questions
> where

> import Data.Array
> import Data.List
> import Random

1.) A “rotated array” is an array of integers in ascending order, after which for every element i, it has been moved to element (i + n) mod sizeOfList. Write a function that takes a rotated array and, in less-than-linear time, returns n (the amount of rotation).

First we’ll write a simple function to rotate a given array (xs) by a given amount (n).

> rotate n xs = b ++ a
>     where n'     = n `mod` (length xs)
>           (a, b) = splitAt ((length xs) - n') xs

Now we turn to the function that computes how much the array was rotated. The key to the solution is realizing that you need to find an inflection point where consecutive numbers in the rotated list decrease. To do this, we find the first, largest sub-sequence that monotonically increases. We can find that subsequence using binary search, testing the endpoints of subsequences. The running time is O(log(n)), where n is the length of the input list (ignoring the O(n) time to construct our array).

> rotateAmount xs = _ra 0 ((length xs) - 1) (listArray (0, ((length xs) - 1)) xs)
>     where _ra s e ys = if (e - s) == 1 
>                        then (if ((ys ! s) &lt (ys ! e)) then s else e)  -- base case
>                        else let h  = ys ! s                  -- first item
>                                 l  = ys ! e                  -- last item
>                                 mi = s + ((e - s) `div` 2)   -- middle index
>                                 m  = ys ! mi                 -- middle item
>                             in if (h &lt l)
>                                then s                        -- return start index
>                                else if (h &gt m)
>                                     then _ra s  mi ys
>                                     else _ra mi e  ys

2.) You are given a list of Ball objects. Each Ball is either Red or Blue. Write a function that partitions these balls so that all of the balls of each color are contiguous. Return the index of the first ball of the second color (your result can be Red balls, then Blue balls, or the other way around). In haskell, you’ll probably want to return a ([Ball],Int).

This one is dead-simple in Haskell.

> data Ball = Red | Blue deriving (Eq, Ord, Show, Read)

> groupBalls bs = let gs = (group . sort) bs
>                 in (concat gs, length $ head gs)

3.) Live Search is a search engine. Suppose it was to be tied into an online store. Now you’re given two lists. One is a [(SessionId, NormalizedQuery)]. That is, when a particular user performs a query, it is turned into some consistent format, based on their apparent intent, and stored in this logfile. The second list is a [(SessionId, ProductId)]. This indicates the product bought by a particular user. Now, you want to take these two (potentially very long) lists, and return some structure that will make it easy to take a query and return a list of the most popular resulting purchases. That is, of people who have run this query in the past, what are the most common products they’ve wound up buying? The interviewer said that this is an instance of a well-known problem, but I didn’t catch the name of it.

I’m skipping this for now because its more of a rambling thought experiment. I’d love to chat about it, but I’m not going to immediately dive into writing some code.

4.) You’re given an array which contains the numbers from 1 to n, in random order, except there is one missing. Write a function to return the missing number.

Obviously sorting and walking through would work, but we can do better because the sum of the numbers 1 through n is (n * (n+1) / 2). So we can get it in one pass. This takes O(n) time. Neat.

> missingInt xs = let n = length xs
>                 in ((n + 1) * (n + 2) `div` 2) - (sum xs)


5.) Write a function to reconstruct a binary tree from its preorder traversal and inorder traversal. Take into account that the traversals could be invalid.

First define a tree data structure.

> data Tree a = Tree a (Tree a) (Tree a) | Leaf a | Empty
>               deriving (Eq, Ord, Show, Read)

For the pre-order list we need to split it up by what elements are less than or greater than the head of the list (thinking recursively here). So in the initial list, the first element is the root, and then the subsequent items that are less than the first element are in the left branch, and the other items are in the right branch. I don’t catch invalid traversals, although they would show up if ‘rest2′ in the below function was not empty.

> preorderTree xs = f xs
>     where f []          = Empty
>           f (h:[])      = Leaf h
>           f (h:tl)      = let (left,  rest1) = span (&lt h) tl
>                               (right, rest2) = span (&gt h) rest1
>                           in Tree h (f left) (f right)

> po1 = [4, 2, 1, 3, 5, 6]   -- test

Now, for the in-order traversal, every input will simply be an in-order list of numbers. So we create a balanced binary tree using that traversal by recursively splitting the list in half.

> inorderTree xs = f xs
>     where f [] = Empty
>           f (h:[]) = Leaf h
>           f (h1:h2:[]) = Tree h2 (Leaf h1) Empty
>           f ys = let (left, right) = splitAt ((length ys) `div` 2) ys
>                  in Tree (head right) (f left) (f $ tail right)

> pi1 = [1..6]

6.) You have a [(WeatherStationId, Latitude, Longitude)]. Similar to #3, write a function which will, off-line, turn this into a data structure from which you can easily determine the nearest Weather Station, given an arbitrary Latitude and Longitude.

I’m fairly stumped by this one. I can think of good ways to to solve this problem conceptualy, but I can’t think of a simple data structure to return. I’d like to return a data structure of polygons, where each polygon encapsulates what points are closest to each weather station. I don’t feel like coding that up though.

7.) Write a function for scoring a mastermind guess. That is, in a game of mastermind (http://en.wikipedia.org/wiki/Mastermind_(board_game)), given a guess, and the actual answer, determine the number correct, the number wrong,and the number out of place.

For this solution, we zip up the answer and the guess so we can examine the elements pair-wise. We then consider each pair. If they are equal, we can increment a correct counter. Otherwise, we must accumulate a list of incorrect values. As we build up the incorrect values, we check if each guess and answer has already been accumulated in the list of incorrect values. When we find it in the accumulated list, we know we’ve found a guess that was in the wrong position.


> data ColoredPeg = W | G | B | R | P | O deriving (Eq, Ord, Show, Read)

> scoreMM as gs = let (crct, wrg, _) = foldl f (0, [], []) (zip as gs)
>                     wrongPosition = (length as) - crct - (length wrg)
>                 in (crct, (length wrg), wrongPosition)
>     where f (c, oA, oG) 
>                 (a, g) = case g == a of  -- update an accumulator after examining each pair
>                          True -> (c+1, oA, oG) -- match, so simply update the count of correct
>                          False -> case ((a `elem` oG), (g `elem` oA)) of
>                               (True,True)->(c, (rem g oA), (rem a oG))
>                               (False,True)->(c, a:(rem g oA), (rem a oG))
>                               (True,False)->(c, (rem g oA), g:(rem a oG))
>                               (False,False)->(c, a:(rem g oA), g:(rem a oG))
>           rem a [] = []
>           rem a (b:bs) = if (a == b) then bs else b:(rem a bs)

> testAnswer1 = [W, G, B, R]
> testGuess1 = [W, G, R, B]
> testGuess2 = [W, G, R, P]

8.) Implement a trie (http://en.wikipedia.org/wiki/Trie) data structure. Write a function add, which takes a word, and a trie, and adds the word to the trie. Write another function lookup, which takes a prefix and a trie, and returns all the words in the trie that start with that prefix.

This is a fairly straightforward problem. We create the Trie data structure and define the recursive functions. I wish that we didn’t have a special data value for the Trie root, but I couldn’t think of an alternate solution besides having a special null character as the root.


> data Trie = TrieRoot { tries :: [Trie] } 
>     | Trie { char :: Char, tries :: [Trie] }
>             deriving (Eq, Ord, Show, Read)

> trieAdd t [] = t
> trieAdd (TrieRoot ts) ws = TrieRoot{tries = (_tahelp ts ws)}
> trieAdd (Trie c ts) ws   = Trie{char = c, tries = (_tahelp ts ws)}
> _tahelp ts (w:ws) = case find (\t -> (char t) == w) ts of 
>                     Nothing -> let newTrie = trieAdd Trie{char=w, 
>                                                           tries=[]} ws
>                                in newTrie:ts
>                     Just mtch -> let otherTries = filter (\t -> (char t) /= w) ts
>                                      newTrie    = trieAdd mtch ws
>                                  in newTrie:otherTries

> trieLookup (TrieRoot ts) ws = concatMap (\t -> trieLookup t ws) ts
> trieLookup (Trie c ts) [] = case ts of
>                             []        -> [[c]]
>                             otherwise -> recurse
>     where recurse = map (\str -> c:str) $ concatMap (\t -> trieLookup t []) ts
> trieLookup (Trie c ts) (w:ws) = if (c == w) 
>                                 then case ts of -- we matched the character
>                                      []        -> [[c]]
>                                      otherwise -> recurse
>                                 else [] -- stop the search down this trie branch
>     where recurse = map (\str -> c:str) $ concatMap (\t -> trieLookup t ws) ts

> testTrie = trieAdd (trieAdd (trieAdd (TrieRoot []) "hi") "hot") "gr"
> testTrie2 = trieAdd (TrieRoot []) "h"

9.) Write an algorithm to shuffle a deck of cards. Now write a function to perform some kind of evaluation of “how shuffled” a deck of cards is.

To shuffle I swap element i with a random element at position [i, (n-1)].

> shuffle gen xs = let n = length xs
>                      a = listArray (0, (n - 1)) xs                 -- create an Array
>                      swapPairs = (zip [0..(n - 1)] (swaps gen n))  -- compute a sequence of swaps to perform
>                  in elems $ foldl f a swapPairs
>     where f a' (i1, i2) = a' // [(i1, a'!i2), (i2, a'!i1)]         -- swap element at i1 with element at i2

Here’s a function which generates a sequence of swaps. We swap element at index ‘i’ into the range [i, (n-1)].

> swaps gen n = unfoldr f (gen, 0) 
>     where f (g, i) = if (i &lt n) 
>                      then let (randInt, g') = next g
>                               swapIndex = (randInt `mod` (n - i)) + i  -- produce a number in [i, (n-1)]
>                           in Just (swapIndex, (g', (i+1)))         -- add 'swapIndex' to the generated list
>                      else Nothing                                  -- stop generating elements

Here are functions that generates a sequence of random numbers or random generators. Can be used to call shuffle multiple times.

> randomGems = map mkStdGen randomNums
> randomNums = unfoldr (Just . next) (mkStdGen 1)

One way we might measure how good the suffle is (although for a single shuffle, the question is a bit preposterous), is to compute the min, max, and average distance that each item moved in the list.


> shuffleQuality xs ys = let xsPos = sortBySnd $ zip [1..(length xs)] xs
>                            ysPos = sortBySnd $ zip [1..(length ys)] ys
>                            diffFun = (\ (xp, yp) -> abs ((fst xp) - (fst yp)))
>                            posDiffs = map diffFun (zip xsPos ysPos)
>                            maxDiff = maximum posDiffs
>                            minDiff = minimum posDiffs
>                            avgDiff = (sum posDiffs) `div` (length posDiffs)
>                        in (maxDiff, minDiff, avgDiff)
>     where sortBySnd ps = sortBy (\ p1 p2 -> compare (snd p1) (snd p2)) ps

Comments (2)

Monads Demystified

Haskell’s monads are an enigma. They hold the key to shorter, more modular Haskell programs, but at first they’re hard to understand. For sure, many monadic tutorials exist, but I had to study them for weeks before it all clicked. I know others who struggled just as much.

I had such a hard time partly because I didn’t understand some fundamental concepts as well as I had thought. Unfortunately, it took me a while to realize this because I already had experience writing real Haskell code. It didn’t occur to me that I had to revisit basic concepts like types and functions. I also think that other tutorials don’t spend enough time breaking down the syntactic sugar that makes Haskell’s monads so terse.

This writeup focuses on the concepts that confused me. The intended audience is people who have studied Haskell, yet have struggled with monads. Although some fundemental concepts are explained, this is not a comprehensive introduction to Haskell.

Before we dive in, I want to acknowledge a few people and resources that I found most helpful during my studies. Paul Hudak’s writing is exceptionally lucid. His original A Gentle Introduction to Haskell is a tremendous resource. Cale Gibbard wrote my two favorite monadic introductions: Monads as Containers and Monads as Computation. In addition, Jeff Newbern’s All About Monads contains a well written Catalog of Standard Monads. Finally, the experts on the #haskell IRC channel are always helpful.

Back to Basics

Before we talk about the syntax or semantics of monads, and before we step through any examples, we go back to basics. When I started learning about monads, I overestimated my understanding of Haskell’s type system. This section highlights the concepts that I overlooked.

Every monad is nothing more than a paramaterized type that implements a few functions. Let’s review paramaterized types by exploring the details of (Maybe a).

> data Maybe a = Nothing
>              | Just a

It’s straightforward to see that (Maybe a) can be used to represent values that either exist or are missing. It’s also intuitive that the variable a is a place holder for the type that may or may not be there (perhaps an Int). Fair enough, but there’s more.

First let’s break down the type’s name. Although it is often called the “maybe type” in conversation, its proper name is (Maybe a). The word Maybe is a type constructor and the character a is a type variable.

The type constructor Maybe is a function that accepts the given type variable a and returns the type (Maybe a). I found this notion confusing because you cannot call the Maybe function within regular code. For example, ghci prints out:

Prelude> Maybe 4
:1:0: Not in scope: data constructor `Maybe'
Prelude> :t Maybe
:1:0: Not in scope: data constructor `Maybe'
Prelude> :kind Maybe
Maybe :: * -> *

The last statement, using :kind, gives an indication that Maybe is a unary type constructor. We won’t stop to discuss notion of a kinds (partly because I don’t understand them well enough myself). We can safely skip that topic. The error messages are printed because the Maybe function is only valid within the context of type definitions, type class definitions, and type signatures. For example, you might write:

> catMaybes :: [Maybe a] -> [a]

Within this type signature, Maybe is a function being applied to the type variable a, to produce a type of (Maybe a). (Incidentally, the type (Maybe a) is passed in turn to the type constructor [].) This is code, but it is within the scope of type signatures. We’ll return to this distinction later when we replace particular type constructors like Maybe with a variable that represents any parametric type constructor.

The right hand side of the type definition lists one or more value constructors, separated by the pipe symbol. For (Maybe a), we have Nothing and Just a. Even though these value constructors are defined within the type definition, they are valid in regular Haskell code, as we can see with ghci:

Prelude> :t Nothing
Nothing :: Maybe a
Prelude> :t Just
Just :: a -> Maybe a
Prelude> Just 5
Just 5

The ghci output says that the function named Just takes some value x of type a and returns a value of type (Maybe a), which by definition equals Just x. We introduce the value variable x here to distinguish it from a, which is a type variable. Similarly, Nothing is a nullary function of type (Maybe a).

Note that unlike the type constructor Maybe, which produces a type named (Maybe a), the value constructors Nothing and Just produce values that have the type (Maybe a). One consequence of this distinction is the tendency for value constructors to be named after its type constructor. This is not a conflict because value constructors and type constructors are in different namespaces.

Finally, be sure to review the notion of Haskell type classes and instances. Type classes allow us to define a particular interface, and then instances allow us to declare that a type implements that interface. For the purposes of monads, we will be examining the type classes Functor, and Monad.

Functors

For whatever reason, I had it in my mind that I would put off learning about functors until I understood monads. I wasn’t sure what a functor was, but I also wasn’t sure what a monad was, and I wanted to take things one at a time. In retrospect, this was a foolish mistake because the concepts are related, and functors are much simpler than monads.

A functor is simply a fancy name for a type that supports the map function, which happens to be called fmap in the Functor class. In ghci you can see:

Prelude> :t map
map :: (a -> b) -> [a] -> [b]
Prelude> :t fmap
fmap :: (Functor f) => (a -> b) -> f a -> f b

As the types show, the map function only operates over lists, whereas fmap is generalized to operate over any parametric type. The idea is that we want to apply some function to every item within a collection. The Functor class is defined as follows:

> class Functor f where
>     fmap     :: (a -> b) -> f a -> f b

This type class definition is written in the language for types. The variable f is a placeholder for any parametric type constructor. We could instantiate the variable with any parametric type constructor, including Maybe. For example:

> instance Functor Maybe where
>     fmap f Nothing  = Nothing
>     fmap f (Just x) = Just (f x)

A minor point — do not let the reuse of the variable f confuse you. In the Functor class definition, f is a placeholder for a type constructor. Within this instance defintion, f represents the function that we want to apply to whatever is within the Just x value.

Let’s see what happens in ghci:

Prelude> fmap (* 2) (Just 4)
Just 8
Prelude> fmap (* 2) Nothing
Nothing
Prelude> fmap odd (Just 4)
Just False
Prelude> fmap odd Nothing
Nothing

For the list type, we simply have:

> instance Functor [] where
>     fmap = map

To be precise, there are a two semantic rules that every proper fmap implementation must abide by:

> fmap id      = id
> fmap (f . g) = fmap f . fmap g

Together, these rules ensure that fmap doesn’t modify the shape or order of its input. Most sensible definitions of fmap abide by these rules, so don’t think about them too hard.

The important takeway from this section is the generalization of map to any parametric type using the variable f within the type signature of fmap. This allows us to make any parametric type (such as [a]) implement fmap, satisfying the common need of applying a function to every item in some collection. In the case of (Maybe a), we apply the function to zero or one values. For lists (the [a] type), we apply the function to zero or more values.

The Monad Type Class

Now we turn to the Monad class. Perhaps surprisingly, we’ll hold off discussing how monads can improve your Haskell code. Instead, we simply introduce the methods of the Monad class, just as we did for the Functor class. We also introduce Haskell’s special monadic syntactic sugar.

Here is the Monad class definition:

> infixl 1  >>, >>=
> class  Monad m  where
>     return   :: a -> m a
>     (>>=)    :: m a -> (a -> m b) -> m b
>     (>>)     :: m a -> m b -> m b
>     fail     :: String -> m a
>     m >> k   =  m >>= \_ -> k

The type class’s two important functions are return and (>>=), which is conversationally called “bind”. The function (>>) is defined in terms of bind, and exists to simplify syntax. We’ll discuss fail later, but it’s typically used to handle exceptional results.

Don’t fall in the trap of trying to think about what each of these functions “typically do.” The meaning is different for each instance of the Monad class. We will examine particular implementations shortly.

First, let’s examine return. Despite its name, it has nothing to do with the standard flow control keyword in other languages. In Haskell it is not a keyword, and it is not a flow control operator. Instead, return is a generalized value constructor, similar to how fmap was a genearlized version of map. We can show this in ghci:

Prelude> :t Just
Just :: a -> Maybe a
Prelude> :t return
return :: (Monad m) => a -> m a

Both functions take a value of some type, call it a, and return a value of a type that is parameterized over a. The Just function always returns a value of type (Maybe a), whereas the return function can generate a value of any parameterized type that is an instance of the Monad class. It is an alias for one or more of the type’s value constructors. We’ll give use cases for return later, but for now understand that if you need to create a monad, you often use return instead of explicitly using the type’s value constructors.

Next, consider bind, or (>>=). It is very similar to the fmap function, as we can see in ghci:

Prelude> :t fmap
fmap :: (Functor f) => (a -> b) -> f a -> f b
Prelude> :t (>>=)
(>>=) :: (Monad m) => m a -> (a -> m b) -> m b
Prelude> :t (flip (>>=))
(flip (>>=)) :: (Monad m) => (a -> m b) -> m a -> m b

Both functions operate over a function and a parameterized type. The first two arguments are flipped, but that’s a small matter of syntax. Also, the functions have slightly different signatures, but the intent looks familiar.

Just like with Functor, there are also some rules that any well defined instance of the Monad class must define.

> return a >>= k                 = k a
> m        >>= return            = m
> xs       >>= return . f        = fmap f xs
> m        >>= (\x -> k x >>= h) = (m >>= k) >>= h

As with the fmap rules, don’t think about these too hard. The first two rules say that return doesn’t tinker its argument. The third rule relates bind to fmap, as we hinted above. The third rule is a sort of associativity.

Haskell provides special syntactic sugar for the bind operator within its do block. Haskell performs the following two translations for us:

> do e1 ; e2         = e1 >>  e2
> do p <- e1 ; e2    = e1 >>= \p -> e2

In the second case, if p does not pattern match with e2, then fail is called. These two translations allow us to write monadic code that implicitly calls the bind operator. One effect of this notation is that the resulting code resembles typical more familiar imperative code, as we’ll see in the next section when we look at examples.

Basic Example Monads

Let’s make these monadic functions concrete by looking at two basic monads: (Maybe a) and [a]. For some time, I was confused when familiar types like these were referred to as monads. It wasn’t clear to me that any parametric type which implements the Monad class is always a monad. The monadic functionality only shines we apply a monadic operator, such as bind, on a value with the monadic type.

Monadic Maybe a

Starting with (Maybe a), we define the two key monadic operators as follows:

> instance Monad Maybe where
>     return         = Just
>     Nothing  >>= f = Nothing
>     (Just x) >>= f = f x
>     fail _         = Nothing

The return function is simply an alias for the value constructor Just. The binding operator always returns Nothing if the first argument is Nothing. Otherwise, we apply the given function f to the value x paramaterized by Just in the first argument. Due to its type, the function f must return either Just x' or Nothing.

It’s helpful to think of this instance of the bind operator passing zero or more values from one function to the next. As the type signature of (>>=) dictates, each function must produce a value of type (Maybe a). Consider the following example.

Suppose we want to define a decrement operator over the natural numbers (all integers greater than or equal to zero). To seamlessly support inputs less than or equal to zero, we define our function as follows:

> decrementNat x | x <= 0    = Nothing
>                | otherwise = Just (x-1)

Note that decrementNat has the desirable signature a -> Maybe a. Now we can use the monadic bind function to perform multiple decrements. If we load the above function from a module Foo in ghci, we can write:

*Foo> Nothing >>= decrementNat
Nothing
*Foo> Nothing >>= decrementNat >>= decrementNat
Nothing
*Foo> Just 2 >>= decrementNat
Just 1
*Foo> Just 2 >>= decrementNat >>= decrementNat
Just 0
*Foo> Just 2 >>= decrementNat >>= decrementNat >>= decrementNat
Nothing

We can also use the syntactic sugar of do, to write a function such as:

> decrementNat3 x = do x1 <- decrementNat x
>                      x2 <- decrementNat x1
>                      decrementNat x2

Then, once again, in ghci, we can write:

*Foo> decrementNat3 2
Nothing
*Foo> decrementNat3 5
Just 2

Notice that once the bind function (as defined for the (Maybe a) type) encounters a Nothing, it forever generates a Nothing. It short circuits. Otherwise, the incrementally smaller value is passed along the chain.

Monadic List

The list type is also an instance of the Monad type class, defined as follows:

> instance Monad [] where
>     return x = [x]
>     m >>= f  = concatMap f m
>     fail _   = []

Once again, return is an alias for the value constructor []. The bind operator is best conceptualized in two steps. First, a 2d list (a list of lists) is created because the function f is applied to every element in the list m. Remember that f creates a list. Then all of those lists are concatenated together.

Consider a simple expression such as:

Prelude> [1,2] >>= (\x -> return $ odd x)
[True,False]

Alternatively, you could write:

> myodd = do x <- [1,2]
>            return $ odd x

What exactly is going on here? Remember that for lists, the bind operator is concatMap, and return is the list constructor. We might also write it as:

Prelude> concatMap (return . odd) [1,2]
[True,False]

So the short monadic bind expression applies the function \x -> return $ odd x to both 1 and 2 to create [True] and [False], which are then concatenated together.

We can expand this example to produce all pairs of a list l.

> allpairs l = do x <- l
>                 y <- l
>                 return (x, y)

Note that in this case there are two chained calls to concatMap.

To be continued. . .

These are the basic ideas behind monads. We have not covered the type class MonadPlus. We have also not explored many common instances of the Monad class, most notably (IO a) and (State a). Perhaps I’ll tackle those topics in a subsequent posts.

Comments (1)

Another approach to infinite set operations

Brent wrote a nice reply to my last post about infinite set operations. I agree that the arbitrary halting threshold embedded in my solution is imperfect. This post further expands upon Brent’s suggested approach.

What if we redefine the difference and intersection operations as functions that emit information about the comparisons that they perform as they move through both inputs? In this case we can use (Maybe a), producing a Nothing when we reject an item, and a (Just a) when an item is accepted.

This stream of (Maybe a) values could then be filtered by another function to produce a result appropriate for the application at hand.

> module InfiniteSets2 where
> import List
> import Maybe

First we redefine the difference function.

> infDiff2 :: (Eq a, Ord a, Enum a) => [a] -> [a] -> [Maybe a]
> infDiff2 [] _          = []
> infDiff2 (x:xs) []     = (Just x):(infDiff2 xs [])
> infDiff2 (x:xs) (y:ys) | x == y = Nothing  : (infDiff2 xs ys)
>                        | x <  y = (Just x) : (infDiff2 xs (y:ys))
>                        | otherwise = infDiff2 (x:xs) ys

And here is the intersection function.

> infIntersect2 :: (Eq a, Ord a, Enum a) => [a] -> [a] -> [Maybe a]
> infIntersect2 [] _     = []
> infIntersect2 _  []    = []
> infIntersect2 (x:xs) (y:ys) | x == y    = (Just x) : (infIntersect2 xs ys)
>                             | x <  y    = Nothing : (infIntersect2 xs (y:ys))
>                             | otherwise = Nothing : (infIntersect2 (x:xs) ys)

We can rewrite our old infDiff function, here renamed to nDiff, as
follows.

> nDiff n l1 l2 = f $ map (catMaybes . (take n)) (tails $ infDiff2 l1 l2)
>     where f []      = []
>           f ([]:xs) = []
>           f (x:xs)  = (head x) : (f xs)

And here are some example calls.

> test1 = take 20 $ infDiff2 [1,2,3,5,10,20,50,100] [1,3,4,6,10,15,30,50]
> test2 = take 20 $ infDiff2 [3,5..] [3,5..]
> test3 = take 20 $ infDiff2 ([1,2] ++ [3,5..]) [3,5..]
> test4 = take 20 $ infDiff2 [1,3..] [2,4..]
> test5 = take 20 $ infDiff2 ([1,2] ++ [3,5..]) [3,5..25]

> test6 = take 20 $ infIntersect2 [1,2,3,5,10] [1,3,4,6,10]
> test7 = take 20 $ infIntersect2 [3,5..] [3,5..]
> test8 = take 20 $ infIntersect2 [3,5..] [2,4..]

> testNDiff1 = take 40 $ nDiff 5 ([1,2] ++ [3,5..]) [3,5..]

Leave a Comment

Older Posts »
Follow

Get every new post delivered to your Inbox.