diff --git a/Math/Manifold/Core/PseudoAffine.hs b/Math/Manifold/Core/PseudoAffine.hs --- a/Math/Manifold/Core/PseudoAffine.hs +++ b/Math/Manifold/Core/PseudoAffine.hs @@ -15,6 +15,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UnicodeSyntax #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} @@ -209,6 +210,18 @@ +-- | A fibre bundle combines points in the /base space/ @b@ with points in the /fibre/ +-- @f@. The type @FibreBundle b f@ is thus isomorphic to the tuple space @(b,f)@, but +-- it can have a different topology, the prime example being 'TangentBundle', where +-- nearby points may have differently-oriented tangent spaces. +data FibreBundle b f = FibreBundle + { baseSpace :: !(Interior b) + , fibreSpace :: !f + } deriving (Generic) +deriving instance (Show (Interior b), Show f) => Show (FibreBundle b f) + +-- | Points on a manifold, combined with vectors in the respective tangent space. +type TangentBundle m = FibreBundle m (Needle m) @@ -340,14 +353,12 @@ fromInterior = id toInterior = pure translateP = Tagged (.+~^) - S¹ φ₀ .+~^ δφ - | φ' < 0 = S¹ $ φ' + tau - | otherwise = S¹ $ φ' + S¹Polar φ₀ .+~^ δφ = S¹Polar $ φ' where φ' = toS¹range $ φ₀ + δφ instance PseudoAffine S¹ where - S¹ φ₁ .-~. S¹ φ₀ - | δφ > pi = pure (δφ - 2*pi) - | δφ < (-pi) = pure (δφ + 2*pi) + S¹Polar φ₁ .-~. S¹Polar φ₀ + | δφ > pi = pure (δφ - tau) + | δφ < (-pi) = pure (δφ + tau) | otherwise = pure δφ where δφ = φ₁ - φ₀ @@ -367,16 +378,45 @@ +instance Semimanifold ℝP⁰ where + type Needle ℝP⁰ = ZeroDim ℝ + fromInterior = id + toInterior = pure + translateP = Tagged (.+~^) + p .+~^ Origin = p + p .-~^ Origin = p +instance PseudoAffine ℝP⁰ where + ℝPZero .-~. ℝPZero = pure Origin +instance Semimanifold ℝP¹ where + type Needle ℝP¹ = ℝ + fromInterior = id + toInterior = pure + translateP = Tagged (.+~^) + HemisphereℝP¹Polar r₀ .+~^ δr = HemisphereℝP¹Polar . toℝP¹range $ r₀ + δr +instance PseudoAffine ℝP¹ where + HemisphereℝP¹Polar φ₁ .-~. HemisphereℝP¹Polar φ₀ + | δφ > pi/2 = pure (δφ - pi) + | δφ < (-pi/2) = pure (δφ + pi) + | otherwise = pure δφ + where δφ = φ₁ - φ₀ + + tau :: ℝ tau = 2 * pi toS¹range :: ℝ -> ℝ toS¹range φ = (φ+pi)`mod'`tau - pi + +toℝP¹range :: ℝ -> ℝ +toℝP¹range φ = (φ+pi/2)`mod'`pi - pi/2 + +toUnitrange :: ℝ -> ℝ +toUnitrange φ = (φ+1)`mod'`2 - 1 diff --git a/Math/Manifold/Core/Types.hs b/Math/Manifold/Core/Types.hs --- a/Math/Manifold/Core/Types.hs +++ b/Math/Manifold/Core/Types.hs @@ -13,10 +13,19 @@ {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} -module Math.Manifold.Core.Types where +module Math.Manifold.Core.Types + ( ℝ⁰, ℝ + , S⁰(..), otherHalfSphere, S¹(..), pattern S¹, S²(..), pattern S² + , D¹(..), fromIntv0to1, D²(..), pattern D² + , ℝP⁰(..), ℝP¹(..), pattern ℝP¹, ℝP²(..), pattern ℝP² + , Cℝay(..), CD¹(..) + ) where +import Math.Manifold.Core.Types.Internal import Data.VectorSpace import Math.Manifold.VectorSpace.ZeroDimensional @@ -25,45 +34,41 @@ import Data.Void import Data.Monoid -import Control.Applicative (Const(..), Alternative(..)) --- | The zero-dimensional sphere is actually just two points. Implementation might --- therefore change to @ℝ⁰ 'Control.Category.Constrained.+' ℝ⁰@: the disjoint sum of two --- single-point spaces. -data S⁰ = PositiveHalfSphere | NegativeHalfSphere deriving(Eq, Show) - otherHalfSphere :: S⁰ -> S⁰ otherHalfSphere PositiveHalfSphere = NegativeHalfSphere otherHalfSphere NegativeHalfSphere = PositiveHalfSphere --- | The unit circle. -newtype S¹ = S¹ { φParamS¹ :: Double -- ^ Must be in range @[-π, π[@. - } deriving (Show) - - +{-# DEPRECATED S¹ "Use Math.Manifold.Core.Types.S¹Polar" #-} +pattern S¹ :: Double -> S¹ +pattern S¹ φ = S¹Polar φ +{-# DEPRECATED ℝP¹ "Use Math.Manifold.Core.Types.HemisphereℝP¹Polar (notice: different range)" #-} +pattern ℝP¹ :: Double -> ℝP¹ +pattern ℝP¹ r <- (HemisphereℝP¹Polar ((2/pi*)->r)) + where ℝP¹ r = HemisphereℝP¹Polar $ r * pi/2 -type ℝP¹ = S¹ +{-# DEPRECATED S² "Use Math.Manifold.Core.Types.S²Polar" #-} +pattern S² :: Double -> Double -> S² +pattern S² ϑ φ = S²Polar ϑ φ +{-# DEPRECATED ℝP² "Use Math.Manifold.Core.Types.HemisphereℝP²Polar (notice: different range)" #-} +pattern ℝP² :: Double -> Double -> ℝP² +pattern ℝP² r φ <- (HemisphereℝP²Polar ((2/pi*)->r) φ) + where ℝP² r φ = HemisphereℝP²Polar (r * pi/2) φ +{-# DEPRECATED D² "Use Math.Manifold.Core.Types.D²Polar" #-} +pattern D² :: Double -> Double -> D² +pattern D² r φ = D²Polar r φ --- | The “one-dimensional disk” – really just the line segment between --- the two points -1 and 1 of 'S⁰', i.e. this is simply a closed interval. -newtype D¹ = D¹ { xParamD¹ :: Double -- ^ Range @[-1, 1]@. - } deriving (Show) fromIntv0to1 :: ℝ -> D¹ fromIntv0to1 x | x<0 = D¹ (-1) | x>1 = D¹ 1 | otherwise = D¹ $ x*2 - 1 - - - -type ℝ = Double -type ℝ⁰ = ZeroDim ℝ diff --git a/Math/Manifold/Core/Types/Internal.hs b/Math/Manifold/Core/Types/Internal.hs new file mode 100644 --- /dev/null +++ b/Math/Manifold/Core/Types/Internal.hs @@ -0,0 +1,88 @@ +-- | +-- Module : Math.Manifold.Core.Types.Internal +-- Copyright : (c) Justus Sagemüller 2018 +-- License : GPL v3 +-- +-- Maintainer : (@) jsagemue $ uni-koeln.de +-- Stability : experimental +-- Portability : portable +-- +-- Several low-dimensional manifolds, represented in some simple way as Haskell +-- data types. All these are in the 'PseudoAffine' class. +-- + + +module Math.Manifold.Core.Types.Internal where + +import Math.Manifold.VectorSpace.ZeroDimensional + + + +-- | The zero-dimensional sphere is actually just two points. Implementation might +-- therefore change to @ℝ⁰ 'Control.Category.Constrained.+' ℝ⁰@: the disjoint sum of two +-- single-point spaces. +data S⁰ = PositiveHalfSphere | NegativeHalfSphere deriving(Eq, Show) + +data ℝP⁰ = ℝPZero deriving (Eq, Show) + +-- | The unit circle. +newtype S¹ = S¹Polar { φParamS¹ :: Double -- ^ Must be in range @[-π, π[@. + } deriving (Show) + + +newtype ℝP¹ = HemisphereℝP¹Polar { φParamℝP¹ :: Double -- ^ Range @[-π/2,π/2[@. + } deriving (Show) + +-- | The ordinary unit sphere. +data S² = S²Polar { ϑParamS² :: !Double -- ^ Range @[0, π[@. + , φParamS² :: !Double -- ^ Range @[-π, π[@. + } deriving (Show) + + +-- | The two-dimensional real projective space, implemented as a disk with +-- opposing points on the rim glued together. Image this disk as the northern hemisphere +-- of a unit sphere; 'ℝP²' is the space of all straight lines passing through +-- the origin of 'ℝ³', and each of these lines is represented by the point at which it +-- passes through the hemisphere. +data ℝP² = HemisphereℝP²Polar { ϑParamℝP² :: !Double -- ^ Range @[0, π/2]@. + , φParamℝP² :: !Double -- ^ Range @[-π, π[@. + } deriving (Show) + + +-- | The standard, closed unit disk. Homeomorphic to the cone over 'S¹', but not in the +-- the obvious, “flat” way. (In is /not/ homeomorphic, despite +-- the almost identical ADT definition, to the projective space 'ℝP²'!) +data D² = D²Polar { rParamD² :: !Double -- ^ Range @[0, 1]@. + , φParamD² :: !Double -- ^ Range @[-π, π[@. + } deriving (Show) + +-- | A (closed) cone over a space @x@ is the product of @x@ with the closed interval 'D¹' +-- of “heights”, +-- except on its “tip”: here, @x@ is smashed to a single point. +-- +-- This construct becomes (homeomorphic-to-) an actual geometric cone (and to 'D²') in the +-- special case @x = 'S¹'@. +data CD¹ x = CD¹ { hParamCD¹ :: !Double -- ^ Range @[0, 1]@ + , pParamCD¹ :: !x -- ^ Irrelevant at @h = 0@. + } deriving (Show) + + +-- | An open cone is homeomorphic to a closed cone without the “lid”, +-- i.e. without the “last copy” of @x@, at the far end of the height +-- interval. Since that means the height does not include its supremum, it is actually +-- more natural to express it as the entire real ray, hence the name. +data Cℝay x = Cℝay { hParamCℝay :: !Double -- ^ Range @[0, ∞[@ + , pParamCℝay :: !x -- ^ Irrelevant at @h = 0@. + } deriving (Show) + +-- | The “one-dimensional disk” – really just the line segment between +-- the two points -1 and 1 of 'S⁰', i.e. this is simply a closed interval. +newtype D¹ = D¹ { xParamD¹ :: Double -- ^ Range @[-1, 1]@. + } deriving (Show) + +type ℝ = Double +type ℝ⁰ = ZeroDim ℝ + + + + diff --git a/manifolds-core.cabal b/manifolds-core.cabal --- a/manifolds-core.cabal +++ b/manifolds-core.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: manifolds-core -version: 0.4.4.0 +version: 0.4.5.0 synopsis: The basic classes for the manifolds hierarchy. description: The basic classes for the hierarchy. @@ -21,7 +21,7 @@ exposed-modules: Math.Manifold.Core.Types , Math.Manifold.Core.PseudoAffine , Math.Manifold.VectorSpace.ZeroDimensional - -- other-modules: + other-modules: Math.Manifold.Core.Types.Internal other-extensions: FlexibleInstances, UndecidableInstances, ExplicitNamespaces, TypeFamilies, FunctionalDependencies, FlexibleContexts, GADTs, RankNTypes, TupleSections, ConstraintKinds, PatternGuards, TypeOperators, ScopedTypeVariables, RecordWildCards, DataKinds, StandaloneDeriving, DefaultSignatures, UnicodeSyntax, MultiWayIf build-depends: base >=4.5 && <5 , vector-space >=0.11