Frege cp. Haskell – strange data point in Mandelbrot Benchmark

MandelbrotGist.fr

{-
    Get Frege:
        wget -O fregec.jar 'https://github.com/Frege/frege/releases/download/3.23.288/frege3.23.288-gaa3af0c.jar'
        alias frege="java -Xss4m -Xmx4G -cp fregec.jar:."
        alias fregec="java -Xss4m -Xmx4G -jar fregec.jar"

    Java: java -version
        java version "1.8.0_45"
        Java(TM) SE Runtime Environment (build 1.8.0_45-b14)
        Java HotSpot(TM) 64-Bit Server VM (build 25.45-b02, mixed mode)

    Frege: fregec -version
        3.23.299-g5d2b11c
        runtime 0.23 wallclock seconds.

    Compile with:
        fregec -O MandelbrotGist.fr

    Run with:
        frege MandelbrotGist 0.01 30000

    { startup: 51 ms, warmup: 62934 ms, total: 66255 ms, mean: 6625 ms }
    runtime 129.403 wallclock seconds.

    Mean runtime after ten runs is 6625 ms.
-}

module MandelbrotGist where

{- --------- Benchmark Suite --------- -}

private nano = 1L
private micro = 1000L * nano
private milli = 1000L * micro
private seconds = 1000L * milli
private minute = 60L * seconds

--- Measures the time in milliseconds to evaluate 'a' and returns the Tuple of 'a' and the time measured.
benchmark a = do
    start <- System.nanoTime ()
    let !r = case a of
                !_ -> a
    end <- System.nanoTime ()
    return (r, (end - start) `div` milli)

data BenchmarkResult =  BenchmarkResult {
                          startup :: Long
                        , warmup :: Long
                        , total :: Long
                        , mean :: Long
                        }
instance Show BenchmarkResult where
    show (BenchmarkResult a b c d) = "{ startup: " ++ show a ++ " ms, warmup: " ++ show b ++ " ms, total: " ++ show c ++ " ms, mean: " ++ show d ++ " ms }"

{-
 - http://www.ibm.com/developerworks/library/j-benchmark1/
 - So, benchmarking the steady-state performance requires something like:
 -   1. Execute task once to load all classes.
 -   2. Execute task enough times to ensure that its steady-state execution profile has emerged.
 -   3. Execute task some more times to obtain an estimate of its execution time.
 -   4. Use Step 3 to calculate n, the number of task executions whose cumulative execution time is sufficiently large.
 -   5. Measure the overall execution time t of n more calls of task.
 -   6. Estimate the execution time as t/n.
 -}
benchmark' startup warmup n g = do
        (_, t_s) <- benchmark startup   -- 1.
        t_w <- loop n warmup 0L         -- 2.
        t_e <- loop n g 0L              -- Steps 3 and 4 are not present; we use fixed sizes provided by the caller.
        return $ BenchmarkResult t_s t_w t_e (t_e `div` n) -- 5. & 6.
    where
        loop  0 f !t = return t
        loop !i f !t = do
                (_, t') <- benchmark (f i)
                loop (i - 1) f (t + t')

{- --------- Mandelbrot Benchmark --------- -}

infix 6 `:+`
infix 13 `plus`
infix 14 `mult`

type D = Double

data Complex = C {!re, !im :: D}

instance Show Complex where
    show (C x y) = show x ++ " :+ " ++ show y

range :: Num α => α -> α -> α -> [α]
range from to step | from <= to = from : (range (from + step) to step)
                   | otherwise  = []

x :+ y = C x y

imag = fst
real = snd

magnitude :: Complex -> D
magnitude (C x y) = x*x + y*y

plus (C x y) (C x' y') =  (x+x') :+ (y+y')
mult (C x y) (C x' y') =  ((x * x') - (y * y')) :+ ((x * y') + (y * x'))

start :: Complex
start = 0 :+ 0

next :: Complex -> Complex -> Complex
next c z = z `mult` z `plus` c

iter c !max = go start 0
    where go !z !i | i < max && magnitude z < 4 = go (next c z) (i + 1)
                   | otherwise                  = (z, i)

genGrid :: (D, D, D) -> (D, D, D) -> [Complex]
genGrid (x_l, x_u, x_s) (y_l, y_u, y_s) =
    [(C x y) | x <- range x_l x_u x_s, y <- range y_l y_u y_s]

pure native atod java.lang.Double.parseDouble :: String -> Double

main [step, iterations] = do
        execute (atod step) (atoi iterations)

main _ = do
    error "arguments needed"

execute step max = do
        t <- benchmark' ((calc startup 1) 0) (warmup max) 10 (calc cs max)
        println t
    where
        cs = genGrid ((-2.0), 1.0, step) ((-1.0), 1.0, step)
        startup = genGrid (-1.0, 0.5, 0.1) (-0.5, 0.5, 0.1)
        warmup max i = length $ filter (< max) $ map snd $ map (\c -> iter c max) g
                where g = genGrid ((-2.0) + d, 1.0 + d, step) ((-1.0) + d, 1.0 + d, step)
                      d = 1 / i.double
        calc grid max = \i -> length $ filter (< max) $ map snd $ map (\c -> iter c max) grid

MandelbrotGist.hs

{-
    GHC: ghc --version
        The Glorious Glasgow Haskell Compilation System, version 7.6.3

    Compile with:
        ghc -XBangPatterns -O2 -rtsopts MandelbrotGist.hs

    Run with: 
        ./MandelbrotGist 0.01 30000

    For ten runs I get a mean runtime of 8008 ms.
-}

module Main where

import System.Environment
import System.CPUTime

import Text.Printf

infixl 6 `plus`
infixl 7 `mult`

type D = Double
data Complex = !D :+ !D
    deriving Show

--range :: Num α => α -> α -> α -> [α]
range from to step | from <= to = from : (range (from + step) to step)
                   | otherwise  = []

imag (_ :+ x) = x
real (x :+ _) = x

magnitude :: Complex -> D
magnitude (x :+ y) = x*x + y*y

plus (x :+ y) (x' :+ y') =  (x+x') :+ (y+y')
mult (x :+ y) (x' :+ y') =  ((x * x') - (y * y')) :+ ((x * y') + (y * x'))

start :: Complex
start = 0 :+ 0

next :: Complex -> Complex -> Complex
next c z = z `mult` z `plus` c

iter c !max = go start 0
    where go !z !i | i < max && magnitude z < 4 = go (next c z) (i + 1)
                   | otherwise                  = (z, i)

genGrid :: (D, D, D) -> (D, D, D) -> [Complex]
genGrid (x_l, x_u, x_s) (y_l, y_u, y_s) =
    [(x :+ y) | x <- range x_l x_u x_s, y <- range y_l y_u y_s]

pico = 1
nano = pico * 1000
micro = nano * 1000
milli = micro * 1000

main = do
    args <- getArgs
    let
        a1 = args !! 0
        a2 = args !! 1
        s :: Double
        s  = read a1
        !cs = genGrid ((-2.0), 1.0, s) ((-1.0), 1.0, s)
        calc :: [Complex] -> Int -> [(Complex, Int)]
        calc grid max = map (\c -> iter c max) grid
        max :: Int
        max = read a2
    start <- getCPUTime
    let !l = length $ filter (< max) $ map snd $ calc cs max
    end <- getCPUTime
    print l
    let diff = (fromIntegral (end - start)) / milli
    printf "Computation time: %0f ms\n" (diff :: Double)