-- |
-- Module      : Data.Manifold.Types
-- Copyright   : (c) Justus Sagemüller 2015
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 
-- Several commonly-used manifolds, represented in some simple way as Haskell
-- data types. All these are in the 'PseudoAffine' class.


{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE UndecidableInstances     #-}
{-# 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 ScopedTypeVariables      #-}
{-# LANGUAGE UnicodeSyntax            #-}
{-# LANGUAGE PatternSynonyms          #-}


module Data.Manifold.Types (
        -- * Index / ASCII names
          Real0, Real1, RealPlus, Real2, Real3
        , Sphere0, Sphere1, Sphere2
        , Projective0, Projective1, Projective2
        , Disk1, Disk2, Cone, OpenCone
        , FibreBundle(..), TangentBundle
        -- * Trivial manifolds
        , EmptyMfd(..), ZeroDim(..)
        -- * Linear manifolds
        , ℝ, ℝ⁰, ℝ¹, ℝ², ℝ³, ℝ⁴
        -- * Hyperspheres
        -- ** General form: Stiefel manifolds
        , Stiefel1(..), stiefel1Project, stiefel1Embed
        -- ** Specific examples
        , HasUnitSphere(..)
        , S⁰, S⁰_(..), S¹, S¹_(..), pattern S¹, S², S²_(..), pattern S²
        -- * Projective spaces
        , ℝP⁰, ℝP⁰_(..), ℝP¹, ℝP¹_(..), pattern ℝP¹,  ℝP²,  ℝP²_(..), pattern ℝP²
        -- * Intervals\/disks\/cones
        , D¹, D¹_(..), D², D²_(..), pattern D²
        , ℝay
        , CD¹(..), Cℝay(..)
        -- * Affine subspaces
        -- ** Lines
        , Line(..), lineAsPlaneIntersection
        -- ** Hyperplanes
        , Cutplane(..), normalPlane
        , fathomCutDistance, sideOfCut, cutPosBetween
        -- * Linear mappings
        , LinearMap, LocalLinear
        -- * Misc
        , 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

import qualified Prelude
import qualified Data.Traversable as Hask

import Control.Category.Constrained.Prelude hiding ((^))
import Control.Arrow.Constrained
import Control.Monad.Constrained
import Data.Foldable.Constrained

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 { 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 { Stiefel1Basis v -> Int
getStiefel1Basis :: Int }
s1bTrie :: ∀ v b. FiniteFreeSpace v => (Stiefel1Basis v->b) -> Stiefel1Basis v:->:b
s1bTrie :: (Stiefel1Basis v -> b) -> Stiefel1Basis v :->: b
s1bTrie = \Stiefel1Basis v -> b
f -> Array b -> Stiefel1Basis v :->: b
forall v a. Array a -> Stiefel1Basis v :->: a
St1BTrie (Array b -> Stiefel1Basis v :->: b)
-> Array b -> Stiefel1Basis v :->: b
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Int -> b) -> Vector Int -> Array 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 (Stiefel1Basis v -> b) -> (Int -> Stiefel1Basis v) -> Int -> b
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
. Int -> Stiefel1Basis v
forall v. Int -> Stiefel1Basis v
Stiefel1Basis) Vector Int
allIs
 where d :: Int
d = [v] -> Int
forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])
       allIs :: Vector Int
allIs = [Int] -> Vector Int
forall (v :: * -> *) a. Vector v a => [a] -> v a
Arr.fromList [Int
0 .. Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2]

instance FiniteFreeSpace v => HasTrie (Stiefel1Basis v) where
  data (Stiefel1Basis v :->: a) = St1BTrie ( Array a )
  trie :: (Stiefel1Basis v -> b) -> Stiefel1Basis v :->: b
trie = (Stiefel1Basis v -> b) -> Stiefel1Basis v :->: b
forall v b.
FiniteFreeSpace v =>
(Stiefel1Basis v -> b) -> Stiefel1Basis v :->: b
s1bTrie; untrie :: (Stiefel1Basis v :->: b) -> Stiefel1Basis v -> b
untrie (St1BTrie a) (Stiefel1Basis Int
i) = Array b
a Array b -> Int -> b
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
Arr.! Int
i
  enumerate :: (Stiefel1Basis v :->: b) -> [(Stiefel1Basis v, b)]
enumerate (St1BTrie a) = (Int -> b -> [(Stiefel1Basis v, b)] -> [(Stiefel1Basis v, b)])
-> [(Stiefel1Basis v, b)] -> Vector b -> [(Stiefel1Basis v, b)]
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 -> (Int -> Stiefel1Basis v
forall v. Int -> Stiefel1Basis v
Stiefel1Basis Int
i,b
x)(Stiefel1Basis v, b)
-> [(Stiefel1Basis v, b)] -> [(Stiefel1Basis v, b)]
forall a. a -> [a] -> [a]
:[(Stiefel1Basis v, b)]
l) [] Vector 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 = Vector (Scalar v) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle (Vector (Scalar v) -> Stiefel1Needle v)
-> Vector (Scalar v) -> Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Vector (Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
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 = Vector (Scalar v) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle (Vector (Scalar v) -> Stiefel1Needle v)
-> Vector (Scalar v) -> Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Vector (Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
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 = Stiefel1Needle v
forall v. (FiniteFreeSpace v, Unbox (Scalar v)) => Stiefel1Needle v
s1nZ; negateV :: Stiefel1Needle v -> Stiefel1Needle v
negateV (Stiefel1Needle Vector (Scalar v)
v) = Vector (Scalar v) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle (Vector (Scalar v) -> Stiefel1Needle v)
-> Vector (Scalar v) -> Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Scalar v -> Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UArr.map Scalar v -> Scalar v
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 :: Vector n -> Vector n -> Vector n
uarrAdd = (n -> n -> n) -> Vector n -> Vector n -> Vector n
forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
UArr.zipWith n -> n -> n
forall a. Num a => a -> a -> a
(+)
uarrSubtract :: (Num n, UArr.Unbox n) => UArr.Vector n -> UArr.Vector n -> UArr.Vector n
uarrSubtract :: Vector n -> Vector n -> Vector n
uarrSubtract = (n -> n -> n) -> Vector n -> Vector n -> Vector n
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 :: Stiefel1Needle v
s1nZ = Vector (Scalar v) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle (Vector (Scalar v) -> Stiefel1Needle v)
-> ([Scalar v] -> Vector (Scalar v))
-> [Scalar v]
-> Stiefel1Needle v
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
. [Scalar v] -> Vector (Scalar v)
forall a. Unbox a => [a] -> Vector a
UArr.fromList ([Scalar v] -> Stiefel1Needle v) -> [Scalar v] -> Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> Scalar v -> [Scalar v]
forall a. Int -> a -> [a]
replicate (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Scalar v
0
 where d :: Int
d = [v] -> Int
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 = Vector (Scalar v) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle (Vector (Scalar v) -> Stiefel1Needle v)
-> Vector (Scalar v) -> Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale Scalar v
Scalar (Stiefel1Needle v)
μ Vector (Scalar v)
v

uarrScale :: (Num n, UArr.Unbox n) => n -> UArr.Vector n -> UArr.Vector n
uarrScale :: n -> Vector n -> Vector n
uarrScale n
μ = (n -> n) -> Vector n -> Vector n
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UArr.map (n -> n -> n
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 = Basis (Stiefel1Needle v) -> Stiefel1Needle v
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) = (Int -> Scalar v -> (Stiefel1Basis v, Scalar v))
-> [Int] -> [Scalar v] -> [(Stiefel1Basis v, Scalar v)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((,)(Stiefel1Basis v -> Scalar v -> (Stiefel1Basis v, Scalar v))
-> (Int -> Stiefel1Basis v)
-> Int
-> Scalar v
-> (Stiefel1Basis v, Scalar v)
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
.Int -> Stiefel1Basis v
forall v. Int -> Stiefel1Basis v
Stiefel1Basis) [Int
0..] ([Scalar v] -> [(Stiefel1Basis v, Scalar v)])
-> [Scalar v] -> [(Stiefel1Basis v, Scalar v)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Vector (Scalar v) -> [Scalar v]
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 i) = Vector (Scalar v)
v Vector (Scalar v) -> Int -> Scalar 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 :: Stiefel1Basis v -> Stiefel1Needle v
s1bV = \(Stiefel1Basis Int
i) -> Vector (Scalar v) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle
            (Vector (Scalar v) -> Stiefel1Needle v)
-> Vector (Scalar v) -> Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Scalar v] -> Vector (Scalar v)
forall a. Unbox a => [a] -> Vector a
UArr.fromList [ if Int
kInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
i then Scalar v
1 else Scalar v
0 | Int
k<-[Int
0..Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2] ]
 where d :: Int
d = [v] -> Int
forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v])

instance (FiniteFreeSpace v, UArr.Unbox (Scalar v))
                      => FiniteFreeSpace (Stiefel1Needle v) where
  freeDimension :: p (Stiefel1Needle v) -> Int
freeDimension = p (Stiefel1Needle v) -> Int
forall v (p :: * -> *).
FiniteFreeSpace v =>
p (Stiefel1Needle v) -> Int
s1nD
  toFullUnboxVect :: Stiefel1Needle v -> Vector (Scalar (Stiefel1Needle v))
toFullUnboxVect = Stiefel1Needle v -> Vector (Scalar (Stiefel1Needle v))
forall v. Stiefel1Needle v -> Vector (Scalar v)
getStiefel1Tangent
  unsafeFromFullUnboxVect :: Vector (Scalar (Stiefel1Needle v)) -> Stiefel1Needle v
unsafeFromFullUnboxVect = Vector (Scalar (Stiefel1Needle v)) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle
s1nD :: ∀ v p . FiniteFreeSpace v => p (Stiefel1Needle v) -> Int
s1nD :: p (Stiefel1Needle v) -> Int
s1nD p (Stiefel1Needle v)
_ = [v] -> Int
forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v]) Int -> Int -> Int
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
(.+^) = Stiefel1Needle v -> Diff (Stiefel1Needle v) -> Stiefel1Needle v
forall v. AdditiveGroup v => v -> v -> v
(^+^)
  .-. :: Stiefel1Needle v -> Stiefel1Needle v -> Diff (Stiefel1Needle v)
