{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE PatternSynonyms #-}
module Data.Manifold.Types (
Real0, Real1, RealPlus, Real2, Real3
, Sphere0, Sphere1, Sphere2
, Projective0, Projective1, Projective2
, Disk1, Disk2, Cone, OpenCone
, FibreBundle(..), TangentBundle
, EmptyMfd(..), ZeroDim(..)
, ℝ, ℝ⁰, ℝ¹, ℝ², ℝ³, ℝ⁴
, Stiefel1(..), stiefel1Project, stiefel1Embed
, HasUnitSphere(..)
, S⁰, S⁰_(..), S¹, S¹_(..), pattern S¹, S², S²_(..), pattern S²
, ℝP⁰, ℝP⁰_(..), ℝP¹, ℝP¹_(..), pattern ℝP¹, ℝP², ℝP²_(..), pattern ℝP²
, D¹, D¹_(..), D², D²_(..), pattern D²
, ℝay
, CD¹(..), Cℝay(..)
, Line(..), lineAsPlaneIntersection
, Cutplane(..), normalPlane
, fathomCutDistance, sideOfCut, cutPosBetween
, LinearMap, LocalLinear
, StiefelScalar
) where
import Data.VectorSpace
import Data.VectorSpace.Free
import Data.AffineSpace
import Data.MemoTrie (HasTrie(..))
import Data.Basis
import Data.Fixed
import Data.Tagged
import qualified Data.Vector.Generic as Arr
import qualified Data.Vector
import qualified Data.Vector.Unboxed as UArr
import Data.List (maximumBy)
import Data.Ord (comparing)
import Data.Manifold.Types.Primitive
import Data.Manifold.Types.Stiefel
import Data.Manifold.PseudoAffine
import Data.Manifold.Cone
import Math.LinearMap.Category
#if MIN_VERSION_linearmap_category(0,6,0)
import Math.VectorSpace.DimensionAware
#if MIN_VERSION_singletons(3,0,0)
import Prelude.Singletons (SNum(..))
import GHC.TypeLits.Singletons (withKnownNat, SNat(..))
#else
import Data.Singletons.Prelude.Num (SNum(..), SNat(..))
import Data.Singletons.TypeLits (withKnownNat)
#endif
#endif
#if MIN_VERSION_linearmap_category(0,5,0)
import Math.LinearMap.Coercion
#endif
import qualified Prelude
import GHC.TypeLits (type (+), type (-))
import qualified Data.Traversable as Hask
import Control.Category.Constrained.Prelude hiding ((^), type (+))
import Control.Arrow.Constrained
import Control.Monad.Constrained
import Data.Foldable.Constrained hiding (type (+))
import Data.Coerce
import Data.Type.Coercion
type StiefelScalar s = (RealFloat s, UArr.Unbox s)
#define deriveAffine(c,t) \
instance (c) => Semimanifold (t) where { \
type Needle (t) = Diff (t); \
(.+~^) = (.+^) }; \
instance (c) => PseudoAffine (t) where { \
a.-~.b = pure (a.-.b); \
a.-~!b = a.-.b }
newtype Stiefel1Needle v = Stiefel1Needle { forall v. Stiefel1Needle v -> Vector (Scalar v)
getStiefel1Tangent :: UArr.Vector (Scalar v) }
deriving instance (Eq (Scalar v), UArr.Unbox (Scalar v)) => Eq (Stiefel1Needle v)
newtype Stiefel1Basis v = Stiefel1Basis { forall v. Stiefel1Basis v -> Int
getStiefel1Basis :: Int }
s1bTrie :: ∀ v b. FiniteFreeSpace v => (Stiefel1Basis v->b) -> Stiefel1Basis v:->:b
s1bTrie :: forall v b.
FiniteFreeSpace v =>
(Stiefel1Basis v -> b) -> Stiefel1Basis v :->: b
s1bTrie = \Stiefel1Basis v -> b
f -> forall v a. Array a -> Stiefel1Basis v :->: a
St1BTrie forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Stiefel1Basis v -> b
f forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. Int -> Stiefel1Basis v
Stiefel1Basis) Vector Int
allIs
where d :: Int
d = forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
allIs :: Vector Int
allIs = forall (v :: * -> *) a. Vector v a => [a] -> v a
Arr.fromList [Int
0 .. Int
dforall a. Num a => a -> a -> a
-Int
2]
instance FiniteFreeSpace v => HasTrie (Stiefel1Basis v) where
data (Stiefel1Basis v :->: a) = St1BTrie ( Array a )
trie :: forall b. (Stiefel1Basis v -> b) -> Stiefel1Basis v :->: b
trie = forall v b.
FiniteFreeSpace v =>
(Stiefel1Basis v -> b) -> Stiefel1Basis v :->: b
s1bTrie; untrie :: forall b. (Stiefel1Basis v :->: b) -> Stiefel1Basis v -> b
untrie (St1BTrie Array b
a) (Stiefel1Basis Int
i) = Array b
a forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
Arr.! Int
i
enumerate :: forall b. (Stiefel1Basis v :->: b) -> [(Stiefel1Basis v, b)]
enumerate (St1BTrie Array b
a) = forall (v :: * -> *) a b.
Vector v a =>
(Int -> a -> b -> b) -> b -> v a -> b
Arr.ifoldr (\Int
i b
x [(Stiefel1Basis v, b)]
l -> (forall v. Int -> Stiefel1Basis v
Stiefel1Basis Int
i,b
x)forall a. a -> [a] -> [a]
:[(Stiefel1Basis v, b)]
l) [] Array b
a
type Array = Data.Vector.Vector
instance (FiniteFreeSpace v, UArr.Unbox (Scalar v))
=> AdditiveGroup(Stiefel1Needle v) where
Stiefel1Needle Vector (Scalar v)
v ^+^ :: Stiefel1Needle v -> Stiefel1Needle v -> Stiefel1Needle v
^+^ Stiefel1Needle Vector (Scalar v)
w = forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall n. (Num n, Unbox n) => Vector n -> Vector n -> Vector n
uarrAdd Vector (Scalar v)
v Vector (Scalar v)
w
Stiefel1Needle Vector (Scalar v)
v ^-^ :: Stiefel1Needle v -> Stiefel1Needle v -> Stiefel1Needle v
^-^ Stiefel1Needle Vector (Scalar v)
w = forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall n. (Num n, Unbox n) => Vector n -> Vector n -> Vector n
uarrSubtract Vector (Scalar v)
v Vector (Scalar v)
w
zeroV :: Stiefel1Needle v
zeroV = forall v. (FiniteFreeSpace v, Unbox (Scalar v)) => Stiefel1Needle v
s1nZ; negateV :: Stiefel1Needle v -> Stiefel1Needle v
negateV (Stiefel1Needle Vector (Scalar v)
v) = forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UArr.map forall a. Num a => a -> a
negate Vector (Scalar v)
v
uarrAdd :: (Num n, UArr.Unbox n) => UArr.Vector n -> UArr.Vector n -> UArr.Vector n
uarrAdd :: forall n. (Num n, Unbox n) => Vector n -> Vector n -> Vector n
uarrAdd = forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
UArr.zipWith forall a. Num a => a -> a -> a
(+)
uarrSubtract :: (Num n, UArr.Unbox n) => UArr.Vector n -> UArr.Vector n -> UArr.Vector n
uarrSubtract :: forall n. (Num n, Unbox n) => Vector n -> Vector n -> Vector n
uarrSubtract = forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
UArr.zipWith (-)
s1nZ :: ∀ v. (FiniteFreeSpace v, UArr.Unbox (Scalar v)) => Stiefel1Needle v
s1nZ :: forall v. (FiniteFreeSpace v, Unbox (Scalar v)) => Stiefel1Needle v
s1nZ = forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Unbox a => [a] -> Vector a
UArr.fromList forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Int -> a -> [a]
replicate (Int
dforall a. Num a => a -> a -> a
-Int
1) Scalar v
0
where d :: Int
d = forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
instance (FiniteFreeSpace v, UArr.Unbox (Scalar v)) => VectorSpace (Stiefel1Needle v) where
type Scalar (Stiefel1Needle v) = Scalar v
Scalar (Stiefel1Needle v)
μ *^ :: Scalar (Stiefel1Needle v) -> Stiefel1Needle v -> Stiefel1Needle v
*^ Stiefel1Needle Vector (Scalar v)
v = forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale Scalar (Stiefel1Needle v)
μ Vector (Scalar v)
v
uarrScale :: (Num n, UArr.Unbox n) => n -> UArr.Vector n -> UArr.Vector n
uarrScale :: forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale n
μ = forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UArr.map (forall a. Num a => a -> a -> a
*n
μ)
instance (FiniteFreeSpace v, UArr.Unbox (Scalar v)) => HasBasis (Stiefel1Needle v) where
type Basis (Stiefel1Needle v) = Stiefel1Basis v
basisValue :: Basis (Stiefel1Needle v) -> Stiefel1Needle v
basisValue = forall v b.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
Stiefel1Basis v -> Stiefel1Needle v
s1bV
decompose :: Stiefel1Needle v
-> [(Basis (Stiefel1Needle v), Scalar (Stiefel1Needle v))]
decompose (Stiefel1Needle Vector (Scalar v)
v) = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((,)forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.forall v. Int -> Stiefel1Basis v
Stiefel1Basis) [Int
0..] forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Unbox a => Vector a -> [a]
UArr.toList Vector (Scalar v)
v
decompose' :: Stiefel1Needle v
-> Basis (Stiefel1Needle v) -> Scalar (Stiefel1Needle v)
decompose' (Stiefel1Needle Vector (Scalar v)
v) (Stiefel1Basis Int
i) = Vector (Scalar v)
v forall a. Unbox a => Vector a -> Int -> a
UArr.! Int
i
s1bV :: ∀ v b. (FiniteFreeSpace v, UArr.Unbox (Scalar v))
=> Stiefel1Basis v -> Stiefel1Needle v
s1bV :: forall v b.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
Stiefel1Basis v -> Stiefel1Needle v
s1bV = \(Stiefel1Basis Int
i) -> forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Unbox a => [a] -> Vector a
UArr.fromList [ if Int
kforall a. Eq a => a -> a -> Bool
==Int
i then Scalar v
1 else Scalar v
0 | Int
k<-[Int
0..Int
dforall a. Num a => a -> a -> a
-Int
2] ]
where d :: Int
d = forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
instance (FiniteFreeSpace v, UArr.Unbox (Scalar v))
=> FiniteFreeSpace (Stiefel1Needle v) where
freeDimension :: forall (p :: * -> *). Functor p => p (Stiefel1Needle v) -> Int
freeDimension = forall v (p :: * -> *).
FiniteFreeSpace v =>
p (Stiefel1Needle v) -> Int
s1nD
toFullUnboxVect :: Unbox (Scalar (Stiefel1Needle v)) =>
Stiefel1Needle v -> Vector (Scalar (Stiefel1Needle v))
toFullUnboxVect = forall v. Stiefel1Needle v -> Vector (Scalar v)
getStiefel1Tangent
unsafeFromFullUnboxVect :: Unbox (Scalar (Stiefel1Needle v)) =>
Vector (Scalar (Stiefel1Needle v)) -> Stiefel1Needle v
unsafeFromFullUnboxVect = forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle
s1nD :: ∀ v p . FiniteFreeSpace v => p (Stiefel1Needle v) -> Int
s1nD :: forall v (p :: * -> *).
FiniteFreeSpace v =>
p (Stiefel1Needle v) -> Int
s1nD p (Stiefel1Needle v)
_ = forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v]) forall a. Num a => a -> a -> a
- Int
1
instance (FiniteFreeSpace v, UArr.Unbox (Scalar v)) => AffineSpace (Stiefel1Needle v) where
type Diff (Stiefel1Needle v) = Stiefel1Needle v
.+^ :: Stiefel1Needle v -> Diff (Stiefel1Needle v) -> Stiefel1Needle v
(.+^) = forall v. AdditiveGroup v => v -> v -> v
(^+^)
.-. :: Stiefel1Needle v -> Stiefel1Needle v -> Diff (Stiefel1Needle v)
(.-.) = forall v. AdditiveGroup v => v -> v -> v
(^-^)
deriveAffine((FiniteFreeSpace v, UArr.Unbox (Scalar v)), Stiefel1Needle v)
#if MIN_VERSION_linearmap_category(0,6,0)
type family ClipPred n where
ClipPred 0 = 0
ClipPred n = n-1
type family FmapClipPred n where
FmapClipPred ('Just n) = 'Just (ClipPred n)
FmapClipPred 'Nothing = 'Nothing
clipPredSing :: SNat n -> SNat (ClipPred n)
clipPredSing :: forall (n :: Natural). SNat n -> SNat (ClipPred n)
clipPredSing SNat n
_ = forall a. HasCallStack => a
undefined
instance ∀ v . (FiniteFreeSpace v, DimensionAware v, UArr.Unbox (Scalar v))
=> DimensionAware (Stiefel1Needle v) where
type StaticDimension (Stiefel1Needle v) = FmapClipPred (StaticDimension v)
dimensionalityWitness :: DimensionalityWitness (Stiefel1Needle v)
dimensionalityWitness = case forall v. DimensionAware v => DimensionalityWitness v
dimensionalityWitness @v of
DimensionalityWitness v
IsStaticDimensional -> forall (n :: Natural) r. Sing n -> (KnownNat n => r) -> r
withKnownNat (forall (n :: Natural). SNat n -> SNat (ClipPred n)
clipPredSing forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v (n :: Natural). Dimensional n v => Sing n
dimensionalitySing @v)
forall (n :: Natural) v. Dimensional n v => DimensionalityWitness v
IsStaticDimensional
DimensionalityWitness v
IsFlexibleDimensional -> forall v. (StaticDimension v ~ 'Nothing) => DimensionalityWitness v
IsFlexibleDimensional
instance ∀ v n n' . ( FiniteFreeSpace v, n`Dimensional`v, n' ~ ClipPred n
, UArr.Unbox (Scalar v) )
=> n'`Dimensional`(Stiefel1Needle v) where
knownDimensionalitySing :: Sing n'
knownDimensionalitySing = forall (n :: Natural). SNat n -> SNat (ClipPred n)
clipPredSing (forall v (n :: Natural). Dimensional n v => Sing n
dimensionalitySing @v)
#endif
instance ∀ v . (LSpace v, FiniteFreeSpace v, Eq (Scalar v), UArr.Unbox (Scalar v))
=> TensorSpace (Stiefel1Needle v) where
type TensorProduct (Stiefel1Needle v) w = Array w
scalarSpaceWitness :: ScalarSpaceWitness (Stiefel1Needle v)
scalarSpaceWitness = case forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness v of
ScalarSpaceWitness v
ScalarSpaceWitness -> forall v.
(Num' (Scalar v), Scalar (Scalar v) ~ Scalar v) =>
ScalarSpaceWitness v
ScalarSpaceWitness
linearManifoldWitness :: LinearManifoldWitness (Stiefel1Needle v)
linearManifoldWitness = forall v.
(Needle v ~ v, AffineSpace v, Diff v ~ v) =>
LinearManifoldWitness v
LinearManifoldWitness
zeroTensor :: forall w.
(TensorSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
Stiefel1Needle v ⊗ w
zeroTensor = forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a. Vector v a => Int -> a -> v a
Arr.replicate (forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v]) forall a. Num a => a -> a -> a
- Int
1) forall v. AdditiveGroup v => v
zeroV
toFlatTensor :: Stiefel1Needle v -+> (Stiefel1Needle v ⊗ Scalar (Stiefel1Needle v))
toFlatTensor = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
Arr.convert forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. Stiefel1Needle v -> Vector (Scalar v)
getStiefel1Tangent
fromFlatTensor :: (Stiefel1Needle v ⊗ Scalar (Stiefel1Needle v)) -+> Stiefel1Needle v
fromFlatTensor = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
Arr.convert forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w. Tensor s v w -> TensorProduct v w
getTensorProduct
addTensors :: forall w.
(TensorSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
(Stiefel1Needle v ⊗ w)
-> (Stiefel1Needle v ⊗ w) -> Stiefel1Needle v ⊗ w
addTensors (Tensor TensorProduct (Stiefel1Needle v) w
a) (Tensor TensorProduct (Stiefel1Needle v) w
b) = forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
Arr.zipWith forall v. AdditiveGroup v => v -> v -> v
(^+^) TensorProduct (Stiefel1Needle v) w
a TensorProduct (Stiefel1Needle v) w
b
subtractTensors :: forall w.
(TensorSpace (Stiefel1Needle v), TensorSpace w,
Scalar w ~ Scalar (Stiefel1Needle v)) =>
(Stiefel1Needle v ⊗ w)
-> (Stiefel1Needle v ⊗ w) -> Stiefel1Needle v ⊗ w
subtractTensors (Tensor TensorProduct (Stiefel1Needle v) w
a) (Tensor TensorProduct (Stiefel1Needle v) w
b) = forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
Arr.zipWith forall v. AdditiveGroup v => v -> v -> v
(^-^) TensorProduct (Stiefel1Needle v) w
a TensorProduct (Stiefel1Needle v) w
b
scaleTensor :: forall w.
(TensorSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
Bilinear
(Scalar (Stiefel1Needle v))
(Stiefel1Needle v ⊗ w)
(Stiefel1Needle v ⊗ w)
scaleTensor = forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Scalar v
μ (Tensor TensorProduct (Stiefel1Needle v) w
a) -> forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Arr.map (Scalar v
μforall v. VectorSpace v => Scalar v -> v -> v
*^) TensorProduct (Stiefel1Needle v) w
a
negateTensor :: forall w.
(TensorSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
(Stiefel1Needle v ⊗ w) -+> (Stiefel1Needle v ⊗ w)
negateTensor = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor TensorProduct (Stiefel1Needle v) w
a) -> forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Arr.map forall v. AdditiveGroup v => v -> v
negateV TensorProduct (Stiefel1Needle v) w
a
tensorProduct :: forall w.
(TensorSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
Bilinear (Stiefel1Needle v) w (Stiefel1Needle v ⊗ w)
tensorProduct = forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Stiefel1Needle Vector (Scalar v)
n) w
w
-> forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Arr.map (forall v. VectorSpace v => Scalar v -> v -> v
*^w
w) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
Arr.convert Vector (Scalar v)
n
transposeTensor :: forall w.
(TensorSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
(Stiefel1Needle v ⊗ w) -+> (w ⊗ Stiefel1Needle v)
transposeTensor = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor TensorProduct (Stiefel1Needle v) w
a) -> forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
Arr.foldl' forall v. AdditiveGroup v => v -> v -> v
(^+^) forall v. AdditiveGroup v => v
zeroV
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(Int -> a -> b) -> v a -> v b
Arr.imap ( \Int
i w
w -> (forall s v w. LinearFunction s v w -> v -> w
getLinearFunction forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear v w (v ⊗ w)
tensorProduct w
w) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Unbox a => Int -> (Int -> a) -> Vector a
UArr.generate Int
d (\Int
j -> if Int
iforall a. Eq a => a -> a -> Bool
==Int
j then Scalar v
1 else Scalar v
0) ) TensorProduct (Stiefel1Needle v) w
a
where d :: Int
d = forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v]) forall a. Num a => a -> a -> a
- Int
1
fmapTensor :: forall w x.
(TensorSpace w, TensorSpace x,
Scalar w ~ Scalar (Stiefel1Needle v),
Scalar x ~ Scalar (Stiefel1Needle v)) =>
Bilinear (w -+> x) (Stiefel1Needle v ⊗ w) (Stiefel1Needle v ⊗ x)
fmapTensor = forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \LinearFunction (Scalar v) w x
f (Tensor TensorProduct (Stiefel1Needle v) w
a) -> forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Arr.map (LinearFunction (Scalar v) w x
fforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$) TensorProduct (Stiefel1Needle v) w
a
fzipTensorWith :: forall u w x.
(TensorSpace u, TensorSpace w, TensorSpace x,
Scalar u ~ Scalar (Stiefel1Needle v),
Scalar w ~ Scalar (Stiefel1Needle v),
Scalar x ~ Scalar (Stiefel1Needle v)) =>
Bilinear
((w, x) -+> u)
(Stiefel1Needle v ⊗ w, Stiefel1Needle v ⊗ x)
(Stiefel1Needle v ⊗ u)
fzipTensorWith = forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \LinearFunction (Scalar v) (w, x) u
f (Tensor TensorProduct (Stiefel1Needle v) w
a, Tensor TensorProduct (Stiefel1Needle v) x
b)
-> forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
Arr.zipWith (forall (k :: * -> * -> *) a b c.
(Curry k, ObjectPair k a b, ObjectMorphism k b c) =>
k (a, b) c -> k a (k b c)
curry forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr LinearFunction (Scalar v) (w, x) u
f) TensorProduct (Stiefel1Needle v) w
a TensorProduct (Stiefel1Needle v) x
b
#if MIN_VERSION_linearmap_category(0,6,0)
coerceFmapTensorProduct :: forall (p :: * -> *) a b.
(Functor p, TensorSpace a, Scalar a ~ Scalar (Stiefel1Needle v),
TensorSpace b, Scalar b ~ Scalar (Stiefel1Needle v)) =>
p (Stiefel1Needle v)
-> VSCCoercion (Scalar (Stiefel1Needle v)) a b
-> Coercion
(TensorProduct (Stiefel1Needle v) a)
(TensorProduct (Stiefel1Needle v) b)
coerceFmapTensorProduct p (Stiefel1Needle v)
_ VSCCoercion (Scalar (Stiefel1Needle v)) a b
VSCCoercion = forall {k} (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
#elif MIN_VERSION_linearmap_category(0,5,0)
coerceFmapTensorProduct _ VSCCoercion = VSCCoercion
#endif
wellDefinedTensor :: forall w.
(TensorSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
(Stiefel1Needle v ⊗ w) -> Maybe (Stiefel1Needle v ⊗ w)
wellDefinedTensor (Tensor TensorProduct (Stiefel1Needle v) w
a) = forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse forall v. TensorSpace v => v -> Maybe v
wellDefinedVector TensorProduct (Stiefel1Needle v) w
a
infixr 0 +$>
(+$>) :: (LinearSpace a, TensorSpace b, Scalar a ~ s, Scalar b ~ s)
=> LinearMap s a b -> a -> b
+$> :: forall a b s.
(LinearSpace a, TensorSpace b, Scalar a ~ s, Scalar b ~ s) =>
LinearMap s a b -> a -> b
(+$>) = forall s v w. LinearFunction s v w -> v -> w
getLinearFunction forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w. LinearFunction s v w -> v -> w
getLinearFunction forall v w.
(LinearSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear (v +> w) v w
applyLinear
instance ∀ v . (LSpace v, FiniteFreeSpace v, Eq (Scalar v), UArr.Unbox (Scalar v))
=> LinearSpace (Stiefel1Needle v) where
type DualVector (Stiefel1Needle v) = Stiefel1Needle v
linearId :: Stiefel1Needle v +> Stiefel1Needle v
linearId = forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Arr.generate Int
d forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Int
i -> forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Arr.generate Int
d forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
\Int
j -> if Int
iforall a. Eq a => a -> a -> Bool
==Int
j then Scalar v
1 else Scalar v
0
where d :: Int
d = forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v]) forall a. Num a => a -> a -> a
- Int
1
tensorId :: forall w.
(LinearSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
(Stiefel1Needle v ⊗ w) +> (Stiefel1Needle v ⊗ w)
tensorId = forall w.
(LinearSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w
-> (Stiefel1Needle v ⊗ w) +> (Stiefel1Needle v ⊗ w)
ti forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where ti :: ∀ w . (LinearSpace w, Scalar w ~ Scalar v)
=> DualSpaceWitness w -> (Stiefel1Needle v ⊗ w) +> (Stiefel1Needle v ⊗ w)
ti :: forall w.
(LinearSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w
-> (Stiefel1Needle v ⊗ w) +> (Stiefel1Needle v ⊗ w)
ti DualSpaceWitness w
DualSpaceWitness = forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Arr.generate Int
d
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Int
i -> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \w
w -> forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Arr.generate Int
d forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
\Int
j -> if Int
iforall a. Eq a => a -> a -> Bool
==Int
j then w
w else forall v. AdditiveGroup v => v
zeroV) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ coerce :: forall a b. Coercible a b => a -> b
coerce (forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id :: w+>w)
d :: Int
d = forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v]) forall a. Num a => a -> a -> a
- Int
1
dualSpaceWitness :: DualSpaceWitness (Stiefel1Needle v)
dualSpaceWitness = case forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v of
DualSpaceWitness v
DualSpaceWitness -> forall v.
(LinearSpace (Scalar v), DualVector (Scalar v) ~ Scalar v,
LinearSpace (DualVector v), Scalar (DualVector v) ~ Scalar v,
DualVector (DualVector v) ~ v,
StaticDimension (DualVector v) ~ StaticDimension v) =>
DualSpaceWitness v
DualSpaceWitness
#if MIN_VERSION_linearmap_category(0,5,0)
coerceDoubleDual :: VSCCoercion
(Scalar (Stiefel1Needle v))
(Stiefel1Needle v)
(DualVector (DualVector (Stiefel1Needle v)))
coerceDoubleDual = forall a b s.
(Coercible a b, StaticDimension a ~ StaticDimension b) =>
VSCCoercion s a b
VSCCoercion
#else
coerceDoubleDual = Coercion
#endif
contractTensorMap :: forall w.
(TensorSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
(Stiefel1Needle v +> (Stiefel1Needle v ⊗ w)) -+> w
contractTensorMap = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap TensorProduct
(DualVector (Stiefel1Needle v))
(Tensor (Scalar v) (Stiefel1Needle v) w)
m)
-> forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
Arr.ifoldl' (\w
acc Int
i (Tensor TensorProduct (Stiefel1Needle v) w
t) -> w
acc forall v. AdditiveGroup v => v -> v -> v
^+^ TensorProduct (Stiefel1Needle v) w
t forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
Arr.! Int
i) forall v. AdditiveGroup v => v
zeroV TensorProduct
(DualVector (Stiefel1Needle v))
(Tensor (Scalar v) (Stiefel1Needle v) w)
m
contractMapTensor :: forall w.
(TensorSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
(Stiefel1Needle v ⊗ (Stiefel1Needle v +> w)) -+> w
contractMapTensor = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor TensorProduct
(Stiefel1Needle v) (LinearMap (Scalar v) (Stiefel1Needle v) w)
m)
-> forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
Arr.ifoldl' (\w
acc Int
i (LinearMap TensorProduct (DualVector (Stiefel1Needle v)) w
t) -> w
acc forall v. AdditiveGroup v => v -> v -> v
^+^ TensorProduct (DualVector (Stiefel1Needle v)) w
t forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
Arr.! Int
i) forall v. AdditiveGroup v => v
zeroV TensorProduct
(Stiefel1Needle v) (LinearMap (Scalar v) (Stiefel1Needle v) w)
m
contractLinearMapAgainst :: forall w.
(LinearSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
Bilinear
(Stiefel1Needle v +> w)
(w -+> Stiefel1Needle v)
(Scalar (Stiefel1Needle v))
contractLinearMapAgainst = forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap TensorProduct (DualVector (Stiefel1Needle v)) w
m) LinearFunction (Scalar v) w (Stiefel1Needle v)
f
-> forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
Arr.ifoldl' (\Scalar v
acc Int
i w
w -> case LinearFunction (Scalar v) w (Stiefel1Needle v)
f forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w
w of
Stiefel1Needle Vector (Scalar v)
n -> Vector (Scalar v)
n forall a. Unbox a => Vector a -> Int -> a
UArr.! Int
i ) Scalar v
0 TensorProduct (DualVector (Stiefel1Needle v)) w
m
applyDualVector :: LinearSpace (Stiefel1Needle v) =>
Bilinear
(DualVector (Stiefel1Needle v))
(Stiefel1Needle v)
(Scalar (Stiefel1Needle v))
applyDualVector = forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Stiefel1Needle Vector (Scalar v)
v) (Stiefel1Needle Vector (Scalar v)
w)
-> forall a. (Unbox a, Num a) => Vector a -> a
UArr.sum forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
UArr.zipWith forall a. Num a => a -> a -> a
(*) Vector (Scalar v)
v Vector (Scalar v)
w
applyLinear :: forall w.
(TensorSpace w, Scalar w ~ Scalar (Stiefel1Needle v)) =>
Bilinear (Stiefel1Needle v +> w) (Stiefel1Needle v) w
applyLinear = forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap TensorProduct (DualVector (Stiefel1Needle v)) w
m) (Stiefel1Needle Vector (Scalar v)
v)
-> forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
Arr.ifoldl' (\w
acc Int
i w
w -> w
acc forall v. AdditiveGroup v => v -> v -> v
^+^ Vector (Scalar v)
v forall a. Unbox a => Vector a -> Int -> a
UArr.! Int
i forall v. VectorSpace v => Scalar v -> v -> v
*^ w
w) forall v. AdditiveGroup v => v
zeroV TensorProduct (DualVector (Stiefel1Needle v)) w
m
applyTensorFunctional :: forall u.
(LinearSpace u, Scalar u ~ Scalar (Stiefel1Needle v)) =>
Bilinear
(DualVector (Stiefel1Needle v ⊗ u))
(Stiefel1Needle v ⊗ u)
(Scalar (Stiefel1Needle v))
applyTensorFunctional = forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap TensorProduct (DualVector (Stiefel1Needle v)) (DualVector u)
f) (Tensor TensorProduct (Stiefel1Needle v) u
t)
-> forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
Arr.ifoldl' (\Scalar v
acc Int
i DualVector u
u -> Scalar v
acc forall a. Num a => a -> a -> a
+ DualVector u
u forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^ TensorProduct (Stiefel1Needle v) u
t forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
Arr.! Int
i) Scalar v
0 TensorProduct (DualVector (Stiefel1Needle v)) (DualVector u)
f
applyTensorLinMap :: ∀ u w . ( LinearSpace u, Scalar u ~ Scalar v
, TensorSpace w, Scalar w ~ Scalar v )
=> Bilinear (LinearMap (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w)
(Tensor (Scalar v) (Stiefel1Needle v) u)
w
applyTensorLinMap :: forall u w.
(LinearSpace u, Scalar u ~ Scalar v, TensorSpace w,
Scalar w ~ Scalar v) =>
Bilinear
(LinearMap (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w)
(Tensor (Scalar v) (Stiefel1Needle v) u)
w
applyTensorLinMap = case forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @u of
DualSpaceWitness u
DualSpaceWitness -> forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(LinearMap TensorProduct
(DualVector (Tensor (Scalar v) (Stiefel1Needle v) u)) w
f) (Tensor TensorProduct (Stiefel1Needle v) u
t)
-> forall (v :: * -> *) b a.
Vector v b =>
(a -> Int -> b -> a) -> a -> v b -> a
Arr.ifoldl' (\w
w Int
i u
u -> w
w forall v. AdditiveGroup v => v -> v -> v
^+^ ((coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ TensorProduct
(DualVector (Tensor (Scalar v) (Stiefel1Needle v) u)) w
f forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
Arr.! Int
i) forall a b s.
(LinearSpace a, TensorSpace b, Scalar a ~ s, Scalar b ~ s) =>
LinearMap s a b -> a -> b
+$> u
u)) forall v. AdditiveGroup v => v
zeroV TensorProduct (Stiefel1Needle v) u
t
composeLinear :: forall w x.
(LinearSpace w, TensorSpace x,
Scalar w ~ Scalar (Stiefel1Needle v),
Scalar x ~ Scalar (Stiefel1Needle v)) =>
Bilinear (w +> x) (Stiefel1Needle v +> w) (Stiefel1Needle v +> x)
composeLinear = forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \LinearMap (Scalar v) w x
f (LinearMap TensorProduct (DualVector (Stiefel1Needle v)) w
g)
-> forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Arr.map (forall s v w. LinearFunction s v w -> v -> w
getLinearFunction forall v w.
(LinearSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear (v +> w) v w
applyLinear LinearMap (Scalar v) w x
fforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$) TensorProduct (DualVector (Stiefel1Needle v)) w
g
useTupleLinearSpaceComponents :: forall x y φ.
(Stiefel1Needle v ~ (x, y)) =>
((LinearSpace x, LinearSpace y, Scalar x ~ Scalar y) => φ) -> φ
useTupleLinearSpaceComponents (LinearSpace x, LinearSpace y, Scalar x ~ Scalar y) => φ
_ = forall a. HasCallStack => a
undefined
instance ∀ v .
( LinearSpace v, FiniteFreeSpace v, FiniteFreeSpace (DualVector v)
, StiefelScalar (Scalar v) ) => Semimanifold (Stiefel1 v) where
type Needle (Stiefel1 v) = Stiefel1Needle v
.+~^ :: Stiefel1 v -> Needle (Stiefel1 v) -> Stiefel1 v
(.+~^) = DualSpaceWitness v -> Stiefel1 v -> Stiefel1Needle v -> Stiefel1 v
tpst forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where tpst :: DualSpaceWitness v -> Stiefel1 v -> Stiefel1Needle v -> Stiefel1 v
tpst :: DualSpaceWitness v -> Stiefel1 v -> Stiefel1Needle v -> Stiefel1 v
tpst DualSpaceWitness v
DualSpaceWitness (Stiefel1 DualVector v
s) (Stiefel1Needle Vector (Scalar v)
n)
= forall v. DualVector v -> Stiefel1 v
Stiefel1 forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
Vector (Scalar v) -> v
unsafeFromFullUnboxVect forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale (forall a. Num a => a -> a
signum Scalar v
s'i)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ if| Scalar v
νforall a. Eq a => a -> a -> Bool
==Scalar v
0 -> Vector (Scalar (DualVector v))
s'
| Scalar v
νforall a. Ord a => a -> a -> Bool
<=Scalar v
2 -> let m :: Vector (Scalar v)
m = forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale Scalar v
ιmν Vector (Scalar v)
spro
forall n. (Num n, Unbox n) => Vector n -> Vector n -> Vector n
`uarrAdd` forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale ((Scalar v
1forall a. Num a => a -> a -> a
-forall a. Num a => a -> a
abs Scalar v
ιmν)forall a. Fractional a => a -> a -> a
/Scalar v
ν') Vector (Scalar v)
n
ιmν :: Scalar v
ιmν = Scalar v
1forall a. Num a => a -> a -> a
-Scalar v
ν
in Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
insi Scalar v
ιmν Vector (Scalar v)
m
| Bool
otherwise -> let m :: Vector (Scalar v)
m = forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale Scalar v
ιmν Vector (Scalar v)
spro
forall n. (Num n, Unbox n) => Vector n -> Vector n -> Vector n
`uarrAdd` forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale ((forall a. Num a => a -> a
abs Scalar v
ιmνforall a. Num a => a -> a -> a
-Scalar v
1)forall a. Fractional a => a -> a -> a
/Scalar v
ν') Vector (Scalar v)
n
ιmν :: Scalar v
ιmν = Scalar v
νforall a. Num a => a -> a -> a
-Scalar v
3
in Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
insi Scalar v
ιmν Vector (Scalar v)
m
where d :: Int
d = forall a. Unbox a => Vector a -> Int
UArr.length Vector (Scalar (DualVector v))
s'
s' :: Vector (Scalar (DualVector v))
s'= forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect DualVector v
s
ν' :: Scalar v
ν' = forall s. (Floating s, Unbox s) => Vector s -> s
l2norm Vector (Scalar v)
n
quop :: Scalar v
quop = forall a. Num a => a -> a
signum Scalar v
s'i forall a. Fractional a => a -> a -> a
/ Scalar v
ν'
ν :: Scalar v
ν = Scalar v
ν' forall a. Real a => a -> a -> a
`mod'` Scalar v
4
im :: Int
im = forall a. (Unbox a, Ord a) => Vector a -> Int
UArr.maxIndex forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UArr.map forall a. Num a => a -> a
abs Vector (Scalar (DualVector v))
s'
s'i :: Scalar v
s'i = Vector (Scalar (DualVector v))
s' forall a. Unbox a => Vector a -> Int -> a
UArr.! Int
im
spro :: Vector (Scalar v)
spro = let v :: Vector (Scalar v)
v = Vector (Scalar v) -> Vector (Scalar v)
deli Vector (Scalar (DualVector v))
s' in forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale (forall a. Fractional a => a -> a
recip Scalar v
s'i) Vector (Scalar v)
v
deli :: Vector (Scalar v) -> Vector (Scalar v)
deli Vector (Scalar v)
v = forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
Arr.take Int
im Vector (Scalar v)
v forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
Arr.++ forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
Arr.drop (Int
imforall a. Num a => a -> a -> a
+Int
1) Vector (Scalar v)
v
insi :: Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
insi Scalar v
ti Vector (Scalar v)
v = forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Arr.generate Int
d forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Int
i -> if | Int
iforall a. Ord a => a -> a -> Bool
<Int
im -> Vector (Scalar v)
v forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
Arr.! Int
i
| Int
iforall a. Ord a => a -> a -> Bool
>Int
im -> Vector (Scalar v)
v forall (v :: * -> *) a.
(HasCallStack, Vector v a) =>
v a -> Int -> a
Arr.! (Int
iforall a. Num a => a -> a -> a
-Int
1)
| Bool
otherwise -> Scalar v
ti
instance ∀ v .
( LinearSpace v, FiniteFreeSpace v, FiniteFreeSpace (DualVector v)
, StiefelScalar (Scalar v) ) => PseudoAffine (Stiefel1 v) where
Stiefel1 v
p.-~. :: Stiefel1 v -> Stiefel1 v -> Maybe (Needle (Stiefel1 v))
.-~.Stiefel1 v
q = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Stiefel1 v
pforall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!Stiefel1 v
q)
.-~! :: HasCallStack => Stiefel1 v -> Stiefel1 v -> Needle (Stiefel1 v)
(.-~!) = DualSpaceWitness v -> Stiefel1 v -> Stiefel1 v -> Stiefel1Needle v
dpst forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where dpst :: DualSpaceWitness v -> Stiefel1 v -> Stiefel1 v -> Stiefel1Needle v
dpst :: DualSpaceWitness v -> Stiefel1 v -> Stiefel1 v -> Stiefel1Needle v
dpst DualSpaceWitness v
DualSpaceWitness (Stiefel1 DualVector v
s) (Stiefel1 DualVector v
t)
= forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ case Vector (Scalar (DualVector v))
s' forall a. Unbox a => Vector a -> Int -> a
UArr.! Int
im of
Scalar v
0 -> forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale (forall a. Fractional a => a -> a
recip forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s. (Floating s, Unbox s) => Vector s -> s
l2norm Vector (Scalar v)
delis) Vector (Scalar v)
delis
Scalar v
s'i | Vector (Scalar v)
v <- forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale (forall a. Fractional a => a -> a
recip Scalar v
s'i) Vector (Scalar v)
delis forall n. (Num n, Unbox n) => Vector n -> Vector n -> Vector n
`uarrSubtract` Vector (Scalar v)
tpro
, Scalar v
absv <- forall s. (Floating s, Unbox s) => Vector s -> s
l2norm Vector (Scalar v)
v
, Scalar v
absv forall a. Ord a => a -> a -> Bool
> Scalar v
0
-> let μ :: Scalar v
μ = (forall a. Num a => a -> a
signum (Scalar v
t'iforall a. Fractional a => a -> a -> a
/Scalar v
s'i) forall a. Num a => a -> a -> a
- forall a. Fractional a => a -> a
recip(Scalar v
absv forall a. Num a => a -> a -> a
+ Scalar v
1)) forall a. Fractional a => a -> a -> a
/ Scalar v
absv
in forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale Scalar v
μ Vector (Scalar v)
v
| Scalar v
t'iforall a. Fractional a => a -> a -> a
/Scalar v
s'i forall a. Ord a => a -> a -> Bool
> Scalar v
0 -> Vector (Scalar v)
samePoint
| Bool
otherwise -> Vector (Scalar v)
antipode
where d :: Int
d = forall a. Unbox a => Vector a -> Int
UArr.length Vector (Scalar (DualVector v))
t'
s' :: Vector (Scalar (DualVector v))
s'= forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect DualVector v
s; t' :: Vector (Scalar (DualVector v))
t' = forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect DualVector v
t
im :: Int
im = forall a. (Unbox a, Ord a) => Vector a -> Int
UArr.maxIndex forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UArr.map forall a. Num a => a -> a
abs Vector (Scalar (DualVector v))
t'
t'i :: Scalar v
t'i = Vector (Scalar (DualVector v))
t' forall a. Unbox a => Vector a -> Int -> a
UArr.! Int
im
tpro :: Vector (Scalar v)
tpro = let v :: Vector (Scalar v)
v = Vector (Scalar v) -> Vector (Scalar v)
deli Vector (Scalar (DualVector v))
t' in forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale (forall a. Fractional a => a -> a
recip Scalar v
t'i) Vector (Scalar v)
v
delis :: Vector (Scalar v)
delis = Vector (Scalar v) -> Vector (Scalar v)
deli Vector (Scalar (DualVector v))
s'
deli :: Vector (Scalar v) -> Vector (Scalar v)
deli Vector (Scalar v)
v = forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
Arr.take Int
im Vector (Scalar v)
v forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
Arr.++ forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
Arr.drop (Int
imforall a. Num a => a -> a -> a
+Int
1) Vector (Scalar v)
v
samePoint :: Vector (Scalar v)
samePoint = forall a. Unbox a => Int -> a -> Vector a
UArr.replicate (Int
dforall a. Num a => a -> a -> a
-Int
1) Scalar v
0
antipode :: Vector (Scalar v)
antipode = (Int
dforall a. Num a => a -> a -> a
-Int
1) forall a. Unbox a => Int -> [a] -> Vector a
`UArr.fromListN` (Scalar v
2 forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat Scalar v
0)
l2norm :: (Floating s, UArr.Unbox s) => UArr.Vector s -> s
l2norm :: forall s. (Floating s, Unbox s) => Vector s -> s
l2norm = forall a. Floating a => a -> a
sqrt forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. (Unbox a, Num a) => Vector a -> a
UArr.sum forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UArr.map (forall a. Num a => a -> Int -> a
^Int
2)
data Line x = Line { forall x. Line x -> x
lineHandle :: x
, forall x. Line x -> Stiefel1 (Needle' x)
lineDirection :: Stiefel1 (Needle' x) }
data Cutplane x = Cutplane { forall x. Cutplane x -> x
sawHandle :: x
, forall x. Cutplane x -> Stiefel1 (Needle x)
cutNormal :: Stiefel1 (Needle x) }
deriving instance (Show x, Show (Needle' x)) => Show (Cutplane x)
normalPlane :: x
-> Needle' x
-> Cutplane x
normalPlane :: forall x. x -> Needle' x -> Cutplane x
normalPlane x
x Needle' x
n = forall x. x -> Stiefel1 (Needle x) -> Cutplane x
Cutplane x
x forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. DualVector v -> Stiefel1 v
Stiefel1 Needle' x
n
sideOfCut :: (WithField ℝ PseudoAffine x, LinearSpace (Needle x))
=> Cutplane x -> x -> Maybe S⁰
sideOfCut :: forall x.
(WithField ℝ PseudoAffine x, LinearSpace (Needle x)) =>
Cutplane x -> x -> Maybe S⁰
sideOfCut (Cutplane x
sh (Stiefel1 DualVector (Needle x)
cn)) x
p
= forall {a} {m :: * -> *} {r}.
(Num a, MonadPlus m, Ord a) =>
a -> m (S⁰_ r)
decideSide forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (DualVector (Needle x)
cnforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^) forall (m :: * -> *) (k :: * -> * -> *) a b.
(Monad m k, Object k a, Object k b, Object k (m a), Object k (m b),
Object k (m (m b))) =>
k a (m b) -> k (m a) (m b)
=<< x
pforall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
sh
where decideSide :: a -> m (S⁰_ r)
decideSide a
0 = forall (m :: * -> *) a. MonadZero m (->) => m a
mzero
decideSide a
μ | a
μ forall a. Ord a => a -> a -> Bool
> a
0 = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall r. S⁰_ r
PositiveHalfSphere
| Bool
otherwise = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall r. S⁰_ r
NegativeHalfSphere
fathomCutDistance :: ∀ x . (WithField ℝ PseudoAffine x, LinearSpace (Needle x))
=> Cutplane x
-> Metric' x
-> x
-> Maybe ℝ
fathomCutDistance :: forall x.
(WithField ℝ PseudoAffine x, LinearSpace (Needle x)) =>
Cutplane x -> Metric' x -> x -> Maybe ℝ
fathomCutDistance = DualSpaceWitness (Needle x)
-> Cutplane x -> Norm (Needle' x) -> x -> Maybe ℝ
fcd forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where fcd :: DualSpaceWitness (Needle x)
-> Cutplane x -> Norm (Needle' x) -> x -> Maybe ℝ
fcd (DualSpaceWitness (Needle x)
DualSpaceWitness :: DualSpaceWitness (Needle x))
(Cutplane x
sh (Stiefel1 Needle' x
cn)) Norm (Needle' x)
met
= \x
x -> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
Object t (f b)) =>
r a b -> t (f a) (f b)
fmap Needle x -> Scalar (Needle x)
fathom forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
x forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. x
sh
where fathom :: Needle x -> Scalar (Needle x)
fathom Needle x
v = (Needle' x
cn forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^ Needle x
v) forall a. Fractional a => a -> a -> a
/ Scalar (Needle' x)
scaleDist
scaleDist :: Scalar (Needle' x)
scaleDist = Norm (Needle' x)
metforall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|Needle' x
cn
cutPosBetween :: WithField ℝ Manifold x => Cutplane x -> (x,x) -> Maybe D¹
cutPosBetween :: forall x.
WithField ℝ Manifold x =>
Cutplane x -> (x, x) -> Maybe D¹
cutPosBetween (Cutplane x
h (Stiefel1 DualVector (Needle x)
cn)) (x
x₀,x
x₁)
| Just [Scalar (Needle x)
d₀,Scalar (Needle x)
d₁] <- forall a b. (a -> b) -> [a] -> [b]
map (DualVector (Needle x)
cnforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [x
x₀forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
h, x
x₁forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
h]
, Scalar (Needle x)
d₀forall a. Num a => a -> a -> a
*Scalar (Needle x)
d₁ forall a. Ord a => a -> a -> Bool
< Scalar (Needle x)
0 = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall r. r -> D¹_ r
D¹ forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Scalar (Needle x)
2 forall a. Num a => a -> a -> a
* Scalar (Needle x)
d₀ forall a. Fractional a => a -> a -> a
/ (Scalar (Needle x)
d₀ forall a. Num a => a -> a -> a
- Scalar (Needle x)
d₁) forall a. Num a => a -> a -> a
- Scalar (Needle x)
1
| Bool
otherwise = forall (f :: * -> *) a. Alternative f => f a
empty
lineAsPlaneIntersection :: ∀ x .
(WithField ℝ Manifold x, FiniteDimensional (Needle' x))
=> Line x -> [Cutplane x]
lineAsPlaneIntersection :: forall x.
(WithField ℝ Manifold x, FiniteDimensional (Needle' x)) =>
Line x -> [Cutplane x]
lineAsPlaneIntersection = DualSpaceWitness (Needle x) -> Line x -> [Cutplane x]
lapi forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where lapi :: DualSpaceWitness (Needle x) -> Line x -> [Cutplane x]
lapi (DualSpaceWitness (Needle x)
DualSpaceWitness :: DualSpaceWitness (Needle x)) (Line x
h (Stiefel1 DualVector (Needle' x)
dir))
= [ forall x. x -> Stiefel1 (Needle x) -> Cutplane x
Cutplane x
h forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall v. DualVector v -> Stiefel1 v
Stiefel1
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle' x
candidate forall v. AdditiveGroup v => v -> v -> v
^-^ Needle' x
worstCandidate forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* (ℝ
overlapforall a. Fractional a => a -> a -> a
/ℝ
worstOvlp)
| (Int
i, (Needle' x
candidate, ℝ
overlap)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Needle' x]
candidates [ℝ]
overlaps
, Int
i forall a. Eq a => a -> a -> Bool
/= Int
worstId ]
where candidates :: [Needle' x]
candidates = forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis forall v. FiniteDimensional v => SubBasis v
entireBasis
overlaps :: [ℝ]
overlaps = (forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^DualVector (Needle' x)
dir) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [Needle' x]
candidates
(Int
worstId, ℝ
worstOvlp) = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Num a => a -> a
abs forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ℝ]
overlaps
worstCandidate :: Needle' x
worstCandidate = [Needle' x]
candidates forall a. [a] -> Int -> a
!! Int
worstId