simple-vec3 (empty) → 0.1.0.0
raw patch · 9 files changed
+650/−0 lines, 9 filesdep +basedep +criteriondep +simple-vec3setup-changed
Dependencies added: base, criterion, simple-vec3, vector
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- benchmark/Benchmark.hs +142/−0
- simple-vec3.cabal +53/−0
- src/Data/Vec3.hs +13/−0
- src/Data/Vec3/Class.hs +166/−0
- src/Data/Vec3/Storable.hs +61/−0
- src/Data/Vec3/TUnboxed.hs +58/−0
- src/Data/Vec3/Unboxed.hs +125/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Dmitry Dzhus++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Dmitry Dzhus nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmark/Benchmark.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-}+import Criterion.Main++import Data.Vector.Generic as VG+import Data.Vector.Storable as VS+import Data.Vector.Unboxed as VU++import Data.Vec3+++oXYZ :: (Double, Double, Double)+oXYZ = (19.899999999, 22.8, -100500)+++oXYZ' :: (Double, Double, Double)+oXYZ' = (2, 12, 85.06)+++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 #-}+++-- 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 #-}+++-- 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 #-}+++-- Note that source arrays are not forced in test functions.++tv :: VU.Vector TUVec3+tv = VG.replicate n $ fromXYZ oXYZ+++uv :: VU.Vector UVec3+uv = VG.replicate n $ fromXYZ oXYZ+++sv :: VS.Vector SVec3+sv = VG.replicate n $ fromXYZ oXYZ+++tv' :: VU.Vector TUVec3+tv' = VG.replicate n $ fromXYZ oXYZ'+++uv' :: VU.Vector UVec3+uv' = VG.replicate n $ fromXYZ oXYZ'+++sv' :: VS.Vector SVec3+sv' = VG.replicate n $ fromXYZ oXYZ'+++bsv :: VS.Vector SVec3+bsv = VG.replicate bigN $ fromXYZ oXYZ+++buv :: VU.Vector UVec3+buv = VG.replicate bigN $ fromXYZ oXYZ+++btv :: VU.Vector TUVec3+btv = VG.replicate bigN $ fromXYZ oXYZ+++bsv' :: VS.Vector SVec3+bsv' = VG.replicate bigN $ fromXYZ oXYZ'+++buv' :: VU.Vector UVec3+buv' = VG.replicate bigN $ fromXYZ oXYZ'+++btv' :: VU.Vector TUVec3+btv' = VG.replicate bigN $ fromXYZ oXYZ'+++main = defaultMain+ [ bgroup "zipWith"+ [ bench "Storable" $ test sv sv'+ , bench "Unboxed (contiguous)" $ test uv uv'+ , bench "Unboxed (tuples)" $ test tv tv'+ ]+ , bgroup "zipWith-by-x"+ [ bench "Storable" $ testComp sv sv'+ , bench "Unboxed (contiguous)" $ testComp uv uv'+ , bench "Unboxed (tuples)" $ testComp tv tv'+ ]+ , bgroup "zipWith-dotM"+ [ bench "Storable" $ testDotM sv sv'+ , bench "Unboxed (contiguous)" $ testDotM uv uv'+ , bench "Unboxed (tuples)" $ testDotM tv tv'+ ]+ , bgroup "zipWith 10M"+ [ bench "Storable" $ test bsv bsv'+ , bench "Unboxed (contiguous)" $ test buv buv'+ , bench "Unboxed (tuples)" $ test btv btv'+ ]+ , bgroup "zipWith-by-x 10M"+ [ bench "Storable" $ testComp bsv bsv'+ , bench "Unboxed (contiguous)" $ testComp buv buv'+ , bench "Unboxed (tuples)" $ testComp btv btv'+ ]+ , bgroup "zipWith-dotM 10M"+ [ bench "Storable" $ testDotM bsv bsv'+ , bench "Unboxed (contiguous)" $ testDotM buv buv'+ , bench "Unboxed (tuples)" $ testDotM btv btv'+ ]+ ]
+ simple-vec3.cabal view
@@ -0,0 +1,53 @@+name: simple-vec3+version: 0.1.0.0++synopsis: Three-dimensional vectors of doubles with basic operations,+ supporting Unbox and Storable class++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++source-repository head+ type: git+ location: http://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++ build-depends:+ base == 4.6.*,+ vector == 0.10.*++executable simple-vec3-benchmark+ main-is: benchmark/Benchmark.hs++ ghc-options: -Wall -O2 -fllvm -rtsopts++ build-depends:+ base == 4.6.*,+ criterion == 0.6.*,+ simple-vec3,+ vector == 0.10.*
+ src/Data/Vec3.hs view
@@ -0,0 +1,13 @@+module Data.Vec3+ ( Vec3(..)+ , UVec3(..)+ , SVec3(..)+ , TUVec3(..)+ )++where++import Data.Vec3.Class+import Data.Vec3.Storable+import Data.Vec3.TUnboxed+import Data.Vec3.Unboxed
+ src/Data/Vec3/Class.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE TypeFamilies #-}++module Data.Vec3.Class+ ( Vec3(..)+ )++where++import Prelude hiding (zipWith)++-- | Three-dimensional vector, with an associated matrix type.+class Vec3 v where+ -- | Associated type for 3×3 matrix.+ data Matrix v++ -- | Origin point @(0, 0, 0)@.+ origin :: v+ origin = fromXYZ (0, 0, 0)+ {-# INLINE origin #-}++ -- | Construct a new vector from components.+ fromXYZ :: (Double, Double, Double) -> v++ -- | Deconstruct a vector into components.+ toXYZ :: v -> (Double, Double, Double)++ -- | Zip two vectors elementwise.+ zipWith :: (Double -> Double -> Double) -> v -> v -> v+ zipWith f v1 v2 = fromXYZ (f x1 x2, f y1 y2, f z1 z2)+ where+ (x1, y1, z1) = toXYZ v1+ (x2, y2, z2) = toXYZ v2+ {-# INLINE zipWith #-}++ -- | Add two vectors.+ (<+>) :: v -> v -> v+ (<+>) v1 v2 = zipWith (+) v1 v2+ {-# INLINE (<+>) #-}++ -- | Subtract two vectors.+ (<->) :: v -> v -> v+ (<->) v1 v2 = zipWith (-) v1 v2+ {-# INLINE (<->) #-}++ -- | Cross product.+ (><) :: v -> v -> v+ (><) v1 v2 = fromXYZ (y1 * z2 - y2 * z1,+ x2 * z1 - x1 * z2,+ x1 * y2 - x2 * y1)+ where+ (x1, y1, z1) = toXYZ v1+ (x2, y2, z2) = toXYZ v2++ -- | Scale a vector.+ (.^) :: v -> Double -> v+ (.^) v s = fromXYZ (x * s, y * s, z * s)+ where+ (x, y, z) = toXYZ v++ -- | Dot product.+ (.*) :: v -> v -> Double+ (.*) v1 v2 = x + y + z+ where+ (x, y, z) = toXYZ $ zipWith (*) v1 v2++ -- | Euclidean norm of a vector.+ norm :: v -> Double+ norm v = sqrt (v .* v)+ {-# INLINE norm #-}++ -- | Produce unit vector with the same direction as the original+ -- one.+ normalize :: v -> v+ normalize v = v .^ (1 / norm v)+ {-# INLINE normalize #-}++ -- | Distance between two points.+ distance :: v -> v -> Double+ distance v1 v2 = norm (v1 <-> v2)+ {-# INLINE distance #-}++ -- | Invert the direction of a vector.+ invert :: v -> v+ invert v = origin <-> v+ {-# INLINE invert #-}+++ -- | Construct a new matrix from rows.+ fromRows :: (v, v, v) -> Matrix v++ -- | Deconstruct a matrix into rows.+ toRows :: Matrix v -> (v, v, v)++ -- | Generic vector dot product.+ --+ -- Multiply the transpose of the first vector by the given matrix,+ -- then multiply the result by the second vector.+ --+ -- @+ -- [ a11 a12 a13 ] [ v2x ]+ -- [ ] [ ]+ -- [ v1x v1y v1z ] . [ a21 a22 a23 ] . [ v2y ] = s+ -- [ ] [ ]+ -- [ a31 a32 a33 ] [ v2z ]+ -- @+ dotM :: v -> v -> Matrix v -> Double+ dotM v1 v2 m = v1 .* (m `mxv` v2)+ {-# INLINE dotM #-}++ -- | Multiply a matrix and a vector.+ --+ -- @+ -- [ a11 a12 a13 ] [ v2x ] [ rx ]+ -- [ ] [ ] [ ]+ -- [ a21 a22 a23 ] . [ v2y ] = [ ry ]+ -- [ ] [ ] [ ]+ -- [ a31 a32 a33 ] [ v2z ] [ rz ]+ -- @+ mxv :: Matrix v -> v -> v+ mxv m v = fromXYZ (r1 .* v, r2 .* v, r3 .* v)+ where+ (r1, r2, r3) = toRows m+ {-# INLINE mxv #-}++ -- | Build a diagonal matrix from a number @d@.+ --+ -- @+ -- [ d 0 0 ]+ -- [ ]+ -- [ 0 d 0 ]+ -- [ ]+ -- [ 0 0 d ]+ -- @+ diag :: Double -> Matrix v+ diag d = fromRows+ (fromXYZ (d, 0, 0),+ fromXYZ (0, d, 0),+ fromXYZ (0, 0, d))+ {-# INLINE diag #-}++ -- | Transpose a vector and multiply it by another vector,+ -- producing a matrix.+ -- + -- @+ -- [ v1x ] [ r11 r12 r13 ]+ -- [ ] [ ]+ -- [ v1y ] . [ v2x v2y v2z ] = [ r21 r22 r23 ]+ -- [ ] [ ]+ -- [ v1z ] [ r31 r32 r33 ]+ -- @+ vxv :: v -> v -> Matrix v+ vxv v1 v2 = fromRows (v2 .^ v11, v2 .^ v12, v2 .^ v13)+ where+ (v11, v12, v13) = toXYZ v1++ {-# INLINE vxv #-}++ -- | Add two matrices.+ addM :: Matrix v -> Matrix v -> Matrix v+ addM m1 m2 = fromRows (r11 <+> r21,+ r12 <+> r22,+ r13 <+> r23)+ where+ (r11, r12, r13) = toRows m1+ (r21, r22, r23) = toRows m2+ {-# INLINE addM #-}
+ src/Data/Vec3/Storable.hs view
@@ -0,0 +1,61 @@+{-# 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 #-}
+ src/Data/Vec3/TUnboxed.hs view
@@ -0,0 +1,58 @@+{-# 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 #-}
+ src/Data/Vec3/Unboxed.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++module Data.Vec3.Unboxed+ ( 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+-- @+--+-- 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)+++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+ 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