manifolds-core 0.5.1.0 → 0.6.0.0

raw patch · 5 files changed

+239/−336 lines, 5 filesdep +equational-reasoningPVP ok

version bump matches the API change (PVP)

Dependencies added: equational-reasoning

API changes (from Hackage documentation)

Files

• Math/Manifold/Core/PseudoAffine.hs +164/−294
• Math/Manifold/Core/Types.hs +5/−4
• Math/Manifold/Core/Types/Internal.hs +45/−37
• Math/Manifold/VectorSpace/Scalar.hs +22/−0
• manifolds-core.cabal +3/−1

@@ -17,6 +17,8 @@ {-# LANGUAGE DeriveGeneric            #-} {-# LANGUAGE StandaloneDeriving       #-} {-# LANGUAGE UnicodeSyntax            #-}+{-# LANGUAGE EmptyCase                #-}+{-# LANGUAGE ConstraintKinds          #-} {-# LANGUAGE ScopedTypeVariables      #-} {-# LANGUAGE TypeOperators            #-} {-# LANGUAGE CPP                      #-}@@ -28,11 +30,10 @@ import Data.AffineSpace import Data.Basis -import Data.Tagged import Data.Fixed (mod') import Data.Void -import Math.Manifold.Core.Types+import Math.Manifold.Core.Types.Internal import Math.Manifold.VectorSpace.ZeroDimensional  import Control.Applicative@@ -43,10 +44,7 @@  import Data.CallStack (HasCallStack) --data BoundarylessWitness m where-  BoundarylessWitness :: (Semimanifold m, Interior m ~ m)-                 => BoundarylessWitness m+type ℝeal r = (RealFloat r, PseudoAffine r, Semimanifold r, Needle r ~ r)  -- | This is the reified form of the property that the interior of a semimanifold --   is a manifold. These constraints would ideally be expressed directly as@@ -54,77 +52,43 @@ --   extension, which is not reliable yet. --  -- Also, if all those equality constraints are in scope, GHC tends to infer needlessly--- complicated types like @'Interior' ('Interior' ('Needle' ('Interior' x)))@, which is+-- complicated types like @'Needle' ('Needle' ('Needle' x))@, which is -- the same as just @'Needle' x@. data SemimanifoldWitness x where   SemimanifoldWitness ::-      ( Semimanifold (Needle x), Needle (Interior x) ~ Needle x-      , Needle (Needle x) ~ Needle x-      , Interior (Needle x) ~ Needle x )-     => BoundarylessWitness (Interior x) -> SemimanifoldWitness x+      ( Semimanifold (Needle x)+      , Needle (Needle x) ~ Needle x )+     => SemimanifoldWitness x  data PseudoAffineWitness x where-  PseudoAffineWitness ::-      ( PseudoAffine (Interior x), PseudoAffine (Needle x) )+  PseudoAffineWitness :: PseudoAffine (Needle x)      => SemimanifoldWitness x -> PseudoAffineWitness x  infix 6 .-~., .-~! infixl 6 .+~^, .-~^  class AdditiveGroup (Needle x) => Semimanifold x where-  {-# MINIMAL ((.+~^) | fromInterior), toInterior, translateP #-}-  -- | The space of &#x201c;natural&#x201d; ways starting from some reference point+  -- | The space of &#x201c;ways&#x201d; starting from some reference point   --   and going to some particular target point. Hence,   --   the name: like a compass needle, but also with an actual length.   --   For affine spaces, 'Needle' is simply the space of   --   line segments (aka vectors) between two points, i.e. the same as 'Diff'.   --   The 'AffineManifold' constraint makes that requirement explicit.   -- -  --   This space should be isomorphic to the tangent space (and is in fact-  --   used somewhat synonymously).+  --   This space should be isomorphic to the tangent space (and in fact+  --   serves an in many ways similar role), however whereas the tangent space+  --   of a manifold is really infinitesimally small, needles actually allow+  --   macroscopic displacements.   type Needle x :: *   type Needle x = GenericNeedle x   -  -- | Manifolds with boundary are a bit tricky. We support such manifolds,-  --   but carry out most calculations only in “the fleshy part” – the-  --   interior, which is an “infinite space”, so you can arbitrarily scale paths.-  -- -  --   The default implementation is @'Interior' x = x@, which corresponds-  --   to a manifold that has no boundary to begin with.-  type Interior x :: *-  type Interior x = x-  -  -- | Generalised translation operation. Note that the result will always also-  --   be in the interior; scaling up the needle can only get you ever /closer/-  --   to a boundary.-  (.+~^) :: Interior x -> Needle x -> x-  (.+~^) = addvp-   where addvp :: ∀ x . Semimanifold x => Interior x -> Needle x -> x-         addvp p = fromInterior . tp p-          where (Tagged tp) = translateP :: Tagged x (Interior x -> Needle x -> Interior x)-    -  -- | 'id' sans boundary.-  fromInterior :: Interior x -> x-  fromInterior p = p .+~^ zeroV -  -  toInterior :: x -> Maybe (Interior x)-  default toInterior :: ( Generic x, Semimanifold (VRep x)-                        , Interior x ~ GenericInterior x )-                            => x -> Maybe (Interior x)-  toInterior p = fmap GenericInterior $ toInterior (Gnrx.from p :: VRep x)-  -  -- | The signature of '.+~^' should really be @'Interior' x -> 'Needle' x -> 'Interior' x@,-  --   only, this is not possible because it only consists of non-injective type families.-  --   The solution is this tagged signature, which is of course rather unwieldy. That's-  --   why '.+~^' has the stronger, but easier usable signature. Without boundary, these-  --   functions should be equivalent, i.e. @translateP = Tagged (.+~^)@.-  translateP :: Tagged x (Interior x -> Needle x -> Interior x)-  default translateP :: ( Generic x, Semimanifold (VRep x)-                        , Interior x ~ GenericInterior x, Needle x ~ GenericNeedle x )-        => Tagged x (Interior x -> Needle x -> Interior x)-  translateP = Tagged $ case translateP :: Tagged (VRep x)-     (Interior (VRep x) -> Needle (VRep x) -> Interior (VRep x)) of-          Tagged tp -> \(GenericInterior p) (GenericNeedle v) -> GenericInterior $ tp p v+  -- | Generalisation of the translation operation '.+^' to possibly non-flat+  --   manifolds, instead of affine spaces.+  (.+~^) :: x -> Needle x -> x+  default (.+~^) :: ( Generic x, Semimanifold (VRep x)+                    , Needle x ~ GenericNeedle x )+        => x -> Needle x -> x+  p.+~^GenericNeedle v = Gnrx.to (Gnrx.from p.+~^v :: Gnrx.Rep x Void)      -- | Shorthand for @\\p v -> p .+~^ 'negateV' v@, which should obey the /asymptotic/ law   --   @@ -133,30 +97,23 @@   -- @   --      --   Meaning: if @v@ is scaled down with sufficiently small factors /&#x3b7;/, then-  --   the difference @(p.-~^v.+~^v) .-~. p@ should scale down even faster:-  --   as /O/ (/&#x3b7;/&#xb2;). For large vectors, it will however behave differently,+  --   the difference @(p.-~^v.+~^v) .-~. p@ should eventually scale down even faster:+  --   as /O/ (/&#x3b7;/&#xb2;). For large vectors, it may however behave differently,   --   except in flat spaces (where all this should be equivalent to the 'AffineSpace'   --   instance).-  (.-~^) :: Interior x -> Needle x -> x+  (.-~^) :: x -> Needle x -> x   p .-~^ v = p .+~^ negateV v      semimanifoldWitness :: SemimanifoldWitness x   default semimanifoldWitness ::-      ( Semimanifold (Interior x), Semimanifold (Needle x)-      , Interior (Interior x) ~ Interior x, Needle (Interior x) ~ Needle x-      , Needle (Needle x) ~ Needle x-      , Interior (Needle x) ~ Needle x )+      ( Semimanifold (Needle x), Needle (Needle x) ~ Needle x )      => SemimanifoldWitness x-  semimanifoldWitness = SemimanifoldWitness BoundarylessWitness+  semimanifoldWitness = SemimanifoldWitness    --- | This is the class underlying manifolds. ('Manifold' only precludes boundaries---   and adds an extra constraint that would be circular if it was in a single---   class. You can always just use 'Manifold' as a constraint in your signatures,---   but you must /define/ only 'PseudoAffine' for manifold types &#x2013;---   the 'Manifold' instance follows universally from this, if @'Interior x ~ x@.)+-- | This is the class underlying what we understand as manifolds.  --   ---   The interface is (boundaries aside) almost identical to the better-known+--   The interface is almost identical to the better-known --   'AffineSpace' class, but we don't require associativity of '.+~^' with '^+^' --   &#x2013; except in an /asymptotic sense/ for small vectors. --   @@ -168,42 +125,77 @@ --   manifolds in their usual maths definition (with an atlas of charts: a family of --   overlapping regions of the topological space, each homeomorphic to the 'Needle' --   vector space or some simply-connected subset thereof).+-- +--   The 'Semimanifold' and 'PseudoAffine' classes can be @anyclass@-derived+--   or empty-instantiated based on 'Generic' for product types (including newtypes) of+--   existing 'PseudoAffine' instances. For example, the definition+--+-- @+-- data Cylinder = CylinderPolar { zCyl :: !D¹, φCyl :: !S¹ }+--   deriving (Generic, Semimanifold, PseudoAffine)+-- @+-- +--   is equivalent to+--+-- @+-- data Cylinder = CylinderPolar { zCyl :: !D¹, φCyl :: !S¹ }+--+-- data CylinderNeedle = CylinderPolarNeedle { δzCyl :: !(Needle D¹), δφCyl :: !(Needle S¹) }+-- +-- instance Semimanifold Cylinder where+--   type Needle Cylinder = CylinderNeedle+--   CylinderPolar z φ .+~^ CylinderPolarNeedle δz δφ+--        = CylinderPolar (z.+~^δz) (φ.+~^δφ)+-- +-- instance PseudoAffine Cylinder where+--   CylinderPolar z₁ φ₁ .-~. CylinderPolar z₀ φ₀+--        = CylinderPolarNeedle <$> z₁.-~.z₀ <*> φ₁.-~.φ₀+--   CylinderPolar z₁ φ₁ .-~! CylinderPolar z₀ φ₀+--        = CylinderPolarNeedle (z₁.-~!z₀) (φ₁.-~.φ₀)+-- @ class Semimanifold x => PseudoAffine x where-  {-# MINIMAL (.-~.) | (.-~!) #-}   -- | The path reaching from one point to another.-  --   Should only yield 'Nothing' if-  -- -  --   * The points are on disjoint segments of a non&#x2013;path-connected space.-  -- -  --   * Either of the points is on the boundary. Use '|-~.' to deal with this.-  -- -  --   On manifolds, the identity-  --   +  --   Should only yield 'Nothing' if the points are on disjoint segments+  --   of a non&#x2013;path-connected space.+  --+  --   For a connected manifold, you may define this method as+  --   -- @-  -- p .+~^ (q.-~.p) &#x2261; q+  --   p.-~.q = pure (p.-~!q)   -- @-  --   -  --   should hold, at least save for floating-point precision limits etc..-  -- -  --   '.-~.' and '.+~^' only really work in manifolds without boundary. If you consider-  --   the path between two points, one of which lies on the boundary, it can't really-  --   be possible to scale this path any longer – it would have to reach “out of the-  --   manifold”. To adress this problem, these functions basically consider only the-  --   /interior/ of the space.   (.-~.) :: x -> x -> Maybe (Needle x)-  p.-~.q = return $ p.-~!q+  default (.-~.) :: ( Generic x, PseudoAffine (VRep x)+                    , Needle x ~ GenericNeedle x )+        => x -> x -> Maybe (Needle x)+  p.-~.q = GenericNeedle <$> Gnrx.from p .-~. (Gnrx.from q :: Gnrx.Rep x Void)      -- | Unsafe version of '.-~.'. If the two points lie in disjoint regions,   --   the behaviour is undefined.+  -- +  --   Whenever @p@ and @q@ lie in a connected region, the identity+  --   +  -- @+  -- p .+~^ (q.-~.p) ≡ q+  -- @+  --   +  --   should hold (up to possible floating point rounding etc.).+  --   Meanwhile, you will in general have+  -- +  -- @+  -- (p.+~^v).-~^v ≠ p+  -- @+  -- +  -- (though in many instances this is at least for sufficiently small @v@ approximately equal).   (.-~!) :: HasCallStack => x -> x -> Needle x-  p.-~!q = case p.-~.q of-      Just v -> v-      Nothing -> error "Attempt to calculate vector between points on disjoint manifold-regions."+  default (.-~!) :: ( Generic x, PseudoAffine (VRep x)+                    , Needle x ~ GenericNeedle x )+        => x -> x -> Needle x+  p.-~!q = GenericNeedle $ Gnrx.from p .-~! (Gnrx.from q :: Gnrx.Rep x Void)   {-# INLINE (.-~!) #-}      pseudoAffineWitness :: PseudoAffineWitness x   default pseudoAffineWitness ::-      ( PseudoAffine (Interior x), PseudoAffine (Needle x) )+      PseudoAffine (Needle x)      => PseudoAffineWitness x   pseudoAffineWitness = PseudoAffineWitness semimanifoldWitness   @@ -233,17 +225,17 @@ --   only makes sense on a Riemannian manifold, as 'Data.Manifold.Riemannian.Geodesic'. palerp :: ∀ x. (PseudoAffine x, VectorSpace (Needle x))     => x -> x -> Maybe (Scalar (Needle x) -> x)-palerp p₀ p₁ = case (toInterior p₀, p₁.-~.p₀) of-  (Just b, Just v) -> return $ \t -> b .+~^ t *^ v-  _ -> Nothing+palerp p₀ p₁ = case p₁.-~.p₀ of+  Just v -> return $ \t -> p₀ .+~^ t *^ v+  _      -> Nothing  -- | Like 'palerp', but actually restricted to the interval between the points, --   with a signature like 'Data.Manifold.Riemannian.geodesicBetween' --   rather than 'Data.AffineSpace.alerp'. palerpB :: ∀ x. (PseudoAffine x, VectorSpace (Needle x), Scalar (Needle x) ~ ℝ)                   => x -> x -> Maybe (D¹ -> x)-palerpB p₀ p₁ = case (toInterior p₀, p₁.-~.p₀) of-  (Just b, Just v) -> return $ \(D¹ t) -> b .+~^ ((t+1)/2) *^ v+palerpB p₀ p₁ = case p₁.-~.p₀ of+  Just v -> return $ \(D¹ t) -> p₀ .+~^ ((t+1)/2) *^ v   _ -> Nothing  -- | Like 'alerp', but actually restricted to the interval between the points.@@ -254,151 +246,86 @@   -hugeℝVal :: ℝ-hugeℝVal = 1e+100- #define deriveAffine(c,t)               \ instance (c) => Semimanifold (t) where { \   type Needle (t) = Diff (t);             \-  fromInterior = id;                       \-  toInterior = pure;                        \-  translateP = Tagged (.+^);                 \-  (.+~^) = (.+^) };                           \-instance (c) => PseudoAffine (t) where {       \-  a.-~.b = pure (a.-.b);      }+  (.+~^) = (.+^) };                        \+instance (c) => PseudoAffine (t) where {    \+  a.-~.b = pure (a.-.b);                     \+  (.-~!) = (.-.) }  deriveAffine((),Double) deriveAffine((),Float) deriveAffine((),Rational) - instance Semimanifold (ZeroDim k) where   type Needle (ZeroDim k) = ZeroDim k-  fromInterior = id-  toInterior = pure   Origin .+~^ Origin = Origin   Origin .-~^ Origin = Origin-  translateP = Tagged (.+~^) instance PseudoAffine (ZeroDim k) where+  Origin .-~! Origin = Origin   Origin .-~. Origin = pure Origin  instance ∀ a b . (Semimanifold a, Semimanifold b) => Semimanifold (a,b) where   type Needle (a,b) = (Needle a, Needle b)-  type Interior (a,b) = (Interior a, Interior b)   (a,b).+~^(v,w) = (a.+~^v, b.+~^w)   (a,b).-~^(v,w) = (a.-~^v, b.-~^w)-  fromInterior (i,j) = (fromInterior i, fromInterior j)-  toInterior (a,b) = (,) <$> toInterior a <*> toInterior b-  translateP = Tagged $ \(a,b) (v,w) -> (ta a v, tb b w)-   where Tagged ta = translateP :: Tagged a (Interior a -> Needle a -> Interior a)-         Tagged tb = translateP :: Tagged b (Interior b -> Needle b -> Interior b)   semimanifoldWitness = case ( semimanifoldWitness :: SemimanifoldWitness a                              , semimanifoldWitness :: SemimanifoldWitness b ) of-     (SemimanifoldWitness BoundarylessWitness, SemimanifoldWitness BoundarylessWitness)-         -> SemimanifoldWitness BoundarylessWitness+     (SemimanifoldWitness, SemimanifoldWitness) -> SemimanifoldWitness instance (PseudoAffine a, PseudoAffine b) => PseudoAffine (a,b) where   (a,b).-~.(c,d) = liftA2 (,) (a.-~.c) (b.-~.d)+  (a,b).-~!(c,d) = (a.-~!c, b.-~!d)   pseudoAffineWitness = case ( pseudoAffineWitness :: PseudoAffineWitness a                              , pseudoAffineWitness :: PseudoAffineWitness b ) of-             (  PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)-              , PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness) )-              ->PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)+             (  PseudoAffineWitness (SemimanifoldWitness)+              , PseudoAffineWitness (SemimanifoldWitness) )+              ->PseudoAffineWitness (SemimanifoldWitness)  instance ∀ a b c . (Semimanifold a, Semimanifold b, Semimanifold c)                           => Semimanifold (a,b,c) where   type Needle (a,b,c) = (Needle a, Needle b, Needle c)-  type Interior (a,b,c) = (Interior a, Interior b, Interior c)   (a,b,c).+~^(v,w,x) = (a.+~^v, b.+~^w, c.+~^x)   (a,b,c).-~^(v,w,x) = (a.-~^v, b.-~^w, c.-~^x)-  fromInterior (i,j,k) = (fromInterior i, fromInterior j, fromInterior k)-  toInterior (a,b,c) = liftA3 (,,) (toInterior a) (toInterior b) (toInterior c)-  translateP = Tagged $ \(a,b,c) (v,w,x) -> (ta a v, tb b w, tc c x)-   where Tagged ta = translateP :: Tagged a (Interior a -> Needle a -> Interior a)-         Tagged tb = translateP :: Tagged b (Interior b -> Needle b -> Interior b)-         Tagged tc = translateP :: Tagged c (Interior c -> Needle c -> Interior c)   semimanifoldWitness = case ( semimanifoldWitness :: SemimanifoldWitness a                              , semimanifoldWitness :: SemimanifoldWitness b                              , semimanifoldWitness :: SemimanifoldWitness c ) of-             ( SemimanifoldWitness BoundarylessWitness-              ,SemimanifoldWitness BoundarylessWitness-              ,SemimanifoldWitness BoundarylessWitness )-                   -> SemimanifoldWitness BoundarylessWitness+             ( SemimanifoldWitness, SemimanifoldWitness, SemimanifoldWitness )+                   -> SemimanifoldWitness instance (PseudoAffine a, PseudoAffine b, PseudoAffine c) => PseudoAffine (a,b,c) where+  (a,b,c).-~!(d,e,f) = (a.-~!d, b.-~!e, c.-~!f)   (a,b,c).-~.(d,e,f) = liftA3 (,,) (a.-~.d) (b.-~.e) (c.-~.f)   pseudoAffineWitness = case ( pseudoAffineWitness :: PseudoAffineWitness a                              , pseudoAffineWitness :: PseudoAffineWitness b                              , pseudoAffineWitness :: PseudoAffineWitness c ) of-             (  PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)-              , PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)-              , PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness) )-              ->PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)+             (  PseudoAffineWitness SemimanifoldWitness+              , PseudoAffineWitness SemimanifoldWitness+              , PseudoAffineWitness SemimanifoldWitness )+              ->PseudoAffineWitness SemimanifoldWitness    -instance Semimanifold S⁰ where-  type Needle S⁰ = ZeroDim ℝ-  fromInterior = id-  toInterior = pure-  translateP = Tagged (.+~^)-  p .+~^ Origin = p-  p .-~^ Origin = p-instance PseudoAffine S⁰ where-  PositiveHalfSphere .-~. PositiveHalfSphere = pure Origin-  NegativeHalfSphere .-~. NegativeHalfSphere = pure Origin-  _ .-~. _ = Nothing -instance Semimanifold S¹ where-  type Needle S¹ = ℝ-  fromInterior = id-  toInterior = pure-  translateP = Tagged (.+~^)-  S¹Polar φ₀ .+~^ δφ  = S¹Polar $ φ'-   where φ' = toS¹range $ φ₀ + δφ-instance PseudoAffine S¹ where-  S¹Polar φ₁ .-~. S¹Polar φ₀-     | δφ > pi     = pure (δφ - tau)-     | δφ < (-pi)  = pure (δφ + tau)-     | otherwise   = pure δφ-   where δφ = φ₁ - φ₀ -instance Semimanifold D¹ where-  type Needle D¹ = ℝ-  type Interior D¹ = ℝ-  fromInterior = D¹ . tanh-  toInterior (D¹ x) | abs x < 1  = return $ atanh x-                    | otherwise  = empty-  translateP = Tagged (+)-instance PseudoAffine D¹ where-  D¹ 1 .-~. _ = empty-  D¹ (-1) .-~. _ = empty-  D¹ x .-~. D¹ y-    | abs x < 1, abs y < 1  = return $ atanh x - atanh y-    | otherwise             = empty ---instance Semimanifold ℝP⁰ where-  type Needle ℝP⁰ = ZeroDim ℝ-  fromInterior = id-  toInterior = pure-  translateP = Tagged (.+~^)+instance Semimanifold (ℝP⁰_ r) where+  type Needle (ℝP⁰_ r) = ZeroDim r   p .+~^ Origin = p   p .-~^ Origin = p-instance PseudoAffine ℝP⁰ where+instance PseudoAffine (ℝP⁰_ r) where+  ℝPZero .-~! ℝPZero = Origin   ℝPZero .-~. ℝPZero = pure Origin -instance Semimanifold ℝP¹ where-  type Needle ℝP¹ = ℝ-  fromInterior = id-  toInterior = pure-  translateP = Tagged (.+~^)+instance ℝeal r => Semimanifold (ℝP¹_ r) where+  type Needle (ℝP¹_ r) = r   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 δφ+instance ℝeal r => PseudoAffine (ℝP¹_ r) where+  p.-~.q = pure (p.-~!q)+  HemisphereℝP¹Polar φ₁ .-~! HemisphereℝP¹Polar φ₀+     | δφ > pi/2     = δφ - pi+     | δφ < (-pi/2)  = δφ + pi+     | otherwise     = δφ    where δφ = φ₁ - φ₀  @@ -406,16 +333,16 @@   -tau :: ℝ+tau :: RealFloat r => r tau = 2 * pi -toS¹range :: ℝ -> ℝ+toS¹range :: RealFloat r => r -> r toS¹range φ = (φ+pi)`mod'`tau - pi -toℝP¹range :: ℝ -> ℝ+toℝP¹range :: RealFloat r => r -> r toℝP¹range φ = (φ+pi/2)`mod'`pi - pi/2 -toUnitrange :: ℝ -> ℝ+toUnitrange :: RealFloat r => r -> r toUnitrange φ = (φ+1)`mod'`2 - 1  @@ -445,9 +372,6 @@     => Semimanifold (NeedleProductSpace f g p) where   type Needle (NeedleProductSpace f g p) = NeedleProductSpace f g p   (.+~^) = (^+^)-  fromInterior = id-  toInterior = pure-  translateP = Tagged (^+^) instance (PseudoAffine (f p), PseudoAffine (g p))     => PseudoAffine (NeedleProductSpace f g p) where   p.-~.q = Just $ p.-.q@@ -466,42 +390,6 @@   decompose' (NeedleProductSpace _ vg) (Right bg) = decompose' vg bg  -data InteriorProductSpace f g p = InteriorProductSpace-            !(Interior (f p)) !(Interior (g p)) deriving (Generic)-instance ∀ f g p . (Semimanifold (f p), Semimanifold (g p))-    => Semimanifold (InteriorProductSpace f g p) where-  type Needle (InteriorProductSpace f g p) = NeedleProductSpace f g p-  type Interior (InteriorProductSpace f g p) = InteriorProductSpace f g p-  (.+~^) = case-     ( translateP :: Tagged (f p) (Interior (f p) -> Needle (f p) -> Interior (f p))-     , translateP :: Tagged (g p) (Interior (g p) -> Needle (g p) -> Interior (g p)) ) of-             (Tagged tf, Tagged tg)-               -> \(InteriorProductSpace pf pg) (NeedleProductSpace vf vg)-                    -> InteriorProductSpace (tf pf vf) (tg pg vg)-  fromInterior = id-  toInterior = pure-  translateP = Tagged $ case-     ( translateP :: Tagged (f p) (Interior (f p) -> Needle (f p) -> Interior (f p))-     , translateP :: Tagged (g p) (Interior (g p) -> Needle (g p) -> Interior (g p)) ) of-             (Tagged tf, Tagged tg)-               -> \(InteriorProductSpace pf pg) (NeedleProductSpace vf vg)-                    -> InteriorProductSpace (tf pf vf) (tg pg vg)-instance ∀ f g p . (PseudoAffine (f p), PseudoAffine (g p))-    => PseudoAffine (InteriorProductSpace f g p) where-  (.-~.) = case-     ( pseudoAffineWitness :: PseudoAffineWitness (f p)-     , pseudoAffineWitness :: PseudoAffineWitness (g p) ) of-             ( PseudoAffineWitness (SemimanifoldWitness _)-              ,PseudoAffineWitness (SemimanifoldWitness _) )-               -> \(InteriorProductSpace pf pg) (InteriorProductSpace qf qg)-                 -> NeedleProductSpace <$> pf.-~.qf <*> pg.-~.qg-  (.-~!) = case-     ( pseudoAffineWitness :: PseudoAffineWitness (f p)-     , pseudoAffineWitness :: PseudoAffineWitness (g p) ) of-             ( PseudoAffineWitness (SemimanifoldWitness _)-              ,PseudoAffineWitness (SemimanifoldWitness _) )-               -> \(InteriorProductSpace pf pg) (InteriorProductSpace qf qg)-                 -> NeedleProductSpace (pf.-~!qf) (pg.-~!qg)   newtype GenericNeedle x = GenericNeedle {getGenericNeedle :: Needle (VRep x)}@@ -522,100 +410,82 @@   (.+^) = (^+^) instance AdditiveGroup (Needle (VRep x)) => Semimanifold (GenericNeedle x) where   type Needle (GenericNeedle x) = GenericNeedle x-  type Interior (GenericNeedle x) = GenericNeedle x-  fromInterior = id-  toInterior = pure-  translateP = Tagged (^+^)+  (.+~^) = (.+^) instance AdditiveGroup (Needle (VRep x)) => PseudoAffine (GenericNeedle x) where   GenericNeedle v .-~. GenericNeedle w = Just $ GenericNeedle (v ^-^ w)   GenericNeedle v .-~! GenericNeedle w = GenericNeedle (v ^-^ w)  -newtype GenericInterior x = GenericInterior {getGenericInterior :: Interior (VRep x)}-    deriving (Generic) -instance Semimanifold (VRep x) => Semimanifold (GenericInterior x) where-  type Needle (GenericInterior x) = GenericNeedle x-  type Interior (GenericInterior x) = GenericInterior x-  fromInterior = id-  toInterior = pure-  translateP = Tagged $ case translateP :: Tagged (VRep x)-       (Interior (VRep x) -> Needle (VRep x) -> Interior (VRep x)) of-         Tagged tp -> \(GenericInterior p) (GenericNeedle v) -> GenericInterior $ tp p v-instance ∀ x . PseudoAffine (VRep x) => PseudoAffine (GenericInterior x) where-  (.-~.) = case pseudoAffineWitness :: PseudoAffineWitness (VRep x) of-      PseudoAffineWitness (SemimanifoldWitness _)-          -> \(GenericInterior v) (GenericInterior w)-                               -> GenericNeedle <$> (v .-~. w)-  (.-~!) = case pseudoAffineWitness :: PseudoAffineWitness (VRep x) of-      PseudoAffineWitness (SemimanifoldWitness _)-          -> \(GenericInterior v) (GenericInterior w)-                               -> GenericNeedle (v .-~! w) -- instance ∀ a s . Semimanifold a => Semimanifold (Gnrx.Rec0 a s) where   type Needle (Gnrx.Rec0 a s) = Needle a-  type Interior (Gnrx.Rec0 a s) = Interior a   semimanifoldWitness = case semimanifoldWitness :: SemimanifoldWitness a of-           SemimanifoldWitness BoundarylessWitness-               -> SemimanifoldWitness BoundarylessWitness-  fromInterior = Gnrx.K1 . fromInterior-  toInterior = toInterior . Gnrx.unK1-  translateP = case semimanifoldWitness :: SemimanifoldWitness a of-           SemimanifoldWitness BoundarylessWitness -> Tagged (.+~^)+           SemimanifoldWitness+               -> SemimanifoldWitness+  Gnrx.K1 p .+~^ v = Gnrx.K1 $ p .+~^ v instance ∀ f p i c . Semimanifold (f p) => Semimanifold (Gnrx.M1 i c f p) where   type Needle (Gnrx.M1 i c f p) = Needle (f p)-  type Interior (Gnrx.M1 i c f p) = Interior (f p)   semimanifoldWitness = case semimanifoldWitness :: SemimanifoldWitness (f p) of-           SemimanifoldWitness BoundarylessWitness-               -> SemimanifoldWitness BoundarylessWitness-  fromInterior = Gnrx.M1 . fromInterior-  toInterior = toInterior . Gnrx.unM1-  translateP = case semimanifoldWitness :: SemimanifoldWitness (f p) of-           SemimanifoldWitness BoundarylessWitness -> Tagged (.+~^)+           SemimanifoldWitness -> SemimanifoldWitness+  Gnrx.M1 p.+~^v = Gnrx.M1 $ p.+~^v instance ∀ f g p . (Semimanifold (f p), Semimanifold (g p))          => Semimanifold ((f :*: g) p) where   type Needle ((f:*:g) p) = NeedleProductSpace f g p-  type Interior ((f:*:g) p) = InteriorProductSpace f g p   semimanifoldWitness = case ( semimanifoldWitness :: SemimanifoldWitness (f p)                              , semimanifoldWitness :: SemimanifoldWitness (g p) ) of-           ( SemimanifoldWitness BoundarylessWitness-            ,SemimanifoldWitness BoundarylessWitness )-               -> SemimanifoldWitness BoundarylessWitness-  fromInterior (InteriorProductSpace pf pg) = fromInterior pf :*: fromInterior pg-  toInterior (pf :*: pg) = InteriorProductSpace <$> toInterior pf <*> toInterior pg-  translateP = Tagged $ case-     ( translateP :: Tagged (f p) (Interior (f p) -> Needle (f p) -> Interior (f p))-     , translateP :: Tagged (g p) (Interior (g p) -> Needle (g p) -> Interior (g p)) ) of-             (Tagged tf, Tagged tg)-               -> \(InteriorProductSpace pf pg) (NeedleProductSpace vf vg)-                    -> InteriorProductSpace (tf pf vf) (tg pg vg)+           ( SemimanifoldWitness, SemimanifoldWitness )+               -> SemimanifoldWitness+  (p:*:q).+~^(NeedleProductSpace v w) = (p.+~^v) :*: (q.+~^w)     instance ∀ a s . PseudoAffine a => PseudoAffine (Gnrx.Rec0 a s) where   pseudoAffineWitness = case pseudoAffineWitness :: PseudoAffineWitness a of-           PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)-               -> PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)+           PseudoAffineWitness SemimanifoldWitness+               -> PseudoAffineWitness SemimanifoldWitness   Gnrx.K1 p .-~. Gnrx.K1 q = p .-~. q   Gnrx.K1 p .-~! Gnrx.K1 q = p .-~! q instance ∀ f p i c . PseudoAffine (f p) => PseudoAffine (Gnrx.M1 i c f p) where   pseudoAffineWitness = case pseudoAffineWitness :: PseudoAffineWitness (f p) of-           PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)-               -> PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)+           PseudoAffineWitness SemimanifoldWitness+               -> PseudoAffineWitness SemimanifoldWitness   Gnrx.M1 p .-~. Gnrx.M1 q = p .-~. q   Gnrx.M1 p .-~! Gnrx.M1 q = p .-~! q instance ∀ f g p . (PseudoAffine (f p), PseudoAffine (g p))          => PseudoAffine ((f :*: g) p) where   pseudoAffineWitness = case ( pseudoAffineWitness :: PseudoAffineWitness (f p)                              , pseudoAffineWitness :: PseudoAffineWitness (g p) ) of-           ( PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)-            ,PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness) )-               -> PseudoAffineWitness (SemimanifoldWitness BoundarylessWitness)+           ( PseudoAffineWitness SemimanifoldWitness+            ,PseudoAffineWitness SemimanifoldWitness )+               -> PseudoAffineWitness SemimanifoldWitness   (pf:*:pg) .-~. (qf:*:qg) = NeedleProductSpace <$> (pf.-~.qf) <*> (pg.-~.qg)   (pf:*:pg) .-~! (qf:*:qg) = NeedleProductSpace     (pf.-~!qf)     (pg.-~!qg)   type VRep x = Gnrx.Rep x Void++++-- | 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¹ :: !(Scalar (Needle x)) -- ^ Range @[0, 1]@+                 , pParamCD¹ :: !x                   -- ^ Irrelevant at @h = 0@.+                 } deriving (Generic)+deriving instance (Show x, Show (Scalar (Needle x))) => Show (CD¹ x)+++-- | 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 :: !(Scalar (Needle x))  -- ^ Range @[0, ∞[@+                   , pParamCℝay :: !x                    -- ^ Irrelevant at @h = 0@.+                   } deriving (Generic)+deriving instance (Show x, Show (Scalar (Needle x))) => Show (Cℝay x)+

@@ -18,14 +18,15 @@   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²+        ( EmptyMfd(..), ℝ⁰, ℝ+        , S⁰, S⁰_(..), otherHalfSphere, S¹, S¹_(..), pattern S¹, S², S²_(..), pattern S²+        , D¹, D¹_(..), fromIntv0to1, D², D²_(..), pattern D²+        , ℝP⁰, ℝP⁰_(..), ℝP¹, ℝP¹_(..), pattern ℝP¹, ℝP², ℝP²_(..), pattern ℝP²         , Cℝay(..), CD¹(..)         ) where  import Math.Manifold.Core.Types.Internal+import Math.Manifold.Core.PseudoAffine  import Data.VectorSpace import Math.Manifold.VectorSpace.ZeroDimensional

@@ -11,6 +11,7 @@ -- data types. All these are in the 'PseudoAffine' class. --  {-# LANGUAGE DeriveGeneric    #-}+{-# LANGUAGE EmptyCase        #-}   module Math.Manifold.Core.Types.Internal where@@ -19,33 +20,55 @@  import Data.Fixed (mod') +import Proof.Propositional (Empty(..))+ import GHC.Generics  +-- | The empty space can be considered a manifold with any sort of tangent space.+data EmptyMfd v++instance Empty (EmptyMfd v) where+  eliminate p = case p of {}+instance Eq (EmptyMfd v) where+  p==q = eliminate p && eliminate q+instance Ord (EmptyMfd v) where+  p<q = eliminate p && eliminate q+  p<=q = eliminate p && eliminate q+ -- | 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, Generic)+type S⁰ = S⁰_ Double -data ℝP⁰ = ℝPZero deriving (Eq, Show, Generic)+data S⁰_ r = PositiveHalfSphere | NegativeHalfSphere deriving(Eq, Show, Generic) +type ℝP⁰ = ℝP⁰_ Double+data ℝP⁰_ r = ℝPZero deriving (Eq, Show, Generic)+ -- | The unit circle.-newtype S¹ = S¹Polar { φParamS¹ :: Double -- ^ Must be in range @[-π, π[@.-                     } deriving (Show, Generic)+type S¹ = S¹_ Double -instance Eq S¹ where+newtype S¹_ r = S¹Polar { φParamS¹ :: r -- ^ Must be in range @[-π, π[@.+                        } deriving (Show, Generic)++instance (Eq r, RealFloat r) => Eq (S¹_ r) where   S¹Polar φ == S¹Polar φ' = φ `mod'` (2*pi) == φ' `mod'` (2*pi)+     -- It's not clear that it's actually a good idea to fold back the range here,+     -- since values outside @[-π, π[@ should not be allowed in the first place.  -newtype ℝP¹ = HemisphereℝP¹Polar { φParamℝP¹ :: Double -- ^ Range @[-π\/2,π\/2[@.-                                 } deriving (Show, Generic)+type ℝP¹ = ℝP¹_ Double+newtype ℝP¹_ r = HemisphereℝP¹Polar { φParamℝP¹ :: r -- ^ Range @[-π\/2,π\/2[@.+                                    } deriving (Show, Generic)  -- | The ordinary unit sphere.-data S² = S²Polar { ϑParamS² :: !Double -- ^ Range @[0, π[@.-                  , φParamS² :: !Double -- ^ Range @[-π, π[@.-                  } deriving (Show, Generic)+type S² = S²_ Double+data S²_ r = S²Polar { ϑParamS² :: !r -- ^ Range @[0, π[@.+                     , φParamS² :: !r -- ^ Range @[-π, π[@.+                     } deriving (Show, Generic) -instance Eq S² where+instance (Eq r, RealFloat r) => Eq (S²_ r) where   S²Polar θ φ == S²Polar θ' φ'    | θ > 0, θ < pi  = θ == θ' && φ `mod'` (2*pi) == φ' `mod'` (2*pi)    | otherwise      = θ == θ'@@ -55,41 +78,26 @@ --   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, Generic)+type ℝP² = ℝP²_ Double+data ℝP²_ r = HemisphereℝP²Polar { ϑParamℝP² :: !r -- ^ Range @[0, π/2]@.+                                 , φParamℝP² :: !r -- ^ Range @[-π, π[@.+                                 } deriving (Show, Generic)   -- | 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, Generic)---- | 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, Generic)+type D² = D²_ Double+data D²_ r = D²Polar { rParamD² :: !r -- ^ Range @[0, 1]@.+                     , φParamD² :: !r -- ^ Range @[-π, π[@.+                     } deriving (Show, Generic)  --- | 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, Generic)- -- | 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, Generic)+type D¹ = D¹_ Double+newtype D¹_ r = D¹ { xParamD¹ :: r -- ^ Range @[-1, 1]@.+                   } deriving (Show, Generic)  type ℝ = Double type ℝ⁰ = ZeroDim ℝ

@@ -0,0 +1,22 @@+-- |+-- Module      : Math.Manifold.VectorSpace.Scalar+-- Copyright   : (c) Justus Sagemüller 2022+-- License     : GPL v3+-- +-- Maintainer  : (@) jsag $ hvl.no+-- Stability   : experimental+-- Portability : portable+-- ++{-# LANGUAGE FlexibleInstances        #-}+{-# LANGUAGE UndecidableInstances     #-}+{-# LANGUAGE TypeFamilies             #-}+++module Math.Manifold.VectorSpace.Scalar where++import Data.VectorSpace+++class (VectorSpace s, Num s, Scalar s ~ s) => ScalarSpace s+instance (VectorSpace s, Num s, Scalar s ~ s) => ScalarSpace s

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                manifolds-core-version:             0.5.1.0+version:             0.6.0.0 synopsis:            The basic classes for the manifolds hierarchy. description:         The basic classes for the                      <http://hackage.haskell.org/package/manifolds manifolds> hierarchy.@@ -21,11 +21,13 @@   exposed-modules:     Math.Manifold.Core.Types                        , Math.Manifold.Core.PseudoAffine                        , Math.Manifold.VectorSpace.ZeroDimensional+                       , Math.Manifold.VectorSpace.Scalar   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                        , tagged                        , call-stack+                       , equational-reasoning >=0.6 && <0.8   -- hs-source-dirs:         default-language:    Haskell2010