DQuaternion.hs

{-# LANGUAGE BlockArguments #-}

module Bench.DQuaternion (benchmarks) where

import Test.Tasty.Bench

import Data.List (foldl1')

import qualified Geomancy
import qualified Geomancy.DQuaternion

import qualified Linear
import qualified Linear.Quaternion

import Bench.Common (chain, clones)

benchmarks :: Benchmark
benchmarks = bgroup "dquaternion"
  [ bgroup "euler" dquatFromEuler
  , bgroup "axisAngle" dquatAxisAngle
  , bgroup "multiply" $ flip map [10, 100, 1000] \size ->
      env (clones size benchDQuat benchLQuat) $
        dquatMultiply size
  , bgroup "rotate" $ flip map [10, 100, 1000] \size ->
      env (clones size (Geomancy.dvec3 1 2 3) (Linear.V3 1 2 3)) $
        dquatRotate size
  , bgroup "rotate chain" dquatRotateChain
  ]

dquatFromEuler :: [Benchmark]
dquatFromEuler =
  [ bench "fused" $ whnf (\a -> Geomancy.DQuaternion.intrinsic a a a) (pi/3)
  , bench "composed" $ whnf (\a -> Geomancy.DQuaternion.extrinsic a a a) (pi/3)
  ]

dquatAxisAngle :: [Benchmark]
dquatAxisAngle =
  [ bench "geomancy" $ whnf (Geomancy.DQuaternion.axisAngle (Geomancy.dvec3 1 2 3)) (pi/7)
  , bench "linear"   $ whnf (Linear.Quaternion.axisAngle (Linear.V3 1 2 3 :: Linear.V3 Double)) (pi/7)
  ]

benchDQuat :: Geomancy.DQuaternion
benchDQuat = Geomancy.DQuaternion.axisAngle (Geomancy.dvec3 1 2 3) (pi/7)

benchLQuat :: Linear.Quaternion.Quaternion Double
benchLQuat = Linear.Quaternion.axisAngle (Linear.V3 1 2 3) (pi/7)

dquatMultiply
  :: Int
  -> ([Geomancy.DQuaternion], [Linear.Quaternion.Quaternion Double])
  -> Benchmark
dquatMultiply size ~(dquats, lquats) = bgroup (show size)
  [ bench "geomancy" $ whnf (foldl1' (*)) dquats
  , bench "linear"   $ whnf (foldl1' (*)) lquats
  ]

dquatRotate
  :: Int
  -> ([Geomancy.DVec3], [Linear.V3 Double])
  -> Benchmark
dquatRotate size ~(dvecs, lvecs) = bgroup (show size)
  [ bench "geomancy" $ nf (map (Geomancy.DQuaternion.rotate benchDQuat)) dvecs
  , bench "linear"   $ nf (map (Linear.Quaternion.rotate benchLQuat)) lvecs
  ]

dquatRotateChain :: [Benchmark]
dquatRotateChain =
  [ bench "geomancy" $ whnf (chain (Geomancy.DQuaternion.rotate benchDQuat) (Geomancy.dvec3 1 2 3)) 1000
  , bench "linear"   $ whnf (chain (Linear.Quaternion.rotate benchLQuat) (Linear.V3 1 2 3)) 1000
  ]