manifolds-0.1.5.2: Coordinate-free hypersurfaces

Copyright(c) Justus Sagemüller 2015
LicenseGPL v3
Maintainer(@) sagemueller $ geo.uni-koeln.de
Stabilityexperimental
Portabilityportable
Safe HaskellNone
LanguageHaskell2010

Data.Manifold.PseudoAffine

Contents

Description

This is the second prototype of a manifold class. It appears to give considerable advantages over Manifold, so that class will probably soon be replaced with the one we define here (though PseudoAffine does not follow the standard notion of a manifold very closely, it should work quite equivalently for pretty much all Haskell types that qualify as manifolds).

Manifolds are interesting as objects of various categories, from continuous to diffeomorphic. At the moment, we mainly focus on region-wise differentiable functions, which are a promising compromise between flexibility of definition and provability of analytic properties. In particular, they are well-suited for visualisation purposes.

The classes in this module are mostly aimed at manifolds without boundary. Manifolds with boundary (which we call MWBound, never manifold!) are more or less treated as a disjoint sum of the interior and the boundary. To understand how this module works, best first forget about boundaries – in this case, Interior x ~ x, fromInterior and toInterior are trivial, and .+~|, |-~. and betweenBounds are irrelevant. The manifold structure of the boundary itself is not considered at all here.

Synopsis

Manifold class

class (PseudoAffine m, LinearManifold (Needle m), Interior m ~ m) => Manifold m Source

See Semimanifold and PseudoAffine for the methods.

Instances

class (AdditiveGroup (Needle x), Interior (Interior x) ~ Interior x) => Semimanifold x where Source

Minimal complete definition

((.+~^) | fromInterior), toInterior, translateP

Associated Types

type Needle x :: * Source

The space of “natural” ways 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).

type Interior x :: * Source

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.

Methods

(.+~^) :: Interior x -> Needle x -> x infixl 6 Source

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.

fromInterior :: Interior x -> x Source

id sans boundary.

toInterior :: x -> Option (Interior x) Source

translateP :: Tagged x (Interior x -> Needle x -> Interior x) Source

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 (.+~^).

(.-~^) :: Interior x -> Needle x -> x infixl 6 Source

Shorthand for \p v -> p .+~^ negateV v, which should obey the asymptotic law

p .-~^ v .+~^ v ≅ p

Meaning: if v is scaled down with sufficiently small factors η, then the difference (p.-~^v.+~^v) .-~. p should scale down even faster: as O (η²). For large vectors, it will however behave differently, except in flat spaces (where all this should be equivalent to the AffineSpace instance).

class (Semimanifold x, Semimanifold (Interior x), Needle (Interior x) ~ Needle x, Interior (Interior x) ~ Interior x) => PseudoAffine x where Source

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 – the Manifold instance follows universally from this, if 'Interior x ~ x.)

The interface is (boundaries aside) almost identical to the better-known AffineSpace class, but we don't require associativity of .+~^ with ^+^ – except in an asymptotic sense for small vectors.

That innocent-looking change makes the class applicable to vastly more general types: while an affine space is basically nothing but a vector space without particularly designated origin, a pseudo-affine space can have nontrivial topology on the global scale, and yet be used in practically the same way as an affine space. At least the usual spheres and tori make good instances, perhaps the class is in fact equivalent to 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).

Methods

(.-~.) :: x -> Interior x -> Option (Needle x) infix 6 Source

The path reaching from one point to another. Should only yield Nothing if

  • The points are on disjoint segments of a non–path-connected space.
  • Either of the points is on the boundary. Use |-~. to deal with this.

On manifolds, the identity

