Quaternion.hs

{-# LANGUAGE BlockArguments #-}

module Bench.Quaternion (benchmarks) where

import Test.Tasty.Bench

import qualified Geomancy
import qualified Geomancy.Quaternion

import qualified Linear
import qualified Linear.Quaternion

import Bench.Common (chain, clones)

benchmarks :: Benchmark
benchmarks = bgroup "quaternion"
  [ bgroup "euler" quatFromEuler
  , bgroup "rotate" $ flip map [10, 100, 1000] \size ->
      env (clones size (Geomancy.vec3 1 2 3) (Linear.V3 1 2 3)) $
        quatRotate size
  , bgroup "rotate chain" quatRotateChain
  ]

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

benchQuat :: Geomancy.Quaternion
benchQuat = Geomancy.Quaternion.axisAngle (Geomancy.vec3 1 2 3) (pi/7)

benchLQuatF :: Linear.Quaternion.Quaternion Float
benchLQuatF = Linear.Quaternion.axisAngle (Linear.V3 1 2 3) (pi/7)

quatRotate
  :: Int
  -> ([Geomancy.Vec3], [Linear.V3 Float])
  -> Benchmark
quatRotate size ~(vecs, lvecs) = bgroup (show size)
  [ bench "geomancy" $ nf (map (Geomancy.Quaternion.rotate benchQuat)) vecs
  , bench "linear"   $ nf (map (Linear.Quaternion.rotate benchLQuatF)) lvecs
  ]

quatRotateChain :: [Benchmark]
quatRotateChain =
  [ bench "geomancy" $ whnf (chain (Geomancy.Quaternion.rotate benchQuat) (Geomancy.vec3 1 2 3)) 1000
  , bench "linear"   $ whnf (chain (Linear.Quaternion.rotate benchLQuatF) (Linear.V3 1 2 3)) 1000
  ]