(.-.) = Stiefel1Needle v -> Stiefel1Needle v -> Diff (Stiefel1Needle v)
forall v. AdditiveGroup v => v -> v -> v
(^-^)

deriveAffine((FiniteFreeSpace v, UArr.Unbox (Scalar v)), Stiefel1Needle v)

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 ScalarSpaceWitness v
forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness :: ScalarSpaceWitness v of
         ScalarSpaceWitness v
ScalarSpaceWitness -> ScalarSpaceWitness (Stiefel1Needle v)
forall v.
(Num' (Scalar v), Scalar (Scalar v) ~ Scalar v) =>
ScalarSpaceWitness v
ScalarSpaceWitness
  linearManifoldWitness :: LinearManifoldWitness (Stiefel1Needle v)
linearManifoldWitness = LinearManifoldWitness (Stiefel1Needle v)
forall v.
(Needle v ~ v, AffineSpace v, Diff v ~ v) =>
LinearManifoldWitness v
LinearManifoldWitness
  zeroTensor :: Stiefel1Needle v ⊗ w
zeroTensor = Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> w -> Array w
forall (v :: * -> *) a. Vector v a => Int -> a -> v a
Arr.replicate ([v] -> Int
forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v]) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) w
forall v. AdditiveGroup v => v
zeroV
  toFlatTensor :: Stiefel1Needle v -+> (Stiefel1Needle v ⊗ Scalar (Stiefel1Needle v))
toFlatTensor = (Stiefel1Needle v
 -> Tensor (Scalar v) (Stiefel1Needle v) (Scalar v))
-> LinearFunction
     (Scalar v)
     (Stiefel1Needle v)
     (Tensor (Scalar v) (Stiefel1Needle v) (Scalar v))
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Stiefel1Needle v
  -> Tensor (Scalar v) (Stiefel1Needle v) (Scalar v))
 -> LinearFunction
      (Scalar v)
      (Stiefel1Needle v)
      (Tensor (Scalar v) (Stiefel1Needle v) (Scalar v)))
-> (Stiefel1Needle v
    -> Tensor (Scalar v) (Stiefel1Needle v) (Scalar v))
-> LinearFunction
     (Scalar v)
     (Stiefel1Needle v)
     (Tensor (Scalar v) (Stiefel1Needle v) (Scalar v))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Array (Scalar v) -> Tensor (Scalar v) (Stiefel1Needle v) (Scalar v)
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array (Scalar v)
 -> Tensor (Scalar v) (Stiefel1Needle v) (Scalar v))
-> (Stiefel1Needle v -> Array (Scalar v))
-> Stiefel1Needle v
-> Tensor (Scalar v) (Stiefel1Needle v) (Scalar v)
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
. Vector (Scalar v) -> Array (Scalar v)
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
Arr.convert (Vector (Scalar v) -> Array (Scalar v))
-> (Stiefel1Needle v -> Vector (Scalar v))
-> Stiefel1Needle v
-> Array (Scalar v)
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
. Stiefel1Needle v -> Vector (Scalar v)
forall v. Stiefel1Needle v -> Vector (Scalar v)
getStiefel1Tangent
  fromFlatTensor :: (Stiefel1Needle v ⊗ Scalar (Stiefel1Needle v)) -+> Stiefel1Needle v
fromFlatTensor = (Tensor (Scalar v) (Stiefel1Needle v) (Scalar v)
 -> Stiefel1Needle v)
-> LinearFunction
     (Scalar v)
     (Tensor (Scalar v) (Stiefel1Needle v) (Scalar v))
     (Stiefel1Needle v)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Tensor (Scalar v) (Stiefel1Needle v) (Scalar v)
  -> Stiefel1Needle v)
 -> LinearFunction
      (Scalar v)
      (Tensor (Scalar v) (Stiefel1Needle v) (Scalar v))
      (Stiefel1Needle v))
-> (Tensor (Scalar v) (Stiefel1Needle v) (Scalar v)
    -> Stiefel1Needle v)
-> LinearFunction
     (Scalar v)
     (Tensor (Scalar v) (Stiefel1Needle v) (Scalar v))
     (Stiefel1Needle v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Vector (Scalar v) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle (Vector (Scalar v) -> Stiefel1Needle v)
-> (Tensor (Scalar v) (Stiefel1Needle v) (Scalar v)
    -> Vector (Scalar v))
-> Tensor (Scalar v) (Stiefel1Needle v) (Scalar v)
-> Stiefel1Needle v
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
. Array (Scalar v) -> Vector (Scalar v)
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
Arr.convert (Array (Scalar v) -> Vector (Scalar v))
-> (Tensor (Scalar v) (Stiefel1Needle v) (Scalar v)
    -> Array (Scalar v))
-> Tensor (Scalar v) (Stiefel1Needle v) (Scalar v)
-> Vector (Scalar v)
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
. Tensor (Scalar v) (Stiefel1Needle v) (Scalar v) -> Array (Scalar v)
forall s v w. Tensor s v w -> TensorProduct v w
getTensorProduct
  addTensors :: (Stiefel1Needle v ⊗ w)
-> (Stiefel1Needle v ⊗ w) -> Stiefel1Needle v ⊗ w
addTensors (Tensor TensorProduct (Stiefel1Needle v) w
a) (Tensor TensorProduct (Stiefel1Needle v) w
b) = Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w -> w -> w) -> Array w -> Array w -> Array w
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 w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
(^+^) Array w
TensorProduct (Stiefel1Needle v) w
a Array w
TensorProduct (Stiefel1Needle v) w
b
  subtractTensors :: (Stiefel1Needle v ⊗ w)
-> (Stiefel1Needle v ⊗ w) -> Stiefel1Needle v ⊗ w
subtractTensors (Tensor TensorProduct (Stiefel1Needle v) w
a) (Tensor TensorProduct (Stiefel1Needle v) w
b) = Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w -> w -> w) -> Array w -> Array w -> Array w
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 w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
(^-^) Array w
TensorProduct (Stiefel1Needle v) w
a Array w
TensorProduct (Stiefel1Needle v) w
b
  scaleTensor :: Bilinear
  (Scalar (Stiefel1Needle v))
  (Stiefel1Needle v ⊗ w)
  (Stiefel1Needle v ⊗ w)
scaleTensor = (Scalar v
 -> Tensor (Scalar v) (Stiefel1Needle v) w
 -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> LinearFunction
     (Scalar (Scalar v))
     (Scalar v)
     (LinearFunction
        (Scalar (Scalar v))
        (Tensor (Scalar v) (Stiefel1Needle v) w)
        (Tensor (Scalar v) (Stiefel1Needle v) w))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((Scalar v
  -> Tensor (Scalar v) (Stiefel1Needle v) w
  -> Tensor (Scalar v) (Stiefel1Needle v) w)
 -> LinearFunction
      (Scalar (Scalar v))
      (Scalar v)
      (LinearFunction
         (Scalar (Scalar v))
         (Tensor (Scalar v) (Stiefel1Needle v) w)
         (Tensor (Scalar v) (Stiefel1Needle v) w)))
-> (Scalar v
    -> Tensor (Scalar v) (Stiefel1Needle v) w
    -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> LinearFunction
     (Scalar (Scalar v))
     (Scalar v)
     (LinearFunction
        (Scalar (Scalar v))
        (Tensor (Scalar v) (Stiefel1Needle v) w)
        (Tensor (Scalar v) (Stiefel1Needle v) w))
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) -> Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w -> w) -> Array w -> Array w
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Arr.map (Scalar v
Scalar w
μScalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
*^) Array w
TensorProduct (Stiefel1Needle v) w
a
  negateTensor :: (Stiefel1Needle v ⊗ w) -+> (Stiefel1Needle v ⊗ w)
negateTensor = (Tensor (Scalar v) (Stiefel1Needle v) w
 -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> LinearFunction
     (Scalar v)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Tensor (Scalar v) (Stiefel1Needle v) w
  -> Tensor (Scalar v) (Stiefel1Needle v) w)
 -> LinearFunction
      (Scalar v)
      (Tensor (Scalar v) (Stiefel1Needle v) w)
      (Tensor (Scalar v) (Stiefel1Needle v) w))
