diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Wojciech Danilo + +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 Wojciech Danilo 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/algebraic.cabal b/algebraic.cabal new file mode 100644 --- /dev/null +++ b/algebraic.cabal @@ -0,0 +1,55 @@ +-- Initial algebraic.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: algebraic +version: 0.1.0.0 +synopsis: General linear algebra structures. +-- description: +license: BSD3 +license-file: LICENSE +author: Wojciech Danilo +maintainer: wojciech.danilo@gmail.com +-- copyright: +category: Math +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + Hs-Source-Dirs: src + exposed-modules: Math.Constants, + Math.Coordinate, + Math.Metric, + Math.Linear.Epsilon, + Math.Metric.Euclidean, + Math.Metric.Discrete, + Math.Metric.Taxicab, + Math.Metric.Minkowski, + Math.Metric.Chebyshev, + Math.Metric.Metric, + Math.Coordinate.BiPolar2Center, + Math.Coordinate.Coordinate, + Math.Coordinate.Elliptic, + Math.Coordinate.BiAngular, + Math.Coordinate.LogPolar, + Math.Coordinate.Polar, + Math.Coordinate.Parabolic, + Math.Coordinate.Cartesian, + Math.Coordinate.UV, + Math.Coordinate.BiPolar, + Math.Space.Space, + Math.Space.MetricSpace + -- other-modules: + default-extensions: MultiParamTypeClasses, + FlexibleInstances, + FlexibleContexts + other-extensions: NoMonomorphismRestriction, + FunctionalDependencies, + GADTs, + UndecidableInstances, + OverlappingInstances, + TypeFamilies, + ConstraintKinds + build-depends: base >=4.6 && <4.7 + -- hs-source-dirs: + default-language: Haskell2010 diff --git a/src/Math/Constants.hs b/src/Math/Constants.hs new file mode 100644 --- /dev/null +++ b/src/Math/Constants.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} + +module Math.Constants where + +import qualified Prelude as P + +pi = P.pi +e = P.exp 1 diff --git a/src/Math/Coordinate.hs b/src/Math/Coordinate.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate.hs @@ -0,0 +1,23 @@ +--------------------------------------------------------------------------- +-- Copyright (C) Flowbox, Inc - All Rights Reserved +-- Unauthorized copying of this file, via any medium is strictly prohibited +-- Proprietary and confidential +-- Flowbox Team , 2014 +--------------------------------------------------------------------------- + +module Math.Coordinate ( + module Math.Coordinate, + module X +) where + +import Math.Coordinate.Coordinate as X (convertCoord) +--import Math.Coordinate.BiAngular as X (BiAngular , toBiAngular) +import Math.Coordinate.BiPolar as X (BiPolar , toBiPolar) +import Math.Coordinate.BiPolar2Center as X (BiPolar2Center , toBiPolar2Center) +import Math.Coordinate.Cartesian as X (Cartesian , toCartesian) +import Math.Coordinate.Elliptic as X (Elliptic , toElliptic) +import Math.Coordinate.LogPolar as X (LogPolar , toLogPolar) +import Math.Coordinate.Parabolic as X (Parabolic , toParabolic) +import Math.Coordinate.Polar as X (Polar , toPolar) +import Math.Coordinate.UV as X (UV , toUV) + diff --git a/src/Math/Coordinate/BiAngular.hs b/src/Math/Coordinate/BiAngular.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate/BiAngular.hs @@ -0,0 +1,1 @@ +module Math.Coordinate.BiAngular where diff --git a/src/Math/Coordinate/BiPolar.hs b/src/Math/Coordinate/BiPolar.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate/BiPolar.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverlappingInstances #-} + +module Math.Coordinate.BiPolar where + +import qualified Math.Coordinate.Cartesian as Cartesian +import Math.Coordinate.Cartesian (Cartesian) +import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord) +import Math.Space.Space (Space2) + +data BiPolar a = BiPolar !a deriving (Show) + +data Point a = Point { a :: !a + , sigma :: !a + , tau :: !a + } deriving (Show) + +toBiPolar = convertCoord . BiPolar + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance Floating a => CoordConversion ManualConversion Cartesian space (Point a) (Cartesian.Point2 a) where + convertCoordBase _ _ _ (Point a sigma tau) = Cartesian.Point2 x y where + x = a * (sinh tau) / (cosh tau - cos sigma) + y = a * (sin sigma) / (cosh tau - cos sigma) + +instance (a~b) => CoordConversion ManualConversion (BiPolar b) space (Cartesian.Point2 a) (Point a) where + convertCoordBase _ _ _ (Cartesian.Point2 x y) = undefined diff --git a/src/Math/Coordinate/BiPolar2Center.hs b/src/Math/Coordinate/BiPolar2Center.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate/BiPolar2Center.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverlappingInstances #-} + +module Math.Coordinate.BiPolar2Center where + +import qualified Math.Coordinate.Cartesian as Cartesian +import Math.Coordinate.Cartesian (Cartesian) +import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord) +import Math.Space.Space (Space2) + +data BiPolar2Center a = BiPolar2Center !a deriving (Show) + +data Point a = Point { a :: !a + , r1 :: !a + , r2 :: !a + } deriving (Show) + +toBiPolar2Center = convertCoord . BiPolar2Center + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance Floating a => CoordConversion ManualConversion Cartesian space (Point a) (Cartesian.Point2 a) where + convertCoordBase _ _ _ (Point a r1 r2) = Cartesian.Point2 x y where + x = (r1**2 - r2**2) / (4*a) + y = (sqrt $ 16 * a**2 * r1**2 - (r1**2 - r2**2 + 4 * a**2))/(4*a) + +instance (Floating a, a~b) => CoordConversion ManualConversion (BiPolar2Center b) space (Cartesian.Point2 a) (Point a) where + 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 diff --git a/src/Math/Coordinate/Cartesian.hs b/src/Math/Coordinate/Cartesian.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate/Cartesian.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances #-} +{-# LANGUAGE TypeFamilies #-} + +module Math.Coordinate.Cartesian where + +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) + +toCartesian = convertCoord Cartesian + +-------------------------------------------------------------------------------- +-- Classes +-------------------------------------------------------------------------------- + +class CartesianCoord1 coord where + x :: coord a -> a + +class CartesianCoord1 coord => CartesianCoord2 coord where + y :: coord a -> a + +class CartesianCoord2 coord => CartesianCoord3 coord where + z :: coord a -> a + +class CartesianCoord3 coord => CartesianCoord4 coord where + w :: coord a -> a + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance CartesianCoord1 Point1 where x (Point1 x) = x + +instance CartesianCoord1 Point2 where x (Point2 x _) = x +instance CartesianCoord2 Point2 where y (Point2 _ y) = y + +instance CartesianCoord1 Point3 where x (Point3 x _ _) = x +instance CartesianCoord2 Point3 where y (Point3 _ y _) = y +instance CartesianCoord3 Point3 where z (Point3 _ _ z) = z + +instance CartesianCoord1 Point4 where x (Point4 x _ _ _) = x +instance CartesianCoord2 Point4 where y (Point4 _ y _ _) = y +instance CartesianCoord3 Point4 where z (Point4 _ _ z _) = z +instance CartesianCoord4 Point4 where w (Point4 _ _ _ w) = w + + +instance ( CoordConversion ManualConversion Cartesian space a b + , CoordConversion ManualConversion sys space b c) => + CoordConversion AutoConversion sys space a c where + convertCoordBase _ coord space = (convertCoordBase ManualConversion coord space) . (convertCoordBase ManualConversion Cartesian space) + + +instance CoordConversion ManualConversion Cartesian space (Point2 a) (Point2 a) where + convertCoordBase _ _ _ = id diff --git a/src/Math/Coordinate/Coordinate.hs b/src/Math/Coordinate/Coordinate.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate/Coordinate.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ConstraintKinds #-} + +module Math.Coordinate.Coordinate where + +import GHC.Exts + +-- convType is used to prevent context reduction stack overflow when combining with +-- automatic coordinate conversion +class CoordConversion convType sys space c1 c2 | sys c1 -> c2 where + convertCoordBase :: convType -> sys -> space -> c1 -> c2 + + +data ManualConversion = ManualConversion deriving Show +data AutoConversion = AutoConversion deriving Show + +--convertCoord :: (CoordConversion AutoConversion sys a b, SpaceOf a space) => +-- sys -> space -> a -> b +convertCoord = convertCoordBase AutoConversion diff --git a/src/Math/Coordinate/Elliptic.hs b/src/Math/Coordinate/Elliptic.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate/Elliptic.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverlappingInstances #-} + +module Math.Coordinate.Elliptic where + +import Data.Complex +import qualified Math.Coordinate.Cartesian as Cartesian +import Math.Coordinate.Cartesian (Cartesian) +import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord) +import Math.Space.Space (Space2) + +data Elliptic a = Elliptic !a deriving (Show) + +data Point a = Point { a :: !a + , u :: !a + , v :: !a + } deriving (Show) + +toElliptic = convertCoord . Elliptic + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance Floating a => CoordConversion ManualConversion Cartesian space (Point a) (Cartesian.Point2 a) where + convertCoordBase _ _ _ (Point a u v) = Cartesian.Point2 x y where + x = a * (cosh u * cos v) + y = a * (sinh u * sin v) + +instance (Floating a, a~b) => CoordConversion ManualConversion (Elliptic b) space (Cartesian.Point2 a) (Point a) where + 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) diff --git a/src/Math/Coordinate/LogPolar.hs b/src/Math/Coordinate/LogPolar.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate/LogPolar.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverlappingInstances #-} + +module Math.Coordinate.LogPolar where + +import qualified Math.Coordinate.Cartesian as Cartesian +import Math.Coordinate.Cartesian (Cartesian) +import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord) +import Math.Space.Space (Space2) +import qualified Math.Constants as Const + +data LogPolar = LogPolar deriving (Show) + +data Point2 a = Point2 { rho :: !a + , phi :: !a + } deriving (Show) + +toLogPolar = convertCoord LogPolar + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance RealFloat a => CoordConversion ManualConversion Cartesian space (Point2 a) (Cartesian.Point2 a) where + convertCoordBase _ _ _ pt@(Point2 rho phi) = Cartesian.Point2 (base * cos phi) (base * sin phi) + where base = Const.e**rho + + +instance RealFloat a => CoordConversion ManualConversion LogPolar space (Cartesian.Point2 a) (Point2 a) where + convertCoordBase _ _ _ (Cartesian.Point2 x y) = Point2 rho phi + where rho = log . sqrt $ (x*x) + (y*y) + phi = atan2 y x diff --git a/src/Math/Coordinate/Parabolic.hs b/src/Math/Coordinate/Parabolic.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate/Parabolic.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverlappingInstances #-} + +module Math.Coordinate.Parabolic where + +import qualified Math.Coordinate.Cartesian as Cartesian +import Math.Coordinate.Cartesian (Cartesian) +import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord) +import Math.Space.Space (Space2) + +data Parabolic = Parabolic deriving (Show) + +data Point a = Point { rho :: !a + , tau :: !a + } deriving (Show) + +toParabolic = convertCoord Parabolic + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance Floating a => CoordConversion ManualConversion Cartesian space (Point a) (Cartesian.Point2 a) where + convertCoordBase _ _ _ (Point rho tau) = Cartesian.Point2 x y where + x = rho * tau + y = (rho**2 - tau**2)/2 + +instance Floating a => CoordConversion ManualConversion Parabolic space (Cartesian.Point2 a) (Point a) where + convertCoordBase _ _ _ (Cartesian.Point2 x y) = Point rho tau + where rho = sqrt $ y + (sqrt $ x**2 + y**2) + tau = x/rho + diff --git a/src/Math/Coordinate/Polar.hs b/src/Math/Coordinate/Polar.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate/Polar.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverlappingInstances #-} + +module Math.Coordinate.Polar where + +import qualified Math.Coordinate.Cartesian as Cartesian +import Math.Coordinate.Cartesian (Cartesian) +import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord) +import Math.Space.Space (Space2) + +data Polar = Polar deriving (Show) + +data Point2 a = Point2 { r :: !a + , phi :: !a + } deriving (Show) + +toPolar = convertCoord Polar + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance Floating a => CoordConversion ManualConversion Cartesian space (Point2 a) (Cartesian.Point2 a) where + convertCoordBase _ _ _ (Point2 r phi) = Cartesian.Point2 (r * cos phi) (r * sin phi) + +instance RealFloat a => CoordConversion ManualConversion Polar space (Cartesian.Point2 a) (Point2 a) where + convertCoordBase _ _ _ (Cartesian.Point2 x y) = Point2 r phi + where r = sqrt $ (x*x) + (y*y) + phi = atan2 y x diff --git a/src/Math/Coordinate/UV.hs b/src/Math/Coordinate/UV.hs new file mode 100644 --- /dev/null +++ b/src/Math/Coordinate/UV.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE OverlappingInstances #-} + +module Math.Coordinate.UV where + +import qualified Math.Coordinate.Cartesian as Cartesian +import Math.Coordinate.Cartesian (Cartesian) +import Math.Coordinate.Coordinate (CoordConversion(..), ManualConversion(..), convertCoord) +import qualified Math.Space.Space as Space +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) + +toUV = convertCoord UV + +-------------------------------------------------------------------------------- +-- Classes +-------------------------------------------------------------------------------- + +class UVCoord1 coord where + u :: coord a -> a + +class UVCoord1 coord => UVCoord2 coord where + v :: coord a -> a + +class UVCoord2 coord => UVCoord3 coord where + w :: coord a -> a + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance UVCoord1 UPoint where u (UPoint u) = u + +instance UVCoord1 UVPoint where u (UVPoint u _) = u +instance UVCoord2 UVPoint where v (UVPoint _ 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 (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) + 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) + where w = Space.width space + h = Space.height space diff --git a/src/Math/Linear/Epsilon.hs b/src/Math/Linear/Epsilon.hs new file mode 100644 --- /dev/null +++ b/src/Math/Linear/Epsilon.hs @@ -0,0 +1,37 @@ +module Math.Linear.Epsilon + ( Epsilon(..) + ) where +import Foreign.C.Types (CFloat, CDouble) + +-- | Provides a fairly subjective test to see if a quantity is near zero. +-- +-- >>> nearZero (1e-11 :: Double) +-- False +-- +-- >>> nearZero (1e-17 :: Double) +-- True +-- +-- >>> nearZero (1e-5 :: Float) +-- False +-- +-- >>> nearZero (1e-7 :: Float) +-- True +class Num a => Epsilon a where + -- | Determine if a quantity is near zero. + nearZero :: a -> Bool + +-- | @'abs' a '<=' 1e-6@ +instance Epsilon Float where + nearZero a = abs a <= 1e-6 + +-- | @'abs' a '<=' 1e-12@ +instance Epsilon Double where + nearZero a = abs a <= 1e-12 + +-- | @'abs' a '<=' 1e-6@ +instance Epsilon CFloat where + nearZero a = abs a <= 1e-6 + +-- | @'abs' a '<=' 1e-12@ +instance Epsilon CDouble where + nearZero a = abs a <= 1e-12 diff --git a/src/Math/Metric.hs b/src/Math/Metric.hs new file mode 100644 --- /dev/null +++ b/src/Math/Metric.hs @@ -0,0 +1,11 @@ +module Math.Metric ( + module X +) where + +import Math.Space.MetricSpace as X +import Math.Metric.Metric as X hiding (distance) +import Math.Metric.Chebyshev as X +import Math.Metric.Discrete as X +import Math.Metric.Euclidean as X +import Math.Metric.Minkowski as X +import Math.Metric.Taxicab as X diff --git a/src/Math/Metric/Chebyshev.hs b/src/Math/Metric/Chebyshev.hs new file mode 100644 --- /dev/null +++ b/src/Math/Metric/Chebyshev.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +module Math.Metric.Chebyshev where + +import Math.Metric.Metric (Metric(..), MetricCoord(..)) +import Math.Coordinate.Cartesian (Cartesian(..), Point2(..)) + + +data Chebyshev = Chebyshev deriving Show + + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance MetricCoord Chebyshev Cartesian where + metricCoord _ = Cartesian + +instance (Num a, Ord a) => Metric Chebyshev (Point2 a) a where + distanceBase _ (Point2 x1 y1) (Point2 x2 y2) = max (abs $ x2-x1) (abs $ y2-y1) + + diff --git a/src/Math/Metric/Discrete.hs b/src/Math/Metric/Discrete.hs new file mode 100644 --- /dev/null +++ b/src/Math/Metric/Discrete.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +module Math.Metric.Discrete where + +import Math.Metric.Metric (Metric(..), MetricCoord(..)) +import Math.Coordinate.Cartesian (Cartesian(..), Point2(..)) + + +data Discrete = Discrete deriving Show + + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance MetricCoord Discrete Cartesian where + metricCoord _ = Cartesian + +instance (Num a, Eq a) => Metric Discrete (Point2 a) a where + distanceBase _ p1 p2 = if p1 == p2 then 0 else 1 + + diff --git a/src/Math/Metric/Euclidean.hs b/src/Math/Metric/Euclidean.hs new file mode 100644 --- /dev/null +++ b/src/Math/Metric/Euclidean.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +module Math.Metric.Euclidean where + +import Math.Metric.Metric (Metric(..), MetricCoord(..)) +import Math.Coordinate.Cartesian (Cartesian(..), Point2(..)) + + +data Euclidean = Euclidean deriving Show + + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance MetricCoord Euclidean Cartesian where + metricCoord _ = Cartesian + +instance Floating a => Metric Euclidean (Point2 a) a where + distanceBase _ (Point2 x1 y1) (Point2 x2 y2) = sqrt $ (x2-x1)**2 + (y2-y1)**2 diff --git a/src/Math/Metric/Metric.hs b/src/Math/Metric/Metric.hs new file mode 100644 --- /dev/null +++ b/src/Math/Metric/Metric.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} + +{-# LANGUAGE FlexibleInstances #-} + +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE OverlappingInstances #-} + +module Math.Metric.Metric where + +import Math.Coordinate.Coordinate --(SpaceOf, CoordConversion, AutoConversion, convertCoord) + +class Metric metric el result | metric el -> result where + distanceBase :: metric -> el -> el -> result + +class MetricCoord metric coord | metric -> coord where + metricCoord :: metric -> coord + + +--distance :: (MetricCoord metric coord +-- , CoordConversion AutoConversion coord a t +-- , CoordConversion AutoConversion coord b t +-- , space ~ SpaceOf a +-- , space ~ SpaceOf b +-- , Metric metric t) => +-- metric -> space -> a -> b -> Double + +distance metric space a b = distanceBase metric (convertCoord coord space a) (convertCoord coord space b) + where coord = metricCoord metric + + diff --git a/src/Math/Metric/Minkowski.hs b/src/Math/Metric/Minkowski.hs new file mode 100644 --- /dev/null +++ b/src/Math/Metric/Minkowski.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +module Math.Metric.Minkowski where + +import Math.Metric.Metric (Metric(..), MetricCoord(..)) +import Math.Coordinate.Cartesian (Cartesian(..), Point2(..)) + + +data Minkowski a = Minkowski a deriving Show + + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance MetricCoord (Minkowski a) Cartesian where + metricCoord _ = Cartesian + +instance Floating a => Metric (Minkowski a) (Point2 a) a where + distanceBase (Minkowski p) (Point2 x1 y1) (Point2 x2 y2) = ((abs $ x1-x2)**p + (abs $ y1-y2)**p)**(1/p) diff --git a/src/Math/Metric/Taxicab.hs b/src/Math/Metric/Taxicab.hs new file mode 100644 --- /dev/null +++ b/src/Math/Metric/Taxicab.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} + +module Math.Metric.Taxicab where + +import Math.Metric.Metric (Metric(..), MetricCoord(..)) +import Math.Coordinate.Cartesian (Cartesian(..), Point2(..)) + + +data Taxicab = Taxicab deriving Show + + +-------------------------------------------------------------------------------- +-- Instances +-------------------------------------------------------------------------------- + +instance MetricCoord Taxicab Cartesian where + metricCoord _ = Cartesian + +instance Num a => Metric Taxicab (Point2 a) a where + distanceBase _ (Point2 x1 y1) (Point2 x2 y2) = x2-x1 + y2-y1 + + diff --git a/src/Math/Space/MetricSpace.hs b/src/Math/Space/MetricSpace.hs new file mode 100644 --- /dev/null +++ b/src/Math/Space/MetricSpace.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} + +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} + +module Math.Space.MetricSpace where + +import qualified Math.Metric.Metric as Metric +import Math.Metric.Metric (Metric, MetricCoord) +import Math.Coordinate.Coordinate --(SpaceOf, CoordConversion, AutoConversion, convertCoord) + + +data MetricSpace metric space = MetricSpace { metric :: metric + , space :: space + } deriving (Show) + + +--distance :: (MetricCoord metric coord +-- , CoordConversion AutoConversion coord a t +-- , CoordConversion AutoConversion coord b t +-- , space ~ SpaceOf a +-- , space ~ SpaceOf b +-- , Metric metric t) => +-- (MetricSpace metric space) -> a -> b -> Double +distance (MetricSpace metric space) = Metric.distance metric space + + + +--class Distance2 a b where +-- distance2 :: a -> b + + +--data X a = X a + +--instance (MetricCoord metric coord +-- , CoordConversion AutoConversion coord a t +-- , CoordConversion AutoConversion coord b t +-- , space ~ SpaceOf a +-- , space ~ SpaceOf b +-- , Metric metric t +-- , out ~ Double) => +-- Distance2 (X metric) (space -> a -> b -> out) where +-- distance2 (X metric) = Metric.distance metric + +--instance (MetricCoord metric coord +-- , CoordConversion AutoConversion coord a t +-- , CoordConversion AutoConversion coord b t +-- , space ~ SpaceOf a +-- , space ~ SpaceOf b +-- , Metric metric t +-- , out ~ Double) => +-- Distance2 (MetricSpace metric space) (a -> b -> out) where +-- distance2 = distance diff --git a/src/Math/Space/Space.hs b/src/Math/Space/Space.hs new file mode 100644 --- /dev/null +++ b/src/Math/Space/Space.hs @@ -0,0 +1,23 @@ +--------------------------------------------------------------------------- +-- Copyright (C) Flowbox, Inc - All Rights Reserved +-- Unauthorized copying of this file, via any medium is strictly prohibited +-- Proprietary and confidential +-- Flowbox Team , 2014 +--------------------------------------------------------------------------- + +module Math.Space.Space where + +--data Space2 = Space2 !Double !Double deriving (Show) + +class Space2 space where + width :: space a -> a + height :: space a -> a + +class Space2 space => Space3 space where + depth :: space a -> a + +data Grid a = Grid !a !a deriving (Show) + +instance Space2 Grid where + width (Grid x _) = x + height (Grid _ x) = x