p .+~^ (q.-~.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.

Regions within a manifold

data Region s m Source

A pathwise connected subset of a manifold m, whose tangent space has scalar s.

smoothIndicator :: LocallyScalable q => Region q -> Differentiable q Source

Represent a Region by a smooth function which is positive within the region, and crosses zero at the boundary.

Hierarchy of manifold-categories

Everywhere differentiable functions

data Differentiable s d c Source

The category of differentiable functions between manifolds over scalar s.

As you might guess, these offer automatic differentiation of sorts (basically, simple forward AD), but that's in itself is not really the killer feature here. More interestingly, we actually have the (à la Curry-Howard) proof built in: the function f has at x₀ derivative f'ₓ₀, if, for¹ ε>0, there exists δ such that |f x − (f x₀ + xf'ₓ₀)| < ε for all |xx₀| < δ.

Observe that, though this looks quite similar to the standard definition of differentiability, it is not equivalent thereto – in fact it does not prove any analytic properties at all. To make it equivalent, we need a lower bound on δ: simply δ gives us continuity, and for continuous differentiability, δ must grow at least like √ε for small ε. Neither of these conditions are enforced by the type system, but we do require them for any allowed values because these proofs are obviously tremendously useful – for instance, you can have a root-finding algorithm and actually be sure you get all solutions correctly, not just some that are (hopefully) the closest to some reference point you'd need to laborously define!

Unfortunately however, this also prevents doing any serious algebra etc. with the category, because even something as simple as division necessary introduces singularities where the derivatives must diverge. Not to speak of many trigonometric e.g. trigonometric functions that are undefined on whole regions. The PWDiffable and RWDiffable categories have explicit handling for those issues built in; you may simply use these categories even when you know the result will be smooth in your relevant domain (or must be, for e.g. physics reasons).

¹(The implementation does not deal with ε and δ as difference-bounding reals, but rather as metric tensors that define a boundary by prohibiting the overlap from exceeding one; this makes the concept actually work on general manifolds.)

Instances

RealDimension s => EnhancedCat (->) (Differentiable s) Source 
MetricScalar s => HasAgent (Differentiable s) Source 
MetricScalar s => Category (Differentiable s) Source 
MetricScalar s => Cartesian (Differentiable s) Source 
MetricScalar s => WellPointed (Differentiable s) Source 
MetricScalar s => PreArrow (Differentiable s) Source 
MetricScalar s => Morphism (Differentiable s) Source 
MetricScalar s => CartesianAgent (Differentiable s) Source 
RealDimension s => EnhancedCat (RWDiffable s) (Differentiable s) Source 
RealDimension s => EnhancedCat (PWDiffable s) (Differentiable s) Source 
type UnitObject (Differentiable s) = ZeroDim s Source 
type Object (Differentiable s) o Source 
type PointObject (Differentiable s) x = () 
type AgentVal (Differentiable s) a v = GenericAgent (Differentiable s) a v 
type PairObjects (Differentiable s) a b = () 

Almost everywhere diff'able funcs

data PWDiffable s d c Source

Category of functions that almost everywhere have an open region in which they are continuously differentiable, i.e. PieceWiseDiff'able.

Instances

RealDimension s => EnhancedCat (->) (PWDiffable s) Source 
RealDimension s => HasAgent (PWDiffable s) Source 
RealDimension s => Category (PWDiffable s) Source 
RealDimension s => Cartesian (PWDiffable s) Source 
RealDimension s => WellPointed (PWDiffable s) Source 
RealDimension s => PreArrow (PWDiffable s) Source 
RealDimension s => Morphism (PWDiffable s) Source 
RealDimension s => CartesianAgent (PWDiffable s) Source 
RealDimension s => EnhancedCat (RWDiffable s) (PWDiffable s) Source 
RealDimension s => EnhancedCat (PWDiffable s) (Differentiable s) Source 
type UnitObject (PWDiffable s) = ZeroDim s Source 
type Object (PWDiffable s) o Source 
type PointObject (PWDiffable s) x = () 
type AgentVal (PWDiffable s) a v = GenericAgent (PWDiffable s) a v 
type PairObjects (PWDiffable s) a b = () 

Region-wise defined diff'able funcs

data RWDiffable s d c Source

Category of functions that, where defined, have an open region in which they are continuously differentiable. Hence RegionWiseDiff'able. Basically these are the partial version of PWDiffable.

Though the possibility of undefined regions is of course not too nice (we don't need Java to demonstrate this with its everywhere-looming null values...), this category will propably be the “workhorse” for most serious calculus applications, because it contains all the usual trig etc. functions and of course everything algebraic you can do in the reals.

The easiest way to define ordinary functions in this category is hence with its AgentValues, which have instances of the standard classes Num through Floating. For instance, the following defines the binary entropy as a differentiable function on the interval ]0,1[: (it will actually know where it's defined and where not! – and I don't mean you need to exhaustively isNaN-check all results...)

hb :: RWDiffable ℝ ℝ ℝ
hb = alg (\p -> - p * logBase 2 p - (1-p) * logBase 2 (1-p) )

Instances

RealDimension s => HasAgent (RWDiffable s) Source 
RealDimension s => Category (RWDiffable s) Source 
RealDimension s => Cartesian (RWDiffable s) Source 
RealDimension s => WellPointed (RWDiffable s) Source 
RealDimension s => PreArrow (RWDiffable s) Source 
RealDimension s => Morphism (RWDiffable s) Source 
RealDimension s => CartesianAgent (RWDiffable s) Source 
RealDimension s => EnhancedCat (RWDiffable s) (PWDiffable s) Source 
RealDimension s => EnhancedCat (RWDiffable s) (Differentiable s) Source 
type UnitObject (RWDiffable s) = ZeroDim s Source 
type Object (RWDiffable s) o Source 
type PointObject (RWDiffable s) x = () 
type AgentVal (RWDiffable s) a v = GenericAgent (RWDiffable s) a v 
type PairObjects (RWDiffable s) a b = () 

Type definitions

Metrics

type Metric x = HerMetric (Needle x) Source

The word “metric” is used in the sense as in general relativity. Cf. HerMetric.

type RieMetric x = x -> Metric x Source

A Riemannian metric assigns each point on a manifold a scalar product on the tangent space. Note that this association is not continuous, because the charts/tangent spaces in the bundle are a priori disjoint. However, for a proper Riemannian metric, all arising expressions of scalar products from needles between points on the manifold ought to be differentiable.

type RieMetric' x = x -> Metric' x Source

Constraints

type RealDimension r = (PseudoAffine r, Interior r ~ r, Needle r ~ r, HasMetric r, DualSpace r ~ r, Scalar r ~ r, RealFloat r) Source

The RealFloat class plus manifold constraints.

type AffineManifold m = (PseudoAffine m, Interior m ~ m, AffineSpace m, Needle m ~ Diff m, LinearManifold (Diff m)) Source

The AffineSpace class plus manifold constraints.

type LinearManifold x = (PseudoAffine x, Interior x ~ x, Needle x ~ x, HasMetric x) Source

Basically just an “updated” version of the VectorSpace class. Every vector space is a manifold, this constraint makes it explicit.

(Actually, LinearManifold is stronger than VectorSpace at the moment, since HasMetric requires FiniteDimensional. This might be lifted in the future.)

type WithField s c x = (c x, s ~ Scalar (Needle x)) Source

Require some constraint on a manifold, and also fix the type of the manifold's underlying field. For example, WithField ℝ HilbertSpace v constrains v to be a real (i.e., Double-) Hilbert space. Note that for this to compile, you will in general need the -XLiberalTypeSynonyms extension (except if the constraint is an actual type class (like Manifold): only those can always be partially applied, for type constraints this is by default not allowed).

type HilbertSpace x = (LinearManifold x, InnerSpace x, Interior x ~ x, Needle x ~ x, DualSpace x ~ x, Floating (Scalar x)) Source

A Hilbert space is a complete inner product space. Being a vector space, it is also a manifold.

(Stricly speaking, that doesn't have much to do with the completeness criterion; but since Manifolds are at the moment confined to finite dimension, they are in fact (trivially) complete.)

type EuclidSpace x = (AffineManifold x, InnerSpace (Diff x), DualSpace (Diff x) ~ Diff x, Floating (Scalar (Diff x))) Source

An euclidean space is a real affine space whose tangent space is a Hilbert space.

Misc

palerp :: forall x. Manifold x => Interior x -> Interior x -> Option (Scalar (Needle x) -> x) Source

Interpolate between points, approximately linearly. For points that aren't close neighbours (i.e. lie in an almost flat region), the pathway is basically undefined – save for its end points.

A proper, really well-defined (on global scales) interpolation only makes sense on a Riemannian manifold, as geodesics. This is a task to be tackled in the future.

discretisePathIn Source

Arguments

:: WithField Manifold x 
=> Int

Limit the number of steps taken in either direction. Note this will not cap the resolution but length of the discretised path.

-> Region

Parameter interval of interest

-> RieMetric x

Inaccuracy allowance ε.

-> Differentiable x

Path specification.

-> [(, x)]

Trail of points along the path, such that a linear interpolation deviates nowhere by more as ε.

discretisePathSegs Source

Arguments

:: WithField Manifold x 
=> Int

Maximum number of path segments and/or points per segment.

-> RieMetric x

Inaccuracy allowance ε.

-> RWDiffable x

Path specification.

-> [[(, x)]]

Trail of points along the path, such that a linear interpolation deviates nowhere by more as ε.

analyseLocalBehaviour Source

Arguments

:: RWDiffable  
->

x₀ value.

-> Option ((, ), -> Option )

f x₀, derivative (i.e. Taylor-1-coefficient), and reverse propagation of O (δ²) bound.