-> (Tensor (Scalar v) (Stiefel1Needle v) w
    -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> LinearFunction
     (Scalar v)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor TensorProduct (Stiefel1Needle v) w
a) -> Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w -> w) -> Array w -> Array w
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Arr.map w -> w
forall v. AdditiveGroup v => v -> v
negateV Array w
TensorProduct (Stiefel1Needle v) w
a
  tensorProduct :: Bilinear (Stiefel1Needle v) w (Stiefel1Needle v ⊗ w)
tensorProduct = (Stiefel1Needle v -> w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> LinearFunction
     (Scalar v)
     (Stiefel1Needle v)
     (LinearFunction
        (Scalar v) w (Tensor (Scalar v) (Stiefel1Needle v) w))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((Stiefel1Needle v -> w -> Tensor (Scalar v) (Stiefel1Needle v) w)
 -> LinearFunction
      (Scalar v)
      (Stiefel1Needle v)
      (LinearFunction
         (Scalar v) w (Tensor (Scalar v) (Stiefel1Needle v) w)))
-> (Stiefel1Needle v
    -> w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> LinearFunction
     (Scalar v)
     (Stiefel1Needle v)
     (LinearFunction
        (Scalar v) w (Tensor (Scalar v) (Stiefel1Needle v) w))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Stiefel1Needle Vector (Scalar v)
n) w
w
                        -> Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Scalar v -> w) -> Array (Scalar v) -> Array w
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Arr.map (Scalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
*^w
w) (Array (Scalar v) -> Array w) -> Array (Scalar v) -> Array w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Vector (Scalar v) -> Array (Scalar v)
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
Arr.convert Vector (Scalar v)
n
  transposeTensor :: (Stiefel1Needle v ⊗ w) -+> (w ⊗ Stiefel1Needle v)
transposeTensor = (Tensor (Scalar v) (Stiefel1Needle v) w -> w ⊗ Stiefel1Needle v)
-> LinearFunction
     (Scalar v)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
     (w ⊗ Stiefel1Needle v)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Tensor (Scalar v) (Stiefel1Needle v) w -> w ⊗ Stiefel1Needle v)
 -> LinearFunction
      (Scalar v)
      (Tensor (Scalar v) (Stiefel1Needle v) w)
      (w ⊗ Stiefel1Needle v))
-> (Tensor (Scalar v) (Stiefel1Needle v) w -> w ⊗ Stiefel1Needle v)
-> LinearFunction
     (Scalar v)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
     (w ⊗ Stiefel1Needle v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Tensor TensorProduct (Stiefel1Needle v) w
a) -> ((w ⊗ Stiefel1Needle v)
 -> (w ⊗ Stiefel1Needle v) -> w ⊗ Stiefel1Needle v)
-> (w ⊗ Stiefel1Needle v)
-> Vector (w ⊗ Stiefel1Needle v)
-> w ⊗ Stiefel1Needle v
forall (v :: * -> *) b a.
Vector v b =>
(a -> b -> a) -> a -> v b -> a
Arr.foldl' (w ⊗ Stiefel1Needle v)
-> (w ⊗ Stiefel1Needle v) -> w ⊗ Stiefel1Needle v
forall v. AdditiveGroup v => v -> v -> v
(^+^) w ⊗ Stiefel1Needle v
forall v. AdditiveGroup v => v
zeroV
       (Vector (w ⊗ Stiefel1Needle v) -> w ⊗ Stiefel1Needle v)
-> Vector (w ⊗ Stiefel1Needle v) -> w ⊗ Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Int -> w -> w ⊗ Stiefel1Needle v)
-> Vector w -> Vector (w ⊗ Stiefel1Needle v)
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(Int -> a -> b) -> v a -> v b
Arr.imap ( \Int
i w
w -> (LinearFunction
  (Scalar v)
  w
  (LinearFunction
     (Scalar w) (Stiefel1Needle v) (w ⊗ Stiefel1Needle v))
-> w
-> LinearFunction
     (Scalar w) (Stiefel1Needle v) (w ⊗ Stiefel1Needle v)
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction LinearFunction
  (Scalar v)
  w
  (LinearFunction
     (Scalar w) (Stiefel1Needle v) (w ⊗ Stiefel1Needle v))
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear v w (v ⊗ w)
tensorProduct w
w) LinearFunction (Scalar w) (Stiefel1Needle v) (w ⊗ Stiefel1Needle v)
-> Stiefel1Needle v -> w ⊗ Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Vector (Scalar v) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle
                             (Vector (Scalar v) -> Stiefel1Needle v)
-> Vector (Scalar v) -> Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> (Int -> Scalar v) -> Vector (Scalar v)
forall a. Unbox a => Int -> (Int -> a) -> Vector a
UArr.generate Int
d (\Int
j -> if Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j then Scalar v
1 else Scalar v
0) ) Vector w
TensorProduct (Stiefel1Needle v) w
a
   where d :: Int
d = [v] -> Int
forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v]) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  fmapTensor :: Bilinear (w -+> x) (Stiefel1Needle v ⊗ w) (Stiefel1Needle v ⊗ x)
fmapTensor = (LinearFunction (Scalar v) w x
 -> Tensor (Scalar v) (Stiefel1Needle v) w
 -> Tensor (Scalar v) (Stiefel1Needle v) x)
-> LinearFunction
     (Scalar x)
     (LinearFunction (Scalar v) w x)
     (LinearFunction
        (Scalar x)
        (Tensor (Scalar v) (Stiefel1Needle v) w)
        (Tensor (Scalar v) (Stiefel1Needle v) x))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((LinearFunction (Scalar v) w x
  -> Tensor (Scalar v) (Stiefel1Needle v) w
  -> Tensor (Scalar v) (Stiefel1Needle v) x)
 -> LinearFunction
      (Scalar x)
      (LinearFunction (Scalar v) w x)
      (LinearFunction
         (Scalar x)
         (Tensor (Scalar v) (Stiefel1Needle v) w)
         (Tensor (Scalar v) (Stiefel1Needle v) x)))
-> (LinearFunction (Scalar v) w x
    -> Tensor (Scalar v) (Stiefel1Needle v) w
    -> Tensor (Scalar v) (Stiefel1Needle v) x)
-> LinearFunction
     (Scalar x)
     (LinearFunction (Scalar v) w x)
     (LinearFunction
        (Scalar x)
        (Tensor (Scalar v) (Stiefel1Needle v) w)
        (Tensor (Scalar v) (Stiefel1Needle v) x))
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) -> Array x -> Tensor (Scalar v) (Stiefel1Needle v) x
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array x -> Tensor (Scalar v) (Stiefel1Needle v) x)
-> Array x -> Tensor (Scalar v) (Stiefel1Needle v) x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w -> x) -> Vector w -> Array x
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Arr.map (LinearFunction (Scalar v) w x
fLinearFunction (Scalar v) w x -> w -> x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$) Vector w
TensorProduct (Stiefel1Needle v) w
a
  fzipTensorWith :: Bilinear
  ((w, x) -+> u)
  (Stiefel1Needle v ⊗ w, Stiefel1Needle v ⊗ x)
  (Stiefel1Needle v ⊗ u)
fzipTensorWith = (LinearFunction (Scalar v) (w, x) u
 -> (Tensor (Scalar v) (Stiefel1Needle v) w,
     Tensor (Scalar v) (Stiefel1Needle v) x)
 -> Tensor (Scalar v) (Stiefel1Needle v) u)
-> LinearFunction
     (Scalar u)
     (LinearFunction (Scalar v) (w, x) u)
     (LinearFunction
        (Scalar u)
        (Tensor (Scalar v) (Stiefel1Needle v) w,
         Tensor (Scalar v) (Stiefel1Needle v) x)
        (Tensor (Scalar v) (Stiefel1Needle v) u))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((LinearFunction (Scalar v) (w, x) u
  -> (Tensor (Scalar v) (Stiefel1Needle v) w,
      Tensor (Scalar v) (Stiefel1Needle v) x)
  -> Tensor (Scalar v) (Stiefel1Needle v) u)
 -> LinearFunction
      (Scalar u)
      (LinearFunction (Scalar v) (w, x) u)
      (LinearFunction
         (Scalar u)
         (Tensor (Scalar v) (Stiefel1Needle v) w,
          Tensor (Scalar v) (Stiefel1Needle v) x)
         (Tensor (Scalar v) (Stiefel1Needle v) u)))
-> (LinearFunction (Scalar v) (w, x) u
    -> (Tensor (Scalar v) (Stiefel1Needle v) w,
        Tensor (Scalar v) (Stiefel1Needle v) x)
    -> Tensor (Scalar v) (Stiefel1Needle v) u)
-> LinearFunction
     (Scalar u)
     (LinearFunction (Scalar v) (w, x) u)
     (LinearFunction
        (Scalar u)
        (Tensor (Scalar v) (Stiefel1Needle v) w,
         Tensor (Scalar v) (Stiefel1Needle v) x)
        (Tensor (Scalar v) (Stiefel1Needle v) u))
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)
                     -> Array u -> Tensor (Scalar v) (Stiefel1Needle v) u
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array u -> Tensor (Scalar v) (Stiefel1Needle v) u)
-> Array u -> Tensor (Scalar v) (Stiefel1Needle v) u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w -> x -> u) -> Vector w -> Vector x -> Array u
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 (((w, x) -> u) -> w -> x -> u
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 (((w, x) -> u) -> w -> x -> u) -> ((w, x) -> u) -> w -> x -> u
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction (Scalar v) (w, x) u -> (w, x) -> u
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) Vector w
TensorProduct (Stiefel1Needle v) w
a Vector x
TensorProduct (Stiefel1Needle v) x
b
  coerceFmapTensorProduct :: p (Stiefel1Needle v)
-> Coercion a b
-> Coercion
     (TensorProduct (Stiefel1Needle v) a)
     (TensorProduct (Stiefel1Needle v) b)
coerceFmapTensorProduct p (Stiefel1Needle v)
_ Coercion a b
Coercion = Coercion
  (TensorProduct (Stiefel1Needle v) a)
  (TensorProduct (Stiefel1Needle v) b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  wellDefinedTensor :: (Stiefel1Needle v ⊗ w) -> Maybe (Stiefel1Needle v ⊗ w)
wellDefinedTensor (Tensor TensorProduct (Stiefel1Needle v) w
a) = Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> Maybe (Array w)
-> Maybe (Tensor (Scalar v) (Stiefel1Needle v) w)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> (w -> Maybe w) -> Array w -> Maybe (Array w)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse w -> Maybe w
forall v. TensorSpace v => v -> Maybe v
wellDefinedVector Array w
TensorProduct (Stiefel1Needle v) w
a

asTensor :: Coercion (LinearMap s a b) (Tensor s (DualVector a) b)
asTensor :: Coercion (LinearMap s a b) (Tensor s (DualVector a) b)
asTensor = Coercion (LinearMap s a b) (Tensor s (DualVector a) b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
asLinearMap :: Coercion (Tensor s (DualVector a) b) (LinearMap s a b)
asLinearMap :: Coercion (Tensor s (DualVector a) b) (LinearMap s a b)
asLinearMap = Coercion (Tensor s (DualVector a) b) (LinearMap s a b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
infixr 0 +$>
(+$>) :: (LinearSpace a, TensorSpace b, Scalar a ~ s, Scalar b ~ s)
            => LinearMap s a b -> a -> b
+$> :: LinearMap s a b -> a -> b
(+$>) = LinearFunction s a b -> a -> b
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction (LinearFunction s a b -> a -> b)
-> (LinearMap (Scalar a) a b -> LinearFunction s a b)
-> LinearMap (Scalar a) a b
-> a
-> b
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
. LinearFunction
  s (LinearMap (Scalar a) a b) (LinearFunction (Scalar a) a b)
-> LinearMap (Scalar a) a b -> LinearFunction (Scalar a) a b
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction LinearFunction
  s (LinearMap (Scalar a) a b) (LinearFunction (Scalar a) a b)
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 = Array (Stiefel1Needle v)
-> LinearMap (Scalar v) (Stiefel1Needle v) (Stiefel1Needle v)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (Array (Stiefel1Needle v)
 -> LinearMap (Scalar v) (Stiefel1Needle v) (Stiefel1Needle v))
-> ((Int -> Stiefel1Needle v) -> Array (Stiefel1Needle v))
-> (Int -> Stiefel1Needle v)
-> LinearMap (Scalar v) (Stiefel1Needle v) (Stiefel1Needle v)
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
. Int -> (Int -> Stiefel1Needle v) -> Array (Stiefel1Needle v)
forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Arr.generate Int
d ((Int -> Stiefel1Needle v)
 -> LinearMap (Scalar v) (Stiefel1Needle v) (Stiefel1Needle v))
-> (Int -> Stiefel1Needle v)
-> LinearMap (Scalar v) (Stiefel1Needle v) (Stiefel1Needle v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Int
i -> Vector (Scalar v) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle (Vector (Scalar v) -> Stiefel1Needle v)
-> ((Int -> Scalar v) -> Vector (Scalar v))
-> (Int -> Scalar v)
-> Stiefel1Needle v
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
. Int -> (Int -> Scalar v) -> Vector (Scalar v)
forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Arr.generate Int
d ((Int -> Scalar v) -> Stiefel1Needle v)
-> (Int -> Scalar v) -> Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                                           \Int
j -> if Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j then Scalar v
1 else Scalar v
0
   where d :: Int
d = [v] -> Int
forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v]) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  tensorId :: (Stiefel1Needle v ⊗ w) +> (Stiefel1Needle v ⊗ w)
tensorId = DualSpaceWitness w
-> (Stiefel1Needle v ⊗ w) +> (Stiefel1Needle v ⊗ w)
forall w.
(LinearSpace w, Scalar w ~ Scalar v) =>
DualSpaceWitness w
-> (Stiefel1Needle v ⊗ w) +> (Stiefel1Needle v ⊗ w)
ti DualSpaceWitness w
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 :: DualSpaceWitness w
-> (Stiefel1Needle v ⊗ w) +> (Stiefel1Needle v ⊗ w)
ti DualSpaceWitness w
DualSpaceWitness = Array
  (Tensor
     (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w))
-> LinearMap
     (Scalar v)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (Array
   (Tensor
      (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w))
 -> LinearMap
      (Scalar v)
      (Tensor (Scalar v) (Stiefel1Needle v) w)
      (Tensor (Scalar v) (Stiefel1Needle v) w))
-> ((Int
     -> Tensor
          (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w))
    -> Array
         (Tensor
            (Scalar v)
            (DualVector w)
            (Tensor (Scalar v) (Stiefel1Needle v) w)))
-> (Int
    -> Tensor
         (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w))
-> LinearMap
     (Scalar v)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
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
. Int
-> (Int
    -> Tensor
         (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w))
-> Array
     (Tensor
        (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w))
forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Arr.generate Int
d
           ((Int
  -> Tensor
       (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w))
 -> LinearMap
      (Scalar v)
      (Tensor (Scalar v) (Stiefel1Needle v) w)
      (Tensor (Scalar v) (Stiefel1Needle v) w))
-> (Int
    -> Tensor
         (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w))
-> LinearMap
     (Scalar v)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
     (Tensor (Scalar v) (Stiefel1Needle v) w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Int
i -> LinearFunction
  (Scalar v) w (Tensor (Scalar v) (Stiefel1Needle v) w)
-> LinearFunction
     (Scalar v)
     (Tensor (Scalar v) (DualVector w) w)
     (Tensor
        (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w))
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 ((w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> LinearFunction
     (Scalar v) w (Tensor (Scalar v) (Stiefel1Needle v) w)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((w -> Tensor (Scalar v) (Stiefel1Needle v) w)
 -> LinearFunction
      (Scalar v) w (Tensor (Scalar v) (Stiefel1Needle v) w))
-> (w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> LinearFunction
     (Scalar v) w (Tensor (Scalar v) (Stiefel1Needle v) w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \w
w -> Array w -> Tensor (Scalar v) (Stiefel1Needle v) w
forall s v w. TensorProduct v w -> Tensor s v w
Tensor (Array w -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> ((Int -> w) -> Array w)
-> (Int -> w)
-> Tensor (Scalar v) (Stiefel1Needle v) w
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
. Int -> (Int -> w) -> Array w
forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Arr.generate Int
d ((Int -> w) -> Tensor (Scalar v) (Stiefel1Needle v) w)
-> (Int -> w) -> Tensor (Scalar v) (Stiefel1Needle v) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
              \Int
j -> if Int
iInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
j then w
w else w
forall v. AdditiveGroup v => v
zeroV) LinearFunction
  (Scalar v)
  (Tensor (Scalar v) (DualVector w) w)
  (Tensor
     (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w))
-> Tensor (Scalar v) (DualVector w) w
-> Tensor
     (Scalar v) (DualVector w) (Tensor (Scalar v) (Stiefel1Needle v) w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Coercion
  (LinearMap (Scalar v) w w) (Tensor (Scalar v) (DualVector w) w)
forall s a b.
Coercion (LinearMap s a b) (Tensor s (DualVector a) b)
asTensor Coercion
  (LinearMap (Scalar v) w w) (Tensor (Scalar v) (DualVector w) w)
-> LinearMap (Scalar v) w w -> Tensor (Scalar v) (DualVector w) w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap (Scalar v) w w
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
         d :: Int
d = [v] -> Int
forall v (p :: * -> *).
(FiniteFreeSpace v, Functor p) =>
p v -> Int
freeDimension ([]::[v]) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  dualSpaceWitness :: DualSpaceWitness (Stiefel1Needle v)
dualSpaceWitness = case DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v of
         DualSpaceWitness v
DualSpaceWitness -> DualSpaceWitness (Stiefel1Needle v)
forall v.
(LinearSpace (Scalar v), DualVector (Scalar v) ~ Scalar v,
 LinearSpace (DualVector v), Scalar (DualVector v) ~ Scalar v,
 DualVector (DualVector v) ~ v) =>
DualSpaceWitness v
DualSpaceWitness
  coerceDoubleDual :: Coercion
  (Stiefel1Needle v) (DualVector (DualVector (Stiefel1Needle v)))
coerceDoubleDual = Coercion
  (Stiefel1Needle v) (DualVector (DualVector (Stiefel1Needle v)))
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  contractTensorMap :: (Stiefel1Needle v +> (Stiefel1Needle v ⊗ w)) -+> w
contractTensorMap = (LinearMap
   (Scalar v)
   (Stiefel1Needle v)
   (Tensor (Scalar v) (Stiefel1Needle v) w)
 -> w)
-> LinearFunction
     (Scalar v)
     (LinearMap
        (Scalar v)
        (Stiefel1Needle v)
        (Tensor (Scalar v) (Stiefel1Needle v) w))
     w
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((LinearMap
    (Scalar v)
    (Stiefel1Needle v)
    (Tensor (Scalar v) (Stiefel1Needle v) w)
  -> w)
 -> LinearFunction
      (Scalar v)
      (LinearMap
         (Scalar v)
         (Stiefel1Needle v)
         (Tensor (Scalar v) (Stiefel1Needle v) w))
      w)
-> (LinearMap
      (Scalar v)
      (Stiefel1Needle v)
      (Tensor (Scalar v) (Stiefel1Needle v) w)
    -> w)
-> LinearFunction
     (Scalar v)
     (LinearMap
        (Scalar v)
        (Stiefel1Needle v)
        (Tensor (Scalar v) (Stiefel1Needle v) w))
     w
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)
                        -> (w -> Int -> Tensor (Scalar v) (Stiefel1Needle v) w -> w)
-> w -> Vector (Tensor (Scalar v) (Stiefel1Needle v) w) -> w
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 w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ Array w
TensorProduct (Stiefel1Needle v) w
t Array w -> Int -> w
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
Arr.! Int
i) w
forall v. AdditiveGroup v => v
zeroV Vector (Tensor (Scalar v) (Stiefel1Needle v) w)
TensorProduct
  (DualVector (Stiefel1Needle v))
  (Tensor (Scalar v) (Stiefel1Needle v) w)
m
  contractMapTensor :: (Stiefel1Needle v ⊗ (Stiefel1Needle v +> w)) -+> w
contractMapTensor = (Tensor
   (Scalar v)
   (Stiefel1Needle v)
   (LinearMap (Scalar v) (Stiefel1Needle v) w)
 -> w)
-> LinearFunction
     (Scalar v)
     (Tensor
        (Scalar v)
        (Stiefel1Needle v)
        (LinearMap (Scalar v) (Stiefel1Needle v) w))
     w
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Tensor
    (Scalar v)
    (Stiefel1Needle v)
    (LinearMap (Scalar v) (Stiefel1Needle v) w)
  -> w)
 -> LinearFunction
      (Scalar v)
      (Tensor
         (Scalar v)
         (Stiefel1Needle v)
         (LinearMap (Scalar v) (Stiefel1Needle v) w))
      w)
-> (Tensor
      (Scalar v)
      (Stiefel1Needle v)
      (LinearMap (Scalar v) (Stiefel1Needle v) w)
    -> w)
-> LinearFunction
     (Scalar v)
     (Tensor
        (Scalar v)
        (Stiefel1Needle v)
        (LinearMap (Scalar v) (Stiefel1Needle v) w))
     w
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)
                        -> (w -> Int -> LinearMap (Scalar v) (Stiefel1Needle v) w -> w)
-> w -> Vector (LinearMap (Scalar v) (Stiefel1Needle v) w) -> w
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 w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ Array w
TensorProduct (DualVector (Stiefel1Needle v)) w
t Array w -> Int -> w
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
Arr.! Int
i) w
forall v. AdditiveGroup v => v
zeroV Vector (LinearMap (Scalar v) (Stiefel1Needle v) w)
TensorProduct
  (Stiefel1Needle v) (LinearMap (Scalar v) (Stiefel1Needle v) w)
m
  contractLinearMapAgainst :: Bilinear
  (Stiefel1Needle v +> w)
  (w -+> Stiefel1Needle v)
  (Scalar (Stiefel1Needle v))
contractLinearMapAgainst = (LinearMap (Scalar v) (Stiefel1Needle v) w
 -> LinearFunction (Scalar v) w (Stiefel1Needle v) -> Scalar v)
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) (Stiefel1Needle v) w)
     (LinearFunction
        (Scalar v)
        (LinearFunction (Scalar v) w (Stiefel1Needle v))
        (Scalar v))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((LinearMap (Scalar v) (Stiefel1Needle v) w
  -> LinearFunction (Scalar v) w (Stiefel1Needle v) -> Scalar v)
 -> LinearFunction
      (Scalar v)
      (LinearMap (Scalar v) (Stiefel1Needle v) w)
      (LinearFunction
         (Scalar v)
         (LinearFunction (Scalar v) w (Stiefel1Needle v))
         (Scalar v)))
