simple-vec3 0.1.0.1 → 0.2

raw patch · 9 files changed

+419/−317 lines, 9 filesdep +QuickCheckdep +tastydep +tasty-quickcheckdep ~basedep ~criteriondep ~simple-vec3PVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, tasty, tasty-quickcheck, tasty-th, vector-th-unbox

Dependency ranges changed: base, criterion, simple-vec3, vector

API changes (from Hackage documentation)

Files

• benchmark/Benchmark.hs +49/−56
• simple-vec3.cabal +56/−46
• src/Data/Vec3.hs +82/−4
• src/Data/Vec3/Class.hs +3/−3
• src/Data/Vec3/Storable.hs +0/−61
• src/Data/Vec3/TUnboxed.hs +0/−58
• src/Data/Vec3/Unboxed.hs +28/−89
• src/Data/Vec3/Unboxed/Contiguous.hs +133/−0
• tests/Tests.hs +68/−0

@@ -1,5 +1,5 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-}+ import Criterion.Main  import Data.Vector.Generic as VG@@ -7,6 +7,7 @@ import Data.Vector.Unboxed as VU  import Data.Vec3+import qualified Data.Vec3.Unboxed.Contiguous as C   oXYZ :: (Double, Double, Double)@@ -20,64 +21,55 @@ n :: Int n = 1000000 + bigN :: Int bigN = n * 10 -foo :: Vec3 v => v -> v -> Double-foo v1 v2 = x1 + x2-    where-      (x1, _, _) = toXYZ v1-      (x2, _, _) = toXYZ v2-{-# INLINE foo #-} - -- Access to whole elements-test :: (Show a, Vec3 a, VG.Vector v a) => v a -> v a -> IO ()-test v v2 = do-  let !vr = VG.zipWith (<+>) v v-  return ()-{-# INLINE test #-}+testWhole :: (Vec3 a, VG.Vector v a) => v a -> v a -> Benchmarkable+testWhole v v2 = whnf (uncurry $ VG.zipWith (<+>)) (v, v2)   -- Access to x components of elements-testComp :: (Show a, Vec3 a, VG.Vector v a, VG.Vector v Double) => v a -> v a -> IO ()-testComp v v2 = do-  let !vr = VG.zipWith (foo) v v-  return ()-{-# INLINE testComp #-}+testComp :: (Vec3 a, VG.Vector v a, VG.Vector v Double) => v a -> v a -> Benchmarkable+testComp v v' = whnf (uncurry $ VG.zipWith foo) (v, v')+  where+    foo v1 v2 = x1 + x2+      where+        (x1, _, _) = toXYZ v1+        (x2, _, _) = toXYZ v2   -- zipWith using generic dot product-testDotM :: (Show a, Vec3 a, VG.Vector v a, VG.Vector v Double) => v a -> v a -> IO ()-testDotM v v2 = do-  let o = fromXYZ oXYZ-      m = fromRows (o, o, o)-      dotM' e1 e2 = dotM e1 e2 m-      !vr = VG.zipWith dotM' v v2-  return ()-{-# INLINE testDotM #-}+testDotM :: (Vec3 a, VG.Vector v a, VG.Vector v Double) => v a -> v a -> Benchmarkable+testDotM v v2 = whnf (uncurry $ VG.zipWith dotM') (v, v2)+  where+    o = fromXYZ oXYZ+    m = fromRows (o, o, o)+    dotM' e1 e2 = dotM e1 e2 m   -- Note that source arrays are not forced in test functions. -tv :: VU.Vector TUVec3+tv :: VU.Vector UVec3 tv = VG.replicate n $ fromXYZ oXYZ  -uv :: VU.Vector UVec3-uv = VG.replicate n $ fromXYZ oXYZ+cv :: VU.Vector C.UVec3+cv = VG.replicate n $ fromXYZ oXYZ   sv :: VS.Vector SVec3 sv = VG.replicate n $ fromXYZ oXYZ  -tv' :: VU.Vector TUVec3+tv' :: VU.Vector UVec3 tv' = VG.replicate n $ fromXYZ oXYZ'  -uv' :: VU.Vector UVec3-uv' = VG.replicate n $ fromXYZ oXYZ'+cv' :: VU.Vector C.UVec3+cv' = VG.replicate n $ fromXYZ oXYZ'   sv' :: VS.Vector SVec3@@ -88,11 +80,11 @@ bsv = VG.replicate bigN $ fromXYZ oXYZ  -buv :: VU.Vector UVec3-buv = VG.replicate bigN $ fromXYZ oXYZ+bcv :: VU.Vector C.UVec3+bcv = VG.replicate bigN $ fromXYZ oXYZ  -btv :: VU.Vector TUVec3+btv :: VU.Vector UVec3 btv = VG.replicate bigN $ fromXYZ oXYZ  @@ -100,43 +92,44 @@ bsv' = VG.replicate bigN $ fromXYZ oXYZ'  -buv' :: VU.Vector UVec3-buv' = VG.replicate bigN $ fromXYZ oXYZ'+bcv' :: VU.Vector C.UVec3+bcv' = VG.replicate bigN $ fromXYZ oXYZ'  -btv' :: VU.Vector TUVec3+btv' :: VU.Vector UVec3 btv' = VG.replicate bigN $ fromXYZ oXYZ'  +main :: IO () main = defaultMain        [ bgroup "zipWith"-                    [ bench "Storable"             $ test sv sv'-                    , bench "Unboxed (contiguous)" $ test uv uv'-                    , bench "Unboxed (tuples)"     $ test tv tv'+                    [ bench "SVec/Storable"           $ testWhole sv sv'+                    , bench "UVec/Unboxed"            $ testWhole tv tv'+                    , bench "UVec/Unboxed/Contiguous" $ testWhole cv cv'                     ]        , bgroup "zipWith-by-x"-                    [ bench "Storable"             $ testComp sv sv'-                    , bench "Unboxed (contiguous)" $ testComp uv uv'-                    , bench "Unboxed (tuples)"     $ testComp tv tv'+                    [ bench "SVec/Storable"           $ testComp sv sv'+                    , bench "UVec/Unboxed"            $ testComp tv tv'+                    , bench "UVec/Unboxed/Contiguous" $ testComp cv cv'                     ]        , bgroup "zipWith-dotM"-                    [ bench "Storable"             $ testDotM sv sv'-                    , bench "Unboxed (contiguous)" $ testDotM uv uv'-                    , bench "Unboxed (tuples)"     $ testDotM tv tv'+                    [ bench "SVec/Storable"           $ testDotM sv sv'+                    , bench "UVec/Unboxed"            $ testDotM tv tv'+                    , bench "UVec/Unboxed/Contiguous" $ testDotM cv cv'                     ]        , bgroup "zipWith 10M"-                    [ bench "Storable"             $ test bsv bsv'-                    , bench "Unboxed (contiguous)" $ test buv buv'-                    , bench "Unboxed (tuples)"     $ test btv btv'+                    [ bench "SVec/Storable"           $ testWhole bsv bsv'+                    , bench "UVec/Unboxed"            $ testWhole btv btv'+                    , bench "UVec/Unboxed/Contiguous" $ testWhole bcv bcv'                     ]        , bgroup "zipWith-by-x 10M"-                    [ bench "Storable"             $ testComp bsv bsv'-                    , bench "Unboxed (contiguous)" $ testComp buv buv'-                    , bench "Unboxed (tuples)"     $ testComp btv btv'+                    [ bench "SVec/Storable"           $ testComp bsv bsv'+                    , bench "UVec/Unboxed"            $ testComp btv btv'+                    , bench "UVec/Unboxed/Contiguous" $ testComp bcv bcv'                     ]        , bgroup "zipWith-dotM 10M"-                    [ bench "Storable"             $ testDotM bsv bsv'-                    , bench "Unboxed (contiguous)" $ testDotM buv buv'-                    , bench "Unboxed (tuples)"     $ testDotM btv btv'+                    [ bench "SVec/Storable"           $ testDotM bsv bsv'+                    , bench "UVec/Unboxed"            $ testDotM btv btv'+                    , bench "UVec/Unboxed/Contiguous" $ testDotM bcv bcv'                     ]        ]

@@ -1,53 +1,63 @@-name:                simple-vec3-version:             0.1.0.1--synopsis:            Three-dimensional vectors of doubles with basic operations--description:         A class of 3-vectors with a set of basic methods for-                     geometry operations on vectors and an associated-                     matrix type. Several instances are provided for-                     use with "Data.Vector.Unboxed" and-                     "Data.Vector.Storable" as container types.--homepage:            http://github.com/dzhus/simple-vec3/-license:             BSD3-license-file:        LICENSE-author:              Dmitry Dzhus-maintainer:          <dima@dzhus.org>-category:            Math, Numerical--build-type:          Simple-cabal-version:       >=1.8-tested-with:         GHC == 7.6.1+name: simple-vec3+version: 0.2+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: <dima@dzhus.org>+homepage: https://github.com/dzhus/simple-vec3#readme+bug-reports: https://github.com/dzhus/simple-vec3/issues+synopsis: Three-dimensional vectors of doubles with basic operations+description:+    A class of 3-vectors with a set of basic methods for geometry operations on vectors and an associated matrix type. Instances are provided for use with "Data.Vector.Unboxed" and "Data.Vector.Storable" as container types.+category: Math, Numerical+author: Dmitry Dzhus  source-repository head-  type:     git-  location: http://github.com/dzhus/simple-vec3/+    type: git+    location: https://github.com/dzhus/simple-vec3  library-  hs-source-dirs: src--  ghc-options: -Wall -O2 -fllvm--  exposed-modules:-    Data.Vec3-    Data.Vec3.Class-    Data.Vec3.Storable-    Data.Vec3.TUnboxed-    Data.Vec3.Unboxed+    exposed-modules:+        Data.Vec3+        Data.Vec3.Class+        Data.Vec3.Unboxed+        Data.Vec3.Unboxed.Contiguous+    build-depends:+        base >=4.9.0.0 && <5,+        QuickCheck >=2.8.2,+        vector >=0.11.0.0,+        vector-th-unbox >=0.2.1.6+    default-language: Haskell2010+    hs-source-dirs: src+    ghc-options: -Wall -  build-depends:-    base        == 4.6.*,-    vector      == 0.10.*+test-suite pythia-recommender-test+    type: exitcode-stdio-1.0+    main-is: Tests.hs+    build-depends:+        base >=4.9.0.0 && <5,+        QuickCheck >=2.8.2,+        vector >=0.11.0.0,+        vector-th-unbox >=0.2.1.6,+        simple-vec3 >=0.2,+        tasty >=0.11.0.4,+        tasty-quickcheck >=0.8.4,+        tasty-th >=0.1.4+    default-language: Haskell2010+    hs-source-dirs: tests+    ghc-options: -Wall  benchmark simple-vec3-benchmark-   type:    exitcode-stdio-1.0-   main-is: benchmark/Benchmark.hs--   ghc-options: -Wall -O2 -fllvm -rtsopts--   build-depends:-     base       == 4.6.*,-     criterion  == 0.6.*,-     simple-vec3,-     vector     == 0.10.*+    type: exitcode-stdio-1.0+    main-is: Benchmark.hs+    build-depends:+        base >=4.9.0.0 && <5,+        QuickCheck >=2.8.2,+        vector >=0.11.0.0,+        vector-th-unbox >=0.2.1.6,+        criterion >=1.1.1.0,+        simple-vec3 >=0.2+    default-language: Haskell2010+    hs-source-dirs: benchmark+    ghc-options: -Wall

@@ -1,13 +1,91 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++{-|++'Vec3' class and implementations.++-}+ module Data.Vec3     ( Vec3(..)-    , UVec3(..)     , SVec3(..)-    , TUVec3(..)+    , UVec3(..)     )  where +import Prelude hiding (reverse)++import Foreign+import Foreign.C.Types+ import Data.Vec3.Class-import Data.Vec3.Storable-import Data.Vec3.TUnboxed import Data.Vec3.Unboxed++import Test.QuickCheck+++-- | 'Vec3' implementation with 'Foreign.Storable.Storable' instance+-- based on a single contiguous array storage scheme, suitable for use+-- with "Data.Vector.Storable".+--+-- 'Unbox' instance provides the required index transformations.+--+-- @+-- interface: [d1 x   y   z  ; d2 x   y   z  ...], length = N = M / 3+--                |   |   |       |   |   |+-- storage:   [  d1x d2y d2z ;   d2x d2y d2z ...], length = M+-- @+data SVec3 = SVec3 !CDouble !CDouble !CDouble+             deriving (Eq, Show)+++instance Storable SVec3 where+  sizeOf _    = sizeOf (undefined :: CDouble) * 3+  alignment _ = alignment (undefined :: CDouble)++  peek p = do+      x <- peekElemOff q 0+      y <- peekElemOff q 1+      z <- peekElemOff q 2+      return $ SVec3 x y z+    where+      q = castPtr p+  {-# INLINE peek #-}++  poke p (SVec3 x y z) = do+      pokeElemOff q 0 x+      pokeElemOff q 1 y+      pokeElemOff q 2 z+    where+      q = castPtr p+  {-# INLINE poke #-}+++instance Vec3 SVec3 where+    newtype Matrix SVec3 = SMatrix (SVec3, SVec3, SVec3)+                           deriving (Eq, Show)++    fromXYZ (x, y, z) = SVec3 (CDouble x) (CDouble y) (CDouble z)+    {-# INLINE fromXYZ #-}++    toXYZ (SVec3 (CDouble x) (CDouble y) (CDouble z)) = (x, y, z)+    {-# INLINE toXYZ #-}++    fromRows (r1, r2, r3) = SMatrix (r1, r2, r3)+    {-# INLINE fromRows #-}++    toRows (SMatrix (r1, r2, r3)) = (r1, r2, r3)+    {-# INLINE toRows #-}+++instance Arbitrary SVec3 where+  arbitrary = do+    x <- arbitrary+    y <- arbitrary+    z <- arbitrary+    return $ fromXYZ (x, y, z)++  shrink (SVec3 (CDouble x) (CDouble y) (CDouble z)) =+    map fromXYZ $ shrink (x, y, z)

@@ -34,12 +34,12 @@      -- | Add two vectors.     (<+>)          :: v -> v -> v-    (<+>) v1 v2     = zipWith (+) v1 v2+    (<+>)          = zipWith (+)     {-# INLINE (<+>) #-}      -- | Subtract two vectors.     (<->)          :: v -> v -> v-    (<->) v1 v2     = zipWith (-) v1 v2+    (<->)          = zipWith (-)     {-# INLINE (<->) #-}      -- | Cross product.@@ -140,7 +140,7 @@      -- | Transpose a vector and multiply it by another vector,     -- producing a matrix.-    -- +    --     -- @     -- [ v1x ]                       [ r11  r12  r13 ]     -- [     ]                       [               ]

@@ -1,61 +0,0 @@-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeFamilies #-}--module Data.Vec3.Storable-    ( SVec3(..)-    )--where--import Prelude hiding (reverse)--import Foreign-import Foreign.C.Types----import Data.Vector.Storable as VS--import Data.Vec3.Class----- | 'Vec3' implementation with 'Foreign.Storable.Storable' instance,--- suitable for use with "Data.Vector.Storable".-data SVec3 = SVec3 !CDouble !CDouble !CDouble-             deriving (Eq, Show)---instance Storable SVec3 where-  sizeOf _    = sizeOf (undefined :: CDouble) * 3-  alignment _ = alignment (undefined :: CDouble)--  peek p = do-      x <- peekElemOff q 0-      y <- peekElemOff q 1-      z <- peekElemOff q 2-      return $ SVec3 x y z-    where-      q = castPtr p-  {-# INLINE peek #-}--  poke p (SVec3 x y z) = do-      pokeElemOff q 0 x-      pokeElemOff q 1 y-      pokeElemOff q 2 z-    where-      q = castPtr p-  {-# INLINE poke #-}---instance Vec3 SVec3 where-    newtype Matrix SVec3 = SMatrix (SVec3, SVec3, SVec3)--    fromXYZ (x, y, z) = SVec3 (CDouble x) (CDouble y) (CDouble z)-    {-# INLINE fromXYZ #-}--    toXYZ (SVec3 (CDouble x) (CDouble y) (CDouble z)) = (x, y, z)-    {-# INLINE toXYZ #-}--    fromRows (r1, r2, r3) = SMatrix (r1, r2, r3)-    {-# INLINE fromRows #-}--    toRows (SMatrix (r1, r2, r3)) = (r1, r2, r3)-    {-# INLINE toRows #-}

@@ -1,58 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeFamilies #-}--module Data.Vec3.TUnboxed-    ( TUVec3(..)-    )--where--import Prelude hiding (reverse)--import Data.Vector.Unboxed as VU-import Data.Vector.Generic as VG-import Data.Vector.Generic.Mutable as VG--import Data.Vec3.Class----- | 'Vec3' implementation with 'Data.Vector.Unboxed.Unbox' instance--- based on tuples, suitable for use with "Data.Vector.Unboxed".------ This represents 3-vector as a triple of doubles, using the default--- Unbox instance for tuples as provided by "Data.Vector.Unboxed",--- which wraps a vector of tuples as a tuple of vectors.------ @--- interface:  [d1 (x, y, z); d2 (x, y, z) ...], length = N---                  |  |  |       |  |  |--- storage(x): [d1x-+  |  | ; d2x-+  |  |  ...], length = N--- storage(y): [d1y----+  | ; d2y----+  |  ...], length = N--- storage(z): [d1z-------+ ; d2z-------+  ...], length = N--- @-newtype TUVec3 = TUVec3 (Double, Double, Double)-                deriving (Eq, Show,-                          VG.Vector VU.Vector,-                          VG.MVector VU.MVector,-                          VU.Unbox)---instance Vec3 TUVec3 where-    newtype Matrix TUVec3 = TUMatrix (TUVec3, TUVec3, TUVec3)-                            deriving (Eq, Show,-                                      VG.Vector VU.Vector,-                                      VG.MVector VU.MVector,-                                      VU.Unbox)---    fromXYZ v = TUVec3 v-    {-# INLINE fromXYZ #-}--    toXYZ (TUVec3 v) = v-    {-# INLINE toXYZ #-}--    fromRows (r1, r2, r3) = TUMatrix (r1, r2, r3)-    {-# INLINE fromRows #-}--    toRows (TUMatrix (r1, r2, r3)) = (r1, r2, r3)-    {-# INLINE toRows #-}

@@ -1,5 +1,6 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}  module Data.Vec3.Unboxed@@ -10,41 +11,44 @@  import Prelude hiding (reverse) -import Control.Monad--import Data.Vector.Unboxed as VU-import Data.Vector.Generic as VG-import Data.Vector.Generic.Mutable as VGM+import Data.Vector.Unboxed.Deriving  import Data.Vec3.Class   -- | 'Vec3' implementation with 'Data.Vector.Unboxed.Unbox' instance--- based on a single contiguous array storage scheme, suitable for use--- with "Data.Vector.Unboxed".+-- based on tuples, suitable for use with "Data.Vector.Unboxed". ----- 'Unbox' instance provides the required index transformations.+-- This represents 3-vector as a triple of doubles, using the default+-- Unbox instance for tuples as provided by "Data.Vector.Unboxed",+-- which wraps a vector of tuples as a tuple of vectors. -- -- @--- interface: [d1 x   y   z  ; d2 x   y   z  ...], length = N = M / 3---                |   |   |       |   |   |--- storage:   [  d1x d2y d2z ;   d2x d2y d2z ...], length = M+-- interface:  [d1 (x, y, z); d2 (x, y, z) ...], length = N+--                  |  |  |       |  |  |+-- storage(x): [d1x-+  |  | ; d2x-+  |  |  ...], length = N+-- storage(y): [d1y----+  | ; d2y----+  |  ...], length = N+-- storage(z): [d1z-------+ ; d2z-------+  ...], length = N -- @------ Thanks to dense packing scheme the performance of this--- implementation should generally be on par with 'Storable'-based--- 'Data.Vec3.SVec3'.-data UVec3 = UVec3 !Double !Double !Double-              deriving (Eq, Show)+newtype UVec3 = UVec3 (Double, Double, Double)+                deriving (Eq, Show)  +derivingUnbox "UVec3"+  [t|UVec3 -> (Double, Double, Double)|]+  [|\(UVec3 v) -> v|]+  [|UVec3|]++ instance Vec3 UVec3 where     newtype Matrix UVec3 = UMatrix (UVec3, UVec3, UVec3)+                           deriving (Eq, Show) -    fromXYZ (x, y, z) = UVec3 x y z++    fromXYZ = UVec3     {-# INLINE fromXYZ #-} -    toXYZ (UVec3 x y z) = (x, y, z)+    toXYZ (UVec3 v) = v     {-# INLINE toXYZ #-}      fromRows (r1, r2, r3) = UMatrix (r1, r2, r3)@@ -54,72 +58,7 @@     {-# INLINE toRows #-}  -newtype instance VU.MVector s UVec3 = MV_UVec3 (VU.MVector s Double)-newtype instance VU.Vector    UVec3 = V_UVec3  (VU.Vector    Double)---instance VGM.MVector VU.MVector UVec3 where-    basicLength (MV_UVec3 v) =-        VGM.basicLength v `quot` 3-    {-# INLINE basicLength #-}--    basicUnsafeSlice s l (MV_UVec3 v) =-        MV_UVec3 $ VGM.basicUnsafeSlice (s * 3) (l * 3) v-    {-# INLINE basicUnsafeSlice #-}--    basicOverlaps (MV_UVec3 v1) (MV_UVec3 v2) =-        VGM.basicOverlaps v1 v2-    {-# INLINE basicOverlaps #-}--    basicUnsafeNew n =-        MV_UVec3 `liftM` VGM.basicUnsafeNew (n * 3)-    {-# INLINE basicUnsafeNew #-}--    basicUnsafeRead (MV_UVec3 v) i = do-        x <- VGM.basicUnsafeRead v  j-        y <- VGM.basicUnsafeRead v (j + 1)-        z <- VGM.basicUnsafeRead v (j + 2)-        return $ UVec3 x y z-        where-          j = i * 3-    {-# INLINE basicUnsafeRead #-}--    basicUnsafeWrite (MV_UVec3 v) i (UVec3 x y z) =-        VGM.basicUnsafeWrite v  j      x >>-        VGM.basicUnsafeWrite v (j + 1) y >>-        VGM.basicUnsafeWrite v (j + 2) z-        where-          j = i * 3-    {-# INLINE basicUnsafeWrite #-}---instance VG.Vector VU.Vector UVec3 where-    basicUnsafeFreeze (MV_UVec3 v) =-        V_UVec3 `liftM` VG.basicUnsafeFreeze v-    {-# INLINE basicUnsafeFreeze #-}--    basicUnsafeThaw (V_UVec3 v) =-        MV_UVec3 `liftM` VG.basicUnsafeThaw v-    {-# INLINE basicUnsafeThaw #-}--    basicLength (V_UVec3 v) = VG.basicLength v `quot` 3-    {-# INLINE basicLength #-}--    basicUnsafeSlice s l (V_UVec3 v) =-        V_UVec3 $ VG.basicUnsafeSlice (s * 3) (l * 3) v-    {-# INLINE basicUnsafeSlice #-}--    basicUnsafeIndexM (V_UVec3 v) i = do-        x <- VG.basicUnsafeIndexM v  j-        y <- VG.basicUnsafeIndexM v (j + 1)-        z <- VG.basicUnsafeIndexM v (j + 2)-        return $ UVec3 x y z-        where-          j = i * 3-    {-# INLINE basicUnsafeIndexM #-}--    basicUnsafeCopy (MV_UVec3 mv) (V_UVec3 v)-        = VG.basicUnsafeCopy mv v-    {-# INLINE basicUnsafeCopy #-}--instance Unbox UVec3+derivingUnbox "UMatrix"+  [t|Matrix UVec3 -> (UVec3, UVec3, UVec3)|]+  [|\(UMatrix v) -> v|]+  [|UMatrix|]

@@ -0,0 +1,133 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++{-|++'Vec3' implementation with 'Data.Vector.Unboxed.Unbox' instance based+on single array storage scheme, suitable for use with+"Data.Vector.Unboxed".++-}++module Data.Vec3.Unboxed.Contiguous+    ( UVec3(..)+    )+++where++import Prelude hiding (reverse)++import Control.Monad++import Data.Vector.Unboxed as VU+import Data.Vector.Generic as VG+import Data.Vector.Generic.Mutable as VGM++import Data.Vec3.Class+++-- | 'Vec3' implementation with 'Data.Vector.Unboxed.Unbox' instance+-- based on a single contiguous array storage scheme, suitable for use+-- with "Data.Vector.Unboxed".+--+-- 'Unbox' instance provides the required index transformations.+--+-- @+-- interface: [d1 x   y   z  ; d2 x   y   z  ...], length = N = M / 3+--                |   |   |       |   |   |+-- storage:   [  d1x d2y d2z ;   d2x d2y d2z ...], length = M+-- @+data UVec3 = UVec3 !Double !Double !Double+              deriving (Eq, Show)+++instance Vec3 UVec3 where+    newtype Matrix UVec3 = UMatrix (UVec3, UVec3, UVec3)++    fromXYZ (x, y, z) = UVec3 x y z+    {-# INLINE fromXYZ #-}++    toXYZ (UVec3 x y z) = (x, y, z)+    {-# INLINE toXYZ #-}++    fromRows (r1, r2, r3) = UMatrix (r1, r2, r3)+    {-# INLINE fromRows #-}++    toRows (UMatrix (r1, r2, r3)) = (r1, r2, r3)+    {-# INLINE toRows #-}+++newtype instance VU.MVector s UVec3 = MV_UVec3 (VU.MVector s Double)+newtype instance VU.Vector    UVec3 = V_UVec3  (VU.Vector    Double)+++instance VGM.MVector VU.MVector UVec3 where+    basicInitialize (MV_UVec3 v) =+        VGM.basicInitialize v+    {-# INLINE basicInitialize #-}++    basicLength (MV_UVec3 v) =+        VGM.basicLength v `quot` 3+    {-# INLINE basicLength #-}++    basicUnsafeSlice s l (MV_UVec3 v) =+        MV_UVec3 $ VGM.basicUnsafeSlice (s * 3) (l * 3) v+    {-# INLINE basicUnsafeSlice #-}++    basicOverlaps (MV_UVec3 v1) (MV_UVec3 v2) =+        VGM.basicOverlaps v1 v2+    {-# INLINE basicOverlaps #-}++    basicUnsafeNew n =+        MV_UVec3 `liftM` VGM.basicUnsafeNew (n * 3)+    {-# INLINE basicUnsafeNew #-}++    basicUnsafeRead (MV_UVec3 v) i = do+        x <- VGM.basicUnsafeRead v  j+        y <- VGM.basicUnsafeRead v (j + 1)+        z <- VGM.basicUnsafeRead v (j + 2)+        return $ UVec3 x y z+        where+          j = i * 3+    {-# INLINE basicUnsafeRead #-}++    basicUnsafeWrite (MV_UVec3 v) i (UVec3 x y z) =+        VGM.basicUnsafeWrite v  j      x >>+        VGM.basicUnsafeWrite v (j + 1) y >>+        VGM.basicUnsafeWrite v (j + 2) z+        where+          j = i * 3+    {-# INLINE basicUnsafeWrite #-}+++instance VG.Vector VU.Vector UVec3 where+    basicUnsafeFreeze (MV_UVec3 v) =+        V_UVec3 `liftM` VG.basicUnsafeFreeze v+    {-# INLINE basicUnsafeFreeze #-}++    basicUnsafeThaw (V_UVec3 v) =+        MV_UVec3 `liftM` VG.basicUnsafeThaw v+    {-# INLINE basicUnsafeThaw #-}++    basicLength (V_UVec3 v) = VG.basicLength v `quot` 3+    {-# INLINE basicLength #-}++    basicUnsafeSlice s l (V_UVec3 v) =+        V_UVec3 $ VG.basicUnsafeSlice (s * 3) (l * 3) v+    {-# INLINE basicUnsafeSlice #-}++    basicUnsafeIndexM (V_UVec3 v) i = do+        x <- VG.basicUnsafeIndexM v  j+        y <- VG.basicUnsafeIndexM v (j + 1)+        z <- VG.basicUnsafeIndexM v (j + 2)+        return $ UVec3 x y z+        where+          j = i * 3+    {-# INLINE basicUnsafeIndexM #-}++    basicUnsafeCopy (MV_UVec3 mv) (V_UVec3 v)+        = VG.basicUnsafeCopy mv v+    {-# INLINE basicUnsafeCopy #-}++instance Unbox UVec3

@@ -0,0 +1,68 @@+{-# LANGUAGE ScopedTypeVariables #-}++import Test.Tasty+import Test.Tasty.QuickCheck++import Data.Vec3+++infix 4 <~=>+(<~=>) :: SVec3 -> SVec3 -> Bool+(<~=>) a b = ax ~= bx &&+             ay ~= by &&+             az ~= bz+  where+    (ax, ay, az) = toXYZ (a :: SVec3)+    (bx, by, bz) = toXYZ (b :: SVec3)+++infix 4 ~=+(~=) :: Double -> Double -> Bool+(~=) a b | a == b = True+         | a == 0 || b == 0 || isDenormalized absDiff = absDiff < maxError+         | otherwise = absDiff / (abs a + abs b) < maxError+  where+    absDiff = abs $ a - b+    maxError = 1e-13+++tests :: [TestTree]+tests =+  [ testProperty+    "Commutativity of addition: a + b = b + a"+    (\(a :: SVec3) b -> a <+> b <~=> b <+> a)+  , testProperty+    "Associativity of addition: (a + b) + c = a + (b + c)"+    (\(a :: SVec3) b c -> (a <+> b) <+> c <~=> a <+> (b <+> c))+  , testProperty+    "Identity element of addition (zero): v + 0 = v"+    (\(v :: SVec3) -> (v <+> origin <~=> v))+  , testProperty+    "Inverse elements of addition: v + (-v) = 0"+    (\(v :: SVec3) -> (v <+> invert v <~=> origin))+  , testProperty+    "Compatibility of scalar and field multiplication"+    (\(v :: SVec3) p q -> (v .^ p .^ q <~=> v .^ (p * q)))+  , testProperty+    "Identity of scalar multiplication"+    (\(v :: SVec3) -> (v .^ 1 <~=> v))+  , testProperty+    "Distributivity wrt vector addition"+    (\(a :: SVec3) b p -> ((a <+> b) .^ p) <~=> (a .^ p) <+> (b .^ p))+  , testProperty+    "Distributivity wrt scalar addition"+    (\(a :: SVec3) p q -> (a .^ (p + q) <~=> (a .^ p) <+> (a .^ q)))+  , testProperty+    "Subtraction definition"+    (\(a :: SVec3) b -> (a <+> invert b <~=> a <-> b))+  , testProperty+    "Normalization"+    (\(v :: SVec3) -> (v <~=> origin || norm (normalize v) ~= 1))+  , testProperty+    "Triangle inequality"+    (\(a :: SVec3) b c -> (distance a b + distance b c >= distance a c))+  ]+++main :: IO ()+main = defaultMain $ testGroup "Tests" tests