Main.hs

module Main where

import Text.Printf
import Data.List
import Data.Packed.Vector
import qualified Data.Packed.Vector as P
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Storable as S
import Numeric.LinearAlgebra.HMatrix hiding (udot)
import Criterion.Main


sum' = foldl' (+) 0

ldot :: [Double] -> [Double] -> Double
ldot l1 l2 =
  sum' $ zipWith (*) l1 l2

tdot :: (Double, Double, Double) -> (Double, Double, Double) -> Double
tdot (a1, a2, a3) (b1, b2, b3) =
  a1 * b1 + a2 * b2 + a3 * b3

vdot :: V.Vector Double -> V.Vector Double -> Double
vdot x y = V.foldl1' (+) $ V.zipWith (*) x y
udot :: U.Vector Double -> U.Vector Double -> Double
udot x y = U.foldl1' (+) $ U.zipWith (*) x y
sdot :: S.Vector Double -> S.Vector Double -> Double
sdot x y = S.foldl1' (+) $ S.zipWith (*) x y

pdot :: P.Vector Double -> P.Vector Double -> Double
pdot x y = P.foldVector (+) 0 $ P.zipVectorWith (*) x y



benchVectors :: Int -> Benchmark
benchVectors size =
  let
    list = [0.0..fromIntegral size] :: [Double]
    packed = vector [0.0..fromIntegral size] :: P.Vector Double
    vec = V.fromList [0.0..fromIntegral size] :: V.Vector Double
    uvec = U.fromList [0.0..fromIntegral size] :: U.Vector Double
    svec = S.fromList [0.0..fromIntegral size] :: S.Vector Double
  in
    bgroup ("dot prod (" ++ show size ++ ")")
      [ bench "List" $ nf ((list `ldot`) :: [Double] -> Double) list
      , bench "Vector" $ nf ((vec `vdot`) :: V.Vector Double -> Double) vec
      , bench "Unboxed" $ nf ((uvec `udot`) :: U.Vector Double -> Double) uvec
      , bench "Storable" $ nf ((svec `sdot`) :: S.Vector Double -> Double) svec
      , bench "Packed <·>" $ nf ((packed <·>) :: P.Vector Double -> Double) packed
      , bench "Packed pdot" $ nf ((packed `pdot`) :: P.Vector Double -> Double) packed
      , bench "Packed with Storable" $ nf ((packed `sdot`) :: P.Vector Double -> Double) packed
      ]

main = do
  defaultMain
    [ benchVectors 3
    , benchVectors 3000
    , benchVectors 30000
    ]