-> (LinearMap (Scalar v) (Stiefel1Needle v) w
    -> LinearFunction (Scalar v) w (Stiefel1Needle v) -> Scalar v)
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) (Stiefel1Needle v) w)
     (LinearFunction
        (Scalar v)
        (LinearFunction (Scalar v) w (Stiefel1Needle v))
        (Scalar v))
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
                        -> (Scalar v -> Int -> w -> Scalar v)
-> Scalar v -> Vector w -> Scalar v
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 LinearFunction (Scalar v) w (Stiefel1Needle v)
-> w -> Stiefel1Needle v
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 Vector (Scalar v) -> Int -> Scalar v
forall a. Unbox a => Vector a -> Int -> a
UArr.! Int
i ) Scalar v
0 Vector w
TensorProduct (DualVector (Stiefel1Needle v)) w
m
  applyDualVector :: Bilinear
  (DualVector (Stiefel1Needle v))
  (Stiefel1Needle v)
  (Scalar (Stiefel1Needle v))
applyDualVector = (Stiefel1Needle v -> Stiefel1Needle v -> Scalar v)
-> LinearFunction
     (Scalar v)
     (Stiefel1Needle v)
     (LinearFunction (Scalar v) (Stiefel1Needle v) (Scalar v))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((Stiefel1Needle v -> Stiefel1Needle v -> Scalar v)
 -> LinearFunction
      (Scalar v)
      (Stiefel1Needle v)
      (LinearFunction (Scalar v) (Stiefel1Needle v) (Scalar v)))
-> (Stiefel1Needle v -> Stiefel1Needle v -> Scalar v)
-> LinearFunction
     (Scalar v)
     (Stiefel1Needle v)
     (LinearFunction (Scalar v) (Stiefel1Needle v) (Scalar v))
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)
                        -> Vector (Scalar v) -> Scalar v
forall a. (Unbox a, Num a) => Vector a -> a
UArr.sum (Vector (Scalar v) -> Scalar v) -> Vector (Scalar v) -> Scalar v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Scalar v -> Scalar v -> Scalar v)
-> Vector (Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
forall a b c.
(Unbox a, Unbox b, Unbox c) =>
(a -> b -> c) -> Vector a -> Vector b -> Vector c
UArr.zipWith Scalar v -> Scalar v -> Scalar v
forall a. Num a => a -> a -> a
(*) Vector (Scalar v)
v Vector (Scalar v)
w
  applyLinear :: Bilinear (Stiefel1Needle v +> w) (Stiefel1Needle v) w
applyLinear = (LinearMap (Scalar v) (Stiefel1Needle v) w
 -> Stiefel1Needle v -> w)
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) (Stiefel1Needle v) w)
     (LinearFunction (Scalar v) (Stiefel1Needle v) w)
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((LinearMap (Scalar v) (Stiefel1Needle v) w
  -> Stiefel1Needle v -> w)
 -> LinearFunction
      (Scalar v)
      (LinearMap (Scalar v) (Stiefel1Needle v) w)
      (LinearFunction (Scalar v) (Stiefel1Needle v) w))
-> (LinearMap (Scalar v) (Stiefel1Needle v) w
    -> Stiefel1Needle v -> w)
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) (Stiefel1Needle v) w)
     (LinearFunction (Scalar v) (Stiefel1Needle v) w)
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)
                        -> (w -> Int -> w -> w) -> w -> Vector w -> w
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 w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ Vector (Scalar v)
v Vector (Scalar v) -> Int -> Scalar v
forall a. Unbox a => Vector a -> Int -> a
UArr.! Int
i Scalar w -> w -> w
forall v. VectorSpace v => Scalar v -> v -> v
*^ w
w) w
forall v. AdditiveGroup v => v
zeroV Vector w
TensorProduct (DualVector (Stiefel1Needle v)) w
m
  applyTensorFunctional :: Bilinear
  (DualVector (Stiefel1Needle v ⊗ u))
  (Stiefel1Needle v ⊗ u)
  (Scalar (Stiefel1Needle v))
