diff --git a/Math/LinearMap/Asserted.hs b/Math/LinearMap/Asserted.hs --- a/Math/LinearMap/Asserted.hs +++ b/Math/LinearMap/Asserted.hs @@ -28,6 +28,8 @@ import Data.VectorSpace import Data.Basis +import Math.Manifold.Core.PseudoAffine + import Prelude () import qualified Prelude as Hask @@ -37,6 +39,7 @@ import Data.Coerce import Data.Type.Coercion +import Data.Tagged import Data.VectorSpace.Free import qualified Linear.Matrix as Mat @@ -90,6 +93,14 @@ instance VectorSpace w => VectorSpace (LinearFunction s v w) where type Scalar (LinearFunction s v w) = Scalar w μ *^ LinearFunction f = LinearFunction $ (μ*^) . f +instance VectorSpace w => Semimanifold (LinearFunction s v w) where + type Needle (LinearFunction s v w) = LinearFunction s v w + toInterior = pure + fromInterior = id + (.+~^) = (^+^) + translateP = Tagged (^+^) +instance VectorSpace w => PseudoAffine (LinearFunction s v w) where + f.-~.g = return $ f^-^g instance Functor (LinearFunction s v) Coercion Coercion where fmap Coercion = Coercion diff --git a/Math/LinearMap/Category.hs b/Math/LinearMap/Category.hs --- a/Math/LinearMap/Category.hs +++ b/Math/LinearMap/Category.hs @@ -49,8 +49,8 @@ , normSpanningSystem , normSpanningSystem' -- ** Variances - , Variance, spanVariance, dualNorm - , dependence + , Variance, spanVariance, varianceSpanningSystem + , dualNorm, dualNorm', dependence -- ** Utility , densifyNorm -- * Solving linear equations @@ -78,9 +78,12 @@ , DualSpace, riesz, coRiesz, showsPrecAsRiesz, (.<) -- ** Constraint synonyms , HilbertSpace, SimpleSpace - , Num' + , Num'(..) , Fractional' , RealFrac', RealFloat' + -- ** Double-dual, scalar-scalar etc. identity + , ClosedScalarWitness(..), ScalarSpaceWitness(..), DualSpaceWitness(..) + , LinearManifoldWitness(..) -- ** Misc , relaxNorm, transformNorm, transformVariance , findNormalLength, normalLength @@ -203,7 +206,7 @@ -- | A linear map that simply projects from a dual vector in @u@ to a vector in @v@. -- -- @ --- (du-+|>v) u ≡ v ^* (du<.>^u) +-- (du '-+|>' v) u ≡ v '^*' (du '<.>^' u) -- @ infixr 7 -+|> (-+|>) :: ( EnhancedCat f (LinearFunction s) @@ -316,6 +319,12 @@ dualNorm :: SimpleSpace v => Norm v -> Variance v dualNorm = spanVariance . normSpanningSystem' +-- | 'dualNorm' in the opposite direction. This is actually self-inverse; +-- with 'dualSpaceWitness' you can replace each with the other direction. +dualNorm' :: ∀ v . SimpleSpace v => Variance v -> Norm v +dualNorm' = case dualSpaceWitness :: DualSpaceWitness v of + DualSpaceWitness -> spanNorm . normSpanningSystem' + transformNorm :: ∀ v w . (LSpace v, LSpace w, Scalar v~Scalar w) => (v+>w) -> Norm w -> Norm v transformNorm = case ( dualSpaceWitness :: DualSpaceWitness v @@ -559,6 +568,10 @@ => Seminorm v -> [v] normSpanningSystem' me = orthonormaliseFussily 0 me $ enumerateSubBasis entireBasis +-- | Inverse of 'spanVariance'. Equivalent to 'normSpanningSystem' on the dual space. +varianceSpanningSystem :: ∀ v . SimpleSpace v => Variance v -> [v] +varianceSpanningSystem = case dualSpaceWitness :: DualSpaceWitness v of + DualSpaceWitness -> normSpanningSystem -- | For any two norms, one can find a system of co-vectors that, with suitable -- coefficients, spans /either/ of them: if @shSys = sharedNormSpanningSystem n₀ n₁@, diff --git a/Math/LinearMap/Category/Class.hs b/Math/LinearMap/Category/Class.hs --- a/Math/LinearMap/Category/Class.hs +++ b/Math/LinearMap/Category/Class.hs @@ -26,6 +26,7 @@ module Math.LinearMap.Category.Class where import Data.VectorSpace +import Data.AffineSpace import Prelude () import qualified Prelude as Hask @@ -35,7 +36,9 @@ import Data.Coerce import Data.Type.Coercion +import Data.Tagged +import Math.Manifold.Core.PseudoAffine import Math.LinearMap.Asserted import Math.VectorSpace.ZeroDimensional @@ -48,8 +51,11 @@ data ScalarSpaceWitness v where ScalarSpaceWitness :: (Num' (Scalar v), Scalar (Scalar v) ~ Scalar v) => ScalarSpaceWitness v +data LinearManifoldWitness v where + LinearManifoldWitness :: (Needle v ~ v, AffineSpace v, Diff v ~ v) + => BoundarylessWitness v -> LinearManifoldWitness v -class (VectorSpace v) => TensorSpace v where +class (VectorSpace v, PseudoAffine v) => TensorSpace v where -- | The internal representation of a 'Tensor' product. -- -- For euclidean spaces, this is generally constructed by replacing each @s@ @@ -57,6 +63,7 @@ -- then a “nested vector” or, if @v@ is a @DualVector@ / “row vector”, a matrix. type TensorProduct v w :: * scalarSpaceWitness :: ScalarSpaceWitness v + linearManifoldWitness :: LinearManifoldWitness v zeroTensor :: (TensorSpace w, Scalar w ~ Scalar v) => v ⊗ w toFlatTensor :: v -+> (v ⊗ Scalar v) @@ -195,6 +202,7 @@ type TensorProduct (ZeroDim s) v = ZeroDim s scalarSpaceWitness = case closedScalarWitness :: ClosedScalarWitness s of ClosedScalarWitness -> ScalarSpaceWitness + linearManifoldWitness = LinearManifoldWitness BoundarylessWitness zeroTensor = Tensor Origin toFlatTensor = LinearFunction $ \Origin -> Tensor Origin fromFlatTensor = LinearFunction $ \(Tensor Origin) -> Origin @@ -305,6 +313,17 @@ , scalarSpaceWitness :: ScalarSpaceWitness w ) of (DualSpaceWitness, ScalarSpaceWitness) -> fromTensor $ (scaleTensor-+$>μ) -+$> asTensor $ v +instance ∀ v w s . (LinearSpace v, TensorSpace w, Scalar v~s, Scalar w~s) + => Semimanifold (LinearMap s v w) where + type Needle (LinearMap s v w) = LinearMap s v w + toInterior = pure + fromInterior = id + (.+~^) = (^+^) + translateP = Tagged (^+^) +instance ∀ v w s . (LinearSpace v, TensorSpace w, Scalar v~s, Scalar w~s) + => PseudoAffine (LinearMap s v w) where + f.-~.g = return $ f^-^g + (.-~!) = (^-^) instance (TensorSpace v, TensorSpace w, Scalar v~s, Scalar w~s) => AdditiveGroup (Tensor s v w) where @@ -316,6 +335,17 @@ => VectorSpace (Tensor s v w) where type Scalar (Tensor s v w) = s μ*^t = (scaleTensor-+$>μ)-+$>t +instance (TensorSpace v, TensorSpace w, Scalar v~s, Scalar w~s) + => Semimanifold (Tensor s v w) where + type Needle (Tensor s v w) = Tensor s v w + toInterior = pure + fromInterior = id + (.+~^) = (^+^) + translateP = Tagged (^+^) +instance (TensorSpace v, TensorSpace w, Scalar v~s, Scalar w~s) + => PseudoAffine (Tensor s v w) where + f.-~.g = return $ f^-^g + (.-~!) = (^-^) infixr 6 ⊕, >+<, <⊕ @@ -384,6 +414,11 @@ scalarSpaceWitness = case ( scalarSpaceWitness :: ScalarSpaceWitness u , scalarSpaceWitness :: ScalarSpaceWitness v ) of (ScalarSpaceWitness, ScalarSpaceWitness) -> ScalarSpaceWitness + linearManifoldWitness = case ( linearManifoldWitness :: LinearManifoldWitness u + , linearManifoldWitness :: LinearManifoldWitness v ) of + ( LinearManifoldWitness BoundarylessWitness + ,LinearManifoldWitness BoundarylessWitness ) + -> LinearManifoldWitness BoundarylessWitness zeroTensor = zeroTensor <⊕ zeroTensor scaleTensor = bilinearFunction $ \μ (Tensor (v,w)) -> Tensor ( (scaleTensor-+$>μ)-+$>v, (scaleTensor-+$>μ)-+$>w ) @@ -532,7 +567,14 @@ type TensorProduct (LinearMap s u v) w = TensorProduct (DualVector u) (Tensor s v w) scalarSpaceWitness = case ( scalarSpaceWitness :: ScalarSpaceWitness u , scalarSpaceWitness :: ScalarSpaceWitness v ) of - (ScalarSpaceWitness, ScalarSpaceWitness) -> ScalarSpaceWitness + (ScalarSpaceWitness, _ScalarSpaceWitness) -> ScalarSpaceWitness + linearManifoldWitness = case ( scalarSpaceWitness :: ScalarSpaceWitness u + , linearManifoldWitness :: LinearManifoldWitness u + , linearManifoldWitness :: LinearManifoldWitness v ) of + ( ScalarSpaceWitness + ,LinearManifoldWitness BoundarylessWitness + ,LinearManifoldWitness BoundarylessWitness ) + -> LinearManifoldWitness BoundarylessWitness zeroTensor = deferLinearMap $ zeroV toFlatTensor = case scalarSpaceWitness :: ScalarSpaceWitness u of ScalarSpaceWitness -> arr deferLinearMap . fmap toFlatTensor @@ -662,6 +704,11 @@ scalarSpaceWitness = case ( scalarSpaceWitness :: ScalarSpaceWitness u , scalarSpaceWitness :: ScalarSpaceWitness v ) of (ScalarSpaceWitness, ScalarSpaceWitness) -> ScalarSpaceWitness + linearManifoldWitness = case ( linearManifoldWitness :: LinearManifoldWitness u + , linearManifoldWitness :: LinearManifoldWitness v ) of + ( LinearManifoldWitness BoundarylessWitness + ,LinearManifoldWitness BoundarylessWitness ) + -> LinearManifoldWitness BoundarylessWitness zeroTensor = lassocTensor $ zeroTensor toFlatTensor = case scalarSpaceWitness :: ScalarSpaceWitness u of ScalarSpaceWitness -> arr lassocTensor . fmap toFlatTensor @@ -831,6 +878,11 @@ scalarSpaceWitness = case ( scalarSpaceWitness :: ScalarSpaceWitness u , scalarSpaceWitness :: ScalarSpaceWitness v ) of (ScalarSpaceWitness, ScalarSpaceWitness) -> ScalarSpaceWitness + linearManifoldWitness = case ( linearManifoldWitness :: LinearManifoldWitness u + , linearManifoldWitness :: LinearManifoldWitness v ) of + ( LinearManifoldWitness BoundarylessWitness + ,LinearManifoldWitness BoundarylessWitness ) + -> LinearManifoldWitness BoundarylessWitness zeroTensor = fromLinearFn $ const0 toFlatTensor = case scalarSpaceWitness :: ScalarSpaceWitness u of ScalarSpaceWitness -> fmap fromLinearFn $ applyDualVector @@ -921,3 +973,21 @@ $ sampleLinearFunctionFn -+$> exposeLinearFn . curryLinearMap $ f ) + +instance (TensorSpace u, TensorSpace v, s~Scalar u, s~Scalar v) + => AffineSpace (Tensor s u v) where + type Diff (Tensor s u v) = Tensor s u v + (.-.) = (^-^) + (.+^) = (^+^) +instance (LinearSpace u, TensorSpace v, s~Scalar u, s~Scalar v) + => AffineSpace (LinearMap s u v) where + type Diff (LinearMap s u v) = LinearMap s u v + (.-.) = (^-^) + (.+^) = (^+^) +instance (TensorSpace u, TensorSpace v, s~Scalar u, s~Scalar v) + => AffineSpace (LinearFunction s u v) where + type Diff (LinearFunction s u v) = LinearFunction s u v + (.-.) = (^-^) + (.+^) = (^+^) + + diff --git a/Math/LinearMap/Category/Instances.hs b/Math/LinearMap/Category/Instances.hs --- a/Math/LinearMap/Category/Instances.hs +++ b/Math/LinearMap/Category/Instances.hs @@ -25,6 +25,8 @@ import Data.VectorSpace import Data.Basis +import Math.Manifold.Core.PseudoAffine + import Prelude () import qualified Prelude as Hask @@ -33,6 +35,7 @@ import Data.Coerce import Data.Type.Coercion +import Data.Tagged import Data.Foldable (foldl') @@ -48,6 +51,7 @@ import Math.VectorSpace.ZeroDimensional +infixr 7 <.>^ (<.>^) :: LinearSpace v => DualVector v -> v -> Scalar v f<.>^v = (applyDualVector-+$>f)-+$>v @@ -60,6 +64,7 @@ instance TensorSpace ℝ where type TensorProduct ℝ w = w scalarSpaceWitness = ScalarSpaceWitness + linearManifoldWitness = LinearManifoldWitness BoundarylessWitness zeroTensor = Tensor zeroV scaleTensor = bilinearFunction $ \μ (Tensor t) -> Tensor $ μ*^t addTensors (Tensor v) (Tensor w) = Tensor $ v ^+^ w @@ -92,11 +97,19 @@ composeLinear = bilinearFunction $ \f (LinearMap g) -> LinearMap $ (applyLinear-+$>f)-+$>g -#define FreeLinearSpace(V, LV, tp, tenspl, tenid, dspan, contraction, contraaction) \ +#define FreeLinearSpace(V, LV, tp, tenspl, tenid, dspan, contraction, contraaction) \ +instance Num s => Semimanifold (V s) where { \ + type Needle (V s) = V s; \ + toInterior = pure; fromInterior = id; \ + (.+~^) = (^+^); \ + translateP = Tagged (^+^) }; \ +instance Num s => PseudoAffine (V s) where { \ + v.-~.w = pure (v^-^w); (.-~!) = (^-^) }; \ instance ∀ s . Num' s => TensorSpace (V s) where { \ type TensorProduct (V s) w = V w; \ scalarSpaceWitness = case closedScalarWitness :: ClosedScalarWitness s of{ \ ClosedScalarWitness -> ScalarSpaceWitness}; \ + linearManifoldWitness = LinearManifoldWitness BoundarylessWitness; \ zeroTensor = Tensor $ pure zeroV; \ addTensors (Tensor m) (Tensor n) = Tensor $ liftA2 (^+^) m n; \ subtractTensors (Tensor m) (Tensor n) = Tensor $ liftA2 (^-^) m n; \ @@ -234,22 +247,4 @@ - -instance (LSpace u, LSpace v, s~Scalar u, s~Scalar v) - => AffineSpace (Tensor s u v) where - type Diff (Tensor s u v) = Tensor s u v - (.-.) = (^-^) - (.+^) = (^+^) -instance (LSpace u, LSpace v, s~Scalar u, s~Scalar v) - => AffineSpace (LinearMap s u v) where - type Diff (LinearMap s u v) = LinearMap s u v - (.-.) = (^-^) - (.+^) = (^+^) -instance (LSpace u, LSpace v, s~Scalar u, s~Scalar v) - => AffineSpace (LinearFunction s u v) where - type Diff (LinearFunction s u v) = LinearFunction s u v - (.-.) = (^-^) - (.+^) = (^+^) - - diff --git a/Math/VectorSpace/ZeroDimensional.hs b/Math/VectorSpace/ZeroDimensional.hs --- a/Math/VectorSpace/ZeroDimensional.hs +++ b/Math/VectorSpace/ZeroDimensional.hs @@ -7,52 +7,11 @@ -- Stability : experimental -- Portability : portable -- -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE UnicodeSyntax #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE StandaloneDeriving #-} module Math.VectorSpace.ZeroDimensional ( ZeroDim (..) ) where -import Data.AffineSpace -import Data.VectorSpace -import Data.Basis -import Data.Void - +import Math.Manifold.VectorSpace.ZeroDimensional -data ZeroDim s = Origin - -instance Monoid (ZeroDim s) where - mempty = Origin - mappend Origin Origin = Origin - -instance AffineSpace (ZeroDim s) where - type Diff (ZeroDim s) = ZeroDim s - Origin .+^ Origin = Origin - Origin .-. Origin = Origin -instance AdditiveGroup (ZeroDim s) where - zeroV = Origin - Origin ^+^ Origin = Origin - negateV Origin = Origin -instance VectorSpace (ZeroDim s) where - type Scalar (ZeroDim s) = s - _ *^ Origin = Origin -instance HasBasis (ZeroDim s) where - type Basis (ZeroDim k) = Void - basisValue = absurd - decompose Origin = [] - decompose' Origin = absurd diff --git a/linearmap-category.cabal b/linearmap-category.cabal --- a/linearmap-category.cabal +++ b/linearmap-category.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: linearmap-category -version: 0.2.0.0 +version: 0.3.0.1 synopsis: Native, complete, matrix-free linear algebra. description: The term /numerical linear algebra/ is often used almost synonymous with /matrix modifications/. However, what's interesting @@ -49,8 +49,10 @@ vector-space >=0.10 && <0.11, constrained-categories >=0.3 && <0.4, containers, vector, + tagged, free-vector-spaces >= 0.1.1 && < 0.2, linear, lens, + manifolds-core >= 0.4 && < 0.5, semigroups, ieee754 >= 0.7 && < 0.9 -- hs-source-dirs: