algebraic 0.1.0.1 → 0.1.0.2
raw patch · 15 files changed
+1014/−52 lines, 15 filesdep +acceleratedep ~basenew-uploader
Dependencies added: accelerate
Dependency ranges changed: base
Files
- algebraic.cabal +3/−2
- src/Math/Coordinate/BiAngular.hs +1/−0
- src/Math/Coordinate/BiPolar.hs +83/−4
- src/Math/Coordinate/BiPolar2Center.hs +83/−4
- src/Math/Coordinate/Cartesian.hs +289/−8
- src/Math/Coordinate/Coordinate.hs +3/−0
- src/Math/Coordinate/Elliptic.hs +83/−4
- src/Math/Coordinate/LogPolar.hs +82/−4
- src/Math/Coordinate/Parabolic.hs +81/−4
- src/Math/Coordinate/Polar.hs +82/−4
- src/Math/Coordinate/UV.hs +221/−16
- src/Math/Linear/Epsilon.hs +0/−0
- src/Math/Metric/Minkowski.hs +2/−1
- src/Math/Metric/Taxicab.hs +1/−1
- src/Math/Space/Space.hs +0/−0
algebraic.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: algebraic-version: 0.1.0.1+version: 0.1.0.2 synopsis: General linear algebra structures. -- description: license: BSD3@@ -53,6 +53,7 @@ OverlappingInstances, TypeFamilies, ConstraintKinds- build-depends: base >=4.6 && <4.7+ build-depends: base >=4.6 && <4.8,+ accelerate -- hs-source-dirs: default-language: Haskell2010
src/Math/Coordinate/BiAngular.hs view
@@ -1,1 +1,2 @@ module Math.Coordinate.BiAngular where+
src/Math/Coordinate/BiPolar.hs view
@@ -1,11 +1,24 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Math.Coordinate.BiPolar where +import Data.Typeable (Typeable)+import Control.Applicative+import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Sugar+import Data.Complex+import qualified Data.Foldable as F+ import qualified Math.Coordinate.Cartesian as Cartesian import Math.Coordinate.Cartesian (Cartesian) import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord)@@ -16,7 +29,7 @@ data Point a = Point { a :: !a , sigma :: !a , tau :: !a - } deriving (Show)+ } deriving (Eq, Ord, Show, Read, Typeable) toBiPolar = convertCoord . BiPolar @@ -31,3 +44,69 @@ instance (a~b) => CoordConversion ManualConversion (BiPolar b) space (Cartesian.Point2 a) (Point a) where convertCoordBase _ _ _ (Cartesian.Point2 x y) = undefined++--------------------------------------------------------------------------------+-- Point+--------------------------------------------------------------------------------+instance Functor Point where+ fmap f (Point a b c) = Point (f a) (f b) (f c)++instance Applicative Point where+ pure a = Point a a a+ {-# INLINE pure #-}+ Point a b c <*> Point d e f = Point (a d) (b e) (c f)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point a) = EltRepr (a, a, a)+type instance EltRepr' (Point a) = EltRepr' (a, a, a)++instance Elt a => Elt (Point a) where+ eltType _ = eltType (undefined :: (a,a,a))+ toElt p = case toElt p of+ (x, y, z) -> Point x y z+ fromElt (Point x y z) = fromElt (x, y, z)++ eltType' _ = eltType' (undefined :: (a,a,a))+ toElt' p = case toElt' p of+ (x, y, z) -> Point x y z+ fromElt' (Point x y z) = fromElt' (x, y, z)++instance IsTuple (Point a) where+ type TupleRepr (Point a) = TupleRepr (a,a,a)+ fromTuple (Point x y z) = fromTuple (x,y,z)+ toTuple t = case toTuple t of+ (x, y, z) -> Point x y z++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point a) where+ type Plain (Point a) = Point (Plain a)+ --lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point x y z) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y `SnocTup` lift z++instance (Elt a, e ~ Exp a) => Unlift Exp (Point e) where+ unlift t = Point (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+ (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)
src/Math/Coordinate/BiPolar2Center.hs view
@@ -1,11 +1,24 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Math.Coordinate.BiPolar2Center where +import Data.Typeable (Typeable)+import Control.Applicative+import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Sugar+import Data.Complex+import qualified Data.Foldable as F+ import qualified Math.Coordinate.Cartesian as Cartesian import Math.Coordinate.Cartesian (Cartesian) import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord)@@ -16,7 +29,7 @@ data Point a = Point { a :: !a , r1 :: !a , r2 :: !a- } deriving (Show)+ } deriving (Eq, Ord, Show, Read, Typeable) toBiPolar2Center = convertCoord . BiPolar2Center @@ -33,3 +46,69 @@ convertCoordBase _ (BiPolar2Center a) _ (Cartesian.Point2 x y) = Point a r1 r2 where r1 = sqrt $ (a+x)**2 + y**2 r2 = sqrt $ (x-a)**2 + y**2++--------------------------------------------------------------------------------+-- Point+--------------------------------------------------------------------------------+instance Functor Point where+ fmap f (Point a b c) = Point (f a) (f b) (f c)++instance Applicative Point where+ pure a = Point a a a+ {-# INLINE pure #-}+ Point a b c <*> Point d e f = Point (a d) (b e) (c f)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point a) = EltRepr (a, a, a)+type instance EltRepr' (Point a) = EltRepr' (a, a, a)++instance Elt a => Elt (Point a) where+ eltType _ = eltType (undefined :: (a,a,a))+ toElt p = case toElt p of+ (x, y, z) -> Point x y z+ fromElt (Point x y z) = fromElt (x, y, z)++ eltType' _ = eltType' (undefined :: (a,a,a))+ toElt' p = case toElt' p of+ (x, y, z) -> Point x y z+ fromElt' (Point x y z) = fromElt' (x, y, z)++instance IsTuple (Point a) where+ type TupleRepr (Point a) = TupleRepr (a,a,a)+ fromTuple (Point x y z) = fromTuple (x,y,z)+ toTuple t = case toTuple t of+ (x, y, z) -> Point x y z++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point a) where+ type Plain (Point a) = Point (Plain a)+ --lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point x y z) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y `SnocTup` lift z++instance (Elt a, e ~ Exp a) => Unlift Exp (Point e) where+ unlift t = Point (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+ (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)
src/Math/Coordinate/Cartesian.hs view
@@ -1,22 +1,36 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Math.Coordinate.Cartesian where +++import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Sugar+import Data.Complex+import qualified Data.Foldable as F+import Data.Typeable++import Control.Applicative+ import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), AutoConversion(..), convertCoord) import Math.Space.Space (Space2) data Cartesian = Cartesian deriving (Show) -data Point1 a = Point1 !a deriving (Show, Eq)-data Point2 a = Point2 !a !a deriving (Show, Eq)-data Point3 a = Point3 !a !a !a deriving (Show, Eq)-data Point4 a = Point4 !a !a !a !a deriving (Show, Eq)+data Point1 a = Point1 !a deriving (Eq, Ord, Show, Read,Typeable)+data Point2 a = Point2 !a !a deriving (Eq, Ord, Show, Read,Typeable)+data Point3 a = Point3 !a !a !a deriving (Eq, Ord, Show, Read,Typeable)+data Point4 a = Point4 !a !a !a !a deriving (Eq, Ord, Show, Read,Typeable) toCartesian = convertCoord Cartesian @@ -37,6 +51,12 @@ w :: coord a -> a --------------------------------------------------------------------------------+-- Functions+--------------------------------------------------------------------------------+uncurry :: (a -> a -> b) -> Point2 a -> b+uncurry f (Point2 x y) = f x y++-------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------- @@ -63,3 +83,264 @@ instance CoordConversion ManualConversion Cartesian space (Point2 a) (Point2 a) where convertCoordBase _ _ _ = id++--------------------------------------------------------------------------------+-- Point1+--------------------------------------------------------------------------------+instance Functor Point1 where+ fmap f (Point1 a) = Point1 (f a)++instance Applicative Point1 where+ pure a = Point1 a+ {-# INLINE pure #-}+ Point1 a <*> Point1 d = Point1 (a d)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point1 a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point1 a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point1 a) = EltRepr a+type instance EltRepr' (Point1 a) = EltRepr' a++instance Elt a => Elt (Point1 a) where+ eltType _ = eltType (undefined :: a)+ toElt = Point1 . toElt+ fromElt (Point1 a) = fromElt a++ eltType' _ = eltType' (undefined :: a)+ toElt' = Point1 . toElt'+ fromElt' (Point1 a) = fromElt' a++instance IsTuple (Point1 a) where+ type TupleRepr (Point1 a) = ((), a)+ fromTuple (Point1 x) = ((), x)+ toTuple ((), x) = Point1 x++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point1 a) where+ type Plain (Point1 a) = Point1 (Plain a)+ lift (Point1 x) = Exp . Tuple $ NilTup `SnocTup` lift x++instance (Elt a, e ~ Exp a) => Unlift Exp (Point1 e) where+ unlift t = Point1 $ Exp $ ZeroTupIdx `Prj` t+--------------------------------------------------------------------------------+-- Point2+--------------------------------------------------------------------------------+instance Functor Point2 where+ fmap f (Point2 a b) = Point2 (f a) (f b)++instance Applicative Point2 where+ pure a = Point2 a a+ {-# INLINE pure #-}+ Point2 a b <*> Point2 d e = Point2 (a d) (b e)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point2 a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point2 a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point2 a) = EltRepr (a, a)+type instance EltRepr' (Point2 a) = EltRepr' (a, a)++instance Elt a => Elt (Point2 a) where+ eltType _ = eltType (undefined :: (a,a))+ toElt p = case toElt p of+ (x, y) -> Point2 x y+ fromElt (Point2 x y) = fromElt (x, y)++ eltType' _ = eltType' (undefined :: (a,a))+ toElt' p = case toElt' p of+ (x, y) -> Point2 x y+ fromElt' (Point2 x y) = fromElt' (x, y)++instance IsTuple (Point2 a) where+ type TupleRepr (Point2 a) = TupleRepr (a,a)+ fromTuple (Point2 x y) = fromTuple (x,y)+ toTuple t = case toTuple t of+ (x, y) -> Point2 x y++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point2 a) where+ type Plain (Point2 a) = Point2 (Plain a)+ --lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point2 x y) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y++instance (Elt a, e ~ Exp a) => Unlift Exp (Point2 e) where+ unlift t = Point2 (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)++--------------------------------------------------------------------------------+-- Point3+--------------------------------------------------------------------------------+instance Functor Point3 where+ fmap f (Point3 a b c) = Point3 (f a) (f b) (f c)++instance Applicative Point3 where+ pure a = Point3 a a a+ {-# INLINE pure #-}+ Point3 a b c <*> Point3 d e f = Point3 (a d) (b e) (c f)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point3 a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point3 a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point3 a) = EltRepr (a, a, a)+type instance EltRepr' (Point3 a) = EltRepr' (a, a, a)++instance Elt a => Elt (Point3 a) where+ eltType _ = eltType (undefined :: (a,a,a))+ toElt p = case toElt p of+ (x, y, z) -> Point3 x y z+ fromElt (Point3 x y z) = fromElt (x, y, z)++ eltType' _ = eltType' (undefined :: (a,a,a))+ toElt' p = case toElt' p of+ (x, y, z) -> Point3 x y z+ fromElt' (Point3 x y z) = fromElt' (x, y, z)++instance IsTuple (Point3 a) where+ type TupleRepr (Point3 a) = TupleRepr (a,a,a)+ fromTuple (Point3 x y z) = fromTuple (x,y,z)+ toTuple t = case toTuple t of+ (x, y, z) -> Point3 x y z++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point3 a) where+ type Plain (Point3 a) = Point3 (Plain a)+ --lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point3 x y z) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y `SnocTup` lift z++instance (Elt a, e ~ Exp a) => Unlift Exp (Point3 e) where+ unlift t = Point3 (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+ (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)++--------------------------------------------------------------------------------+-- Point4+--------------------------------------------------------------------------------+instance Functor Point4 where+ fmap f (Point4 a b c d) = Point4 (f a) (f b) (f c) (f d)++instance Applicative Point4 where+ pure a = Point4 a a a a+ {-# INLINE pure #-}+ Point4 a b c d <*> Point4 e f g h = Point4 (a e) (b f) (c g) (d h)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point4 a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point4 a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point4 a) = EltRepr (a, a, a, a)+type instance EltRepr' (Point4 a) = EltRepr' (a, a, a, a)++instance Elt a => Elt (Point4 a) where+ eltType _ = eltType (undefined :: (a,a,a,a))+ toElt p = case toElt p of+ (x, y, z, w) -> Point4 x y z w+ fromElt (Point4 x y z w) = fromElt (x, y, z, w)++ eltType' _ = eltType' (undefined :: (a,a,a,a))+ toElt' p = case toElt' p of+ (x, y, z, w) -> Point4 x y z w+ fromElt' (Point4 x y z w) = fromElt' (x, y, z, w)++instance IsTuple (Point4 a) where+ type TupleRepr (Point4 a) = TupleRepr (a,a,a,a)+ fromTuple (Point4 x y z w) = fromTuple (x,y,z,w)+ toTuple t = case toTuple t of+ (x, y, z, w) -> Point4 x y z w++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point4 a) where+ type Plain (Point4 a) = Point4 (Plain a)+ -- lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point4 x y z w) = Exp $ Tuple $ NilTup `SnocTup`+ lift x `SnocTup`+ lift y `SnocTup`+ lift z `SnocTup`+ lift w++instance (Elt a, e ~ Exp a) => Unlift Exp (Point4 e) where+ unlift t = Point4 (Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` t)+ (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+ (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)
src/Math/Coordinate/Coordinate.hs view
@@ -4,8 +4,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DeriveDataTypeable #-} module Math.Coordinate.Coordinate where++import Data.Typeable (Typeable) import GHC.Exts
src/Math/Coordinate/Elliptic.hs view
@@ -1,12 +1,25 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Math.Coordinate.Elliptic where +import Data.Typeable (Typeable)+import Control.Applicative+import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Sugar import Data.Complex+import qualified Data.Foldable as F++import Data.Complex import qualified Math.Coordinate.Cartesian as Cartesian import Math.Coordinate.Cartesian (Cartesian) import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord)@@ -17,7 +30,7 @@ data Point a = Point { a :: !a , u :: !a , v :: !a- } deriving (Show)+ } deriving (Eq, Ord, Show, Read, Typeable) toElliptic = convertCoord . Elliptic @@ -34,3 +47,69 @@ convertCoordBase _ (Elliptic a) _ (Cartesian.Point2 x y) = Point a u v where u = acosh $ -sqrt(2)*x / (sqrt $ 1 + x**2 + y**2 - (sqrt $ 4*y**2+ (-1 + x**2 + y**2)**2)) v = acos $ -sqrt(1 + x**2 + y**2 - (sqrt $ 4*y**2 + (-1 + x**2 + y**2)**2)) / (sqrt 2)++--------------------------------------------------------------------------------+-- Point+--------------------------------------------------------------------------------+instance Functor Point where+ fmap f (Point a b c) = Point (f a) (f b) (f c)++instance Applicative Point where+ pure a = Point a a a+ {-# INLINE pure #-}+ Point a b c <*> Point d e f = Point (a d) (b e) (c f)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point a) = EltRepr (a, a, a)+type instance EltRepr' (Point a) = EltRepr' (a, a, a)++instance Elt a => Elt (Point a) where+ eltType _ = eltType (undefined :: (a,a,a))+ toElt p = case toElt p of+ (x, y, z) -> Point x y z+ fromElt (Point x y z) = fromElt (x, y, z)++ eltType' _ = eltType' (undefined :: (a,a,a))+ toElt' p = case toElt' p of+ (x, y, z) -> Point x y z+ fromElt' (Point x y z) = fromElt' (x, y, z)++instance IsTuple (Point a) where+ type TupleRepr (Point a) = TupleRepr (a,a,a)+ fromTuple (Point x y z) = fromTuple (x,y,z)+ toTuple t = case toTuple t of+ (x, y, z) -> Point x y z++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point a) where+ type Plain (Point a) = Point (Plain a)+ --lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point x y z) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y `SnocTup` lift z++instance (Elt a, e ~ Exp a) => Unlift Exp (Point e) where+ unlift t = Point (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+ (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)
src/Math/Coordinate/LogPolar.hs view
@@ -1,11 +1,24 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Math.Coordinate.LogPolar where +import Data.Typeable (Typeable)+import Control.Applicative+import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Sugar+import Data.Complex+import qualified Data.Foldable as F+ import qualified Math.Coordinate.Cartesian as Cartesian import Math.Coordinate.Cartesian (Cartesian) import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord)@@ -16,7 +29,7 @@ data Point2 a = Point2 { rho :: !a , phi :: !a- } deriving (Show)+ } deriving (Eq, Ord, Show, Read, Typeable) toLogPolar = convertCoord LogPolar @@ -33,3 +46,68 @@ convertCoordBase _ _ _ (Cartesian.Point2 x y) = Point2 rho phi where rho = log . sqrt $ (x*x) + (y*y) phi = atan2 y x++--------------------------------------------------------------------------------+-- Point2+--------------------------------------------------------------------------------+instance Functor Point2 where+ fmap f (Point2 a b) = Point2 (f a) (f b)++instance Applicative Point2 where+ pure a = Point2 a a+ {-# INLINE pure #-}+ Point2 a b <*> Point2 d e = Point2 (a d) (b e)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point2 a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point2 a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point2 a) = EltRepr (a, a)+type instance EltRepr' (Point2 a) = EltRepr' (a, a)++instance Elt a => Elt (Point2 a) where+ eltType _ = eltType (undefined :: (a,a))+ toElt p = case toElt p of+ (x, y) -> Point2 x y+ fromElt (Point2 x y) = fromElt (x, y)++ eltType' _ = eltType' (undefined :: (a,a))+ toElt' p = case toElt' p of+ (x, y) -> Point2 x y+ fromElt' (Point2 x y) = fromElt' (x, y)++instance IsTuple (Point2 a) where+ type TupleRepr (Point2 a) = TupleRepr (a,a)+ fromTuple (Point2 x y) = fromTuple (x,y)+ toTuple t = case toTuple t of+ (x, y) -> Point2 x y++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point2 a) where+ type Plain (Point2 a) = Point2 (Plain a)+ --lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point2 x y) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y++instance (Elt a, e ~ Exp a) => Unlift Exp (Point2 e) where+ unlift t = Point2 (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)
src/Math/Coordinate/Parabolic.hs view
@@ -1,11 +1,24 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Math.Coordinate.Parabolic where +import Data.Typeable (Typeable)+import Control.Applicative+import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Sugar+import Data.Complex+import qualified Data.Foldable as F+ import qualified Math.Coordinate.Cartesian as Cartesian import Math.Coordinate.Cartesian (Cartesian) import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord)@@ -15,7 +28,7 @@ data Point a = Point { rho :: !a , tau :: !a - } deriving (Show)+ } deriving (Eq, Ord, Show, Read, Typeable) toParabolic = convertCoord Parabolic @@ -33,3 +46,67 @@ where rho = sqrt $ y + (sqrt $ x**2 + y**2) tau = x/rho +--------------------------------------------------------------------------------+-- Point+--------------------------------------------------------------------------------+instance Functor Point where+ fmap f (Point a b) = Point (f a) (f b)++instance Applicative Point where+ pure a = Point a a+ {-# INLINE pure #-}+ Point a b <*> Point d e = Point (a d) (b e)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point a) = EltRepr (a, a)+type instance EltRepr' (Point a) = EltRepr' (a, a)++instance Elt a => Elt (Point a) where+ eltType _ = eltType (undefined :: (a,a))+ toElt p = case toElt p of+ (x, y) -> Point x y+ fromElt (Point x y) = fromElt (x, y)++ eltType' _ = eltType' (undefined :: (a,a))+ toElt' p = case toElt' p of+ (x, y) -> Point x y+ fromElt' (Point x y) = fromElt' (x, y)++instance IsTuple (Point a) where+ type TupleRepr (Point a) = TupleRepr (a,a)+ fromTuple (Point x y) = fromTuple (x,y)+ toTuple t = case toTuple t of+ (x, y) -> Point x y++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point a) where+ type Plain (Point a) = Point (Plain a)+ --lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point x y) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y++instance (Elt a, e ~ Exp a) => Unlift Exp (Point e) where+ unlift t = Point (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)
src/Math/Coordinate/Polar.hs view
@@ -1,11 +1,24 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Math.Coordinate.Polar where +import Data.Typeable (Typeable)+import Control.Applicative+import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Sugar+import Data.Complex+import qualified Data.Foldable as F+ import qualified Math.Coordinate.Cartesian as Cartesian import Math.Coordinate.Cartesian (Cartesian) import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord)@@ -15,7 +28,7 @@ data Point2 a = Point2 { r :: !a , phi :: !a- } deriving (Show)+ } deriving (Eq, Ord, Show, Read, Typeable) toPolar = convertCoord Polar @@ -30,3 +43,68 @@ convertCoordBase _ _ _ (Cartesian.Point2 x y) = Point2 r phi where r = sqrt $ (x*x) + (y*y) phi = atan2 y x++--------------------------------------------------------------------------------+-- Point2+--------------------------------------------------------------------------------+instance Functor Point2 where+ fmap f (Point2 a b) = Point2 (f a) (f b)++instance Applicative Point2 where+ pure a = Point2 a a+ {-# INLINE pure #-}+ Point2 a b <*> Point2 d e = Point2 (a d) (b e)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point2 a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point2 a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point2 a) = EltRepr (a, a)+type instance EltRepr' (Point2 a) = EltRepr' (a, a)++instance Elt a => Elt (Point2 a) where+ eltType _ = eltType (undefined :: (a,a))+ toElt p = case toElt p of+ (x, y) -> Point2 x y+ fromElt (Point2 x y) = fromElt (x, y)++ eltType' _ = eltType' (undefined :: (a,a))+ toElt' p = case toElt' p of+ (x, y) -> Point2 x y+ fromElt' (Point2 x y) = fromElt' (x, y)++instance IsTuple (Point2 a) where+ type TupleRepr (Point2 a) = TupleRepr (a,a)+ fromTuple (Point2 x y) = fromTuple (x,y)+ toTuple t = case toTuple t of+ (x, y) -> Point2 x y++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point2 a) where+ type Plain (Point2 a) = Point2 (Plain a)+ --lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point2 x y) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y++instance (Elt a, e ~ Exp a) => Unlift Exp (Point2 e) where+ unlift t = Point2 (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)
src/Math/Coordinate/UV.hs view
@@ -1,11 +1,24 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Math.Coordinate.UV where +import Data.Typeable (Typeable)+import Control.Applicative+import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Sugar+import Data.Complex+import qualified Data.Foldable as F+ import qualified Math.Coordinate.Cartesian as Cartesian import Math.Coordinate.Cartesian (Cartesian) import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord)@@ -13,10 +26,11 @@ import Math.Space.Space (Space2) data UV = UV deriving (Show)-data UPoint a = UPoint !a deriving (Show)-data UVPoint a = UVPoint !a !a deriving (Show)-data UVWPoint a = UVWPoint !a !a !a deriving (Show) +data Point1 a = Point1 !a deriving (Eq, Ord, Show, Read, Typeable)+data Point2 a = Point2 !a !a deriving (Eq, Ord, Show, Read, Typeable)+data Point3 a = Point3 !a !a !a deriving (Eq, Ord, Show, Read, Typeable)+ toUV = convertCoord UV --------------------------------------------------------------------------------@@ -36,22 +50,213 @@ -- Instances -------------------------------------------------------------------------------- -instance UVCoord1 UPoint where u (UPoint u) = u+instance UVCoord1 Point1 where u (Point1 u) = u -instance UVCoord1 UVPoint where u (UVPoint u _) = u-instance UVCoord2 UVPoint where v (UVPoint _ v) = v+instance UVCoord1 Point2 where u (Point2 u _) = u+instance UVCoord2 Point2 where v (Point2 _ v) = v -instance UVCoord1 UVWPoint where u (UVWPoint u _ _) = u-instance UVCoord2 UVWPoint where v (UVWPoint _ v _) = v-instance UVCoord3 UVWPoint where w (UVWPoint _ _ w) = w+instance UVCoord1 Point3 where u (Point3 u _ _) = u+instance UVCoord2 Point3 where v (Point3 _ v _) = v+instance UVCoord3 Point3 where w (Point3 _ _ w) = w -instance (Space2 space, Num a, a~b) => CoordConversion ManualConversion Cartesian (space b) (UVPoint a) (Cartesian.Point2 a) where- convertCoordBase _ _ space (UVPoint u v) = Cartesian.Point2 (u*w) (v*h)+instance (Space2 space, Num a, a~b) => CoordConversion ManualConversion Cartesian (space b) (Point2 a) (Cartesian.Point2 a) where+ convertCoordBase _ _ space (Point2 u v) = Cartesian.Point2 (u*w) (v*h) where w = Space.width space h = Space.height space -instance (Space2 space, Fractional a, a~b) => CoordConversion ManualConversion UV (space b) (Cartesian.Point2 a) (UVPoint a) where- convertCoordBase _ sys space (Cartesian.Point2 x y) = UVPoint (x/w) (y/h)+instance (Space2 space, Fractional a, a~b) => CoordConversion ManualConversion UV (space b) (Cartesian.Point2 a) (Point2 a) where+ convertCoordBase _ sys space (Cartesian.Point2 x y) = Point2 (x/w) (y/h) where w = Space.width space h = Space.height space++--------------------------------------------------------------------------------+-- Point1+--------------------------------------------------------------------------------+instance Functor Point1 where+ fmap f (Point1 a) = Point1 (f a)++instance Applicative Point1 where+ pure a = Point1 a+ {-# INLINE pure #-}+ Point1 a <*> Point1 d = Point1 (a d)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point1 a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point1 a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point1 a) = EltRepr a+type instance EltRepr' (Point1 a) = EltRepr' a++instance Elt a => Elt (Point1 a) where+ eltType _ = eltType (undefined :: a)+ toElt = Point1 . toElt+ fromElt (Point1 a) = fromElt a++ eltType' _ = eltType' (undefined :: a)+ toElt' = Point1 . toElt'+ fromElt' (Point1 a) = fromElt' a++instance IsTuple (Point1 a) where+ type TupleRepr (Point1 a) = ((), a)+ fromTuple (Point1 x) = ((), x)+ toTuple ((), x) = Point1 x++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point1 a) where+ type Plain (Point1 a) = Point1 (Plain a)+ lift (Point1 x) = Exp . Tuple $ NilTup `SnocTup` lift x++instance (Elt a, e ~ Exp a) => Unlift Exp (Point1 e) where+ unlift t = Point1 $ Exp $ ZeroTupIdx `Prj` t++--------------------------------------------------------------------------------+-- Point2+--------------------------------------------------------------------------------+instance Functor Point2 where+ fmap f (Point2 a b) = Point2 (f a) (f b)++instance Applicative Point2 where+ pure a = Point2 a a+ {-# INLINE pure #-}+ Point2 a b <*> Point2 d e = Point2 (a d) (b e)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point2 a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point2 a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point2 a) = EltRepr (a, a)+type instance EltRepr' (Point2 a) = EltRepr' (a, a)++instance Elt a => Elt (Point2 a) where+ eltType _ = eltType (undefined :: (a,a))+ toElt p = case toElt p of+ (x, y) -> Point2 x y+ fromElt (Point2 x y) = fromElt (x, y)++ eltType' _ = eltType' (undefined :: (a,a))+ toElt' p = case toElt' p of+ (x, y) -> Point2 x y+ fromElt' (Point2 x y) = fromElt' (x, y)++instance IsTuple (Point2 a) where+ type TupleRepr (Point2 a) = TupleRepr (a,a)+ fromTuple (Point2 x y) = fromTuple (x,y)+ toTuple t = case toTuple t of+ (x, y) -> Point2 x y++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point2 a) where+ type Plain (Point2 a) = Point2 (Plain a)+ --lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point2 x y) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y++instance (Elt a, e ~ Exp a) => Unlift Exp (Point2 e) where+ unlift t = Point2 (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)++--------------------------------------------------------------------------------+-- Point3+--------------------------------------------------------------------------------+instance Functor Point3 where+ fmap f (Point3 a b c) = Point3 (f a) (f b) (f c)++instance Applicative Point3 where+ pure a = Point3 a a a+ {-# INLINE pure #-}+ Point3 a b c <*> Point3 d e f = Point3 (a d) (b e) (c f)+ {-# INLINE (<*>) #-}++instance Num a => Num (Point3 a) where+ (+) = liftA2 (+)+ {-# INLINE (+) #-}+ (-) = liftA2 (-)+ {-# INLINE (-) #-}+ (*) = liftA2 (*)+ {-# INLINE (*) #-}+ negate = fmap negate+ {-# INLINE negate #-}+ abs = fmap abs+ {-# INLINE abs #-}+ signum = fmap signum+ {-# INLINE signum #-}+ fromInteger = pure . fromInteger+ {-# INLINE fromInteger #-}++instance Fractional a => Fractional (Point3 a) where+ recip = fmap recip+ {-# INLINE recip #-}+ (/) = liftA2 (/)+ {-# INLINE (/) #-}+ fromRational = pure . fromRational+ {-# INLINE fromRational #-}++type instance EltRepr (Point3 a) = EltRepr (a, a, a)+type instance EltRepr' (Point3 a) = EltRepr' (a, a, a)++instance Elt a => Elt (Point3 a) where+ eltType _ = eltType (undefined :: (a,a,a))+ toElt p = case toElt p of+ (x, y, z) -> Point3 x y z+ fromElt (Point3 x y z) = fromElt (x, y, z)++ eltType' _ = eltType' (undefined :: (a,a,a))+ toElt' p = case toElt' p of+ (x, y, z) -> Point3 x y z+ fromElt' (Point3 x y z) = fromElt' (x, y, z)++instance IsTuple (Point3 a) where+ type TupleRepr (Point3 a) = TupleRepr (a,a,a)+ fromTuple (Point3 x y z) = fromTuple (x,y,z)+ toTuple t = case toTuple t of+ (x, y, z) -> Point3 x y z++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Point3 a) where+ type Plain (Point3 a) = Point3 (Plain a)+ --lift = Exp . Tuple . F.foldl SnocTup NilTup+ lift (Point3 x y z) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y `SnocTup` lift z++instance (Elt a, e ~ Exp a) => Unlift Exp (Point3 e) where+ unlift t = Point3 (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+ (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+ (Exp $ ZeroTupIdx `Prj` t)
src/Math/Linear/Epsilon.hs view
src/Math/Metric/Minkowski.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} module Math.Metric.Minkowski where @@ -17,5 +18,5 @@ instance MetricCoord (Minkowski a) Cartesian where metricCoord _ = Cartesian -instance Floating a => Metric (Minkowski a) (Point2 a) a where+instance (Floating a, a~b) => Metric (Minkowski b) (Point2 a) a where distanceBase (Minkowski p) (Point2 x1 y1) (Point2 x2 y2) = ((abs $ x1-x2)**p + (abs $ y1-y2)**p)**(1/p)
src/Math/Metric/Taxicab.hs view
@@ -18,6 +18,6 @@ metricCoord _ = Cartesian instance Num a => Metric Taxicab (Point2 a) a where- distanceBase _ (Point2 x1 y1) (Point2 x2 y2) = x2-x1 + y2-y1+ distanceBase _ (Point2 x1 y1) (Point2 x2 y2) = abs (x2 - x1) + abs (y2 - y1)
src/Math/Space/Space.hs view