Haskell extremely slow simple recurrence

Viewed 221

I'm experimenting with Haskell profiling with a simple recursive max algorithm:

max_tag :: Integer -> [Integer] -> Integer
max_tag head [] = head
max_tag head (x:xs) =
    let {m = max_tag x xs} in
      let {b = (Prelude.<=) m head} in
        case b of {True -> head; False -> m}

When I compare it to a python imperative equivalent, I get a 10x speed factor in favor of python:

with open("input.txt") as fl:
    data = [int(d) for d in fl.read().splitlines()]
max_ = 0
for d in data:
    if max_ < d:
        max_ = d
print(max_)
  • It seems there is an inherent limitation of using tail recursion in the Haskell case, am I right?
  • Any other way to make the Haskell code faster?
  • The input file contains 1M unsigned, unbounded integers (on average 32 digits)

For completeness, here is the complete Haskell file (not sure it is needed):

import Max
import System.IO  
import Control.Monad
import System.Environment
import Prelude

readInt :: String -> Integer
readInt = read

max_tag :: Integer -> [Integer] -> Integer
max_tag head [] = head
max_tag head (x:xs) =
    let {m = max_tag x xs} in
      let {b = (Prelude.<=) m head} in
        case b of {True -> head; False -> m}

main = do
    args <- getArgs
    contents <- readFile "input.txt"
    let numbers_as_strings = words $ contents
    let numbers = map readInt numbers_as_strings
    let max_number = max_tag 0 numbers
    print max_number

EDIT: refactor suggested by @Willem Van Onsem, works ! (28 sec -> 12 sec)

max_bar :: Integer -> [Integer] -> Integer
max_bar head [] = head
max_bar head (x:xs) =
  let {b = head < x} in
    let {m = case b of {True -> x; False -> head}} in
      max_bar m xs

Any ideas on further improvements? I must be faster than python !

2 Answers

An even more efficient way than @Noughtmare's answer is to use Data.ByteString which does not have the overhead of handling encodings, which is not needed here. In my tests, with one million random 32 digit numbers as input, this runs in ~290ms while the answer by @Noughtmare runs in ~1020ms. For comparison, the original Python one runs in ~560ms.

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

-- NOTE: This will throw an error if parsing fails.
readInt :: B.ByteString -> Integer
readInt = fst . fromJust . C.readInteger

main :: IO ()
main = do
  contents <- B.readFile "read-integers.txt"
  let numbers = map readInt $ C.lines contents
  print $ max_tag 0 numbers

max_tag :: Integer -> [Integer] -> Integer
max_tag head [] = head
max_tag head (x : xs) = max_tag (max head x) xs

Using this to benchmark your function should make it go much faster (also be sure to use text version 2.0 or later):

import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T

readInt :: T.Text -> Integer
readInt t = 
  case T.signed T.decimal t of
    Right (x, _) -> x

main :: IO ()
main = do
    args <- getArgs
    contents <- T.readFile "input.txt"
    let numbers_as_strings = T.words contents
    let numbers = map readInt numbers_as_strings
    let max_number = max_tag 0 numbers
    print max_number

You can also speed up your max_tag function itself by making it tail recursive and thus avoiding a bunch of memory allocations:

max_tag :: Integer -> [Integer] -> Integer
max_tag head [] = head
max_tag head (x:xs) 
  | x <= head = max_tag head xs
  | otherwise = max_tag x xs

You can make it even slightly faster by using foldr so that you get foldr/build fusion with map readInt:

max_tag :: Integer -> [Integer] -> Integer
max_tag x0 xs = foldr (\x go y -> if x > y then go x else go y) id xs x0
Related