applyTensorFunctional = (LinearMap (Scalar v) (Stiefel1Needle v) (DualVector u)
 -> Tensor (Scalar v) (Stiefel1Needle v) u -> Scalar v)
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) (Stiefel1Needle v) (DualVector u))
     (LinearFunction
        (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) (Scalar v))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((LinearMap (Scalar v) (Stiefel1Needle v) (DualVector u)
  -> Tensor (Scalar v) (Stiefel1Needle v) u -> Scalar v)
 -> LinearFunction
      (Scalar v)
      (LinearMap (Scalar v) (Stiefel1Needle v) (DualVector u))
      (LinearFunction
         (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) (Scalar v)))
-> (LinearMap (Scalar v) (Stiefel1Needle v) (DualVector u)
    -> Tensor (Scalar v) (Stiefel1Needle v) u -> Scalar v)
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) (Stiefel1Needle v) (DualVector u))
     (LinearFunction
        (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) (Scalar v))
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)
                           -> (Scalar v -> Int -> DualVector u -> Scalar v)
-> Scalar v -> Vector (DualVector u) -> Scalar v
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 Scalar v -> Scalar v -> Scalar v
forall a. Num a => a -> a -> a
+ DualVector u
u DualVector u -> u -> Scalar u
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^ Array u
TensorProduct (Stiefel1Needle v) u
t Array u -> Int -> u
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
Arr.! Int
i) Scalar v
0 Vector (DualVector u)
TensorProduct (DualVector (Stiefel1Needle v)) (DualVector u)
f
  applyTensorLinMap :: Bilinear ((Stiefel1Needle v ⊗ u) +> w) (Stiefel1Needle v ⊗ u) w
