Abnormally slow Haskell code

haskell

Solution

If you're patient, you'll notice that the second result is calculated much faster than the first. That's because your implementation takes some time to read in the csv files.

You may be tempted to stick a print statement to see when it's done loading like so:

main = do
    trainingSample <- readDigits "trainingsample.csv"
    validationSample <- readDigits "validationsample.csv"
    putStrLn "done loading data"

But due to lazyIO, this won't do what you think it does. `trainingSample` and `validationSample` are not yet fully evaluated. So your print statement will print almost immediately, and the first result will still take forever.

You can force `readDigits` to fully evaluate their return values, though, which will give you a better idea of how much time is spent there. You could either switch to using non-lazy IO, or just print something derived from the data:

readDigits :: String -> IO [Digit]
readDigits filename = do
    fileContent <- readFile filename
    putStr' $ filename ++ ": "
    rows <- forM (tail $ lines fileContent) $ \line -> do
      let xs = parseDigit line
      putStr' $ case compare (sum $ pixels xs) 0 of
                LT -> "-"
                EQ -> "0"
                GT -> "+"
      return xs
    putStrLn ""
    return rows
  where putStr' s = putStr s >> hFlush stdout

On my machine, this let me see that it took about 27 seconds to fully read the digits from `trainingsample.csv`.

This is printf-style profiling, which isn't great (much better to use a real profiler, or use criterion to benchmark various parts of your code), but good enough for these purposes.

That's clearly a major part of the slowdown, so it's worth trying to switch to strict io. Using `Data.Text.IO.readFile`, which is strict, cut it down to ~18 seconds.

UPDATE

Here's how to speed up your updated code:

Use unboxed vectors for `Pixels` (small win):

import qualified Data.Vector.Unboxed as U
-- ...

type Pixels = U.Vector Int
-- ...

distance :: Pixels -> Pixels -> Float
distance d1 d2 = sqrt . U.sum $ U.zipWith pointDistance d1 d2
    where pointDistance a b = fromIntegral $ (a - b) * (a - b)

parseDigit :: T.Text -> Digit
parseDigit s = Digit label (U.fromList pixels)
    where (label:pixels) = map toDigit $ T.splitOn (T.pack ",") s
          toDigit s      = either (\_ -> 0) fst (T.Read.decimal s)

Force the distance evaluation early by using `seq` (big win):

identify :: Digit -> V.Vector Digit -> (Digit, Float)
identify digit training = V.minimumBy (comparing snd) distances
    where distances = V.map fn training
          fn ref    = let d = distance (pixels digit) (pixels ref) in d `seq` (ref, d)

On my machine, the whole program now runs in ~5s:

% ghc --make -O2 Main.hs
[1 of 1] Compiling Main             ( Main.hs, Main.o )
Linking Main ...
% time ./Main
./Main  5.00s user 0.11s system 99% cpu 5.115 total

The thunks were killing you.

Problem

Original source