project euler #2

E2.hs

{-# LANGUAGE BangPatterns #-}

{-
Each new term in the Fibonacci sequence is generated by adding the previous two
terms. By starting with 1 and 2, the first 10 terms will be:

1, 2, 3, 5, 8, 13, 21, 34, 55, 89, ...

Find the sum of all the even-valued terms in the sequence which do not exceed
four million.

ghc --make E2.hs -O3 -fforce-recomp -funbox-strict-fields -fvia-C -optc-O3
./E2 -u e2.csv
pdftk e2-sol*.pdf cat output e2.pdf
-}

module Main where

import Control.Exception
import Criterion.Config
import Criterion.Main
import Data.Monoid
import qualified Criterion.MultiMap as M

myConfig =
  defaultConfig
    { cfgPerformGC    = Last (return True)
    , cfgPlot         = M.singleton KernelDensity (PDF 470 175)
    , cfgPlotSameAxis = Last (return True)
    , cfgVerbosity    = Last (return Verbose)
    }

main :: IO ()
main = do
    let (r1:rs) = map (\f -> f n) [sol1, sol3, sol4, sol5, sol6, sol7, sol8]
    assert (all (== r1) rs) $
      defaultMainWith myConfig (return ()) [
          bgroup "e2"
            [ bench "sol1" (whnf sol1 n)
            , bench "sol3" (whnf sol3 n)
            , bench "sol4" (whnf sol4 n) -- #3
            , bench "sol5" (whnf sol5 n)
            , bench "sol6" (whnf sol6 n)
            , bench "sol7" (whnf sol7 n) -- #2
            , bench "sol8" (whnf sol8 n) -- #1
            ]
        ]
  where
    n = 10^2000

sol1 :: Integer -> Integer
sol1 c =
    f 0 0 1
  where
    f a x y = if x > c then a else g (a+x) y (x+y)
    g a x y = h a y (x+y)
    h a x y = f a y (x+y)

-- Direct accumulating approach
-- 1/3 the numbers, but at the expensive of exponentials (several multiplies)
-- and a division We'd be better off going through all fibs.
-- XXX This doesn't work for large numbers due to floating point calculations
sol2 :: Int -> Int
sol2 c =
    f 0 0
  where
    f !a !n = let !z = dfib n in if z > c then a else f (a+z) (n+3)
    -- goldenRatio
    !sq5 = sqrt 5
    !gr = (1 + sq5) / 2
    -- With the exception of the first fibs, this is the cheapest way to calculate
    -- a single fib.
    dfib !n = round $ (gr^n-(-1/gr)^n) / sq5

sol3 :: Integer -> Integer
sol3 c =
    sum . every 3 . takeWhile (<c) $ fib
  where
    fib = 0 : 1 : zipWith (+) fib (tail fib)
    every n =
        go
      where
        go [] = []
        go xs = let (!h,rxs) = splitAt (fromInteger n) xs
                    !y = head h
                in y : go rxs

sol4 :: Integer -> Integer
sol4 c =
    sum . takeWhile (<c) . filter even $ fib
  where
    fib = f 0 1
    f !x !y = x : f y (x+y)

-- a modification of bsl's solution with comparisons removed and bangpatterns
-- used instead of seq
sol5 :: Integer -> Integer
sol5 m =
    go 0 1 0
  where
    go !p !q !acc
      | p > m = acc
      | otherwise =
        let !r = p+q
            !s = q+r
        in go s (r+s) (acc+p)

-- sol1 with strictness
sol6 :: Integer -> Integer
sol6 c =
    f 0 0 1
  where
    f !a !x !y = if x > c then a else g (a+x) y (x+y)
    g !a !x !y = h a y (x+y)
    h !a !x !y = f a y (x+y)

-- sol4 with different fib function
sol7 :: Integer -> Integer
sol7 c =
    sum . takeWhile (<c) . filter even $ fib
  where
    fib = 0 : 1 : zipWith (+) fib (tail fib)

-- sol7 with strict zipWith
sol8 :: Integer -> Integer
sol8 c =
    sum . takeWhile (<c) . filter even $ fib
  where
    fib = 0 : 1 : zipWith' (+) fib (tail fib)
    zipWith' f (!a:as) (!b:bs) = let !y = f a b in y : zipWith' f as bs
    zipWith' _ _ _ = []

e2.pdf