applyTensorLinMap = (LinearMap (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w
 -> Tensor (Scalar v) (Stiefel1Needle v) u -> w)
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w)
     (LinearFunction
        (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w)
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction ((LinearMap (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w
  -> Tensor (Scalar v) (Stiefel1Needle v) u -> w)
 -> LinearFunction
      (Scalar v)
      (LinearMap (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w)
      (LinearFunction
         (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w))
-> (LinearMap (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w
    -> Tensor (Scalar v) (Stiefel1Needle v) u -> w)
-> LinearFunction
     (Scalar v)
     (LinearMap (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w)
     (LinearFunction
        (Scalar v) (Tensor (Scalar v) (Stiefel1Needle v) u) w)
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)
         -> (w -> Int -> u -> w) -> w -> Vector u -> w
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 w -> w -> w
forall v. AdditiveGroup v => v -> v -> v
^+^ ((Coercion
  (Tensor (Scalar v) (DualVector u) w) (LinearMap (Scalar v) u w)
forall s a b.
Coercion (Tensor s (DualVector a) b) (LinearMap s a b)
asLinearMap Coercion
  (Tensor (Scalar v) (DualVector u) w) (LinearMap (Scalar v) u w)
-> Tensor (Scalar v) (DualVector u) w -> LinearMap (Scalar v) u w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Array (Tensor (Scalar v) (DualVector u) w)
TensorProduct
  (DualVector (Tensor (Scalar v) (Stiefel1Needle v) u)) w
f Array (Tensor (Scalar v) (DualVector u) w)
-> Int -> Tensor (Scalar v) (DualVector u) w
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
Arr.! Int
i) LinearMap (Scalar v) u w -> u -> w
forall a b s.
(LinearSpace a, TensorSpace b, Scalar a ~ s, Scalar b ~ s) =>
LinearMap s a b -> a -> b
+$> u
u)) w
forall v. AdditiveGroup v => v
zeroV Vector u
TensorProduct (Stiefel1Needle v) u
t
  composeLinear :: Bilinear (w +> x) (Stiefel1Needle v +> w) (Stiefel1Needle v +> x)
composeLinear = ((w +> x)
 -> LinearMap (Scalar v) (Stiefel1Needle v) w
 -> LinearMap (Scalar v) (Stiefel1Needle v) x)
-> LinearFunction
     (Scalar v)
     (w +> x)
     (LinearFunction
        (Scalar v)
        (LinearMap (Scalar v) (Stiefel1Needle v) w)
        (LinearMap (Scalar v) (Stiefel1Needle v) x))
forall v w y. (v -> w -> y) -> Bilinear v w y
bilinearFunction (((w +> x)
  -> LinearMap (Scalar v) (Stiefel1Needle v) w
  -> LinearMap (Scalar v) (Stiefel1Needle v) x)
 -> LinearFunction
      (Scalar v)
      (w +> x)
      (LinearFunction
         (Scalar v)
         (LinearMap (Scalar v) (Stiefel1Needle v) w)
         (LinearMap (Scalar v) (Stiefel1Needle v) x)))
-> ((w +> x)
    -> LinearMap (Scalar v) (Stiefel1Needle v) w
    -> LinearMap (Scalar v) (Stiefel1Needle v) x)
-> LinearFunction
     (Scalar v)
     (w +> x)
     (LinearFunction
        (Scalar v)
        (LinearMap (Scalar v) (Stiefel1Needle v) w)
        (LinearMap (Scalar v) (Stiefel1Needle v) x))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \w +> x
f (LinearMap TensorProduct (DualVector (Stiefel1Needle v)) w
g)
                     -> Array x -> LinearMap (Scalar v) (Stiefel1Needle v) x
forall s v w. TensorProduct (DualVector v) w -> LinearMap s v w
LinearMap (Array x -> LinearMap (Scalar v) (Stiefel1Needle v) x)
-> Array x -> LinearMap (Scalar v) (Stiefel1Needle v) x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w -> x) -> Vector w -> Array x
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
Arr.map (LinearFunction (Scalar v) (w +> x) (LinearFunction (Scalar w) w x)
-> (w +> x) -> LinearFunction (Scalar w) w x
forall s v w. LinearFunction s v w -> v -> w
getLinearFunction LinearFunction (Scalar v) (w +> x) (LinearFunction (Scalar w) w x)
forall v w.
(LinearSpace v, TensorSpace w, Scalar w ~ Scalar v) =>
Bilinear (v +> w) v w
applyLinear w +> x
fLinearFunction (Scalar w) w x -> w -> x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$) Vector w
TensorProduct (DualVector (Stiefel1Needle v)) w
g
  useTupleLinearSpaceComponents :: ((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 DualSpaceWitness v
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)
             = DualVector v -> Stiefel1 v
forall v. DualVector v -> Stiefel1 v
Stiefel1 (DualVector v -> Stiefel1 v)
-> (Vector (Scalar v) -> DualVector v)
-> Vector (Scalar v)
-> Stiefel1 v
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
. Vector (Scalar (DualVector v)) -> DualVector v
forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
Vector (Scalar v) -> v
unsafeFromFullUnboxVect (Vector (Scalar (DualVector v)) -> DualVector v)
-> (Vector (Scalar v) -> Vector (Scalar (DualVector v)))
-> Vector (Scalar v)
-> DualVector v
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
. Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale (Scalar v -> Scalar v
forall a. Num a => a -> a
signum Scalar v
s'i)
          (Vector (Scalar v) -> Stiefel1 v)
-> Vector (Scalar v) -> Stiefel1 v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ if| Scalar v
νScalar v -> Scalar v -> Bool
forall a. Eq a => a -> a -> Bool
==Scalar v
0      -> Vector (Scalar v)
Vector (Scalar (DualVector v))
s' -- ν'≡0 is a special case of this, so if not ν=0
                                --  we can otherwise assume ν'>0.
              | Scalar v
νScalar v -> Scalar v -> Bool
forall a. Ord a => a -> a -> Bool
<=Scalar v
2      -> let m :: Vector (Scalar v)
m = Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale Scalar v
ιmν Vector (Scalar v)
spro
                                       Vector (Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => Vector n -> Vector n -> Vector n
`uarrAdd` Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale ((Scalar v
1Scalar v -> Scalar v -> Scalar v
forall a. Num a => a -> a -> a
-Scalar v -> Scalar v
forall a. Num a => a -> a
abs Scalar v
ιmν)Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/Scalar v
ν') Vector (Scalar v)
n
                                 ιmν :: Scalar v
ιmν = Scalar v
1Scalar v -> Scalar v -> Scalar v
forall 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 = Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale Scalar v
ιmν Vector (Scalar v)
spro
                                       Vector (Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => Vector n -> Vector n -> Vector n
`uarrAdd` Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale ((Scalar v -> Scalar v
forall a. Num a => a -> a
abs Scalar v
ιmνScalar v -> Scalar v -> Scalar v
forall a. Num a => a -> a -> a
-Scalar v
1)Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/Scalar v
ν') Vector (Scalar v)
n
                                 ιmν :: Scalar v
ιmν = Scalar v
νScalar v -> Scalar v -> 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 = Vector (Scalar v) -> Int
forall a. Unbox a => Vector a -> Int
UArr.length Vector (Scalar v)
Vector (Scalar (DualVector v))
s'
                s' :: Vector (Scalar (DualVector v))
s'= DualVector v -> Vector (Scalar (DualVector v))
forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect DualVector v
s
                ν' :: Scalar v
ν' = Vector (Scalar v) -> Scalar v
forall s. (Floating s, Unbox s) => Vector s -> s
l2norm Vector (Scalar v)
n
                quop :: Scalar v
quop = Scalar v -> Scalar v
forall a. Num a => a -> a
signum Scalar v
s'i Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/ Scalar v
ν'
                ν :: Scalar v
ν = Scalar v
ν' Scalar v -> Scalar v -> Scalar v
forall a. Real a => a -> a -> a
`mod'` Scalar v
4
                im :: Int
im = Vector (Scalar v) -> Int
forall a. (Unbox a, Ord a) => Vector a -> Int
UArr.maxIndex (Vector (Scalar v) -> Int) -> Vector (Scalar v) -> Int
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Scalar v -> Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UArr.map Scalar v -> Scalar v
forall a. Num a => a -> a
abs Vector (Scalar v)
Vector (Scalar (DualVector v))
s'
                s'i :: Scalar v
s'i = Vector (Scalar v)
Vector (Scalar (DualVector v))
s' Vector (Scalar v) -> Int -> Scalar v
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 v)
Vector (Scalar (DualVector v))
s' in Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale (Scalar v -> Scalar v
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 = Int -> Vector (Scalar v) -> Vector (Scalar v)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
Arr.take Int
im Vector (Scalar v)
v Vector (Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
Arr.++ Int -> Vector (Scalar v) -> Vector (Scalar v)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
Arr.drop (Int
imInt -> Int -> Int
forall 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 = Int -> (Int -> Scalar v) -> Vector (Scalar v)
forall (v :: * -> *) a. Vector v a => Int -> (Int -> a) -> v a
Arr.generate Int
d ((Int -> Scalar v) -> Vector (Scalar v))
-> (Int -> Scalar v) -> Vector (Scalar v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Int
i -> if | Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
im      -> Vector (Scalar v)
v Vector (Scalar v) -> Int -> Scalar v
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
Arr.! Int
i
                                                      | Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
im      -> Vector (Scalar v)
v Vector (Scalar v) -> Int -> Scalar v
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
Arr.! (Int
iInt -> Int -> Int
forall 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 = Stiefel1Needle v -> Maybe (Stiefel1Needle v)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Stiefel1 v
pStiefel1 v -> Stiefel1 v -> Needle (Stiefel1 v)
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!Stiefel1 v
q)
  .-~! :: Stiefel1 v -> Stiefel1 v -> Needle (Stiefel1 v)
(.-~!) = DualSpaceWitness v -> Stiefel1 v -> Stiefel1 v -> Stiefel1Needle v
dpst DualSpaceWitness v
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)
             = Vector (Scalar v) -> Stiefel1Needle v
forall v. Vector (Scalar v) -> Stiefel1Needle v
Stiefel1Needle (Vector (Scalar v) -> Stiefel1Needle v)
-> Vector (Scalar v) -> Stiefel1Needle v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ case Vector (Scalar v)
Vector (Scalar (DualVector v))
s' Vector (Scalar v) -> Int -> Scalar v
forall a. Unbox a => Vector a -> Int -> a
UArr.! Int
im of
                   Scalar v
0 -> Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale (Scalar v -> Scalar v
forall a. Fractional a => a -> a
recip (Scalar v -> Scalar v) -> Scalar v -> Scalar v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Vector (Scalar v) -> Scalar v
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 <- Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale (Scalar v -> Scalar v
forall a. Fractional a => a -> a
recip Scalar v
s'i) Vector (Scalar v)
delis Vector (Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => Vector n -> Vector n -> Vector n
`uarrSubtract` Vector (Scalar v)
tpro
                       , Scalar v
absv <- Vector (Scalar v) -> Scalar v
forall s. (Floating s, Unbox s) => Vector s -> s
l2norm Vector (Scalar v)
v
                       , Scalar v
absv Scalar v -> Scalar v -> Bool
forall a. Ord a => a -> a -> Bool
> Scalar v
0
                              -> let μ :: Scalar v
μ = (Scalar v -> Scalar v
forall a. Num a => a -> a
signum (Scalar v
t'iScalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/Scalar v
s'i) Scalar v -> Scalar v -> Scalar v
forall a. Num a => a -> a -> a
- Scalar v -> Scalar v
forall a. Fractional a => a -> a
recip(Scalar v
absv Scalar v -> Scalar v -> Scalar v
forall a. Num a => a -> a -> a
+ Scalar v
1)) Scalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/ Scalar v
absv
                                 in Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale Scalar v
μ Vector (Scalar v)
v
                       | Scalar v
t'iScalar v -> Scalar v -> Scalar v
forall a. Fractional a => a -> a -> a
/Scalar v
s'i Scalar v -> Scalar v -> Bool
forall a. Ord a => a -> a -> Bool
> Scalar v
0  -> Vector (Scalar v)
samePoint
                       | Bool
otherwise    -> Vector (Scalar v)
antipode
          where d :: Int
d = Vector (Scalar v) -> Int
forall a. Unbox a => Vector a -> Int
UArr.length Vector (Scalar v)
Vector (Scalar (DualVector v))
t'
                s' :: Vector (Scalar (DualVector v))
s'= DualVector v -> Vector (Scalar (DualVector v))
forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect DualVector v
s; t' :: Vector (Scalar (DualVector v))
t' = DualVector v -> Vector (Scalar (DualVector v))
forall v.
(FiniteFreeSpace v, Unbox (Scalar v)) =>
v -> Vector (Scalar v)
toFullUnboxVect DualVector v
t
                im :: Int
im = Vector (Scalar v) -> Int
forall a. (Unbox a, Ord a) => Vector a -> Int
UArr.maxIndex (Vector (Scalar v) -> Int) -> Vector (Scalar v) -> Int
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Scalar v -> Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UArr.map Scalar v -> Scalar v
forall a. Num a => a -> a
abs Vector (Scalar v)
Vector (Scalar (DualVector v))
t'
                t'i :: Scalar v
t'i = Vector (Scalar v)
Vector (Scalar (DualVector v))
t' Vector (Scalar v) -> Int -> Scalar v
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 v)
Vector (Scalar (DualVector v))
t' in Scalar v -> Vector (Scalar v) -> Vector (Scalar v)
forall n. (Num n, Unbox n) => n -> Vector n -> Vector n
uarrScale (Scalar v -> Scalar v
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 v)
Vector (Scalar (DualVector v))
s'
                deli :: Vector (Scalar v) -> Vector (Scalar v)
deli Vector (Scalar v)
v = Int -> Vector (Scalar v) -> Vector (Scalar v)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
Arr.take Int
im Vector (Scalar v)
v Vector (Scalar v) -> Vector (Scalar v) -> Vector (Scalar v)
forall (v :: * -> *) a. Vector v a => v a -> v a -> v a
Arr.++ Int -> Vector (Scalar v) -> Vector (Scalar v)
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
Arr.drop (Int
imInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Vector (Scalar v)
v
                samePoint :: Vector (Scalar v)
samePoint = Int -> Scalar v -> Vector (Scalar v)
forall a. Unbox a => Int -> a -> Vector a
UArr.replicate (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Scalar v
0
                antipode :: Vector (Scalar v)
antipode = (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> [Scalar v] -> Vector (Scalar v)
forall a. Unbox a => Int -> [a] -> Vector a
`UArr.fromListN` (Scalar v
2 Scalar v -> [Scalar v] -> [Scalar v]
forall a. a -> [a] -> [a]
: Scalar v -> [Scalar v]
forall a. a -> [a]
repeat Scalar v
0)


-- instance ( WithField ℝ HilbertManifold x ) => ConeSemimfd (Stiefel1 x) where
--   type CℝayInterior (Stiefel1 x) = x


l2norm :: (Floating s, UArr.Unbox s) => UArr.Vector s -> s
l2norm :: Vector s -> s
l2norm = s -> s
forall a. Floating a => a -> a
sqrt (s -> s) -> (Vector s -> s) -> Vector s -> s
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
. Vector s -> s
forall a. (Unbox a, Num a) => Vector a -> a
UArr.sum (Vector s -> s) -> (Vector s -> Vector s) -> Vector s -> s
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
. (s -> s) -> Vector s -> Vector s
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
UArr.map (s -> Int -> s
forall a. Num a => a -> Int -> a
^Int
2)




data Line x = Line { Line x -> x
lineHandle :: x
                   , Line x -> Stiefel1 (Needle' x)
lineDirection :: Stiefel1 (Needle' x) }



-- | Oriented hyperplanes, na&#xef;vely generalised to 'PseudoAffine' manifolds:
--   @'Cutplane' p w@ represents the set of all points 'q' such that
--   @(q.-~.p) ^\<.\> w &#x2261; 0@.
-- 
--   In vector spaces this is indeed a hyperplane; for general manifolds it should
--   behave locally as a plane, globally as an (/n/−1)-dimensional submanifold.
data Cutplane x = Cutplane { Cutplane x -> x
sawHandle :: x
                           , Cutplane x -> Stiefel1 (Needle x)
cutNormal :: Stiefel1 (Needle x) }
deriving instance (Show x, Show (Needle' x)) => Show (Cutplane x)

normalPlane :: x         -- ^ Some point lying in the desired plane.
            -> Needle' x -- ^ Co-vector perpendicular to the plane. Must be nonzero.
            -> Cutplane x
normalPlane :: x -> Needle' x -> Cutplane x
normalPlane x
x Needle' x
n = x -> Stiefel1 (Needle x) -> Cutplane x
forall x. x -> Stiefel1 (Needle x) -> Cutplane x
Cutplane x
x (Stiefel1 (Needle x) -> Cutplane x)
-> Stiefel1 (Needle x) -> Cutplane x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle' x -> Stiefel1 (Needle x)
forall v. DualVector v -> Stiefel1 v
Stiefel1 Needle' x
n


sideOfCut :: (WithField ℝ PseudoAffine x, LinearSpace (Needle x))
                   => Cutplane x -> x -> Maybe S⁰
sideOfCut :: Cutplane x -> x -> Maybe S⁰
sideOfCut (Cutplane x
sh (Stiefel1 DualVector (Needle x)
cn)) x
p
              = ℝ -> Maybe S⁰
forall a (m :: * -> *) r.
(Num a, MonadPlus m, Ord a) =>
a -> m (S⁰_ r)
decideSide (ℝ -> Maybe S⁰) -> (Needle x -> ℝ) -> Needle x -> Maybe S⁰
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)
cnDualVector (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^) (Needle x -> Maybe S⁰) -> Maybe (Needle x) -> Maybe S⁰
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
px -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
sh
 where decideSide :: a -> m (S⁰_ r)
decideSide a
0 = m (S⁰_ r)
forall (m :: * -> *) a. MonadZero m (->) => m a
mzero
       decideSide a
μ | a
μ a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0      = S⁰_ r -> m (S⁰_ r)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure S⁰_ r
forall r. S⁰_ r
PositiveHalfSphere
                    | Bool
otherwise  = S⁰_ r -> m (S⁰_ r)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure S⁰_ r
forall r. S⁰_ r
NegativeHalfSphere


fathomCutDistance :: ∀ x . (WithField ℝ PseudoAffine x, LinearSpace (Needle x))
        => Cutplane x        -- ^ Hyperplane to measure the distance from.
         -> Metric' x        -- ^ Metric to use for measuring that distance.
                             --   This can only be accurate if the metric
                             --   is valid both around the cut-plane's 'sawHandle', and
                             --   around the points you measure.
                             --   (Strictly speaking, we would need /parallel transport/
                             --   to ensure this).
         -> x                -- ^ Point to measure the distance to.
         -> Maybe ℝ          -- ^ A signed number, giving the distance from plane
                             --   to point with indication on which side the point lies.
                             --   'Nothing' if the point isn't reachable from the plane.
fathomCutDistance :: Cutplane x -> Metric' x -> x -> Maybe ℝ
fathomCutDistance = DualSpaceWitness (Needle x)
-> Cutplane x -> Metric' x -> x -> Maybe ℝ
fcd DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
 where fcd :: DualSpaceWitness (Needle x)
-> Cutplane x -> Metric' x -> x -> Maybe ℝ
fcd (DualSpaceWitness (Needle x)
DualSpaceWitness :: DualSpaceWitness (Needle x))
           (Cutplane sh (Stiefel1 cn)) Metric' x
met
               = \x
x -> (Needle x -> ℝ) -> Maybe (Needle x) -> Maybe ℝ
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 -> ℝ
fathom (Maybe (Needle x) -> Maybe ℝ) -> Maybe (Needle x) -> Maybe ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
x x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. x
sh
        where fathom :: Needle x -> ℝ
fathom Needle x
v = (DualVector (Needle x)
cn DualVector (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^ Needle x
v) ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ
Scalar (DualVector (Needle x))
scaleDist
              scaleDist :: Scalar (DualVector (Needle x))
scaleDist = Metric' x
metMetric' x
-> DualVector (Needle x) -> Scalar (DualVector (Needle x))
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|DualVector (Needle x)
cn
          

cutPosBetween :: WithField ℝ Manifold x => Cutplane x -> (x,x) -> Maybe D¹
cutPosBetween :: Cutplane x -> (x, x) -> Maybe D¹
cutPosBetween (Cutplane x
h (Stiefel1 DualVector (Needle x)
cn)) (x
x₀,x
x₁)
    | Just [ℝ
d₀,ℝ
d₁] <- (Needle x -> ℝ) -> [Needle x] -> [ℝ]
forall a b. (a -> b) -> [a] -> [b]
map (DualVector (Needle x)
cnDualVector (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^) ([Needle x] -> [ℝ]) -> Maybe [Needle x] -> Maybe [ℝ]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [Maybe (Needle x)] -> Maybe [Needle x]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [x
x₀x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
h, x
x₁x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
h]
    , ℝ
d₀ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
d₁ ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
< ℝ
0  = D¹ -> Maybe D¹
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (D¹ -> Maybe D¹) -> (ℝ -> D¹) -> ℝ -> Maybe D¹
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
. ℝ -> D¹
forall r. r -> D¹_ r
D¹ (ℝ -> Maybe D¹) -> ℝ -> Maybe D¹
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
d₀ ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ (ℝ
d₀ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
d₁) ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
1
    | Bool
otherwise  = Maybe D¹
forall (f :: * -> *) a. Alternative f => f a
empty


lineAsPlaneIntersection :: ∀ x .
       (WithField ℝ Manifold x, FiniteDimensional (Needle' x))
           => Line x -> [Cutplane x]
lineAsPlaneIntersection :: Line x -> [Cutplane x]
lineAsPlaneIntersection = DualSpaceWitness (Needle x) -> Line x -> [Cutplane x]
lapi DualSpaceWitness (Needle x)
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 h (Stiefel1 dir))
             = [ x -> Stiefel1 (Needle x) -> Cutplane x
forall x. x -> Stiefel1 (Needle x) -> Cutplane x
Cutplane x
h (Stiefel1 (Needle x) -> Cutplane x)
-> (DualVector (Needle x) -> Stiefel1 (Needle x))
-> DualVector (Needle x)
-> Cutplane x
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) -> Stiefel1 (Needle x)
forall v. DualVector v -> Stiefel1 v
Stiefel1
                     (DualVector (Needle x) -> Cutplane x)
-> DualVector (Needle x) -> Cutplane x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DualVector (Needle x)
candidate DualVector (Needle x)
-> DualVector (Needle x) -> DualVector (Needle x)
forall v. AdditiveGroup v => v -> v -> v
^-^ DualVector (Needle x)
worstCandidate DualVector (Needle x) -> ℝ -> DualVector (Needle x)
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* (ℝ
overlapℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
worstOvlp)
               | (Int
i, (DualVector (Needle x)
candidate, ℝ
overlap)) <- [Int]
-> [(DualVector (Needle x), ℝ)]
-> [(Int, (DualVector (Needle x), ℝ))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([(DualVector (Needle x), ℝ)]
 -> [(Int, (DualVector (Needle x), ℝ))])
-> [(DualVector (Needle x), ℝ)]
-> [(Int, (DualVector (Needle x), ℝ))]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [DualVector (Needle x)] -> [ℝ] -> [(DualVector (Needle x), ℝ)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DualVector (Needle x)]
candidates [ℝ]
overlaps
               , Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
worstId ]
        where candidates :: [DualVector (Needle x)]
candidates = SubBasis (DualVector (Needle x)) -> [DualVector (Needle x)]
forall v. FiniteDimensional v => SubBasis v -> [v]
enumerateSubBasis SubBasis (DualVector (Needle x))
forall v. FiniteDimensional v => SubBasis v
entireBasis
              overlaps :: [ℝ]
overlaps = (DualVector (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^DualVector (DualVector (Needle x))
Needle x
dir) (DualVector (Needle x) -> ℝ) -> [DualVector (Needle x)] -> [ℝ]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [DualVector (Needle x)]
candidates
              (Int
worstId, ℝ
worstOvlp) = ((Int, ℝ) -> (Int, ℝ) -> Ordering) -> [(Int, ℝ)] -> (Int, ℝ)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((Int, ℝ) -> ℝ) -> (Int, ℝ) -> (Int, ℝ) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((Int, ℝ) -> ℝ) -> (Int, ℝ) -> (Int, ℝ) -> Ordering)
-> ((Int, ℝ) -> ℝ) -> (Int, ℝ) -> (Int, ℝ) -> Ordering
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ
forall a. Num a => a -> a
abs (ℝ -> ℝ) -> ((Int, ℝ) -> ℝ) -> (Int, ℝ) -> ℝ
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
. (Int, ℝ) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd) ([(Int, ℝ)] -> (Int, ℝ)) -> [(Int, ℝ)] -> (Int, ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Int] -> [ℝ] -> [(Int, ℝ)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ℝ]
overlaps
              worstCandidate :: DualVector (Needle x)
worstCandidate = [DualVector (Needle x)]
candidates [DualVector (Needle x)] -> Int -> DualVector (Needle x)
forall a. [a] -> Int -> a
!! Int
worstId