{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}
module Cybus.Mat (
type Mat,
mVec,
mIndices,
pattern Mat,
pattern MatU,
Vec,
Mat2,
Mat3,
Mat4,
Mat5,
Mat6,
MatN,
ConsMatC (..),
SnocMatC (..),
Eof1 (..),
EofN (..),
MatTupleC (..),
MatTupleT,
ListTupleCInternal (..),
MatConvertersC (..),
nestedListToMatValidated,
nestedNonEmptyToMatValidated,
MatToNestedVecT,
mkMat,
mkMatC,
mat,
mat',
vec,
vec',
mat2,
mat2',
gen',
gen,
mm,
buildMat,
(.:),
se1,
(.::),
se2,
(.|),
(.||),
ixMat,
ixMat',
setMat,
updateMat,
indexMat,
finMatRows,
reverseRows,
sortByRows,
multMat,
DotC (..),
zipWithMat,
zipWithMat3,
zipMat,
zipWithMatA,
izipWith,
izipWithM,
cartesian,
pureMat,
replicateMat,
determinant,
deleteColumnL,
deleteRow,
deleteRow',
insertRow,
insertRow',
swapRow,
swapRow',
_row,
_row',
rows,
unrows,
_rows,
wrapRows1,
indexRow,
deleteCol,
deleteCol',
insertCol,
insertCol',
swapCol,
swapCol',
_col,
_col',
swapMat,
swapMat',
appendV,
appendH,
permutationsMat,
findMatElems,
bulkMat,
updatesMat,
getsMat,
setsMat,
nonEmptyMatsToMat,
_transposeMat,
transposeMat,
toND,
MatToNDT,
toVec,
toMat2,
toMat3,
concatMat,
redim,
reverseDim,
rotateLeft,
rotateRight,
SliceC (..),
SliceT,
SliceC' (..),
SliceT',
slice,
sliceUpdate,
sliceToFinMat,
SliceToFinMatT,
ixSlice,
ixSlice',
subsetRows,
subsetCols,
diagonal,
rowsToMat,
chunkNV,
chunkNVMat,
LeafC (..),
traverseLeafSimple,
mapLeafSimple,
foldMapLeaf,
foldMapLeafR,
mapLeaf,
mapLeafS,
mapLeafSimpleS,
foldLeaf,
toLeaves,
mapCols,
mapCols',
ShowMatC (..),
ShowOpts (..),
defShowOpts,
prtMat,
showMat,
readMatP,
readMat,
readMat2,
readVec,
Row1 (..),
Row2 (..),
Row3 (..),
Row4 (..),
Row5 (..),
Row6 (..),
Row7 (..),
Row8 (..),
Row9 (..),
Row10 (..),
_c1,
_c2,
_c3,
_c4,
_c5,
_c6,
_c7,
_c8,
_c9,
_c10,
finMatMatrix,
finMatMatrix',
scanlVec,
scanrVec,
postscanlMat,
postscanrMat,
dim1,
dim2,
dim3,
dim4,
dim5,
dim6,
dim7,
dim8,
dim9,
dim10,
) where
import Control.Applicative
import Control.Applicative.Backwards
import Control.Arrow
import Control.DeepSeq
import Control.Monad
import qualified Control.Monad.State.Strict as S
import Control.Monad.Zip
import Cybus.Fin
import Cybus.FinMat
import Cybus.NatHelper
import Data.Bool
import Data.Coerce
import Data.Distributive
import Data.Foldable
import Data.Foldable.WithIndex
import qualified Data.Functor.Apply as Apply
import qualified Data.Functor.Bind as Bind
import Data.Functor.Identity
import Data.Functor.Rep
import Data.Functor.WithIndex
import Data.Kind
import qualified Data.List as L
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as N
import Data.Pos
import Data.Semigroup
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.String
import Data.Traversable.WithIndex
import Data.Tuple
import Data.Vector (Vector)
import qualified Data.Vector as V
import GHC.Enum
import qualified GHC.Exts as GE (IsList (..))
import GHC.Generics (Generic, Generic1)
import qualified GHC.Read as GR
import GHC.Stack
import qualified GHC.TypeLits as GL
import GHC.TypeNats (Nat)
import qualified GHC.TypeNats as GN
import Primus.Enum
import Primus.Error
import Primus.Fold
import Primus.Lens
import Primus.List
import Primus.NonEmpty
import Primus.Num1
import Primus.One
import Primus.Rep
import qualified Primus.TypeLevel as TP
import qualified Text.ParserCombinators.ReadP as P
import qualified Text.ParserCombinators.ReadPrec as PC
type Mat :: [Nat] -> Type -> Type
data Mat ns a = MatUnsafe !(Vector a) !(NonEmpty Pos)
deriving stock (a -> Mat ns b -> Mat ns a
(a -> b) -> Mat ns a -> Mat ns b
(forall a b. (a -> b) -> Mat ns a -> Mat ns b)
-> (forall a b. a -> Mat ns b -> Mat ns a) -> Functor (Mat ns)
forall (ns :: [Nat]) a b. a -> Mat ns b -> Mat ns a
forall (ns :: [Nat]) a b. (a -> b) -> Mat ns a -> Mat ns b
forall a b. a -> Mat ns b -> Mat ns a
forall a b. (a -> b) -> Mat ns a -> Mat ns b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Mat ns b -> Mat ns a
$c<$ :: forall (ns :: [Nat]) a b. a -> Mat ns b -> Mat ns a
fmap :: (a -> b) -> Mat ns a -> Mat ns b
$cfmap :: forall (ns :: [Nat]) a b. (a -> b) -> Mat ns a -> Mat ns b
Functor, Functor (Mat ns)
Foldable (Mat ns)
Functor (Mat ns)
-> Foldable (Mat ns)
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Mat ns a -> f (Mat ns b))
-> (forall (f :: * -> *) a.
Applicative f =>
Mat ns (f a) -> f (Mat ns a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Mat ns a -> m (Mat ns b))
-> (forall (m :: * -> *) a.
Monad m =>
Mat ns (m a) -> m (Mat ns a))
-> Traversable (Mat ns)
(a -> f b) -> Mat ns a -> f (Mat ns b)
forall (ns :: [Nat]). Functor (Mat ns)
forall (ns :: [Nat]). Foldable (Mat ns)
forall (ns :: [Nat]) (m :: * -> *) a.
Monad m =>
Mat ns (m a) -> m (Mat ns a)
forall (ns :: [Nat]) (f :: * -> *) a.
Applicative f =>
Mat ns (f a) -> f (Mat ns a)
forall (ns :: [Nat]) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Mat ns a -> m (Mat ns b)
forall (ns :: [Nat]) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Mat ns a -> f (Mat ns b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Mat ns (m a) -> m (Mat ns a)
forall (f :: * -> *) a.
Applicative f =>
Mat ns (f a) -> f (Mat ns a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Mat ns a -> m (Mat ns b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Mat ns a -> f (Mat ns b)
sequence :: Mat ns (m a) -> m (Mat ns a)
$csequence :: forall (ns :: [Nat]) (m :: * -> *) a.
Monad m =>
Mat ns (m a) -> m (Mat ns a)
mapM :: (a -> m b) -> Mat ns a -> m (Mat ns b)
$cmapM :: forall (ns :: [Nat]) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Mat ns a -> m (Mat ns b)
sequenceA :: Mat ns (f a) -> f (Mat ns a)
$csequenceA :: forall (ns :: [Nat]) (f :: * -> *) a.
Applicative f =>
Mat ns (f a) -> f (Mat ns a)
traverse :: (a -> f b) -> Mat ns a -> f (Mat ns b)
$ctraverse :: forall (ns :: [Nat]) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Mat ns a -> f (Mat ns b)
$cp2Traversable :: forall (ns :: [Nat]). Foldable (Mat ns)
$cp1Traversable :: forall (ns :: [Nat]). Functor (Mat ns)
Traversable, Mat ns a -> Bool
(a -> m) -> Mat ns a -> m
(a -> b -> b) -> b -> Mat ns a -> b
(forall m. Monoid m => Mat ns m -> m)
-> (forall m a. Monoid m => (a -> m) -> Mat ns a -> m)
-> (forall m a. Monoid m => (a -> m) -> Mat ns a -> m)
-> (forall a b. (a -> b -> b) -> b -> Mat ns a -> b)
-> (forall a b. (a -> b -> b) -> b -> Mat ns a -> b)
-> (forall b a. (b -> a -> b) -> b -> Mat ns a -> b)
-> (forall b a. (b -> a -> b) -> b -> Mat ns a -> b)
-> (forall a. (a -> a -> a) -> Mat ns a -> a)
-> (forall a. (a -> a -> a) -> Mat ns a -> a)
-> (forall a. Mat ns a -> [a])
-> (forall a. Mat ns a -> Bool)
-> (forall a. Mat ns a -> Int)
-> (forall a. Eq a => a -> Mat ns a -> Bool)
-> (forall a. Ord a => Mat ns a -> a)
-> (forall a. Ord a => Mat ns a -> a)
-> (forall a. Num a => Mat ns a -> a)
-> (forall a. Num a => Mat ns a -> a)
-> Foldable (Mat ns)
forall (ns :: [Nat]) a. Eq a => a -> Mat ns a -> Bool
forall (ns :: [Nat]) a. Num a => Mat ns a -> a
forall (ns :: [Nat]) a. Ord a => Mat ns a -> a
forall (ns :: [Nat]) m. Monoid m => Mat ns m -> m
forall (ns :: [Nat]) a. Mat ns a -> Bool
forall (ns :: [Nat]) a. Mat ns a -> Int
forall (ns :: [Nat]) a. Mat ns a -> [a]
forall (ns :: [Nat]) a. (a -> a -> a) -> Mat ns a -> a
forall (ns :: [Nat]) m a. Monoid m => (a -> m) -> Mat ns a -> m
forall (ns :: [Nat]) b a. (b -> a -> b) -> b -> Mat ns a -> b
forall (ns :: [Nat]) a b. (a -> b -> b) -> b -> Mat ns a -> b
forall a. Eq a => a -> Mat ns a -> Bool
forall a. Num a => Mat ns a -> a
forall a. Ord a => Mat ns a -> a
forall m. Monoid m => Mat ns m -> m
forall a. Mat ns a -> Bool
forall a. Mat ns a -> Int
forall a. Mat ns a -> [a]
forall a. (a -> a -> a) -> Mat ns a -> a
forall m a. Monoid m => (a -> m) -> Mat ns a -> m
forall b a. (b -> a -> b) -> b -> Mat ns a -> b
forall a b. (a -> b -> b) -> b -> Mat ns a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Mat ns a -> a
$cproduct :: forall (ns :: [Nat]) a. Num a => Mat ns a -> a
sum :: Mat ns a -> a
$csum :: forall (ns :: [Nat]) a. Num a => Mat ns a -> a
minimum :: Mat ns a -> a
$cminimum :: forall (ns :: [Nat]) a. Ord a => Mat ns a -> a
maximum :: Mat ns a -> a
$cmaximum :: forall (ns :: [Nat]) a. Ord a => Mat ns a -> a
elem :: a -> Mat ns a -> Bool
$celem :: forall (ns :: [Nat]) a. Eq a => a -> Mat ns a -> Bool
length :: Mat ns a -> Int
$clength :: forall (ns :: [Nat]) a. Mat ns a -> Int
null :: Mat ns a -> Bool
$cnull :: forall (ns :: [Nat]) a. Mat ns a -> Bool
toList :: Mat ns a -> [a]
$ctoList :: forall (ns :: [Nat]) a. Mat ns a -> [a]
foldl1 :: (a -> a -> a) -> Mat ns a -> a
$cfoldl1 :: forall (ns :: [Nat]) a. (a -> a -> a) -> Mat ns a -> a
foldr1 :: (a -> a -> a) -> Mat ns a -> a
$cfoldr1 :: forall (ns :: [Nat]) a. (a -> a -> a) -> Mat ns a -> a
foldl' :: (b -> a -> b) -> b -> Mat ns a -> b
$cfoldl' :: forall (ns :: [Nat]) b a. (b -> a -> b) -> b -> Mat ns a -> b
foldl :: (b -> a -> b) -> b -> Mat ns a -> b
$cfoldl :: forall (ns :: [Nat]) b a. (b -> a -> b) -> b -> Mat ns a -> b
foldr' :: (a -> b -> b) -> b -> Mat ns a -> b
$cfoldr' :: forall (ns :: [Nat]) a b. (a -> b -> b) -> b -> Mat ns a -> b
foldr :: (a -> b -> b) -> b -> Mat ns a -> b
$cfoldr :: forall (ns :: [Nat]) a b. (a -> b -> b) -> b -> Mat ns a -> b
foldMap' :: (a -> m) -> Mat ns a -> m
$cfoldMap' :: forall (ns :: [Nat]) m a. Monoid m => (a -> m) -> Mat ns a -> m
foldMap :: (a -> m) -> Mat ns a -> m
$cfoldMap :: forall (ns :: [Nat]) m a. Monoid m => (a -> m) -> Mat ns a -> m
fold :: Mat ns m -> m
$cfold :: forall (ns :: [Nat]) m. Monoid m => Mat ns m -> m
Foldable, (forall x. Mat ns a -> Rep (Mat ns a) x)
-> (forall x. Rep (Mat ns a) x -> Mat ns a) -> Generic (Mat ns a)
forall (ns :: [Nat]) a x. Rep (Mat ns a) x -> Mat ns a
forall (ns :: [Nat]) a x. Mat ns a -> Rep (Mat ns a) x
forall x. Rep (Mat ns a) x -> Mat ns a
forall x. Mat ns a -> Rep (Mat ns a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (ns :: [Nat]) a x. Rep (Mat ns a) x -> Mat ns a
$cfrom :: forall (ns :: [Nat]) a x. Mat ns a -> Rep (Mat ns a) x
Generic, (forall a. Mat ns a -> Rep1 (Mat ns) a)
-> (forall a. Rep1 (Mat ns) a -> Mat ns a) -> Generic1 (Mat ns)
forall (ns :: [Nat]) a. Rep1 (Mat ns) a -> Mat ns a
forall (ns :: [Nat]) a. Mat ns a -> Rep1 (Mat ns) a
forall a. Rep1 (Mat ns) a -> Mat ns a
forall a. Mat ns a -> Rep1 (Mat ns) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall (ns :: [Nat]) a. Rep1 (Mat ns) a -> Mat ns a
$cfrom1 :: forall (ns :: [Nat]) a. Mat ns a -> Rep1 (Mat ns) a
Generic1, Mat ns a -> Mat ns a -> Bool
(Mat ns a -> Mat ns a -> Bool)
-> (Mat ns a -> Mat ns a -> Bool) -> Eq (Mat ns a)
forall (ns :: [Nat]) a. Eq a => Mat ns a -> Mat ns a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mat ns a -> Mat ns a -> Bool
$c/= :: forall (ns :: [Nat]) a. Eq a => Mat ns a -> Mat ns a -> Bool
== :: Mat ns a -> Mat ns a -> Bool
$c== :: forall (ns :: [Nat]) a. Eq a => Mat ns a -> Mat ns a -> Bool
Eq, Eq (Mat ns a)
Eq (Mat ns a)
-> (Mat ns a -> Mat ns a -> Ordering)
-> (Mat ns a -> Mat ns a -> Bool)
-> (Mat ns a -> Mat ns a -> Bool)
-> (Mat ns a -> Mat ns a -> Bool)
-> (Mat ns a -> Mat ns a -> Bool)
-> (Mat ns a -> Mat ns a -> Mat ns a)
-> (Mat ns a -> Mat ns a -> Mat ns a)
-> Ord (Mat ns a)
Mat ns a -> Mat ns a -> Bool
Mat ns a -> Mat ns a -> Ordering
Mat ns a -> Mat ns a -> Mat ns a
forall (ns :: [Nat]) a. Ord a => Eq (Mat ns a)
forall (ns :: [Nat]) a. Ord a => Mat ns a -> Mat ns a -> Bool
forall (ns :: [Nat]) a. Ord a => Mat ns a -> Mat ns a -> Ordering
forall (ns :: [Nat]) a. Ord a => Mat ns a -> Mat ns a -> Mat ns a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mat ns a -> Mat ns a -> Mat ns a
$cmin :: forall (ns :: [Nat]) a. Ord a => Mat ns a -> Mat ns a -> Mat ns a
max :: Mat ns a -> Mat ns a -> Mat ns a
$cmax :: forall (ns :: [Nat]) a. Ord a => Mat ns a -> Mat ns a -> Mat ns a
>= :: Mat ns a -> Mat ns a -> Bool
$c>= :: forall (ns :: [Nat]) a. Ord a => Mat ns a -> Mat ns a -> Bool
> :: Mat ns a -> Mat ns a -> Bool
$c> :: forall (ns :: [Nat]) a. Ord a => Mat ns a -> Mat ns a -> Bool
<= :: Mat ns a -> Mat ns a -> Bool
$c<= :: forall (ns :: [Nat]) a. Ord a => Mat ns a -> Mat ns a -> Bool
< :: Mat ns a -> Mat ns a -> Bool
$c< :: forall (ns :: [Nat]) a. Ord a => Mat ns a -> Mat ns a -> Bool
compare :: Mat ns a -> Mat ns a -> Ordering
$ccompare :: forall (ns :: [Nat]) a. Ord a => Mat ns a -> Mat ns a -> Ordering
$cp1Ord :: forall (ns :: [Nat]) a. Ord a => Eq (Mat ns a)
Ord)
deriving anyclass (Mat ns a -> ()
(Mat ns a -> ()) -> NFData (Mat ns a)
forall (ns :: [Nat]) a. NFData a => Mat ns a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Mat ns a -> ()
$crnf :: forall (ns :: [Nat]) a. NFData a => Mat ns a -> ()
NFData, (forall a. (a -> ()) -> Mat ns a -> ()) -> NFData1 (Mat ns)
forall (ns :: [Nat]) a. (a -> ()) -> Mat ns a -> ()
forall a. (a -> ()) -> Mat ns a -> ()
forall (f :: * -> *).
(forall a. (a -> ()) -> f a -> ()) -> NFData1 f
liftRnf :: (a -> ()) -> Mat ns a -> ()
$cliftRnf :: forall (ns :: [Nat]) a. (a -> ()) -> Mat ns a -> ()
NFData1)
mVec :: Mat ns a -> Vector a
mVec :: Mat ns a -> Vector a
mVec (MatUnsafe Vector a
v NonEmpty Pos
_) = Vector a
v
mIndices :: Mat ns a -> NonEmpty Pos
mIndices :: Mat ns a -> NonEmpty Pos
mIndices (MatUnsafe Vector a
_ NonEmpty Pos
ns) = NonEmpty Pos
ns
type Vec :: Nat -> Type -> Type
type Vec n = Mat '[n]
type Mat2 :: Nat -> Nat -> Type -> Type
type Mat2 n m = Mat '[n, m]
type Mat3 :: Nat -> Nat -> Nat -> Type -> Type
type Mat3 n m p = Mat '[n, m, p]
type Mat4 :: Nat -> Nat -> Nat -> Nat -> Type -> Type
type Mat4 n m p q = Mat '[n, m, p, q]
type Mat5 :: Nat -> Nat -> Nat -> Nat -> Nat -> Type -> Type
type Mat5 n m p q r = Mat '[n, m, p, q, r]
type Mat6 :: Nat -> Nat -> Nat -> Nat -> Nat -> Nat -> Type -> Type
type Mat6 n m p q r s = Mat '[n, m, p, q, r, s]
type MatN :: Nat -> Type -> Type
type MatN n = Mat (NN n)
{-# COMPLETE Mat #-}
pattern Mat ::
forall (ns :: [Nat]) a.
Vector a ->
NonEmpty Pos ->
Mat ns a
pattern $mMat :: forall r (ns :: [Nat]) a.
Mat ns a -> (Vector a -> NonEmpty Pos -> r) -> (Void# -> r) -> r
Mat v ps <- MatUnsafe v ps
{-# COMPLETE MatIU #-}
pattern MatIU ::
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a ->
NonEmpty Pos ->
Mat ns a
pattern $bMatIU :: Vector a -> NonEmpty Pos -> Mat ns a
$mMatIU :: forall r (ns :: [Nat]) a.
HasCallStack =>
Mat ns a -> (Vector a -> NonEmpty Pos -> r) -> (Void# -> r) -> r
MatIU v ps <-
MatUnsafe v ps
where
MatIU = Either String (Mat ns a) -> Mat ns a
forall a. HasCallStack => Either String a -> a
frp (Either String (Mat ns a) -> Mat ns a)
-> (Vector a -> NonEmpty Pos -> Either String (Mat ns a))
-> Vector a
-> NonEmpty Pos
-> Mat ns a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ Vector a -> NonEmpty Pos -> Either String (Mat ns a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat
{-# COMPLETE MatU #-}
pattern MatU ::
forall (ns :: [Nat]) a.
(NS ns, HasCallStack) =>
Vector a ->
NonEmpty Pos ->
Mat ns a
pattern $bMatU :: Vector a -> NonEmpty Pos -> Mat ns a
$mMatU :: forall r (ns :: [Nat]) a.
(NS ns, HasCallStack) =>
Mat ns a -> (Vector a -> NonEmpty Pos -> r) -> (Void# -> r) -> r
MatU v ps <-
MatUnsafe v ps
where
MatU = Either String (Mat ns a) -> Mat ns a
forall a. HasCallStack => Either String a -> a
frp (Either String (Mat ns a) -> Mat ns a)
-> (Vector a -> NonEmpty Pos -> Either String (Mat ns a))
-> Vector a
-> NonEmpty Pos
-> Mat ns a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ Vector a -> NonEmpty Pos -> Either String (Mat ns a)
forall (ns :: [Nat]) a.
NS ns =>
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMatC
instance (Bounded a, Enum a) => Num1 (Mat ns a) where
fromInteger1 :: Mat ns a -> Integer -> Either String (Mat ns a)
fromInteger1 = Mat ns a -> Integer -> Either String (Mat ns a)
forall a (f :: * -> *) z.
(Traversable f, Enum a, Bounded a) =>
f z -> Integer -> Either String (f a)
toEnumTraversable
toInteger1 :: Mat ns a -> Integer
toInteger1 = Mat ns a -> Integer
forall a (t :: * -> *).
(Foldable1 t, Enum a, Bounded a) =>
t a -> Integer
fromEnumFoldable1
instance (Enum a, Bounded a, NS ns) => Enum (Mat ns a) where
toEnum :: Int -> Mat ns a
toEnum = String -> Either String (Mat ns a) -> Mat ns a
forall a. HasCallStack => String -> Either String a -> a
forceRight String
"Enum Mat:toEnum" (Either String (Mat ns a) -> Mat ns a)
-> (Int -> Either String (Mat ns a)) -> Int -> Mat ns a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Either String (Mat ns a)
forall (f :: * -> *) a.
(Traversable f, Representable f, Enum a, Bounded a) =>
Integer -> Either String (f a)
toEnumRep (Integer -> Either String (Mat ns a))
-> (Int -> Integer) -> Int -> Either String (Mat ns a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger
fromEnum :: Mat ns a -> Int
fromEnum = String -> Either String Int -> Int
forall a. HasCallStack => String -> Either String a -> a
forceRight String
"Enum Mat:fromEnum" (Either String Int -> Int)
-> (Mat ns a -> Either String Int) -> Mat ns a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Either String Int
integerToIntSafe (Integer -> Either String Int)
-> (Mat ns a -> Integer) -> Mat ns a -> Either String Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat ns a -> Integer
forall a (t :: * -> *).
(Foldable1 t, Enum a, Bounded a) =>
t a -> Integer
fromEnumFoldable1
enumFrom :: Mat ns a -> [Mat ns a]
enumFrom = Mat ns a -> [Mat ns a]
forall a. (Enum a, Bounded a) => a -> [a]
boundedEnumFrom
enumFromThen :: Mat ns a -> Mat ns a -> [Mat ns a]
enumFromThen = Mat ns a -> Mat ns a -> [Mat ns a]
forall a. (Enum a, Bounded a) => a -> a -> [a]
boundedEnumFromThen
instance (NS ns, Bounded a) => Bounded (Mat ns a) where
minBound :: Mat ns a
minBound = a -> Mat ns a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Bounded a => a
minBound
maxBound :: Mat ns a
maxBound = a -> Mat ns a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Bounded a => a
maxBound
instance (c ~ Char, NS ns) => IsString (Mat ns c) where
fromString :: String -> Mat ns c
fromString = String -> Mat ns c
forall (ns :: [Nat]) a. (HasCallStack, NS ns) => [a] -> Mat ns a
mat
mat, mat' :: forall ns a. (HasCallStack, NS ns) => [a] -> Mat ns a
mat :: [a] -> Mat ns a
mat = Either String (Mat ns a) -> Mat ns a
forall a. HasCallStack => Either String a -> a
fr (Either String (Mat ns a) -> Mat ns a)
-> ([a] -> Either String (Mat ns a)) -> [a] -> Mat ns a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [a] -> Either String (Mat ns a)
forall (ns :: [Nat]) a.
NS ns =>
Bool -> [a] -> Either String (Mat ns a)
matImpl Bool
False
mat' :: [a] -> Mat ns a
mat' = Either String (Mat ns a) -> Mat ns a
forall a. HasCallStack => Either String a -> a
fr (Either String (Mat ns a) -> Mat ns a)
-> ([a] -> Either String (Mat ns a)) -> [a] -> Mat ns a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [a] -> Either String (Mat ns a)
forall (ns :: [Nat]) a.
NS ns =>
Bool -> [a] -> Either String (Mat ns a)
matImpl Bool
True
matImpl :: forall ns a. NS ns => Bool -> [a] -> Either String (Mat ns a)
matImpl :: Bool -> [a] -> Either String (Mat ns a)
matImpl Bool
b = \case
[] -> String -> Either String (Mat ns a)
forall a b. a -> Either a b
Left String
"matImpl: no data"
a
x : [a]
xs -> do
let ns :: NonEmpty Pos
ns = NS ns => NonEmpty Pos
forall (ns :: [Nat]). NS ns => NonEmpty Pos
fromNSP @ns
n :: Pos
n = NonEmpty Pos -> Pos
forall (t :: * -> *). Foldable t => t Pos -> Pos
productP NonEmpty Pos
ns
(NonEmpty a
as, [a]
zs) <- Pos -> NonEmpty a -> Either String (NonEmpty a, [a])
forall a. Pos -> NonEmpty a -> Either String (NonEmpty a, [a])
splitAt1GE Pos
n (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
xs)
case (Bool
b, [a]
zs) of
(Bool
True, a
_ : [a]
_) -> String -> Either String (Mat ns a)
forall a b. a -> Either a b
Left String
"matImpl: found extras"
(Bool, [a])
_o -> Mat ns a -> Either String (Mat ns a)
forall a b. b -> Either a b
Right (Mat ns a -> Either String (Mat ns a))
-> Mat ns a -> Either String (Mat ns a)
forall a b. (a -> b) -> a -> b
$ Vector a -> NonEmpty Pos -> Mat ns a
forall (ns :: [Nat]) a.
(NS ns, HasCallStack) =>
Vector a -> NonEmpty Pos -> Mat ns a
MatU (Int -> [a] -> Vector a
forall a. Int -> [a] -> Vector a
V.fromListN (Pos -> Int
unP Pos
n) (NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
N.toList NonEmpty a
as)) NonEmpty Pos
ns
pureMat :: forall ns a. NS ns => a -> Mat ns a
pureMat :: a -> Mat ns a
pureMat a
a =
let ns :: NonEmpty Pos
ns = NS ns => NonEmpty Pos
forall (ns :: [Nat]). NS ns => NonEmpty Pos
fromNSP @ns
in Vector a -> NonEmpty Pos -> Mat ns a
forall (ns :: [Nat]) a.
(NS ns, HasCallStack) =>
Vector a -> NonEmpty Pos -> Mat ns a
MatU (Int -> a -> Vector a
forall a. Int -> a -> Vector a
V.replicate (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
ns) a
a) NonEmpty Pos
ns
replicateMat :: forall n n1 ns a. PosC n => Mat (n1 ': ns) a -> Mat (n ': n1 ': ns) a
replicateMat :: Mat (n1 : ns) a -> Mat (n : n1 : ns) a
replicateMat (Mat Vector a
v NonEmpty Pos
ns) =
let n :: Pos
n = PosC n => Pos
forall (n :: Nat). PosC n => Pos
fromNP @n
in Vector a -> NonEmpty Pos -> Mat (n : n1 : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ([Vector a] -> Vector a
forall a. [Vector a] -> Vector a
V.concat (Int -> Vector a -> [Vector a]
forall a. Int -> a -> [a]
replicate (Pos -> Int
unP Pos
n) Vector a
v)) (Pos
n Pos -> NonEmpty Pos -> NonEmpty Pos
forall a. a -> NonEmpty a -> NonEmpty a
N.<| NonEmpty Pos
ns)
instance (NS ns, Num a) => Num (Mat ns a) where
+ :: Mat ns a -> Mat ns a -> Mat ns a
(+) = (a -> a -> a) -> Mat ns a -> Mat ns a -> Mat ns a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
(-) = (a -> a -> a) -> Mat ns a -> Mat ns a -> Mat ns a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
* :: Mat ns a -> Mat ns a -> Mat ns a
(*) = (a -> a -> a) -> Mat ns a -> Mat ns a -> Mat ns a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
negate :: Mat ns a -> Mat ns a
negate = (a -> a) -> Mat ns a -> Mat ns a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
signum :: Mat ns a -> Mat ns a
signum = (a -> a) -> Mat ns a -> Mat ns a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
fromInteger :: Integer -> Mat ns a
fromInteger = a -> Mat ns a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Mat ns a) -> (Integer -> a) -> Integer -> Mat ns a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
abs :: Mat ns a -> Mat ns a
abs = (a -> a) -> Mat ns a -> Mat ns a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
instance (NS ns, Fractional a) => Fractional (Mat ns a) where
/ :: Mat ns a -> Mat ns a -> Mat ns a
(/) = (a -> a -> a) -> Mat ns a -> Mat ns a -> Mat ns a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)
recip :: Mat ns a -> Mat ns a
recip = (a -> a) -> Mat ns a -> Mat ns a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
fromRational :: Rational -> Mat ns a
fromRational = a -> Mat ns a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Mat ns a) -> (Rational -> a) -> Rational -> Mat ns a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
instance NS ns => Applicative (Mat ns) where
pure :: a -> Mat ns a
pure = a -> Mat ns a
forall (ns :: [Nat]) a. NS ns => a -> Mat ns a
pureMat
<*> :: Mat ns (a -> b) -> Mat ns a -> Mat ns b
(<*>) = Mat ns (a -> b) -> Mat ns a -> Mat ns b
forall (ns :: [Nat]) a b. Mat ns (a -> b) -> Mat ns a -> Mat ns b
ap2
ap2 :: Mat ns (a -> b) -> Mat ns a -> Mat ns b
ap2 :: Mat ns (a -> b) -> Mat ns a -> Mat ns b
ap2 (Mat Vector (a -> b)
vab NonEmpty Pos
ps) (Mat Vector a
va NonEmpty Pos
_) = Vector b -> NonEmpty Pos -> Mat ns b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (((a -> b) -> a -> b) -> Vector (a -> b) -> Vector a -> Vector b
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith (a -> b) -> a -> b
forall a. a -> a
id Vector (a -> b)
vab Vector a
va) NonEmpty Pos
ps
ap3 :: NS ns => (a -> Mat ns b) -> Mat ns a -> Mat ns b
ap3 :: (a -> Mat ns b) -> Mat ns a -> Mat ns b
ap3 a -> Mat ns b
f = (FinMat ns -> a -> b) -> Mat ns a -> Mat ns b
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\FinMat ns
fn -> FinMat ns -> Mat ns b -> b
forall (ns :: [Nat]) a. FinMat ns -> Mat ns a -> a
indexMat FinMat ns
fn (Mat ns b -> b) -> (a -> Mat ns b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Mat ns b
f)
instance Apply.Apply (Mat ns) where
<.> :: Mat ns (a -> b) -> Mat ns a -> Mat ns b
(<.>) = Mat ns (a -> b) -> Mat ns a -> Mat ns b
forall (ns :: [Nat]) a b. Mat ns (a -> b) -> Mat ns a -> Mat ns b
ap2
instance NS ns => Monad (Mat ns) where
>>= :: Mat ns a -> (a -> Mat ns b) -> Mat ns b
(>>=) = ((a -> Mat ns b) -> Mat ns a -> Mat ns b)
-> Mat ns a -> (a -> Mat ns b) -> Mat ns b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Mat ns b) -> Mat ns a -> Mat ns b
forall (ns :: [Nat]) a b.
NS ns =>
(a -> Mat ns b) -> Mat ns a -> Mat ns b
ap3
instance NS ns => Bind.Bind (Mat ns) where
>>- :: Mat ns a -> (a -> Mat ns b) -> Mat ns b
(>>-) = ((a -> Mat ns b) -> Mat ns a -> Mat ns b)
-> Mat ns a -> (a -> Mat ns b) -> Mat ns b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Mat ns b) -> Mat ns a -> Mat ns b
forall (ns :: [Nat]) a b.
NS ns =>
(a -> Mat ns b) -> Mat ns a -> Mat ns b
ap3
instance NS ns => MonadZip (Mat ns) where
mzipWith :: (a -> b -> c) -> Mat ns a -> Mat ns b -> Mat ns c
mzipWith = (a -> b -> c) -> Mat ns a -> Mat ns b -> Mat ns c
forall a b c (ns :: [Nat]).
(a -> b -> c) -> Mat ns a -> Mat ns b -> Mat ns c
zipWithMat
zipWithMat :: (a -> b -> c) -> Mat ns a -> Mat ns b -> Mat ns c
zipWithMat :: (a -> b -> c) -> Mat ns a -> Mat ns b -> Mat ns c
zipWithMat a -> b -> c
f (Mat Vector a
v NonEmpty Pos
ps) (Mat Vector b
w NonEmpty Pos
_) = Vector c -> NonEmpty Pos -> Mat ns c
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ((a -> b -> c) -> Vector a -> Vector b -> Vector c
forall a b c. (a -> b -> c) -> Vector a -> Vector b -> Vector c
V.zipWith a -> b -> c
f Vector a
v Vector b
w) NonEmpty Pos
ps
zipWithMat3 :: (a -> b -> c -> d) -> Mat ns a -> Mat ns b -> Mat ns c -> Mat ns d
zipWithMat3 :: (a -> b -> c -> d) -> Mat ns a -> Mat ns b -> Mat ns c -> Mat ns d
zipWithMat3 a -> b -> c -> d
f (Mat Vector a
v NonEmpty Pos
ps) (Mat Vector b
w NonEmpty Pos
_) (Mat Vector c
x NonEmpty Pos
_) = Vector d -> NonEmpty Pos -> Mat ns d
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ((a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
forall a b c d.
(a -> b -> c -> d) -> Vector a -> Vector b -> Vector c -> Vector d
V.zipWith3 a -> b -> c -> d
f Vector a
v Vector b
w Vector c
x) NonEmpty Pos
ps
zipMat :: Mat ns a -> Mat ns b -> Mat ns (a, b)
zipMat :: Mat ns a -> Mat ns b -> Mat ns (a, b)
zipMat = (a -> b -> (a, b)) -> Mat ns a -> Mat ns b -> Mat ns (a, b)
forall a b c (ns :: [Nat]).
(a -> b -> c) -> Mat ns a -> Mat ns b -> Mat ns c
zipWithMat (,)
zipWithMatA ::
Applicative f =>
(a -> b -> f c) ->
Mat ns a ->
Mat ns b ->
f (Mat ns c)
zipWithMatA :: (a -> b -> f c) -> Mat ns a -> Mat ns b -> f (Mat ns c)
zipWithMatA a -> b -> f c
f = ((a, b) -> f c) -> Mat ns (a, b) -> f (Mat ns c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> b -> f c) -> (a, b) -> f c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> f c
f) (Mat ns (a, b) -> f (Mat ns c))
-> (Mat ns a -> Mat ns b -> Mat ns (a, b))
-> Mat ns a
-> Mat ns b
-> f (Mat ns c)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ Mat ns a -> Mat ns b -> Mat ns (a, b)
forall (ns :: [Nat]) a b. Mat ns a -> Mat ns b -> Mat ns (a, b)
zipMat
izipWith ::
NS ns =>
(FinMat ns -> a -> b -> c) ->
Mat ns a ->
Mat ns b ->
Mat ns c
izipWith :: (FinMat ns -> a -> b -> c) -> Mat ns a -> Mat ns b -> Mat ns c
izipWith FinMat ns -> a -> b -> c
f = (FinMat ns -> a -> b -> c)
-> Mat ns (FinMat ns) -> Mat ns a -> Mat ns b -> Mat ns c
forall a b c d (ns :: [Nat]).
(a -> b -> c -> d) -> Mat ns a -> Mat ns b -> Mat ns c -> Mat ns d
zipWithMat3 FinMat ns -> a -> b -> c
f Mat ns (FinMat ns)
forall (ns :: [Nat]). NS ns => Mat ns (FinMat ns)
finMatMatrix
izipWithM ::
(NS ns, Applicative f) =>
(FinMat ns -> a -> b -> f c) ->
Mat ns a ->
Mat ns b ->
f (Mat ns c)
izipWithM :: (FinMat ns -> a -> b -> f c)
-> Mat ns a -> Mat ns b -> f (Mat ns c)
izipWithM FinMat ns -> a -> b -> f c
f = (FinMat ns -> (a, b) -> f c) -> Mat ns (a, b) -> f (Mat ns c)
forall i (t :: * -> *) (f :: * -> *) a b.
(TraversableWithIndex i t, Applicative f) =>
(i -> a -> f b) -> t a -> f (t b)
itraverse ((a -> b -> f c) -> (a, b) -> f c
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> b -> f c) -> (a, b) -> f c)
-> (FinMat ns -> a -> b -> f c) -> FinMat ns -> (a, b) -> f c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinMat ns -> a -> b -> f c
f) (Mat ns (a, b) -> f (Mat ns c))
-> (Mat ns a -> Mat ns b -> Mat ns (a, b))
-> Mat ns a
-> Mat ns b
-> f (Mat ns c)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ Mat ns a -> Mat ns b -> Mat ns (a, b)
forall (ns :: [Nat]) a b. Mat ns a -> Mat ns b -> Mat ns (a, b)
zipMat
instance Foldable1 (Mat ns) where
foldMap1 :: (a -> m) -> Mat ns a -> m
foldMap1 a -> m
f = (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f (NonEmpty a -> m) -> (Mat ns a -> NonEmpty a) -> Mat ns a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> NonEmpty a
forall a. HasCallStack => [a] -> NonEmpty a
nep ([a] -> NonEmpty a) -> (Mat ns a -> [a]) -> Mat ns a -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a]) -> (Mat ns a -> Vector a) -> Mat ns a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat ns a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec
instance Traversable1 (Mat ns) where
traverse1 :: (a -> f b) -> Mat ns a -> f (Mat ns b)
traverse1 a -> f b
f (Mat Vector a
v NonEmpty Pos
ps) =
case Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector a
v of
[] -> String -> f (Mat ns b)
forall a. HasCallStack => String -> a
programmError String
"Mat: traverse1: empty vector"
a
a : [a]
as -> (\(b
b :| [b]
bs) -> Vector b -> NonEmpty Pos -> Mat ns b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ([b] -> Vector b
forall a. [a] -> Vector a
V.fromList (b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
bs)) NonEmpty Pos
ps) (NonEmpty b -> Mat ns b) -> f (NonEmpty b) -> f (Mat ns b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> NonEmpty a -> f (NonEmpty b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 a -> f b
f (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as)
instance Semigroup a => Semigroup (Mat ns a) where
<> :: Mat ns a -> Mat ns a -> Mat ns a
(<>) = (a -> a -> a) -> Mat ns a -> Mat ns a -> Mat ns a
forall a b c (ns :: [Nat]).
(a -> b -> c) -> Mat ns a -> Mat ns b -> Mat ns c
zipWithMat a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Monoid a, NS ns) => Monoid (Mat ns a) where
mempty :: Mat ns a
mempty = a -> Mat ns a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
instance NS ns => FunctorWithIndex (FinMat ns) (Mat ns) where
imap :: (FinMat ns -> a -> b) -> Mat ns a -> Mat ns b
imap FinMat ns -> a -> b
f = (Int, Mat ns b) -> Mat ns b
forall a b. (a, b) -> b
snd ((Int, Mat ns b) -> Mat ns b)
-> (Mat ns a -> (Int, Mat ns b)) -> Mat ns a -> Mat ns b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> (Int, b)) -> Int -> Mat ns a -> (Int, Mat ns b)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
L.mapAccumL (\Int
i a
a -> (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, FinMat ns -> a -> b
f (Int -> NonEmpty Pos -> FinMat ns
forall (ns :: [Nat]).
(HasCallStack, NS ns) =>
Int -> NonEmpty Pos -> FinMat ns
FinMatU Int
i (NS ns => NonEmpty Pos
forall (ns :: [Nat]). NS ns => NonEmpty Pos
fromNSP @ns)) a
a)) Int
0
instance NS ns => FoldableWithIndex (FinMat ns) (Mat ns) where
ifoldMap :: (FinMat ns -> a -> m) -> Mat ns a -> m
ifoldMap FinMat ns -> a -> m
f = Mat ns m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Mat ns m -> m) -> (Mat ns a -> Mat ns m) -> Mat ns a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> a -> m) -> Mat ns a -> Mat ns m
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap FinMat ns -> a -> m
f
instance NS ns => TraversableWithIndex (FinMat ns) (Mat ns) where
itraverse :: (FinMat ns -> a -> f b) -> Mat ns a -> f (Mat ns b)
itraverse FinMat ns -> a -> f b
f = Mat ns (f b) -> f (Mat ns b)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Mat ns (f b) -> f (Mat ns b))
-> (Mat ns a -> Mat ns (f b)) -> Mat ns a -> f (Mat ns b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> a -> f b) -> Mat ns a -> Mat ns (f b)
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap FinMat ns -> a -> f b
f
instance NS ns => Distributive (Mat ns) where
collect :: (a -> Mat ns b) -> f a -> Mat ns (f b)
collect a -> Mat ns b
agb f a
fa =
let z :: f (Mat ns b)
z = a -> Mat ns b
agb (a -> Mat ns b) -> f a -> f (Mat ns b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa
in (FinMat ns -> () -> f b) -> Mat ns () -> Mat ns (f b)
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (\FinMat ns
fm -> f b -> () -> f b
forall a b. a -> b -> a
const ((Vector b -> Int -> b
forall a. Vector a -> Int -> a
V.! FinMat ns -> Int
forall (ns :: [Nat]). FinMat ns -> Int
fmPos FinMat ns
fm) (Vector b -> b) -> (Mat ns b -> Vector b) -> Mat ns b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat ns b -> Vector b
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec (Mat ns b -> b) -> f (Mat ns b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Mat ns b)
z)) (() -> Mat ns ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
indexMat :: FinMat ns -> Mat ns a -> a
indexMat :: FinMat ns -> Mat ns a -> a
indexMat FinMat ns
fm = (Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! FinMat ns -> Int
forall (ns :: [Nat]). FinMat ns -> Int
fmPos FinMat ns
fm) (Vector a -> a) -> (Mat ns a -> Vector a) -> Mat ns a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat ns a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec
finMatMatrix :: forall ns. NS ns => Mat ns (FinMat ns)
finMatMatrix :: Mat ns (FinMat ns)
finMatMatrix = Mat ns () -> Mat ns (FinMat ns)
forall (ns :: [Nat]) x. NS ns => Mat ns x -> Mat ns (FinMat ns)
finMatMatrix' (() -> Mat ns ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
finMatMatrix' :: forall ns x. NS ns => Mat ns x -> Mat ns (FinMat ns)
finMatMatrix' :: Mat ns x -> Mat ns (FinMat ns)
finMatMatrix' = (FinMat ns -> x -> FinMat ns) -> Mat ns x -> Mat ns (FinMat ns)
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap FinMat ns -> x -> FinMat ns
forall a b. a -> b -> a
const
instance NS ns => Representable (Mat ns) where
type Rep (Mat ns) = FinMat ns
tabulate :: (Rep (Mat ns) -> a) -> Mat ns a
tabulate Rep (Mat ns) -> a
f = (FinMat ns -> () -> a) -> Mat ns () -> Mat ns a
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (a -> () -> a
forall a b. a -> b -> a
const (a -> () -> a) -> (FinMat ns -> a) -> FinMat ns -> () -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep (Mat ns) -> a
FinMat ns -> a
f) (() -> Mat ns ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
index :: Mat ns a -> Rep (Mat ns) -> a
index = (FinMat ns -> Mat ns a -> a) -> Mat ns a -> FinMat ns -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip FinMat ns -> Mat ns a -> a
forall (ns :: [Nat]) a. FinMat ns -> Mat ns a -> a
indexMat
instance NS ns => GE.IsList (Mat ns a) where
type Item (Mat ns a) = a
fromList :: [Item (Mat ns a)] -> Mat ns a
fromList = ([a], Mat ns a) -> Mat ns a
forall a b. (a, b) -> b
snd (([a], Mat ns a) -> Mat ns a)
-> ([a] -> ([a], Mat ns a)) -> [a] -> Mat ns a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String ([a], Mat ns a) -> ([a], Mat ns a)
forall a. HasCallStack => Either String a -> a
fr (Either String ([a], Mat ns a) -> ([a], Mat ns a))
-> ([a] -> Either String ([a], Mat ns a)) -> [a] -> ([a], Mat ns a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat ns () -> [a] -> Either String ([a], Mat ns a)
forall (t :: * -> *) a z.
Traversable t =>
t z -> [a] -> Either String ([a], t a)
fillTraversable (() -> Mat ns ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
toList :: Mat ns a -> [Item (Mat ns a)]
toList = Mat ns a -> [Item (Mat ns a)]
forall (ns :: [Nat]) a. Mat ns a -> [a]
toListMat
mkMat :: forall ns a. Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat :: Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat Vector a
v NonEmpty Pos
ps =
let n1 :: Int
n1 = NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
ps
n2 :: Int
n2 = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v
ret :: Bool
ret = Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2
in if Bool
ret
then Mat ns a -> Either String (Mat ns a)
forall a b. b -> Either a b
Right (Vector a -> NonEmpty Pos -> Mat ns a
forall (ns :: [Nat]) a. Vector a -> NonEmpty Pos -> Mat ns a
MatUnsafe Vector a
v NonEmpty Pos
ps)
else String -> Either String (Mat ns a)
forall a b. a -> Either a b
Left (String -> Either String (Mat ns a))
-> String -> Either String (Mat ns a)
forall a b. (a -> b) -> a -> b
$ String
"\n\nproduct of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (NonEmpty Pos -> [Int]
forall (t :: * -> *). Foldable t => t Pos -> [Int]
fromPositives NonEmpty Pos
ps) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n1 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nvector length=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
mkMatC :: forall ns a. NS ns => Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMatC :: Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMatC Vector a
v NonEmpty Pos
ps = do
let ps1 :: NonEmpty Pos
ps1 = NS ns => NonEmpty Pos
forall (ns :: [Nat]). NS ns => NonEmpty Pos
fromNSP @ns
if NonEmpty Pos
ps NonEmpty Pos -> NonEmpty Pos -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty Pos
ps1
then Vector a -> NonEmpty Pos -> Either String (Mat ns a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat Vector a
v NonEmpty Pos
ps
else String -> Either String (Mat ns a)
forall a b. a -> Either a b
Left (String -> Either String (Mat ns a))
-> String -> Either String (Mat ns a)
forall a b. (a -> b) -> a -> b
$ String
"\nns mismatch: expected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (NonEmpty Pos -> [Int]
forall (t :: * -> *). Foldable t => t Pos -> [Int]
fromPositives NonEmpty Pos
ps1) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show (NonEmpty Pos -> [Int]
forall (t :: * -> *). Foldable t => t Pos -> [Int]
fromPositives NonEmpty Pos
ps)
gen' :: forall ns a. NS ns => ([Int] -> a) -> Mat ns a
gen' :: ([Int] -> a) -> Mat ns a
gen' [Int] -> a
f = (Rep (Mat ns) -> a) -> Mat ns a
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate ([Int] -> a
f ([Int] -> a) -> (FinMat ns -> [Int]) -> FinMat ns -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Pos -> [Int]
forall (t :: * -> *). Foldable t => t Pos -> [Int]
fromPositives (NonEmpty Pos -> [Int])
-> (FinMat ns -> NonEmpty Pos) -> FinMat ns -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinMat ns -> NonEmpty Pos
forall (ns :: [Nat]). FinMat ns -> NonEmpty Pos
finMatToNonEmpty @ns)
gen :: forall ns a. NS ns => (Int -> a) -> Mat ns a
gen :: (Int -> a) -> Mat ns a
gen Int -> a
f = (Rep (Mat ns) -> a) -> Mat ns a
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate (Int -> a
f (Int -> a) -> (FinMat ns -> Int) -> FinMat ns -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinMat ns -> Int
forall (ns :: [Nat]). FinMat ns -> Int
fmPos)
mm :: forall ns. NS ns => Mat ns Int
mm :: Mat ns Int
mm = (Int -> Int) -> Mat ns Int
forall (ns :: [Nat]) a. NS ns => (Int -> a) -> Mat ns a
gen (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
ixMat :: forall (ns :: [Nat]) a. FinMat ns -> Lens' (Mat ns a) a
ixMat :: FinMat ns -> Lens' (Mat ns a) a
ixMat FinMat ns
i = (Mat ns a -> a)
-> (Mat ns a -> a -> Mat ns a) -> Lens' (Mat ns a) a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (FinMat ns -> Mat ns a -> a
forall (ns :: [Nat]) a. FinMat ns -> Mat ns a -> a
indexMat FinMat ns
i) (\Mat ns a
s a
b -> a -> FinMat ns -> Mat ns a -> Mat ns a
forall a (ns :: [Nat]). a -> FinMat ns -> Mat ns a -> Mat ns a
setMat a
b FinMat ns
i Mat ns a
s)
ixMat' ::
forall (is :: [Nat]) (ns :: [Nat]) a.
FinMatC is ns =>
Lens' (Mat ns a) a
ixMat' :: Lens' (Mat ns a) a
ixMat' = FinMat ns -> Lens' (Mat ns a) a
forall (ns :: [Nat]) a. FinMat ns -> Lens' (Mat ns a) a
ixMat (FinMatC is ns => FinMat ns
forall k (is :: k) (ns :: [Nat]). FinMatC is ns => FinMat ns
finMatC @is @ns)
setMat :: a -> FinMat ns -> Mat ns a -> Mat ns a
setMat :: a -> FinMat ns -> Mat ns a -> Mat ns a
setMat a
a FinMat ns
fm (Mat Vector a
v NonEmpty Pos
ps) = Vector a -> NonEmpty Pos -> Mat ns a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector a -> Vector (Int, a) -> Vector a
forall a. Vector a -> Vector (Int, a) -> Vector a
V.update Vector a
v ((Int, a) -> Vector (Int, a)
forall a. a -> Vector a
V.singleton (FinMat ns -> Int
forall (ns :: [Nat]). FinMat ns -> Int
fmPos FinMat ns
fm, a
a))) NonEmpty Pos
ps
updateMat :: (a -> a) -> FinMat ns -> Mat ns a -> Mat ns a
updateMat :: (a -> a) -> FinMat ns -> Mat ns a -> Mat ns a
updateMat a -> a
f (FinMat Int
i NonEmpty Pos
_) (Mat Vector a
v NonEmpty Pos
ps) = String -> Either String (Mat ns a) -> Mat ns a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"updateMat" (Either String (Mat ns a) -> Mat ns a)
-> Either String (Mat ns a) -> Mat ns a
forall a b. (a -> b) -> a -> b
$ do
let (Vector a
v1, Vector a
v2) = Int -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
i Vector a
v
case Vector a -> Maybe (a, Vector a)
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector a
v2 of
Just (a
a, Vector a
v2') -> Vector a -> NonEmpty Pos -> Either String (Mat ns a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Vector a
v1 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
V.cons (a -> a
f a
a) Vector a
v2') NonEmpty Pos
ps
Maybe (a, Vector a)
Nothing -> String -> Either String (Mat ns a)
forall a b. a -> Either a b
Left (String -> Either String (Mat ns a))
-> String -> Either String (Mat ns a)
forall a b. (a -> b) -> a -> b
$ String
"i=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
(.:) :: forall n a a'. a ~ a' => a -> Vec n a' -> Vec (1 GN.+ n) a'
a
a .: :: a -> Vec n a' -> Vec (1 + n) a'
.: Mat Vector a'
v (Pos
p :| [Pos]
ps) = Vector a -> NonEmpty Pos -> Mat '[1 + n] a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
V.cons a
a Vector a
Vector a'
v) (Pos -> Pos
succP Pos
p Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps)
infixr 4 .:
(.::) :: forall n m ns a. Mat (m ': ns) a -> Mat (n ': m ': ns) a -> Mat (1 GN.+ n ': m ': ns) a
Mat Vector a
v (Pos
_ :| [Pos]
_) .:: :: Mat (m : ns) a -> Mat (n : m : ns) a -> Mat ((1 + n) : m : ns) a
.:: Mat Vector a
v1 (Pos
p1 :| [Pos]
ps1) = Vector a -> NonEmpty Pos -> Mat ((1 + n) : m : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector a
v Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v1) (Pos -> Pos
succP Pos
p1 Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps1)
infixr 3 .::
(.|) :: forall a a'. a ~ a' => a -> a' -> Vec 2 a'
a
a .| :: a -> a' -> Vec 2 a'
.| a'
a' = Vector a -> NonEmpty Pos -> Mat '[2] a
forall (ns :: [Nat]) a.
(NS ns, HasCallStack) =>
Vector a -> NonEmpty Pos -> Mat ns a
MatU (a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
V.cons a
a (a' -> Vector a'
forall a. a -> Vector a
V.singleton a'
a')) (Pos
_2P Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [])
infixr 4 .|
(.||) :: forall m ns a. Mat (m ': ns) a -> Mat (m ': ns) a -> Mat (2 ': m ': ns) a
Mat Vector a
v (Pos
_ :| [Pos]
_) .|| :: Mat (m : ns) a -> Mat (m : ns) a -> Mat (2 : m : ns) a
.|| Mat Vector a
v1 (Pos
p1 :| [Pos]
ps1) = Vector a -> NonEmpty Pos -> Mat (2 : m : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector a
v Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v1) (Pos
_2P Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| Pos
p1 Pos -> [Pos] -> [Pos]
forall a. a -> [a] -> [a]
: [Pos]
ps1)
infixr 3 .||
se1 :: forall a. a -> Vec 1 a
se1 :: a -> Vec 1 a
se1 a
a = Vector a -> NonEmpty Pos -> Vec 1 a
forall (ns :: [Nat]) a.
(NS ns, HasCallStack) =>
Vector a -> NonEmpty Pos -> Mat ns a
MatU (a -> Vector a
forall a. a -> Vector a
V.singleton a
a) (Pos
_1P Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [])
se2 :: forall n ns a. Mat (n ': ns) a -> Mat (1 ': n ': ns) a
se2 :: Mat (n : ns) a -> Mat (1 : n : ns) a
se2 (Mat Vector a
v NonEmpty Pos
ps) = Vector a -> NonEmpty Pos -> Mat (1 : n : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector a
v (Pos
_1P Pos -> NonEmpty Pos -> NonEmpty Pos
forall a. a -> NonEmpty a -> NonEmpty a
N.<| NonEmpty Pos
ps)
vec :: forall n a. (HasCallStack, PosC n) => [a] -> Vec n a
vec :: [a] -> Vec n a
vec = forall (ns :: [Nat]) a. (HasCallStack, NS ns) => [a] -> Mat ns a
forall a. (HasCallStack, NS '[n]) => [a] -> Mat '[n] a
mat @'[n]
vec' :: forall n a. (HasCallStack, PosC n) => [a] -> Vec n a
vec' :: [a] -> Vec n a
vec' = forall (ns :: [Nat]) a. (HasCallStack, NS ns) => [a] -> Mat ns a
forall a. (HasCallStack, NS '[n]) => [a] -> Mat '[n] a
mat' @'[n]
mat2 :: forall n m a. (HasCallStack, PosC n, PosC m) => [a] -> Mat2 n m a
mat2 :: [a] -> Mat2 n m a
mat2 = forall (ns :: [Nat]) a. (HasCallStack, NS ns) => [a] -> Mat ns a
forall a. (HasCallStack, NS '[n, m]) => [a] -> Mat '[n, m] a
mat @'[n, m]
mat2' :: forall n m a. (HasCallStack, PosC n, PosC m) => [a] -> Mat2 n m a
mat2' :: [a] -> Mat2 n m a
mat2' = forall (ns :: [Nat]) a. (HasCallStack, NS ns) => [a] -> Mat ns a
forall a. (HasCallStack, NS '[n, m]) => [a] -> Mat '[n, m] a
mat' @'[n, m]
mapCols ::
forall n m ns a b.
(FinMat (m ': n ': ns) -> Vec (TP.LastT (n ': ns)) a -> Vec (TP.LastT (n ': ns)) b) ->
Mat (n ': m ': ns) a ->
Mat (n ': m ': ns) b
mapCols :: (FinMat (m : n : ns)
-> Vec (LastT (n : ns)) a -> Vec (LastT (n : ns)) b)
-> Mat (n : m : ns) a -> Mat (n : m : ns) b
mapCols FinMat (m : n : ns)
-> Vec (LastT (n : ns)) a -> Vec (LastT (n : ns)) b
f = Mat (m : n : ns) b -> Mat (n : m : ns) b
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat (Mat (m : n : ns) b -> Mat (n : m : ns) b)
-> (Mat (n : m : ns) a -> Mat (m : n : ns) b)
-> Mat (n : m : ns) a
-> Mat (n : m : ns) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat (m : n : ns)
-> Vec (LastT (m : n : ns)) a -> Vec (LastT (m : n : ns)) b)
-> Mat (m : n : ns) a -> Mat (m : n : ns) b
forall (ns :: [Nat]) a b.
LeafC ns =>
(FinMat ns -> Vec (LastT ns) a -> Vec (LastT ns) b)
-> Mat ns a -> Mat ns b
mapLeafSimple FinMat (m : n : ns)
-> Vec (LastT (n : ns)) a -> Vec (LastT (n : ns)) b
FinMat (m : n : ns)
-> Vec (LastT (m : n : ns)) a -> Vec (LastT (m : n : ns)) b
f (Mat (m : n : ns) a -> Mat (m : n : ns) b)
-> (Mat (n : m : ns) a -> Mat (m : n : ns) a)
-> Mat (n : m : ns) a
-> Mat (m : n : ns) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat (n : m : ns) a -> Mat (m : n : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat
mapCols' ::
forall n m ns a b c.
(FinMat (m ': n ': ns) -> c -> Vec (TP.LastT (n ': ns)) a -> (c, Vec (TP.LastT (n ': ns)) b)) ->
c ->
Mat (n ': m ': ns) a ->
(c, Mat (n ': m ': ns) b)
mapCols' :: (FinMat (m : n : ns)
-> c -> Vec (LastT (n : ns)) a -> (c, Vec (LastT (n : ns)) b))
-> c -> Mat (n : m : ns) a -> (c, Mat (n : m : ns) b)
mapCols' FinMat (m : n : ns)
-> c -> Vec (LastT (n : ns)) a -> (c, Vec (LastT (n : ns)) b)
f c
c = (Mat (m : n : ns) b -> Mat (n : m : ns) b)
-> (c, Mat (m : n : ns) b) -> (c, Mat (n : m : ns) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mat (m : n : ns) b -> Mat (n : m : ns) b
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat ((c, Mat (m : n : ns) b) -> (c, Mat (n : m : ns) b))
-> (Mat (n : m : ns) a -> (c, Mat (m : n : ns) b))
-> Mat (n : m : ns) a
-> (c, Mat (n : m : ns) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat (m : n : ns)
-> c
-> Vec (LastT (m : n : ns)) a
-> (c, Vec (LastT (m : n : ns)) b))
-> c -> Mat (m : n : ns) a -> (c, Mat (m : n : ns) b)
forall (ns :: [Nat]) c a b.
LeafC ns =>
(FinMat ns -> c -> Vec (LastT ns) a -> (c, Vec (LastT ns) b))
-> c -> Mat ns a -> (c, Mat ns b)
mapLeafSimpleS FinMat (m : n : ns)
-> c -> Vec (LastT (n : ns)) a -> (c, Vec (LastT (n : ns)) b)
FinMat (m : n : ns)
-> c
-> Vec (LastT (m : n : ns)) a
-> (c, Vec (LastT (m : n : ns)) b)
f c
c (Mat (m : n : ns) a -> (c, Mat (m : n : ns) b))
-> (Mat (n : m : ns) a -> Mat (m : n : ns) a)
-> Mat (n : m : ns) a
-> (c, Mat (m : n : ns) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat (n : m : ns) a -> Mat (m : n : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat
traverseLeafSimple ::
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (TP.LastT ns) a -> m (Vec (TP.LastT ns) b)) ->
Mat ns a ->
m (Mat ns b)
traverseLeafSimple :: (FinMat ns -> Vec (LastT ns) a -> m (Vec (LastT ns) b))
-> Mat ns a -> m (Mat ns b)
traverseLeafSimple FinMat ns -> Vec (LastT ns) a -> m (Vec (LastT ns) b)
f = (Mat (InitT ns) (Vec (LastT ns) b) -> Mat ns b)
-> m (Mat (InitT ns) (Vec (LastT ns) b)) -> m (Mat ns b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mat (InitT ns) (Vec (LastT ns) b) -> Mat ns b
forall (ns :: [Nat]) a.
LeafC ns =>
Mat (InitT ns) (Vec (LastT ns) a) -> Mat ns a
fromLeavesInternalC (m (Mat (InitT ns) (Vec (LastT ns) b)) -> m (Mat ns b))
-> (Mat ns a -> m (Mat (InitT ns) (Vec (LastT ns) b)))
-> Mat ns a
-> m (Mat ns b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (LastT ns) a -> m (Vec (LastT ns) b))
-> Mat ns a -> m (Mat (InitT ns) (Vec (LastT ns) b))
forall (ns :: [Nat]) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (LastT ns) a -> m b)
-> Mat ns a -> m (Mat (InitT ns) b)
traverseLeafC FinMat ns -> Vec (LastT ns) a -> m (Vec (LastT ns) b)
f
mapLeafSimple ::
LeafC ns =>
(FinMat ns -> Vec (TP.LastT ns) a -> Vec (TP.LastT ns) b) ->
Mat ns a ->
Mat ns b
mapLeafSimple :: (FinMat ns -> Vec (LastT ns) a -> Vec (LastT ns) b)
-> Mat ns a -> Mat ns b
mapLeafSimple FinMat ns -> Vec (LastT ns) a -> Vec (LastT ns) b
f = Mat (InitT ns) (Vec (LastT ns) b) -> Mat ns b
forall (ns :: [Nat]) a.
LeafC ns =>
Mat (InitT ns) (Vec (LastT ns) a) -> Mat ns a
fromLeavesInternalC (Mat (InitT ns) (Vec (LastT ns) b) -> Mat ns b)
-> (Mat ns a -> Mat (InitT ns) (Vec (LastT ns) b))
-> Mat ns a
-> Mat ns b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Mat (InitT ns) (Vec (LastT ns) b))
-> Mat (InitT ns) (Vec (LastT ns) b)
forall a. Identity a -> a
runIdentity (Identity (Mat (InitT ns) (Vec (LastT ns) b))
-> Mat (InitT ns) (Vec (LastT ns) b))
-> (Mat ns a -> Identity (Mat (InitT ns) (Vec (LastT ns) b)))
-> Mat ns a
-> Mat (InitT ns) (Vec (LastT ns) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (LastT ns) a -> Identity (Vec (LastT ns) b))
-> Mat ns a -> Identity (Mat (InitT ns) (Vec (LastT ns) b))
forall (ns :: [Nat]) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (LastT ns) a -> m b)
-> Mat ns a -> m (Mat (InitT ns) b)
traverseLeafC (Vec (LastT ns) b -> Identity (Vec (LastT ns) b)
forall a. a -> Identity a
Identity (Vec (LastT ns) b -> Identity (Vec (LastT ns) b))
-> (FinMat ns -> Vec (LastT ns) a -> Vec (LastT ns) b)
-> FinMat ns
-> Vec (LastT ns) a
-> Identity (Vec (LastT ns) b)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ FinMat ns -> Vec (LastT ns) a -> Vec (LastT ns) b
f)
foldMapLeaf
, foldMapLeafR ::
(Monoid z, LeafC ns) =>
(FinMat ns -> Vec (TP.LastT ns) a -> z) ->
Mat ns a ->
z
foldMapLeaf :: (FinMat ns -> Vec (LastT ns) a -> z) -> Mat ns a -> z
foldMapLeaf FinMat ns -> Vec (LastT ns) a -> z
f = Const z (Mat (InitT ns) Any) -> z
forall a k (b :: k). Const a b -> a
getConst (Const z (Mat (InitT ns) Any) -> z)
-> (Mat ns a -> Const z (Mat (InitT ns) Any)) -> Mat ns a -> z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (LastT ns) a -> Const z Any)
-> Mat ns a -> Const z (Mat (InitT ns) Any)
forall (ns :: [Nat]) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (LastT ns) a -> m b)
-> Mat ns a -> m (Mat (InitT ns) b)
traverseLeafC (z -> Const z Any
forall k a (b :: k). a -> Const a b
Const (z -> Const z Any)
-> (FinMat ns -> Vec (LastT ns) a -> z)
-> FinMat ns
-> Vec (LastT ns) a
-> Const z Any
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ FinMat ns -> Vec (LastT ns) a -> z
f)
foldMapLeafR :: (FinMat ns -> Vec (LastT ns) a -> z) -> Mat ns a -> z
foldMapLeafR FinMat ns -> Vec (LastT ns) a -> z
f = Const z (Mat (InitT ns) Any) -> z
forall a k (b :: k). Const a b -> a
getConst (Const z (Mat (InitT ns) Any) -> z)
-> (Mat ns a -> Const z (Mat (InitT ns) Any)) -> Mat ns a -> z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backwards (Const z) (Mat (InitT ns) Any)
-> Const z (Mat (InitT ns) Any)
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards (Const z) (Mat (InitT ns) Any)
-> Const z (Mat (InitT ns) Any))
-> (Mat ns a -> Backwards (Const z) (Mat (InitT ns) Any))
-> Mat ns a
-> Const z (Mat (InitT ns) Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (LastT ns) a -> Backwards (Const z) Any)
-> Mat ns a -> Backwards (Const z) (Mat (InitT ns) Any)
forall (ns :: [Nat]) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (LastT ns) a -> m b)
-> Mat ns a -> m (Mat (InitT ns) b)
traverseLeafC ((Const z Any -> Backwards (Const z) Any
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (Const z Any -> Backwards (Const z) Any)
-> (z -> Const z Any) -> z -> Backwards (Const z) Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. z -> Const z Any
forall k a (b :: k). a -> Const a b
Const) (z -> Backwards (Const z) Any)
-> (FinMat ns -> Vec (LastT ns) a -> z)
-> FinMat ns
-> Vec (LastT ns) a
-> Backwards (Const z) Any
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ FinMat ns -> Vec (LastT ns) a -> z
f)
mapLeaf ::
LeafC ns =>
(FinMat ns -> Vec (TP.LastT ns) a -> b) ->
Mat ns a ->
Mat (TP.InitT ns) b
mapLeaf :: (FinMat ns -> Vec (LastT ns) a -> b)
-> Mat ns a -> Mat (InitT ns) b
mapLeaf FinMat ns -> Vec (LastT ns) a -> b
f = Identity (Mat (InitT ns) b) -> Mat (InitT ns) b
forall a. Identity a -> a
runIdentity (Identity (Mat (InitT ns) b) -> Mat (InitT ns) b)
-> (Mat ns a -> Identity (Mat (InitT ns) b))
-> Mat ns a
-> Mat (InitT ns) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (LastT ns) a -> Identity b)
-> Mat ns a -> Identity (Mat (InitT ns) b)
forall (ns :: [Nat]) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (LastT ns) a -> m b)
-> Mat ns a -> m (Mat (InitT ns) b)
traverseLeafC (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b)
-> (FinMat ns -> Vec (LastT ns) a -> b)
-> FinMat ns
-> Vec (LastT ns) a
-> Identity b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ FinMat ns -> Vec (LastT ns) a -> b
f)
mapLeafS ::
LeafC ns =>
(FinMat ns -> c -> Vec (TP.LastT ns) a -> (c, b)) ->
c ->
Mat ns a ->
(c, Mat (TP.InitT ns) b)
mapLeafS :: (FinMat ns -> c -> Vec (LastT ns) a -> (c, b))
-> c -> Mat ns a -> (c, Mat (InitT ns) b)
mapLeafS FinMat ns -> c -> Vec (LastT ns) a -> (c, b)
f c
c0 = (Mat (InitT ns) b, c) -> (c, Mat (InitT ns) b)
forall a b. (a, b) -> (b, a)
swap ((Mat (InitT ns) b, c) -> (c, Mat (InitT ns) b))
-> (Mat ns a -> (Mat (InitT ns) b, c))
-> Mat ns a
-> (c, Mat (InitT ns) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State c (Mat (InitT ns) b) -> c -> (Mat (InitT ns) b, c))
-> c -> State c (Mat (InitT ns) b) -> (Mat (InitT ns) b, c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State c (Mat (InitT ns) b) -> c -> (Mat (InitT ns) b, c)
forall s a. State s a -> s -> (a, s)
S.runState c
c0 (State c (Mat (InitT ns) b) -> (Mat (InitT ns) b, c))
-> (Mat ns a -> State c (Mat (InitT ns) b))
-> Mat ns a
-> (Mat (InitT ns) b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (LastT ns) a -> StateT c Identity b)
-> Mat ns a -> State c (Mat (InitT ns) b)
forall (ns :: [Nat]) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (LastT ns) a -> m b)
-> Mat ns a -> m (Mat (InitT ns) b)
traverseLeafC (\FinMat ns
i Vec (LastT ns) a
a -> (c -> (b, c)) -> StateT c Identity b
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
S.state ((c -> (b, c)) -> StateT c Identity b)
-> (c -> (b, c)) -> StateT c Identity b
forall a b. (a -> b) -> a -> b
$ \c
c -> (c, b) -> (b, c)
forall a b. (a, b) -> (b, a)
swap (FinMat ns -> c -> Vec (LastT ns) a -> (c, b)
f FinMat ns
i c
c Vec (LastT ns) a
a))
mapLeafSimpleS ::
LeafC ns =>
(FinMat ns -> c -> Vec (TP.LastT ns) a -> (c, Vec (TP.LastT ns) b)) ->
c ->
Mat ns a ->
(c, Mat ns b)
mapLeafSimpleS :: (FinMat ns -> c -> Vec (LastT ns) a -> (c, Vec (LastT ns) b))
-> c -> Mat ns a -> (c, Mat ns b)
mapLeafSimpleS FinMat ns -> c -> Vec (LastT ns) a -> (c, Vec (LastT ns) b)
f c
c0 =
(Mat (InitT ns) (Vec (LastT ns) b) -> Mat ns b)
-> (c, Mat (InitT ns) (Vec (LastT ns) b)) -> (c, Mat ns b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Mat (InitT ns) (Vec (LastT ns) b) -> Mat ns b
forall (ns :: [Nat]) a.
LeafC ns =>
Mat (InitT ns) (Vec (LastT ns) a) -> Mat ns a
fromLeavesInternalC ((c, Mat (InitT ns) (Vec (LastT ns) b)) -> (c, Mat ns b))
-> (Mat ns a -> (c, Mat (InitT ns) (Vec (LastT ns) b)))
-> Mat ns a
-> (c, Mat ns b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mat (InitT ns) (Vec (LastT ns) b), c)
-> (c, Mat (InitT ns) (Vec (LastT ns) b))
forall a b. (a, b) -> (b, a)
swap ((Mat (InitT ns) (Vec (LastT ns) b), c)
-> (c, Mat (InitT ns) (Vec (LastT ns) b)))
-> (Mat ns a -> (Mat (InitT ns) (Vec (LastT ns) b), c))
-> Mat ns a
-> (c, Mat (InitT ns) (Vec (LastT ns) b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State c (Mat (InitT ns) (Vec (LastT ns) b))
-> c -> (Mat (InitT ns) (Vec (LastT ns) b), c))
-> c
-> State c (Mat (InitT ns) (Vec (LastT ns) b))
-> (Mat (InitT ns) (Vec (LastT ns) b), c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State c (Mat (InitT ns) (Vec (LastT ns) b))
-> c -> (Mat (InitT ns) (Vec (LastT ns) b), c)
forall s a. State s a -> s -> (a, s)
S.runState c
c0 (State c (Mat (InitT ns) (Vec (LastT ns) b))
-> (Mat (InitT ns) (Vec (LastT ns) b), c))
-> (Mat ns a -> State c (Mat (InitT ns) (Vec (LastT ns) b)))
-> Mat ns a
-> (Mat (InitT ns) (Vec (LastT ns) b), c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns
-> Vec (LastT ns) a -> StateT c Identity (Vec (LastT ns) b))
-> Mat ns a -> State c (Mat (InitT ns) (Vec (LastT ns) b))
forall (ns :: [Nat]) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (LastT ns) a -> m b)
-> Mat ns a -> m (Mat (InitT ns) b)
traverseLeafC (\FinMat ns
i Vec (LastT ns) a
a -> (c -> (Vec (LastT ns) b, c))
-> StateT c Identity (Vec (LastT ns) b)
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
S.state ((c -> (Vec (LastT ns) b, c))
-> StateT c Identity (Vec (LastT ns) b))
-> (c -> (Vec (LastT ns) b, c))
-> StateT c Identity (Vec (LastT ns) b)
forall a b. (a -> b) -> a -> b
$ \c
c -> (c, Vec (LastT ns) b) -> (Vec (LastT ns) b, c)
forall a b. (a, b) -> (b, a)
swap (FinMat ns -> c -> Vec (LastT ns) a -> (c, Vec (LastT ns) b)
f FinMat ns
i c
c Vec (LastT ns) a
a))
foldLeaf ::
LeafC ns =>
(FinMat ns -> c -> Vec (TP.LastT ns) a -> c) ->
c ->
Mat ns a ->
c
foldLeaf :: (FinMat ns -> c -> Vec (LastT ns) a -> c) -> c -> Mat ns a -> c
foldLeaf FinMat ns -> c -> Vec (LastT ns) a -> c
f = (c, Mat (InitT ns) ()) -> c
forall a b. (a, b) -> a
fst ((c, Mat (InitT ns) ()) -> c)
-> (c -> Mat ns a -> (c, Mat (InitT ns) ())) -> c -> Mat ns a -> c
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (FinMat ns -> c -> Vec (LastT ns) a -> (c, ()))
-> c -> Mat ns a -> (c, Mat (InitT ns) ())
forall (ns :: [Nat]) c a b.
LeafC ns =>
(FinMat ns -> c -> Vec (LastT ns) a -> (c, b))
-> c -> Mat ns a -> (c, Mat (InitT ns) b)
mapLeafS FinMat ns -> c -> Vec (LastT ns) a -> (c, ())
g
where
g :: FinMat ns -> c -> Vec (LastT ns) a -> (c, ())
g FinMat ns
fn c
c Vec (LastT ns) a
m = (FinMat ns -> c -> Vec (LastT ns) a -> c
f FinMat ns
fn c
c Vec (LastT ns) a
m, ())
toLeaves ::
LeafC ns =>
Mat ns a ->
Mat (TP.InitT ns) (Vec (TP.LastT ns) a)
toLeaves :: Mat ns a -> Mat (InitT ns) (Vec (LastT ns) a)
toLeaves = (FinMat ns -> Vec (LastT ns) a -> Vec (LastT ns) a)
-> Mat ns a -> Mat (InitT ns) (Vec (LastT ns) a)
forall (ns :: [Nat]) a b.
LeafC ns =>
(FinMat ns -> Vec (LastT ns) a -> b)
-> Mat ns a -> Mat (InitT ns) b
mapLeaf ((Vec (LastT ns) a -> Vec (LastT ns) a)
-> FinMat ns -> Vec (LastT ns) a -> Vec (LastT ns) a
forall a b. a -> b -> a
const Vec (LastT ns) a -> Vec (LastT ns) a
forall a. a -> a
id)
class LeafC ns where
traverseLeafC ::
Applicative m =>
(FinMat ns -> Vec (TP.LastT ns) a -> m b) ->
Mat ns a ->
m (Mat (TP.InitT ns) b)
fromLeavesInternalC ::
Mat (TP.InitT ns) (Vec (TP.LastT ns) a) ->
Mat ns a
instance
GL.TypeError ( 'GL.Text "LeafC '[]: rows for empty indices are not supported") =>
LeafC '[]
where
traverseLeafC :: (FinMat '[] -> Vec (LastT '[]) a -> m b)
-> Mat '[] a -> m (Mat (InitT '[]) b)
traverseLeafC = String
-> (FinMat '[] -> Vec (LastT '[]) a -> m b)
-> Mat '[] a
-> m (Mat (TypeError ...) b)
forall a. HasCallStack => String -> a
compileError String
"LeafC:traverseLeafC"
fromLeavesInternalC :: Mat (InitT '[]) (Vec (LastT '[]) a) -> Mat '[] a
fromLeavesInternalC = String -> Mat (TypeError ...) (Vec (LastT '[]) a) -> Mat '[] a
forall a. HasCallStack => String -> a
compileError String
"LeafC:fromLeavesInternalC"
instance
GL.TypeError ( 'GL.Text "LeafC: rows for 1D are not supported") =>
LeafC '[n]
where
traverseLeafC :: (FinMat '[n] -> Vec (LastT '[n]) a -> m b)
-> Mat '[n] a -> m (Mat (InitT '[n]) b)
traverseLeafC = String
-> (FinMat '[n] -> Mat '[n] a -> m b)
-> Mat '[n] a
-> m (Mat '[] b)
forall a. HasCallStack => String -> a
compileError String
"LeafC:traverseLeafC"
fromLeavesInternalC :: Mat (InitT '[n]) (Vec (LastT '[n]) a) -> Mat '[n] a
fromLeavesInternalC = String -> Mat '[] (Mat '[n] a) -> Mat '[n] a
forall a. HasCallStack => String -> a
compileError String
"LeafC:fromLeavesInternalC"
instance LeafC (n ': m ': ns) where
traverseLeafC :: (FinMat (n : m : ns) -> Vec (LastT (n : m : ns)) a -> m b)
-> Mat (n : m : ns) a -> m (Mat (InitT (n : m : ns)) b)
traverseLeafC FinMat (n : m : ns) -> Vec (LastT (n : m : ns)) a -> m b
f w :: Mat (n : m : ns) a
w@(Mat Vector a
_ (Pos
n :| [Pos]
ps)) =
case [Pos]
ps of
Pos
m : [Pos]
ns ->
let ([Pos]
ny0, Pos
nx) = NonEmpty Pos -> ([Pos], Pos)
forall a. NonEmpty a -> ([a], a)
unsnoc1 (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns)
ny :: NonEmpty Pos
ny = Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ny0
g :: Mat '[LastT (m : ns)] a -> StateT Int Identity (m b)
g Mat '[LastT (m : ns)] a
x = (Int -> (m b, Int)) -> StateT Int Identity (m b)
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
S.state ((Int -> (m b, Int)) -> StateT Int Identity (m b))
-> (Int -> (m b, Int)) -> StateT Int Identity (m b)
forall a b. (a -> b) -> a -> b
$ \Int
i -> (FinMat (n : m : ns) -> Vec (LastT (n : m : ns)) a -> m b
f (Either String (FinMat (n : m : ns)) -> FinMat (n : m : ns)
forall a. HasCallStack => Either String a -> a
frp (Either String (FinMat (n : m : ns)) -> FinMat (n : m : ns))
-> Either String (FinMat (n : m : ns)) -> FinMat (n : m : ns)
forall a b. (a -> b) -> a -> b
$ Int -> NonEmpty Pos -> Either String (FinMat (n : m : ns))
forall (ns :: [Nat]).
Int -> NonEmpty Pos -> Either String (FinMat ns)
mkFinMat Int
i (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| Pos
m Pos -> [Pos] -> [Pos]
forall a. a -> [a] -> [a]
: [Pos]
ns)) Vec (LastT (n : m : ns)) a
Mat '[LastT (m : ns)] a
x, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Pos -> Int
unP Pos
nx)
zs :: NonEmpty (Mat '[LastT (m : ns)] a)
zs = Either String (NonEmpty (Mat '[LastT (m : ns)] a))
-> NonEmpty (Mat '[LastT (m : ns)] a)
forall a. HasCallStack => Either String a -> a
frp (Either String (NonEmpty (Mat '[LastT (m : ns)] a))
-> NonEmpty (Mat '[LastT (m : ns)] a))
-> Either String (NonEmpty (Mat '[LastT (m : ns)] a))
-> NonEmpty (Mat '[LastT (m : ns)] a)
forall a b. (a -> b) -> a -> b
$ NonEmpty ()
-> NonEmpty Pos
-> Mat (n : m : ns) a
-> Either String (NonEmpty (Mat '[LastT (m : ns)] a))
forall (ns :: [Nat]) (t :: * -> *) (x :: [Nat]) a z.
Traversable t =>
t z -> NonEmpty Pos -> Mat x a -> Either String (t (Mat ns a))
chunkNVMat (Pos -> NonEmpty ()
units1 (NonEmpty Pos -> Pos
forall (t :: * -> *). Foldable t => t Pos -> Pos
productP NonEmpty Pos
ny)) (Pos
nx Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| []) Mat (n : m : ns) a
w
tbs :: m (NonEmpty b)
tbs = NonEmpty (m b) -> m (NonEmpty b)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (NonEmpty (m b) -> m (NonEmpty b))
-> NonEmpty (m b) -> m (NonEmpty b)
forall a b. (a -> b) -> a -> b
$ (State Int (NonEmpty (m b)) -> Int -> NonEmpty (m b))
-> Int -> State Int (NonEmpty (m b)) -> NonEmpty (m b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int (NonEmpty (m b)) -> Int -> NonEmpty (m b)
forall s a. State s a -> s -> a
S.evalState Int
0 (State Int (NonEmpty (m b)) -> NonEmpty (m b))
-> State Int (NonEmpty (m b)) -> NonEmpty (m b)
forall a b. (a -> b) -> a -> b
$ (Mat '[LastT (m : ns)] a -> StateT Int Identity (m b))
-> NonEmpty (Mat '[LastT (m : ns)] a) -> State Int (NonEmpty (m b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Mat '[LastT (m : ns)] a -> StateT Int Identity (m b)
g NonEmpty (Mat '[LastT (m : ns)] a)
zs
in (\NonEmpty b
zz -> Vector b -> NonEmpty Pos -> Mat (n : InitT (m : ns)) b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ([b] -> Vector b
forall a. [a] -> Vector a
V.fromList (NonEmpty b -> [b]
forall a. NonEmpty a -> [a]
N.toList NonEmpty b
zz)) NonEmpty Pos
ny) (NonEmpty b -> Mat (n : InitT (m : ns)) b)
-> m (NonEmpty b) -> m (Mat (n : InitT (m : ns)) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (NonEmpty b)
tbs
[] -> String -> m (Mat (n : InitT (m : ns)) b)
forall a. HasCallStack => String -> a
programmError String
"traverseLeafC: missing indices"
fromLeavesInternalC :: Mat (InitT (n : m : ns)) (Vec (LastT (n : m : ns)) a)
-> Mat (n : m : ns) a
fromLeavesInternalC = Mat (n : (InitT (m : ns) ++ '[LastT (m : ns)])) a
-> Mat (n : m : ns) a
coerce (Mat (n : (InitT (m : ns) ++ '[LastT (m : ns)])) a
-> Mat (n : m : ns) a)
-> (Mat (n : InitT (m : ns)) (Mat '[LastT (m : ns)] a)
-> Mat (n : (InitT (m : ns) ++ '[LastT (m : ns)])) a)
-> Mat (n : InitT (m : ns)) (Mat '[LastT (m : ns)] a)
-> Mat (n : m : ns) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat (n : InitT (m : ns)) (Mat '[LastT (m : ns)] a)
-> Mat (n : (InitT (m : ns) ++ '[LastT (m : ns)])) a
forall (n :: Nat) (ns :: [Nat]) (m :: Nat) (ms :: [Nat]) a.
Mat (n : ns) (Mat (m : ms) a) -> Mat (n : (ns ++ (m : ms))) a
concatMat
finMatRows :: forall ns. NS ns => NonEmpty (FinMat ns)
finMatRows :: NonEmpty (FinMat ns)
finMatRows =
let ([Pos]
xs, Pos
_) = NonEmpty Pos -> ([Pos], Pos)
forall a. NonEmpty a -> ([a], a)
unsnoc1 (NS ns => NonEmpty Pos
forall (ns :: [Nat]). NS ns => NonEmpty Pos
fromNSP @ns)
ns :: NonEmpty Pos
ns = [Pos] -> NonEmpty Pos -> NonEmpty Pos
forall a. [a] -> NonEmpty a -> NonEmpty a
appendL1 [Pos]
xs (Pos
_1P Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [])
fns :: NonEmpty (NonEmpty Pos)
fns = NonEmpty (NonEmpty Pos) -> NonEmpty (NonEmpty Pos)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (NonEmpty (NonEmpty Pos) -> NonEmpty (NonEmpty Pos))
-> NonEmpty (NonEmpty Pos) -> NonEmpty (NonEmpty Pos)
forall a b. (a -> b) -> a -> b
$ (Pos -> NonEmpty Pos) -> NonEmpty Pos -> NonEmpty (NonEmpty Pos)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
N.map Pos -> NonEmpty Pos
forall a. (Bounded a, Enum a) => a -> NonEmpty a
enumTo1 NonEmpty Pos
ns
in String
-> Either String (NonEmpty (FinMat ns)) -> NonEmpty (FinMat ns)
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"finMatRows" (Either String (NonEmpty (FinMat ns)) -> NonEmpty (FinMat ns))
-> Either String (NonEmpty (FinMat ns)) -> NonEmpty (FinMat ns)
forall a b. (a -> b) -> a -> b
$ (NonEmpty Pos -> Either String (FinMat ns))
-> NonEmpty (NonEmpty Pos) -> Either String (NonEmpty (FinMat ns))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
traverse1 NonEmpty Pos -> Either String (FinMat ns)
forall (ns :: [Nat]).
NS ns =>
NonEmpty Pos -> Either String (FinMat ns)
nonEmptyToFinMat NonEmpty (NonEmpty Pos)
fns
reverseRows :: LeafC ns => Mat ns a -> Mat ns a
reverseRows :: Mat ns a -> Mat ns a
reverseRows = (FinMat ns -> Vec (LastT ns) a -> Vec (LastT ns) a)
-> Mat ns a -> Mat ns a
forall (ns :: [Nat]) a b.
LeafC ns =>
(FinMat ns -> Vec (LastT ns) a -> Vec (LastT ns) b)
-> Mat ns a -> Mat ns b
mapLeafSimple (\FinMat ns
_ (MatUnsafe Vector a
v NonEmpty Pos
ps) -> Vector a -> NonEmpty Pos -> Vec (LastT ns) a
forall (ns :: [Nat]) a. Vector a -> NonEmpty Pos -> Mat ns a
MatUnsafe (Vector a -> Vector a
forall a. Vector a -> Vector a
V.reverse Vector a
v) NonEmpty Pos
ps)
sortByRows :: LeafC ns => (a -> a -> Ordering) -> Mat ns a -> Mat ns a
sortByRows :: (a -> a -> Ordering) -> Mat ns a -> Mat ns a
sortByRows a -> a -> Ordering
f = Either String (Mat ns a) -> Mat ns a
forall a. HasCallStack => Either String a -> a
frp (Either String (Mat ns a) -> Mat ns a)
-> (Mat ns a -> Either String (Mat ns a)) -> Mat ns a -> Mat ns a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty a -> NonEmpty a) -> Mat ns a -> Either String (Mat ns a)
forall (ns :: [Nat]) a b.
LeafC ns =>
(NonEmpty a -> NonEmpty b) -> Mat ns a -> Either String (Mat ns b)
wrapRows1 ((a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
N.sortBy a -> a -> Ordering
f)
wrapRows1 :: LeafC ns => (NonEmpty a -> NonEmpty b) -> Mat ns a -> Either String (Mat ns b)
wrapRows1 :: (NonEmpty a -> NonEmpty b) -> Mat ns a -> Either String (Mat ns b)
wrapRows1 NonEmpty a -> NonEmpty b
f = (FinMat ns -> Vec (LastT ns) a -> Either String (Vec (LastT ns) b))
-> Mat ns a -> Either String (Mat ns b)
forall (ns :: [Nat]) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (LastT ns) a -> m (Vec (LastT ns) b))
-> Mat ns a -> m (Mat ns b)
traverseLeafSimple ((Vec (LastT ns) a -> Either String (Vec (LastT ns) b))
-> FinMat ns
-> Vec (LastT ns) a
-> Either String (Vec (LastT ns) b)
forall a b. a -> b -> a
const ((NonEmpty a -> NonEmpty b)
-> Vec (LastT ns) a -> Either String (Vec (LastT ns) b)
forall (g :: * -> *) a b.
(Traversable g, Foldable1 g) =>
(NonEmpty a -> NonEmpty b) -> g a -> Either String (g b)
wrap1 NonEmpty a -> NonEmpty b
f))
reverseDim :: Mat ns a -> Mat (ReverseT ns) a
reverseDim :: Mat ns a -> Mat (ReverseT ns) a
reverseDim (Mat Vector a
v NonEmpty Pos
ps) = Vector a -> NonEmpty Pos -> Mat (ReverseT ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector a
v (NonEmpty Pos -> NonEmpty Pos
forall a. NonEmpty a -> NonEmpty a
N.reverse NonEmpty Pos
ps)
redim :: forall ms ns a. (NS ms, ProductT ns ~ ProductT ms) => Mat ns a -> Mat ms a
redim :: Mat ns a -> Mat ms a
redim (Mat Vector a
v NonEmpty Pos
_) = Vector a -> NonEmpty Pos -> Mat ms a
forall (ns :: [Nat]) a.
(NS ns, HasCallStack) =>
Vector a -> NonEmpty Pos -> Mat ns a
MatU Vector a
v (NS ms => NonEmpty Pos
forall (ns :: [Nat]). NS ns => NonEmpty Pos
fromNSP @ms)
type SliceT' :: [Nat] -> [Nat] -> Type -> Type
type family SliceT' ns' ns a where
SliceT' '[] (_ ': _) _ = GL.TypeError ( 'GL.Text "SliceT' '[] (_ ': _): not defined for empty indices ns'")
SliceT' (_ ': _) '[] _ = GL.TypeError ( 'GL.Text "SliceT' (_ ': _) '[]: not defined for empty indices ns")
SliceT' '[] '[] _ = GL.TypeError ( 'GL.Text "SliceT' '[] '[]: not defined for empty indices ns and ns'")
SliceT' '[n] '[n] a = a
SliceT' (_ ': n' ': ns') '[_] _ =
GL.TypeError
( 'GL.Text "SliceT': there are more ns' indices (lhs) than the actual matrix ns indices (rhs):"
'GL.:<>: 'GL.Text " extra ns'="
'GL.:<>: 'GL.ShowType (n' ': ns')
)
SliceT' '[n] (n ': n1 ': ns) a = Mat (n1 ': ns) a
SliceT' (n ': n1' ': ns') (n ': n1 ': ns) a = SliceT' (n1' ': ns') (n1 ': ns) a
SliceT' (n' ': _) (n ': _) _ =
GL.TypeError
( 'GL.Text "SliceT': indices need to match pointwise:"
'GL.:<>: 'GL.Text "ie n' /= n:"
'GL.:<>: 'GL.ShowType n'
'GL.:<>: 'GL.Text " /= "
'GL.:<>: 'GL.ShowType n
)
type SliceC' :: [Nat] -> [Nat] -> Constraint
class SliceC' ns' ns where
sliceC' :: FinMat ns' -> Mat ns a -> SliceT' ns' ns a
sliceUpdateC' :: FinMat ns' -> Mat ns a -> SliceT' ns' ns a -> Mat ns a
instance GL.TypeError ( 'GL.Text "SliceC' '[] (n ': ns): empty indices ns'") => SliceC' '[] (n ': ns) where
sliceC' :: FinMat '[] -> Mat (n : ns) a -> SliceT' '[] (n : ns) a
sliceC' = String -> FinMat '[] -> Mat (n : ns) a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"sliceC'"
sliceUpdateC' :: FinMat '[]
-> Mat (n : ns) a -> SliceT' '[] (n : ns) a -> Mat (n : ns) a
sliceUpdateC' = String
-> FinMat '[]
-> Mat (n : ns) a
-> (TypeError ...)
-> Mat (n : ns) a
forall a. HasCallStack => String -> a
compileError String
"sliceUpdateC'"
instance GL.TypeError ( 'GL.Text "SliceC' (n' ': ns') '[]: empty indices ns") => SliceC' (n' ': ns') '[] where
sliceC' :: FinMat (n' : ns') -> Mat '[] a -> SliceT' (n' : ns') '[] a
sliceC' = String -> FinMat (n' : ns') -> Mat '[] a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"sliceC'"
sliceUpdateC' :: FinMat (n' : ns')
-> Mat '[] a -> SliceT' (n' : ns') '[] a -> Mat '[] a
sliceUpdateC' = String
-> FinMat (n' : ns') -> Mat '[] a -> (TypeError ...) -> Mat '[] a
forall a. HasCallStack => String -> a
compileError String
"sliceUpdateC'"
instance GL.TypeError ( 'GL.Text "SliceC' '[] '[]: empty indices ns and ns'") => SliceC' '[] '[] where
sliceC' :: FinMat '[] -> Mat '[] a -> SliceT' '[] '[] a
sliceC' = String -> FinMat '[] -> Mat '[] a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"sliceC'"
sliceUpdateC' :: FinMat '[] -> Mat '[] a -> SliceT' '[] '[] a -> Mat '[] a
sliceUpdateC' = String -> FinMat '[] -> Mat '[] a -> (TypeError ...) -> Mat '[] a
forall a. HasCallStack => String -> a
compileError String
"sliceUpdateC'"
instance n ~ n' => SliceC' '[n'] '[n] where
sliceC' :: FinMat '[n'] -> Mat '[n] a -> SliceT' '[n'] '[n] a
sliceC' (FinMat Int
i NonEmpty Pos
_) (Mat Vector a
v NonEmpty Pos
_) =
case Vector a
v Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
V.!? Int
i of
Maybe a
Nothing -> String -> a
forall a. HasCallStack => String -> a
programmError (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"sliceC' '[n] '[n]: index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" out of bounds"
Just a
a -> a
SliceT' '[n'] '[n] a
a
sliceUpdateC' :: FinMat '[n'] -> Mat '[n] a -> SliceT' '[n'] '[n] a -> Mat '[n] a
sliceUpdateC' (FinMat Int
i NonEmpty Pos
_) (Mat Vector a
v NonEmpty Pos
ps) SliceT' '[n'] '[n] a
b = String -> Either String (Mat '[n] a) -> Mat '[n] a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"sliceUpdateC' '[n] '[n]" (Either String (Mat '[n] a) -> Mat '[n] a)
-> Either String (Mat '[n] a) -> Mat '[n] a
forall a b. (a -> b) -> a -> b
$ do
let (Vector a
v1, Vector a
v2) = Int -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
i Vector a
v
case Vector a -> Maybe (a, Vector a)
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector a
v2 of
Just (a
_, Vector a
v3) -> Vector a -> NonEmpty Pos -> Either String (Mat '[n] a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Vector a
v1 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
V.cons a
SliceT' '[n'] '[n] a
b Vector a
v3) NonEmpty Pos
ps
Maybe (a, Vector a)
Nothing -> String -> Either String (Mat '[n] a)
forall a b. a -> Either a b
Left (String -> Either String (Mat '[n] a))
-> String -> Either String (Mat '[n] a)
forall a b. (a -> b) -> a -> b
$ String
"index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" out of bounds"
instance n ~ n' => SliceC' '[n'] (n ': m ': ns) where
sliceC' :: FinMat '[n'] -> Mat (n : m : ns) a -> SliceT' '[n'] (n : m : ns) a
sliceC' (FinMat Int
i NonEmpty Pos
_) (Mat Vector a
v (Pos
_ :| [Pos]
ps)) = String -> Either String (Mat (m : ns) a) -> Mat (m : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"sliceC' '[n] (n ': m ': ns)" (Either String (Mat (m : ns) a) -> Mat (m : ns) a)
-> Either String (Mat (m : ns) a) -> Mat (m : ns) a
forall a b. (a -> b) -> a -> b
$ do
case [Pos]
ps of
Pos
m : [Pos]
ns -> do
let ps1 :: NonEmpty Pos
ps1 = Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns
len1 :: Int
len1 = NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
ps1
Vector a -> NonEmpty Pos -> Either String (Mat (m : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len1) Int
len1 Vector a
v) NonEmpty Pos
ps1
[] -> String -> Either String (Mat (m : ns) a)
forall a b. a -> Either a b
Left (String -> Either String (Mat (m : ns) a))
-> String -> Either String (Mat (m : ns) a)
forall a b. (a -> b) -> a -> b
$ String
"index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": missing indices"
sliceUpdateC' :: FinMat '[n']
-> Mat (n : m : ns) a
-> SliceT' '[n'] (n : m : ns) a
-> Mat (n : m : ns) a
sliceUpdateC' (FinMat Int
i0 NonEmpty Pos
_) (Mat Vector a
v w :: NonEmpty Pos
w@(Pos
_ :| [Pos]
ps)) SliceT' '[n'] (n : m : ns) a
b = String -> Either String (Mat (n : m : ns) a) -> Mat (n : m : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"sliceUpdateC' '[n] (n ': m ': ns)" (Either String (Mat (n : m : ns) a) -> Mat (n : m : ns) a)
-> Either String (Mat (n : m : ns) a) -> Mat (n : m : ns) a
forall a b. (a -> b) -> a -> b
$ do
let len :: Int
len = [Pos] -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt [Pos]
ps
i :: Int
i = Int
i0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
v1 :: Vector a
v1 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Vector a
v
v2 :: Vector a
v2 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Vector a
v
Vector a -> NonEmpty Pos -> Either String (Mat (n : m : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Vector a
v1 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Mat (m : ns) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec SliceT' '[n'] (n : m : ns) a
Mat (m : ns) a
b Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v2) NonEmpty Pos
w
instance
(n ~ n', SliceC' (n1' ': ns') (n1 ': ns)) =>
SliceC' (n ': n1' ': ns') (n' ': n1 ': ns)
where
sliceC' :: FinMat (n : n1' : ns')
-> Mat (n' : n1 : ns) a -> SliceT' (n : n1' : ns') (n' : n1 : ns) a
sliceC' fm :: FinMat (n : n1' : ns')
fm@(FinMat Int
_ (Pos
_ :| [Pos]
n1ns')) w :: Mat (n' : n1 : ns) a
w@(Mat Vector a
_ (Pos
n :| [Pos]
_)) = String
-> Either String (SliceT' (n1' : ns') (n1 : ns) a)
-> SliceT' (n1' : ns') (n1 : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"sliceC' (n ': n1' ': ns')" (Either String (SliceT' (n1' : ns') (n1 : ns) a)
-> SliceT' (n1' : ns') (n1 : ns) a)
-> Either String (SliceT' (n1' : ns') (n1 : ns) a)
-> SliceT' (n1' : ns') (n1 : ns) a
forall a b. (a -> b) -> a -> b
$ do
let Pos
x :| [Pos]
xs = FinMat (n : n1' : ns') -> NonEmpty Pos
forall (ns :: [Nat]). FinMat ns -> NonEmpty Pos
finMatToNonEmpty FinMat (n : n1' : ns')
fm
i :: Int
i = Pos -> Int
unP Pos
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
case ([Pos]
xs, [Pos]
n1ns') of
(Pos
x1 : [Pos]
x1s, Pos
n1 : [Pos]
ns') -> do
FinMat (n1' : ns')
fn1 <- NonEmpty Pos -> NonEmpty Pos -> Either String (FinMat (n1' : ns'))
forall (ns :: [Nat]).
NonEmpty Pos -> NonEmpty Pos -> Either String (FinMat ns)
nonEmptyToFinMat' (Pos
x1 Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
x1s) (Pos
n1 Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns')
FinMat '[n']
w1 <- Int -> NonEmpty Pos -> Either String (FinMat '[n'])
forall (ns :: [Nat]).
Int -> NonEmpty Pos -> Either String (FinMat ns)
mkFinMat Int
i (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [])
SliceT' (n1' : ns') (n1 : ns) a
-> Either String (SliceT' (n1' : ns') (n1 : ns) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SliceT' (n1' : ns') (n1 : ns) a
-> Either String (SliceT' (n1' : ns') (n1 : ns) a))
-> SliceT' (n1' : ns') (n1 : ns) a
-> Either String (SliceT' (n1' : ns') (n1 : ns) a)
forall a b. (a -> b) -> a -> b
$ FinMat (n1' : ns')
-> Mat (n1 : ns) a -> SliceT' (n1' : ns') (n1 : ns) a
forall (ns' :: [Nat]) (ns :: [Nat]) a.
SliceC' ns' ns =>
FinMat ns' -> Mat ns a -> SliceT' ns' ns a
sliceC' @(n1' ': ns') @(n1 ': ns) FinMat (n1' : ns')
fn1 (FinMat '[n']
-> Mat (n : n1 : ns) a -> SliceT' '[n'] (n : n1 : ns) a
forall (ns' :: [Nat]) (ns :: [Nat]) a.
SliceC' ns' ns =>
FinMat ns' -> Mat ns a -> SliceT' ns' ns a
sliceC' @'[n'] @(n ': n1 ': ns) FinMat '[n']
w1 Mat (n : n1 : ns) a
Mat (n' : n1 : ns) a
w)
([], [Pos]
_) -> String -> Either String (SliceT' (n1' : ns') (n1 : ns) a)
forall a b. a -> Either a b
Left String
"missing ns' indices"
([Pos]
_, []) -> String -> Either String (SliceT' (n1' : ns') (n1 : ns) a)
forall a b. a -> Either a b
Left String
"missing ns indices"
sliceUpdateC' :: FinMat (n : n1' : ns')
-> Mat (n' : n1 : ns) a
-> SliceT' (n : n1' : ns') (n' : n1 : ns) a
-> Mat (n' : n1 : ns) a
sliceUpdateC' fm :: FinMat (n : n1' : ns')
fm@(FinMat Int
_ (Pos
_ :| [Pos]
n1ns')) (Mat Vector a
v w :: NonEmpty Pos
w@(Pos
_ :| [Pos]
ps0)) SliceT' (n : n1' : ns') (n' : n1 : ns) a
b = String
-> Either String (Mat (n' : n1 : ns) a) -> Mat (n' : n1 : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"sliceUpdateC' (n ': n1' ': ns')" (Either String (Mat (n' : n1 : ns) a) -> Mat (n' : n1 : ns) a)
-> Either String (Mat (n' : n1 : ns) a) -> Mat (n' : n1 : ns) a
forall a b. (a -> b) -> a -> b
$ do
let Pos
x :| [Pos]
xs = FinMat (n : n1' : ns') -> NonEmpty Pos
forall (ns :: [Nat]). FinMat ns -> NonEmpty Pos
finMatToNonEmpty FinMat (n : n1' : ns')
fm
i :: Int
i = Pos -> Int
unP Pos
x
case ([Pos]
ps0, [Pos]
xs, [Pos]
n1ns') of
(Pos
_ : [Pos]
ns, Pos
x1 : [Pos]
x1s, Pos
n1 : [Pos]
ns') -> do
FinMat (n1' : ns')
fn1 <- NonEmpty Pos -> NonEmpty Pos -> Either String (FinMat (n1' : ns'))
forall (ns :: [Nat]).
NonEmpty Pos -> NonEmpty Pos -> Either String (FinMat ns)
nonEmptyToFinMat' (Pos
x1 Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
x1s) (Pos
n1 Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns')
let ps1 :: NonEmpty Pos
ps1 = Pos
n1 Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns
len :: Int
len = NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
ps1
v1 :: Vector a
v1 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Vector a
v
v2 :: Vector a
v2 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Vector a
v
Mat (n1 : ns) a
m1 <- Vector a -> NonEmpty Pos -> Either String (Mat (n1 : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Int
len Vector a
v) NonEmpty Pos
ps1
let mx :: Mat (n1 : ns) a
mx = FinMat (n1' : ns')
-> Mat (n1 : ns) a
-> SliceT' (n1' : ns') (n1 : ns) a
-> Mat (n1 : ns) a
forall (ns' :: [Nat]) (ns :: [Nat]) a.
SliceC' ns' ns =>
FinMat ns' -> Mat ns a -> SliceT' ns' ns a -> Mat ns a
sliceUpdateC' @(n1' ': ns') @(n1 ': ns) FinMat (n1' : ns')
fn1 Mat (n1 : ns) a
m1 SliceT' (n : n1' : ns') (n' : n1 : ns) a
SliceT' (n1' : ns') (n1 : ns) a
b
Vector a -> NonEmpty Pos -> Either String (Mat (n' : n1 : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Vector a
v1 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Mat (n1 : ns) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec Mat (n1 : ns) a
mx Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v2) NonEmpty Pos
w
([], [Pos]
_, [Pos]
_) -> String -> Either String (Mat (n' : n1 : ns) a)
forall a b. a -> Either a b
Left String
"missing matrix indices"
([Pos]
_, [], [Pos]
_) -> String -> Either String (Mat (n' : n1 : ns) a)
forall a b. a -> Either a b
Left String
"missing ns' indices"
([Pos]
_, [Pos]
_, []) -> String -> Either String (Mat (n' : n1 : ns) a)
forall a b. a -> Either a b
Left String
"missing finmat indices"
instance
GL.TypeError ( 'GL.Text "SliceC': too many indices ns': length ns' > length ns") =>
SliceC' (n' ': n1' ': ns') '[n]
where
sliceC' :: FinMat (n' : n1' : ns')
-> Mat '[n] a -> SliceT' (n' : n1' : ns') '[n] a
sliceC' = String -> FinMat (n' : n1' : ns') -> Mat '[n] a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"sliceC'"
sliceUpdateC' :: FinMat (n' : n1' : ns')
-> Mat '[n] a -> SliceT' (n' : n1' : ns') '[n] a -> Mat '[n] a
sliceUpdateC' = String
-> FinMat (n' : n1' : ns')
-> Mat '[n] a
-> (TypeError ...)
-> Mat '[n] a
forall a. HasCallStack => String -> a
compileError String
"sliceUpdateC'"
type SliceToFinMatT :: [Nat] -> [Nat] -> [Nat]
type family SliceToFinMatT is ns where
SliceToFinMatT (_ ': _) '[] =
GL.TypeError ( 'GL.Text "SliceToFinMatT (_ ': _) '[]: 'is' is empty")
SliceToFinMatT '[] (_ ': _) =
GL.TypeError ( 'GL.Text "SliceToFinMatT '[] (_ ': _): 'ns' is empty")
SliceToFinMatT '[] '[] =
GL.TypeError ( 'GL.Text "SliceToFinMatT '[] '[]: 'is' and 'ns' are empty")
SliceToFinMatT '[_] '[n] = '[n]
SliceToFinMatT (_ ': i ': is) '[_] =
GL.TypeError
( 'GL.Text "SliceToFinMatT: 'is' is larger in length than 'ns':"
'GL.:<>: 'GL.Text " extra 'is'="
'GL.:<>: 'GL.ShowType (i ': is)
)
SliceToFinMatT '[_] (n ': _ ': _) = '[n]
SliceToFinMatT (_ ': i1 ': is) (n ': n1 ': ns) = n ': SliceToFinMatT (i1 ': is) (n1 ': ns)
sliceToFinMat ::
forall is ns.
(NS (SliceToFinMatT is ns), NS is, NS ns) =>
FinMat (SliceToFinMatT is ns)
sliceToFinMat :: FinMat (SliceToFinMatT is ns)
sliceToFinMat =
let is :: NonEmpty Pos
is = NS is => NonEmpty Pos
forall (ns :: [Nat]). NS ns => NonEmpty Pos
fromNSP @is
ns :: NonEmpty Pos
ns = NS ns => NonEmpty Pos
forall (ns :: [Nat]). NS ns => NonEmpty Pos
fromNSP @ns
in Either String (FinMat (SliceToFinMatT is ns))
-> FinMat (SliceToFinMatT is ns)
forall a. HasCallStack => Either String a -> a
frp (Either String (FinMat (SliceToFinMatT is ns))
-> FinMat (SliceToFinMatT is ns))
-> Either String (FinMat (SliceToFinMatT is ns))
-> FinMat (SliceToFinMatT is ns)
forall a b. (a -> b) -> a -> b
$ NonEmpty Pos -> Either String (FinMat (SliceToFinMatT is ns))
forall (ns :: [Nat]).
NS ns =>
NonEmpty Pos -> Either String (FinMat ns)
nonEmptyToFinMat ((Pos -> Pos -> Pos) -> NonEmpty Pos -> NonEmpty Pos -> NonEmpty Pos
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
N.zipWith Pos -> Pos -> Pos
forall a b. a -> b -> a
const NonEmpty Pos
is NonEmpty Pos
ns)
slice ::
forall is ns a z.
(z ~ SliceToFinMatT is ns, NS is, NS ns, NS z, SliceC' z ns) =>
Mat ns a ->
SliceT' z ns a
slice :: Mat ns a -> SliceT' z ns a
slice = FinMat z -> Mat ns a -> SliceT' z ns a
forall (ns' :: [Nat]) (ns :: [Nat]) a.
SliceC' ns' ns =>
FinMat ns' -> Mat ns a -> SliceT' ns' ns a
sliceC' ((NS (SliceToFinMatT is ns), NS is, NS ns) =>
FinMat (SliceToFinMatT is ns)
forall (is :: [Nat]) (ns :: [Nat]).
(NS (SliceToFinMatT is ns), NS is, NS ns) =>
FinMat (SliceToFinMatT is ns)
sliceToFinMat @is @ns)
sliceUpdate ::
forall is ns a z.
(z ~ SliceToFinMatT is ns, NS is, NS ns, NS z, SliceC' z ns) =>
Mat ns a ->
SliceT' z ns a ->
Mat ns a
sliceUpdate :: Mat ns a -> SliceT' z ns a -> Mat ns a
sliceUpdate = FinMat z -> Mat ns a -> SliceT' z ns a -> Mat ns a
forall (ns' :: [Nat]) (ns :: [Nat]) a.
SliceC' ns' ns =>
FinMat ns' -> Mat ns a -> SliceT' ns' ns a -> Mat ns a
sliceUpdateC' ((NS (SliceToFinMatT is ns), NS is, NS ns) =>
FinMat (SliceToFinMatT is ns)
forall (is :: [Nat]) (ns :: [Nat]).
(NS (SliceToFinMatT is ns), NS is, NS ns) =>
FinMat (SliceToFinMatT is ns)
sliceToFinMat @is @ns)
type SliceT :: [Nat] -> [Nat] -> Type -> Type
type family SliceT is ns a where
SliceT '[] (_ ': _) _ = GL.TypeError ( 'GL.Text "SliceT '[] (_ ': _): not defined for empty indices ns'")
SliceT (_ ': _) '[] _ = GL.TypeError ( 'GL.Text "SliceT (_ ': _) '[]: not defined for empty indices ns")
SliceT '[] '[] _ = GL.TypeError ( 'GL.Text "SliceT '[] '[]: not defined for empty indices ns and ns'")
SliceT '[_] '[_] a = a
SliceT (_ ': i ': is) '[_] _ =
GL.TypeError
( 'GL.Text "SliceT: 'is' must be a smaller in length than 'ns'"
'GL.:<>: 'GL.Text " extra 'is'="
'GL.:<>: 'GL.ShowType (i ': is)
)
SliceT '[_] (_ ': n1 ': ns) a = Mat (n1 ': ns) a
SliceT (_ ': i1 ': is) (_ ': n1 ': ns) a = SliceT (i1 ': is) (n1 ': ns) a
type SliceC :: [Nat] -> [Nat] -> Constraint
class SliceC is ns where
sliceC :: Mat ns a -> SliceT is ns a
sliceUpdateC :: Mat ns a -> SliceT is ns a -> Mat ns a
instance GL.TypeError ( 'GL.Text "SliceC '[] (n ': ns): empty indices ns'") => SliceC '[] (n ': ns) where
sliceC :: Mat (n : ns) a -> SliceT '[] (n : ns) a
sliceC = String -> Mat (n : ns) a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"SliceC:sliceC"
sliceUpdateC :: Mat (n : ns) a -> SliceT '[] (n : ns) a -> Mat (n : ns) a
sliceUpdateC = String -> Mat (n : ns) a -> (TypeError ...) -> Mat (n : ns) a
forall a. HasCallStack => String -> a
compileError String
"sliceUpdateC"
instance GL.TypeError ( 'GL.Text "SliceC (n' ': ns') '[]: empty indices ns") => SliceC (n' ': ns') '[] where
sliceC :: Mat '[] a -> SliceT (n' : ns') '[] a
sliceC = String -> Mat '[] a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"SliceC:sliceC"
sliceUpdateC :: Mat '[] a -> SliceT (n' : ns') '[] a -> Mat '[] a
sliceUpdateC = String -> Mat '[] a -> (TypeError ...) -> Mat '[] a
forall a. HasCallStack => String -> a
compileError String
"SliceC:sliceUpdateC"
instance GL.TypeError ( 'GL.Text "SliceC '[] '[]: empty indices ns and ns'") => SliceC '[] '[] where
sliceC :: Mat '[] a -> SliceT '[] '[] a
sliceC = String -> Mat '[] a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"SliceC:sliceC"
sliceUpdateC :: Mat '[] a -> SliceT '[] '[] a -> Mat '[] a
sliceUpdateC = String -> Mat '[] a -> (TypeError ...) -> Mat '[] a
forall a. HasCallStack => String -> a
compileError String
"SliceC:sliceUpdateC"
instance FinC i n => SliceC '[i] '[n] where
sliceC :: Mat '[n] a -> SliceT '[i] '[n] a
sliceC (Mat Vector a
v NonEmpty Pos
_) =
let i :: Int
i = PosC i => Int
forall (n :: Nat). PosC n => Int
fromN @i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
in case Vector a
v Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
V.!? Int
i of
Maybe a
Nothing -> String -> a
forall a. HasCallStack => String -> a
programmError (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"sliceC: index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" out of bounds"
Just a
a -> a
SliceT '[i] '[n] a
a
sliceUpdateC :: Mat '[n] a -> SliceT '[i] '[n] a -> Mat '[n] a
sliceUpdateC (Mat Vector a
v NonEmpty Pos
ps) SliceT '[i] '[n] a
b = String -> Either String (Mat '[n] a) -> Mat '[n] a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"sliceC' '[i] '[n]" (Either String (Mat '[n] a) -> Mat '[n] a)
-> Either String (Mat '[n] a) -> Mat '[n] a
forall a b. (a -> b) -> a -> b
$ do
let i :: Int
i = PosC i => Int
forall (n :: Nat). PosC n => Int
fromN @i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
(Vector a
v1, Vector a
v2) = Int -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
i Vector a
v
case Vector a -> Maybe (a, Vector a)
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector a
v2 of
Just (a
_, Vector a
v3) -> Vector a -> NonEmpty Pos -> Either String (Mat '[n] a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Vector a
v1 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> a -> Vector a -> Vector a
forall a. a -> Vector a -> Vector a
V.cons a
SliceT '[i] '[n] a
b Vector a
v3) NonEmpty Pos
ps
Maybe (a, Vector a)
Nothing -> String -> Either String (Mat '[n] a)
forall a b. a -> Either a b
Left (String -> Either String (Mat '[n] a))
-> String -> Either String (Mat '[n] a)
forall a b. (a -> b) -> a -> b
$ String
"index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" out of bounds"
instance FinC i n => SliceC '[i] (n ': m ': ns) where
sliceC :: Mat (n : m : ns) a -> SliceT '[i] (n : m : ns) a
sliceC (Mat Vector a
v (Pos
_ :| [Pos]
ps)) = String -> Either String (Mat (m : ns) a) -> Mat (m : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"sliceC' '[i] (n ': m ': ns)" (Either String (Mat (m : ns) a) -> Mat (m : ns) a)
-> Either String (Mat (m : ns) a) -> Mat (m : ns) a
forall a b. (a -> b) -> a -> b
$ do
case [Pos]
ps of
Pos
m : [Pos]
ns -> do
let i :: Int
i = PosC i => Int
forall (n :: Nat). PosC n => Int
fromN @i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
ps1 :: NonEmpty Pos
ps1 = Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns
len1 :: Int
len1 = NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
ps1
Vector a -> NonEmpty Pos -> Either String (Mat (m : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len1) Int
len1 Vector a
v) NonEmpty Pos
ps1
[] -> String -> Either String (Mat (m : ns) a)
forall a b. a -> Either a b
Left (String -> Either String (Mat (m : ns) a))
-> String -> Either String (Mat (m : ns) a)
forall a b. (a -> b) -> a -> b
$ String
"index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (PosC i => Int
forall (n :: Nat). PosC n => Int
fromN @i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": missing indices"
sliceUpdateC :: Mat (n : m : ns) a
-> SliceT '[i] (n : m : ns) a -> Mat (n : m : ns) a
sliceUpdateC (Mat Vector a
v w :: NonEmpty Pos
w@(Pos
_ :| [Pos]
ps)) SliceT '[i] (n : m : ns) a
b =
let i :: Int
i = PosC i => Int
forall (n :: Nat). PosC n => Int
fromN @i
len :: Int
len = [Pos] -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt [Pos]
ps
v1 :: Vector a
v1 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Vector a
v
v2 :: Vector a
v2 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Vector a
v
in Vector a -> NonEmpty Pos -> Mat (n : m : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector a
v1 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Mat (m : ns) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec SliceT '[i] (n : m : ns) a
Mat (m : ns) a
b Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v2) NonEmpty Pos
w
instance
(FinC i n, SliceC (i1 ': is) (n1 ': ns)) =>
SliceC (i ': i1 ': is) (n ': n1 ': ns)
where
sliceC :: Mat (n : n1 : ns) a -> SliceT (i : i1 : is) (n : n1 : ns) a
sliceC Mat (n : n1 : ns) a
w =
Mat (n1 : ns) a -> SliceT (i1 : is) (n1 : ns) a
forall (is :: [Nat]) (ns :: [Nat]) a.
SliceC is ns =>
Mat ns a -> SliceT is ns a
sliceC @(i1 ': is) @(n1 ': ns) (Mat (n : n1 : ns) a -> SliceT '[i] (n : n1 : ns) a
forall (is :: [Nat]) (ns :: [Nat]) a.
SliceC is ns =>
Mat ns a -> SliceT is ns a
sliceC @'[i] @(n ': n1 ': ns) Mat (n : n1 : ns) a
w)
sliceUpdateC :: Mat (n : n1 : ns) a
-> SliceT (i : i1 : is) (n : n1 : ns) a -> Mat (n : n1 : ns) a
sliceUpdateC (Mat Vector a
v w :: NonEmpty Pos
w@(Pos
_ :| [Pos]
ps0)) SliceT (i : i1 : is) (n : n1 : ns) a
b = String
-> Either String (Mat (n : n1 : ns) a) -> Mat (n : n1 : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"sliceUpdateC' (i ': i1 ': is) (n ': m ': ns)" (Either String (Mat (n : n1 : ns) a) -> Mat (n : n1 : ns) a)
-> Either String (Mat (n : n1 : ns) a) -> Mat (n : n1 : ns) a
forall a b. (a -> b) -> a -> b
$ do
case [Pos]
ps0 of
Pos
n1 : [Pos]
ns -> do
let i :: Int
i = PosC i => Int
forall (n :: Nat). PosC n => Int
fromN @i
ps1 :: NonEmpty Pos
ps1 = Pos
n1 Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns
len :: Int
len = NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
ps1
v1 :: Vector a
v1 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Vector a
v
v2 :: Vector a
v2 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Vector a
v
Mat (n1 : ns) a
m1 <- Vector a -> NonEmpty Pos -> Either String (Mat (n1 : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice ((Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Int
len Vector a
v) NonEmpty Pos
ps1
let mx :: Mat (n1 : ns) a
mx = Mat (n1 : ns) a -> SliceT (i1 : is) (n1 : ns) a -> Mat (n1 : ns) a
forall (is :: [Nat]) (ns :: [Nat]) a.
SliceC is ns =>
Mat ns a -> SliceT is ns a -> Mat ns a
sliceUpdateC @(i1 ': is) @(n1 ': ns) Mat (n1 : ns) a
m1 SliceT (i : i1 : is) (n : n1 : ns) a
SliceT (i1 : is) (n1 : ns) a
b
Vector a -> NonEmpty Pos -> Either String (Mat (n : n1 : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Vector a
v1 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Mat (n1 : ns) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec Mat (n1 : ns) a
mx Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v2) NonEmpty Pos
w
[] -> String -> Either String (Mat (n : n1 : ns) a)
forall a b. a -> Either a b
Left (String -> Either String (Mat (n : n1 : ns) a))
-> String -> Either String (Mat (n : n1 : ns) a)
forall a b. (a -> b) -> a -> b
$ String
"index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (PosC i => Int
forall (n :: Nat). PosC n => Int
fromN @i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": missing indices"
instance
GL.TypeError ( 'GL.Text "too many indices 'is': length is > length ns") =>
SliceC (i ': i1 ': is) '[n]
where
sliceC :: Mat '[n] a -> SliceT (i : i1 : is) '[n] a
sliceC = String -> Mat '[n] a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"sliceC (2)"
sliceUpdateC :: Mat '[n] a -> SliceT (i : i1 : is) '[n] a -> Mat '[n] a
sliceUpdateC = String -> Mat '[n] a -> (TypeError ...) -> Mat '[n] a
forall a. HasCallStack => String -> a
compileError String
"sliceUpdateC (2)"
_row ::
forall (i :: Nat) (ns :: [Nat]) a.
(SliceC '[i] ns) =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row :: Lens' (Mat ns a) (SliceT '[i] ns a)
_row = forall (is :: [Nat]) (ns :: [Nat]) a.
SliceC is ns =>
Lens' (Mat ns a) (SliceT is ns a)
forall (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
ixSlice @'[i]
_col ::
forall (i :: Nat) n m ns a.
(FinC i m) =>
Lens' (Mat (n ': m ': ns) a) (Mat (n ': ns) a)
_col :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col = (Mat (m : n : ns) a -> f (Mat (m : n : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a b.
Iso
(Mat (n : m : ns) a)
(Mat (n : m : ns) b)
(Mat (m : n : ns) a)
(Mat (m : n : ns) b)
_transposeMat ((Mat (m : n : ns) a -> f (Mat (m : n : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a))
-> ((Mat (n : ns) a -> f (Mat (n : ns) a))
-> Mat (m : n : ns) a -> f (Mat (m : n : ns) a))
-> (Mat (n : ns) a -> f (Mat (n : ns) a))
-> Mat (n : m : ns) a
-> f (Mat (n : m : ns) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @i
ixSlice ::
forall (is :: [Nat]) (ns :: [Nat]) a.
(SliceC is ns) =>
Lens' (Mat ns a) (SliceT is ns a)
ixSlice :: Lens' (Mat ns a) (SliceT is ns a)
ixSlice =
(Mat ns a -> SliceT is ns a)
-> (Mat ns a -> SliceT is ns a -> Mat ns a)
-> Lens' (Mat ns a) (SliceT is ns a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(forall (ns :: [Nat]) a. SliceC is ns => Mat ns a -> SliceT is ns a
forall (is :: [Nat]) (ns :: [Nat]) a.
SliceC is ns =>
Mat ns a -> SliceT is ns a
sliceC @is)
(forall (ns :: [Nat]) a.
SliceC is ns =>
Mat ns a -> SliceT is ns a -> Mat ns a
forall (is :: [Nat]) (ns :: [Nat]) a.
SliceC is ns =>
Mat ns a -> SliceT is ns a -> Mat ns a
sliceUpdateC @is)
_row' ::
forall (n :: Nat) (ns :: [Nat]) a.
(SliceC' '[n] ns) =>
Fin n ->
Lens' (Mat ns a) (SliceT' '[n] ns a)
_row' :: Fin n -> Lens' (Mat ns a) (SliceT' '[n] ns a)
_row' (Fin Pos
i Pos
_) = FinMat '[n] -> Lens' (Mat ns a) (SliceT' '[n] ns a)
forall (ns' :: [Nat]) (ns :: [Nat]) a.
SliceC' ns' ns =>
FinMat ns' -> Lens' (Mat ns a) (SliceT' ns' ns a)
ixSlice' @'[n] (Either String (FinMat '[n]) -> FinMat '[n]
forall a. HasCallStack => Either String a -> a
frp (Either String (FinMat '[n]) -> FinMat '[n])
-> Either String (FinMat '[n]) -> FinMat '[n]
forall a b. (a -> b) -> a -> b
$ Int -> NonEmpty Pos -> Either String (FinMat '[n])
forall (ns :: [Nat]).
Int -> NonEmpty Pos -> Either String (FinMat ns)
mkFinMat (Pos -> Int
unP Pos
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Pos -> Pos
succP Pos
i Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| []))
_col' ::
forall n m ns a.
Fin m ->
Lens' (Mat (n ': m ': ns) a) (Mat (n ': ns) a)
_col' :: Fin m -> Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col' Fin m
fn = (Mat (m : n : ns) a -> f (Mat (m : n : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a b.
Iso
(Mat (n : m : ns) a)
(Mat (n : m : ns) b)
(Mat (m : n : ns) a)
(Mat (m : n : ns) b)
_transposeMat ((Mat (m : n : ns) a -> f (Mat (m : n : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a))
-> ((Mat (n : ns) a -> f (Mat (n : ns) a))
-> Mat (m : n : ns) a -> f (Mat (m : n : ns) a))
-> (Mat (n : ns) a -> f (Mat (n : ns) a))
-> Mat (n : m : ns) a
-> f (Mat (n : m : ns) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fin m -> Lens' (Mat (m : n : ns) a) (SliceT' '[m] (m : n : ns) a)
forall (n :: Nat) (ns :: [Nat]) a.
SliceC' '[n] ns =>
Fin n -> Lens' (Mat ns a) (SliceT' '[n] ns a)
_row' Fin m
fn
ixSlice' ::
forall (ns' :: [Nat]) (ns :: [Nat]) a.
(SliceC' ns' ns) =>
FinMat ns' ->
Lens' (Mat ns a) (SliceT' ns' ns a)
ixSlice' :: FinMat ns' -> Lens' (Mat ns a) (SliceT' ns' ns a)
ixSlice' FinMat ns'
fm =
(Mat ns a -> SliceT' ns' ns a)
-> (Mat ns a -> SliceT' ns' ns a -> Mat ns a)
-> Lens' (Mat ns a) (SliceT' ns' ns a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(FinMat ns' -> Mat ns a -> SliceT' ns' ns a
forall (ns' :: [Nat]) (ns :: [Nat]) a.
SliceC' ns' ns =>
FinMat ns' -> Mat ns a -> SliceT' ns' ns a
sliceC' @ns' FinMat ns'
fm)
(FinMat ns' -> Mat ns a -> SliceT' ns' ns a -> Mat ns a
forall (ns' :: [Nat]) (ns :: [Nat]) a.
SliceC' ns' ns =>
FinMat ns' -> Mat ns a -> SliceT' ns' ns a -> Mat ns a
sliceUpdateC' @ns' FinMat ns'
fm)
rows ::
forall n m ns a.
Mat (n ': m ': ns) a ->
Vec n (Mat (m ': ns) a)
rows :: Mat (n : m : ns) a -> Vec n (Mat (m : ns) a)
rows w :: Mat (n : m : ns) a
w@(Mat Vector a
_ (Pos
n :| [Pos]
ps)) = String
-> Either String (Vec n (Mat (m : ns) a)) -> Vec n (Mat (m : ns) a)
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"rows" (Either String (Vec n (Mat (m : ns) a)) -> Vec n (Mat (m : ns) a))
-> Either String (Vec n (Mat (m : ns) a)) -> Vec n (Mat (m : ns) a)
forall a b. (a -> b) -> a -> b
$
case [Pos]
ps of
Pos
m : [Pos]
ns -> do
[Mat (m : ns) a]
zs <- [()]
-> NonEmpty Pos
-> Mat (n : m : ns) a
-> Either String [Mat (m : ns) a]
forall (ns :: [Nat]) (t :: * -> *) (x :: [Nat]) a z.
Traversable t =>
t z -> NonEmpty Pos -> Mat x a -> Either String (t (Mat ns a))
chunkNVMat (Pos -> [()]
forall (l :: * -> *) a.
(IsList (l a), Item (l a) ~ ()) =>
Pos -> l a
unitsF @[] Pos
n) (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns) Mat (n : m : ns) a
w
Vector (Mat (m : ns) a)
-> NonEmpty Pos -> Either String (Vec n (Mat (m : ns) a))
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat ([Mat (m : ns) a] -> Vector (Mat (m : ns) a)
forall a. [a] -> Vector a
V.fromList [Mat (m : ns) a]
zs) (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [])
[] -> String -> Either String (Vec n (Mat (m : ns) a))
forall a b. a -> Either a b
Left String
"missing indices"
unrows ::
forall n m ns a.
Vec n (Mat (m ': ns) a) ->
Mat (n ': m ': ns) a
unrows :: Vec n (Mat (m : ns) a) -> Mat (n : m : ns) a
unrows = Vec n (Mat (m : ns) a) -> Mat (n : m : ns) a
forall (n :: Nat) (ns :: [Nat]) (m :: Nat) (ms :: [Nat]) a.
Mat (n : ns) (Mat (m : ms) a) -> Mat (n : (ns ++ (m : ms))) a
concatMat
chunkNVMat ::
forall ns t x a z.
Traversable t =>
t z ->
NonEmpty Pos ->
Mat x a ->
Either String (t (Mat ns a))
chunkNVMat :: t z -> NonEmpty Pos -> Mat x a -> Either String (t (Mat ns a))
chunkNVMat t z
tz NonEmpty Pos
ps = ((t (Vector a) -> t (Mat ns a))
-> Either String (t (Vector a)) -> Either String (t (Mat ns a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t (Vector a) -> t (Mat ns a))
-> Either String (t (Vector a)) -> Either String (t (Mat ns a)))
-> ((Vector a -> Mat ns a) -> t (Vector a) -> t (Mat ns a))
-> (Vector a -> Mat ns a)
-> Either String (t (Vector a))
-> Either String (t (Mat ns a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> Mat ns a) -> t (Vector a) -> t (Mat ns a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Vector a -> NonEmpty Pos -> Mat ns a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
`MatIU` NonEmpty Pos
ps) (Either String (t (Vector a)) -> Either String (t (Mat ns a)))
-> (Mat x a -> Either String (t (Vector a)))
-> Mat x a
-> Either String (t (Mat ns a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t z -> Pos -> Vector a -> Either String (t (Vector a))
forall (t :: * -> *) a z.
Traversable t =>
t z -> Pos -> Vector a -> Either String (t (Vector a))
chunkNV t z
tz (NonEmpty Pos -> Pos
forall (t :: * -> *). Foldable t => t Pos -> Pos
productP NonEmpty Pos
ps) (Vector a -> Either String (t (Vector a)))
-> (Mat x a -> Vector a) -> Mat x a -> Either String (t (Vector a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat x a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec
chunkNV ::
forall t a z.
Traversable t =>
t z ->
Pos ->
Vector a ->
Either String (t (Vector a))
chunkNV :: t z -> Pos -> Vector a -> Either String (t (Vector a))
chunkNV t z
tz (Pos Int
n) = (Vector a -> Either String (Vector a, Vector a))
-> t z -> Vector a -> Either String (t (Vector a))
forall (t :: * -> *) a (u :: * -> *) b z.
(Traversable t, Foldable u) =>
(u a -> Either String (u a, b))
-> t z -> u a -> Either String (t b)
chunkN' Vector a -> Either String (Vector a, Vector a)
g t z
tz
where
g :: Vector a -> Either String (Vector a, Vector a)
g = (Vector a, Vector a) -> Either String (Vector a, Vector a)
forall a b. b -> Either a b
Right ((Vector a, Vector a) -> Either String (Vector a, Vector a))
-> (Vector a -> (Vector a, Vector a))
-> Vector a
-> Either String (Vector a, Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a, Vector a) -> (Vector a, Vector a)
forall a b. (a, b) -> (b, a)
swap ((Vector a, Vector a) -> (Vector a, Vector a))
-> (Vector a -> (Vector a, Vector a))
-> Vector a
-> (Vector a, Vector a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt Int
n
type DotC :: [Nat] -> [Nat] -> Type -> Type -> Type -> Type -> Constraint
class
DotC ns ns' a b fa fb
| ns ns' a -> fa
, ns ns' b -> fb
, ns ns' fa -> a
, ns ns' fb -> b
, fa fb a b -> ns ns'
where
dotC ::
(fa -> fb -> c) ->
(NonEmpty c -> d) ->
Mat (n ': m ': ns) a ->
Mat (m ': p ': ns') b ->
Mat2 n p d
instance DotC '[] '[] a b a b where
dotC :: (a -> b -> c)
-> (NonEmpty c -> d)
-> Mat '[n, m] a
-> Mat '[m, p] b
-> Mat2 n p d
dotC = (a -> b -> c)
-> (NonEmpty c -> d)
-> Mat '[n, m] a
-> Mat '[m, p] b
-> Mat2 n p d
forall (n :: Nat) (m :: Nat) (p :: Nat) a b c d.
(a -> b -> c)
-> (NonEmpty c -> d) -> Mat2 n m a -> Mat2 m p b -> Mat2 n p d
dot
instance DotC (q ': ns) '[] a b (Mat (q ': ns) a) b where
dotC :: (Mat (q : ns) a -> b -> c)
-> (NonEmpty c -> d)
-> Mat (n : m : q : ns) a
-> Mat '[m, p] b
-> Mat2 n p d
dotC Mat (q : ns) a -> b -> c
f NonEmpty c -> d
g Mat (n : m : q : ns) a
m1 Mat '[m, p] b
m2 = (Mat (q : ns) a -> b -> c)
-> (NonEmpty c -> d)
-> Mat2 n m (Mat (q : ns) a)
-> Mat '[m, p] b
-> Mat2 n p d
forall (n :: Nat) (m :: Nat) (p :: Nat) a b c d.
(a -> b -> c)
-> (NonEmpty c -> d) -> Mat2 n m a -> Mat2 m p b -> Mat2 n p d
dot Mat (q : ns) a -> b -> c
f NonEmpty c -> d
g (Mat (n : m : q : ns) a -> MatToNDT 2 (n : m : q : ns) a
forall (ns :: [Nat]) a. Mat ns a -> MatToNDT 2 ns a
toMat2 Mat (n : m : q : ns) a
m1) Mat '[m, p] b
m2
instance DotC '[] (r ': xs) a b a (Mat (r ': xs) b) where
dotC :: (a -> Mat (r : xs) b -> c)
-> (NonEmpty c -> d)
-> Mat '[n, m] a
-> Mat (m : p : r : xs) b
-> Mat2 n p d
dotC a -> Mat (r : xs) b -> c
f NonEmpty c -> d
g Mat '[n, m] a
m1 Mat (m : p : r : xs) b
m2 = (a -> Mat (r : xs) b -> c)
-> (NonEmpty c -> d)
-> Mat '[n, m] a
-> Mat2 m p (Mat (r : xs) b)
-> Mat2 n p d
forall (n :: Nat) (m :: Nat) (p :: Nat) a b c d.
(a -> b -> c)
-> (NonEmpty c -> d) -> Mat2 n m a -> Mat2 m p b -> Mat2 n p d
dot a -> Mat (r : xs) b -> c
f NonEmpty c -> d
g Mat '[n, m] a
m1 (Mat (m : p : r : xs) b -> MatToNDT 2 (m : p : r : xs) b
forall (ns :: [Nat]) a. Mat ns a -> MatToNDT 2 ns a
toMat2 Mat (m : p : r : xs) b
m2)
instance DotC (q ': ns) (r ': xs) a b (Mat (q ': ns) a) (Mat (r ': xs) b) where
dotC :: (Mat (q : ns) a -> Mat (r : xs) b -> c)
-> (NonEmpty c -> d)
-> Mat (n : m : q : ns) a
-> Mat (m : p : r : xs) b
-> Mat2 n p d
dotC Mat (q : ns) a -> Mat (r : xs) b -> c
f NonEmpty c -> d
g Mat (n : m : q : ns) a
m1 Mat (m : p : r : xs) b
m2 = (Mat (q : ns) a -> Mat (r : xs) b -> c)
-> (NonEmpty c -> d)
-> Mat2 n m (Mat (q : ns) a)
-> Mat2 m p (Mat (r : xs) b)
-> Mat2 n p d
forall (n :: Nat) (m :: Nat) (p :: Nat) a b c d.
(a -> b -> c)
-> (NonEmpty c -> d) -> Mat2 n m a -> Mat2 m p b -> Mat2 n p d
dot Mat (q : ns) a -> Mat (r : xs) b -> c
f NonEmpty c -> d
g (Mat (n : m : q : ns) a -> MatToNDT 2 (n : m : q : ns) a
forall (ns :: [Nat]) a. Mat ns a -> MatToNDT 2 ns a
toMat2 Mat (n : m : q : ns) a
m1) (Mat (m : p : r : xs) b -> MatToNDT 2 (m : p : r : xs) b
forall (ns :: [Nat]) a. Mat ns a -> MatToNDT 2 ns a
toMat2 Mat (m : p : r : xs) b
m2)
dot ::
forall n m p a b c d.
(a -> b -> c) ->
(NonEmpty c -> d) ->
Mat2 n m a ->
Mat2 m p b ->
Mat2 n p d
dot :: (a -> b -> c)
-> (NonEmpty c -> d) -> Mat2 n m a -> Mat2 m p b -> Mat2 n p d
dot a -> b -> c
f NonEmpty c -> d
g w1 :: Mat2 n m a
w1@(Mat Vector a
_ (Pos
n :| [Pos]
ps1)) w2 :: Mat2 m p b
w2@(Mat Vector b
_ (Pos
_ :| [Pos]
ps2)) = String -> Either String (Mat2 n p d) -> Mat2 n p d
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"dot" (Either String (Mat2 n p d) -> Mat2 n p d)
-> Either String (Mat2 n p d) -> Mat2 n p d
forall a b. (a -> b) -> a -> b
$
case ([Pos]
ps1, [Pos]
ps2) of
([Pos
m], [Pos
p]) -> do
NonEmpty (NonEmpty a)
z1 <- Pos -> Pos -> Mat2 n m a -> Either String (NonEmpty (NonEmpty a))
forall a (u :: * -> *).
Foldable u =>
Pos -> Pos -> u a -> Either String (NonEmpty (NonEmpty a))
chunkNLen1 Pos
n Pos
m Mat2 n m a
w1
NonEmpty (NonEmpty b)
z2 <- NonEmpty (NonEmpty b) -> NonEmpty (NonEmpty b)
forall a. NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)
N.transpose (NonEmpty (NonEmpty b) -> NonEmpty (NonEmpty b))
-> Either String (NonEmpty (NonEmpty b))
-> Either String (NonEmpty (NonEmpty b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pos -> Pos -> Mat2 m p b -> Either String (NonEmpty (NonEmpty b))
forall a (u :: * -> *).
Foldable u =>
Pos -> Pos -> u a -> Either String (NonEmpty (NonEmpty a))
chunkNLen1 Pos
m Pos
p Mat2 m p b
w2
NonEmpty d
w <- NonEmpty (Either String d) -> Either String (NonEmpty d)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (NonEmpty (Either String d) -> Either String (NonEmpty d))
-> NonEmpty (Either String d) -> Either String (NonEmpty d)
forall a b. (a -> b) -> a -> b
$ (NonEmpty a -> NonEmpty b -> Either String d)
-> NonEmpty (NonEmpty a)
-> NonEmpty (NonEmpty b)
-> NonEmpty (Either String d)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((NonEmpty c -> d) -> Either String (NonEmpty c) -> Either String d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty c -> d
g (Either String (NonEmpty c) -> Either String d)
-> (NonEmpty a -> NonEmpty b -> Either String (NonEmpty c))
-> NonEmpty a
-> NonEmpty b
-> Either String d
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (a -> b -> c)
-> NonEmpty a -> NonEmpty b -> Either String (NonEmpty c)
forall (t :: * -> *) (u :: * -> *) a b c.
(Traversable t, Foldable u) =>
(a -> b -> c) -> t a -> u b -> Either String (t c)
zipWithExact a -> b -> c
f) NonEmpty (NonEmpty a)
z1 NonEmpty (NonEmpty b)
z2
Vector d -> NonEmpty Pos -> Either String (Mat2 n p d)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat ([d] -> Vector d
forall a. [a] -> Vector a
V.fromList ([d] -> Vector d) -> [d] -> Vector d
forall a b. (a -> b) -> a -> b
$ NonEmpty d -> [d]
forall a. NonEmpty a -> [a]
N.toList NonEmpty d
w) (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos
p])
([Pos], [Pos])
o -> String -> Either String (Mat2 n p d)
forall a b. a -> Either a b
Left (String -> Either String (Mat2 n p d))
-> String -> Either String (Mat2 n p d)
forall a b. (a -> b) -> a -> b
$ String
"missing indices " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Pos], [Pos]) -> String
forall a. Show a => a -> String
show ([Pos], [Pos])
o
multMat ::
forall n m p a.
Num a =>
Mat2 n m a ->
Mat2 m p a ->
Mat2 n p a
multMat :: Mat2 n m a -> Mat2 m p a -> Mat2 n p a
multMat = (a -> a -> a)
-> (NonEmpty a -> a) -> Mat2 n m a -> Mat2 m p a -> Mat2 n p a
forall (n :: Nat) (m :: Nat) (p :: Nat) a b c d.
(a -> b -> c)
-> (NonEmpty c -> d) -> Mat2 n m a -> Mat2 m p b -> Mat2 n p d
dot a -> a -> a
forall a. Num a => a -> a -> a
(*) NonEmpty a -> a
forall (t :: * -> *) a. (Foldable1 t, Num a) => t a -> a
sum1
deleteRow ::
forall (i :: Nat) (n :: Nat) (ns :: [Nat]) a.
FinC i (1 GN.+ n) =>
Mat (1 GN.+ n ': ns) a ->
Mat (n ': ns) a
deleteRow :: Mat ((1 + n) : ns) a -> Mat (n : ns) a
deleteRow = Fin (1 + n) -> Mat ((1 + n) : ns) a -> Mat (n : ns) a
forall (n :: Nat) (ns :: [Nat]) a.
Fin (1 + n) -> Mat ((1 + n) : ns) a -> Mat (n : ns) a
deleteRow' (FinC i (1 + n) => Fin (1 + n)
forall (i :: Nat) (n :: Nat). FinC i n => Fin n
finC @i @(1 GN.+ n))
deleteRow' ::
forall n ns a.
Fin (1 GN.+ n) ->
Mat (1 GN.+ n ': ns) a ->
Mat (n ': ns) a
deleteRow' :: Fin (1 + n) -> Mat ((1 + n) : ns) a -> Mat (n : ns) a
deleteRow' (Fin (Pos i) _) (Mat v (sn :| ps)) = String -> Either String (Mat (n : ns) a) -> Mat (n : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"deleteRow'" (Either String (Mat (n : ns) a) -> Mat (n : ns) a)
-> Either String (Mat (n : ns) a) -> Mat (n : ns) a
forall a b. (a -> b) -> a -> b
$ do
Pos
n <- Pos -> Either String Pos
predP Pos
sn
let n1 :: Int
n1 = [Pos] -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt [Pos]
ps
s :: Int
s = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n1
v1 :: Vector a
v1 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 Int
s Vector a
v
v2 :: Vector a
v2 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n1) (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt (Pos
sn Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n1) Vector a
v
Vector a -> NonEmpty Pos -> Either String (Mat (n : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Vector a
v1 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v2) (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps)
insertRow ::
forall i n m ns a.
FinC i (1 GN.+ n) =>
Mat (m ': ns) a ->
Mat (n ': m ': ns) a ->
Mat (1 GN.+ n ': m ': ns) a
insertRow :: Mat (m : ns) a -> Mat (n : m : ns) a -> Mat ((1 + n) : m : ns) a
insertRow = Fin (1 + n)
-> Mat (m : ns) a -> Mat (n : m : ns) a -> Mat ((1 + n) : m : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Fin (1 + n)
-> Mat (m : ns) a -> Mat (n : m : ns) a -> Mat ((1 + n) : m : ns) a
insertRow' (FinC i (1 + n) => Fin (1 + n)
forall (i :: Nat) (n :: Nat). FinC i n => Fin n
finC @i @(1 GN.+ n))
insertRow' ::
forall n m ns a.
Fin (1 GN.+ n) ->
Mat (m ': ns) a ->
Mat (n ': m ': ns) a ->
Mat (1 GN.+ n ': m ': ns) a
insertRow' :: Fin (1 + n)
-> Mat (m : ns) a -> Mat (n : m : ns) a -> Mat ((1 + n) : m : ns) a
insertRow' (Fin (Pos i) _) (Mat Vector a
v0 NonEmpty Pos
_) (Mat Vector a
v (Pos
p :| [Pos]
ps)) =
let s :: Int
s = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Pos] -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt [Pos]
ps
v1 :: Vector a
v1 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 Int
s Vector a
v
v2 :: Vector a
v2 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
s (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt (Pos
p Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) Vector a
v
in Vector a -> NonEmpty Pos -> Mat ((1 + n) : m : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector a
v1 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v0 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v2) (Pos -> Pos
succP Pos
p Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps)
deleteCol ::
forall (i :: Nat) (n :: Nat) (n1 :: Nat) ns a.
FinC i (1 GN.+ n1) =>
Mat (n ': (1 GN.+ n1) ': ns) a ->
Mat (n ': n1 ': ns) a
deleteCol :: Mat (n : (1 + n1) : ns) a -> Mat (n : n1 : ns) a
deleteCol = Fin (1 + n1) -> Mat (n : (1 + n1) : ns) a -> Mat (n : n1 : ns) a
forall (n :: Nat) (n1 :: Nat) (ns :: [Nat]) a.
Fin (1 + n1) -> Mat (n : (1 + n1) : ns) a -> Mat (n : n1 : ns) a
deleteCol' (FinC i (1 + n1) => Fin (1 + n1)
forall (i :: Nat) (n :: Nat). FinC i n => Fin n
finC @i @(1 GN.+ n1))
deleteCol' ::
forall (n :: Nat) (n1 :: Nat) ns a.
Fin (1 GN.+ n1) ->
Mat (n ': (1 GN.+ n1) ': ns) a ->
Mat (n ': n1 ': ns) a
deleteCol' :: Fin (1 + n1) -> Mat (n : (1 + n1) : ns) a -> Mat (n : n1 : ns) a
deleteCol' Fin (1 + n1)
fn = forall (ns :: [Nat]) a. Mat (n1 : n : ns) a -> Mat (n : n1 : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat @n1 @n (Mat (n1 : n : ns) a -> Mat (n : n1 : ns) a)
-> (Mat (n : (1 + n1) : ns) a -> Mat (n1 : n : ns) a)
-> Mat (n : (1 + n1) : ns) a
-> Mat (n : n1 : ns) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fin (1 + n1) -> Mat ((1 + n1) : n : ns) a -> Mat (n1 : n : ns) a
forall (n :: Nat) (ns :: [Nat]) a.
Fin (1 + n) -> Mat ((1 + n) : ns) a -> Mat (n : ns) a
deleteRow' @n1 Fin (1 + n1)
fn (Mat ((1 + n1) : n : ns) a -> Mat (n1 : n : ns) a)
-> (Mat (n : (1 + n1) : ns) a -> Mat ((1 + n1) : n : ns) a)
-> Mat (n : (1 + n1) : ns) a
-> Mat (n1 : n : ns) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ns :: [Nat]) a.
Mat (n : (1 + n1) : ns) a -> Mat ((1 + n1) : n : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat @n @(1 GN.+ n1)
insertCol ::
forall (i :: Nat) (n :: Nat) (n1 :: Nat) ns a.
FinC i (1 GN.+ n1) =>
Mat (n ': ns) a ->
Mat (n ': n1 ': ns) a ->
Mat (n ': (1 GN.+ n1) ': ns) a
insertCol :: Mat (n : ns) a -> Mat (n : n1 : ns) a -> Mat (n : (1 + n1) : ns) a
insertCol = Fin (1 + n1)
-> Mat (n : ns) a
-> Mat (n : n1 : ns) a
-> Mat (n : (1 + n1) : ns) a
forall (n :: Nat) (n1 :: Nat) (ns :: [Nat]) a.
Fin (1 + n1)
-> Mat (n : ns) a
-> Mat (n : n1 : ns) a
-> Mat (n : (1 + n1) : ns) a
insertCol' (FinC i (1 + n1) => Fin (1 + n1)
forall (i :: Nat) (n :: Nat). FinC i n => Fin n
finC @i @(1 GN.+ n1))
insertCol' ::
forall (n :: Nat) (n1 :: Nat) ns a.
Fin (1 GN.+ n1) ->
Mat (n ': ns) a ->
Mat (n ': n1 ': ns) a ->
Mat (n ': (1 GN.+ n1) ': ns) a
insertCol' :: Fin (1 + n1)
-> Mat (n : ns) a
-> Mat (n : n1 : ns) a
-> Mat (n : (1 + n1) : ns) a
insertCol' Fin (1 + n1)
fn Mat (n : ns) a
v = forall (ns :: [Nat]) a.
Mat ((1 + n1) : n : ns) a -> Mat (n : (1 + n1) : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat @(1 GN.+ n1) @n (Mat ((1 + n1) : n : ns) a -> Mat (n : (1 + n1) : ns) a)
-> (Mat (n : n1 : ns) a -> Mat ((1 + n1) : n : ns) a)
-> Mat (n : n1 : ns) a
-> Mat (n : (1 + n1) : ns) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fin (1 + n1)
-> Mat (n : ns) a
-> Mat (n1 : n : ns) a
-> Mat ((1 + n1) : n : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Fin (1 + n)
-> Mat (m : ns) a -> Mat (n : m : ns) a -> Mat ((1 + n) : m : ns) a
insertRow' Fin (1 + n1)
fn Mat (n : ns) a
v (Mat (n1 : n : ns) a -> Mat ((1 + n1) : n : ns) a)
-> (Mat (n : n1 : ns) a -> Mat (n1 : n : ns) a)
-> Mat (n : n1 : ns) a
-> Mat ((1 + n1) : n : ns) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ns :: [Nat]) a. Mat (n : n1 : ns) a -> Mat (n1 : n : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat @n @n1
swapRow ::
forall (i :: Nat) (j :: Nat) (n :: Nat) ns a.
(FinC i n, FinC j n) =>
Mat (n ': ns) a ->
Mat (n ': ns) a
swapRow :: Mat (n : ns) a -> Mat (n : ns) a
swapRow = Fin n -> Fin n -> Mat (n : ns) a -> Mat (n : ns) a
forall (n :: Nat) (ns :: [Nat]) a.
Fin n -> Fin n -> Mat (n : ns) a -> Mat (n : ns) a
swapRow' (forall (n :: Nat). FinC i n => Fin n
forall (i :: Nat) (n :: Nat). FinC i n => Fin n
finC @i) (forall (n :: Nat). FinC j n => Fin n
forall (i :: Nat) (n :: Nat). FinC i n => Fin n
finC @j)
swapRow' ::
forall (n :: Nat) ns a.
Fin n ->
Fin n ->
Mat (n ': ns) a ->
Mat (n ': ns) a
swapRow' :: Fin n -> Fin n -> Mat (n : ns) a -> Mat (n : ns) a
swapRow' (Fin Pos
ix Pos
_) (Fin Pos
jx Pos
_) z :: Mat (n : ns) a
z@(Mat Vector a
v w :: NonEmpty Pos
w@(Pos
_ :| [Pos]
ps)) =
let (Pos Int
i, Pos Int
j) = ((Pos, Pos) -> (Pos, Pos))
-> ((Pos, Pos) -> (Pos, Pos)) -> Bool -> (Pos, Pos) -> (Pos, Pos)
forall a. a -> a -> Bool -> a
bool (Pos, Pos) -> (Pos, Pos)
forall a. a -> a
id (Pos, Pos) -> (Pos, Pos)
forall a b. (a, b) -> (b, a)
swap (Pos
ix Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
> Pos
jx) (Pos
ix, Pos
jx)
len :: Int
len = [Pos] -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt [Pos]
ps
in if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
then Mat (n : ns) a
z
else
let s0 :: Int
s0 = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len
s1 :: Int
s1 = (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len
x1 :: Vector a
x1 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 Int
s0 Vector a
v
x2 :: Vector a
x2 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
s0 Int
len Vector a
v
x3 :: Vector a
x3 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
s0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Vector a
v
x4 :: Vector a
x4 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
s1 Int
len Vector a
v
x5 :: Vector a
x5 = Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Vector a
v
in Vector a -> NonEmpty Pos -> Mat (n : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector a
x1 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
x4 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
x3 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
x2 Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
x5) NonEmpty Pos
w
swapCol ::
forall (i :: Nat) (j :: Nat) (n :: Nat) (n1 :: Nat) ns a.
(FinC i n1, FinC j n1) =>
Mat (n ': n1 ': ns) a ->
Mat (n ': n1 ': ns) a
swapCol :: Mat (n : n1 : ns) a -> Mat (n : n1 : ns) a
swapCol = Fin n1 -> Fin n1 -> Mat (n : n1 : ns) a -> Mat (n : n1 : ns) a
forall (n :: Nat) (n1 :: Nat) (ns :: [Nat]) a.
Fin n1 -> Fin n1 -> Mat (n : n1 : ns) a -> Mat (n : n1 : ns) a
swapCol' (forall (n :: Nat). FinC i n => Fin n
forall (i :: Nat) (n :: Nat). FinC i n => Fin n
finC @i) (forall (n :: Nat). FinC j n => Fin n
forall (i :: Nat) (n :: Nat). FinC i n => Fin n
finC @j)
swapCol' ::
forall (n :: Nat) (n1 :: Nat) ns a.
Fin n1 ->
Fin n1 ->
Mat (n ': n1 ': ns) a ->
Mat (n ': n1 ': ns) a
swapCol' :: Fin n1 -> Fin n1 -> Mat (n : n1 : ns) a -> Mat (n : n1 : ns) a
swapCol' Fin n1
fni Fin n1
fnj = Mat (n1 : n : ns) a -> Mat (n : n1 : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat (Mat (n1 : n : ns) a -> Mat (n : n1 : ns) a)
-> (Mat (n : n1 : ns) a -> Mat (n1 : n : ns) a)
-> Mat (n : n1 : ns) a
-> Mat (n : n1 : ns) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fin n1 -> Fin n1 -> Mat (n1 : n : ns) a -> Mat (n1 : n : ns) a
forall (n :: Nat) (ns :: [Nat]) a.
Fin n -> Fin n -> Mat (n : ns) a -> Mat (n : ns) a
swapRow' Fin n1
fni Fin n1
fnj (Mat (n1 : n : ns) a -> Mat (n1 : n : ns) a)
-> (Mat (n : n1 : ns) a -> Mat (n1 : n : ns) a)
-> Mat (n : n1 : ns) a
-> Mat (n1 : n : ns) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat (n : n1 : ns) a -> Mat (n1 : n : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat
swapMat ::
forall (is :: [Nat]) (js :: [Nat]) ns a.
(FinMatC is ns, FinMatC js ns) =>
Mat ns a ->
Mat ns a
swapMat :: Mat ns a -> Mat ns a
swapMat = FinMat ns -> FinMat ns -> Mat ns a -> Mat ns a
forall (ns :: [Nat]) a.
FinMat ns -> FinMat ns -> Mat ns a -> Mat ns a
swapMat' (FinMatC is ns => FinMat ns
forall k (is :: k) (ns :: [Nat]). FinMatC is ns => FinMat ns
finMatC @is @ns) (FinMatC js ns => FinMat ns
forall k (is :: k) (ns :: [Nat]). FinMatC is ns => FinMat ns
finMatC @js @ns)
swapMat' ::
forall ns a.
FinMat ns ->
FinMat ns ->
Mat ns a ->
Mat ns a
swapMat' :: FinMat ns -> FinMat ns -> Mat ns a -> Mat ns a
swapMat' (FinMat Int
i NonEmpty Pos
_) (FinMat Int
j NonEmpty Pos
_) (Mat Vector a
v NonEmpty Pos
ps) =
Vector a -> NonEmpty Pos -> Mat ns a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector a -> Vector (Int, a) -> Vector a
forall a. Vector a -> Vector (Int, a) -> Vector a
V.update Vector a
v ([(Int, a)] -> Vector (Int, a)
forall a. [a] -> Vector a
V.fromList [(Int
i, Vector a
v Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
j), (Int
j, Vector a
v Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
i)])) NonEmpty Pos
ps
appendV ::
Mat (n ': ns) a ->
Mat (n' ': ns) a ->
Mat ((n GN.+ n') ': ns) a
appendV :: Mat (n : ns) a -> Mat (n' : ns) a -> Mat ((n + n') : ns) a
appendV (Mat Vector a
v (Pos
p :| [Pos]
ps)) (Mat Vector a
v1 (Pos
p1 :| [Pos]
_)) =
Vector a -> NonEmpty Pos -> Mat ((n + n') : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector a
v Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
<> Vector a
v1) ((Pos
p Pos -> Pos -> Pos
+! Pos
p1) Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps)
appendH ::
forall n m m' ns a.
Mat (n ': m ': ns) a ->
Mat (n ': m' ': ns) a ->
Mat (n ': (m GN.+ m') ': ns) a
appendH :: Mat (n : m : ns) a
-> Mat (n : m' : ns) a -> Mat (n : (m + m') : ns) a
appendH w :: Mat (n : m : ns) a
w@(Mat Vector a
_ (Pos
n :| [Pos]
ps)) w1 :: Mat (n : m' : ns) a
w1@(Mat Vector a
_ (Pos
n' :| [Pos]
ps1)) = String
-> Either String (Mat (n : (m + m') : ns) a)
-> Mat (n : (m + m') : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"appendH" (Either String (Mat (n : (m + m') : ns) a)
-> Mat (n : (m + m') : ns) a)
-> Either String (Mat (n : (m + m') : ns) a)
-> Mat (n : (m + m') : ns) a
forall a b. (a -> b) -> a -> b
$
if Pos
n Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
n' then
case ([Pos]
ps, [Pos]
ps1) of
([], [Pos]
_) -> String -> Either String (Mat (n : (m + m') : ns) a)
forall a b. a -> Either a b
Left String
"lhs missing indices"
([Pos]
_, []) -> String -> Either String (Mat (n : (m + m') : ns) a)
forall a b. a -> Either a b
Left String
"rhs missing indices"
(Pos
m : [Pos]
ns, Pos
m' : [Pos]
ns')
| [Pos]
ns [Pos] -> [Pos] -> Bool
forall a. Eq a => a -> a -> Bool
== [Pos]
ns' -> do
[Vector a]
x1 <- [()] -> Pos -> Vector a -> Either String [Vector a]
forall (t :: * -> *) a z.
Traversable t =>
t z -> Pos -> Vector a -> Either String (t (Vector a))
chunkNV (Pos -> [()]
forall (l :: * -> *) a.
(IsList (l a), Item (l a) ~ ()) =>
Pos -> l a
unitsF Pos
n) (NonEmpty Pos -> Pos
forall (t :: * -> *). Foldable t => t Pos -> Pos
productP (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns)) (Mat (n : m : ns) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec Mat (n : m : ns) a
w)
[Vector a]
x2 <- [()] -> Pos -> Vector a -> Either String [Vector a]
forall (t :: * -> *) a z.
Traversable t =>
t z -> Pos -> Vector a -> Either String (t (Vector a))
chunkNV (Pos -> [()]
forall (l :: * -> *) a.
(IsList (l a), Item (l a) ~ ()) =>
Pos -> l a
unitsF @[] Pos
n) (NonEmpty Pos -> Pos
forall (t :: * -> *). Foldable t => t Pos -> Pos
productP (Pos
m' Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns')) (Mat (n : m' : ns) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec Mat (n : m' : ns) a
w1)
[Vector a]
ret <- (Vector a -> Vector a -> Vector a)
-> [Vector a] -> [Vector a] -> Either String [Vector a]
forall (t :: * -> *) (u :: * -> *) a b c.
(Traversable t, Foldable u) =>
(a -> b -> c) -> t a -> u b -> Either String (t c)
zipWithExact Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
(<>) [Vector a]
x1 [Vector a]
x2
let ps2 :: NonEmpty Pos
ps2 = Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| ([Pos
m Pos -> Pos -> Pos
+! Pos
m'] [Pos] -> [Pos] -> [Pos]
forall a. Semigroup a => a -> a -> a
<> [Pos]
ns)
Vector a
-> NonEmpty Pos -> Either String (Mat (n : (m + m') : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat ([Vector a] -> Vector a
forall a. [Vector a] -> Vector a
V.concat [Vector a]
ret) NonEmpty Pos
ps2
| Bool
otherwise -> String -> Either String (Mat (n : (m + m') : ns) a)
forall a b. a -> Either a b
Left (String -> Either String (Mat (n : (m + m') : ns) a))
-> String -> Either String (Mat (n : (m + m') : ns) a)
forall a b. (a -> b) -> a -> b
$ String
"ns/=ns' " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Pos], [Pos]) -> String
forall a. Show a => a -> String
show ([Pos]
ns, [Pos]
ns')
else String -> Either String (Mat (n : (m + m') : ns) a)
forall a b. a -> Either a b
Left (String -> Either String (Mat (n : (m + m') : ns) a))
-> String -> Either String (Mat (n : (m + m') : ns) a)
forall a b. (a -> b) -> a -> b
$ String
"n/=n' " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Pos, Pos) -> String
forall a. Show a => a -> String
show (Pos
n, Pos
n')
permutationsMat :: forall n a. Vec n a -> Mat2 (FacT n) n a
permutationsMat :: Vec n a -> Mat2 (FacT n) n a
permutationsMat (Mat Vector a
v (Pos
p :| [Pos]
_)) =
let ret :: [[a]]
ret = [a] -> [[a]]
forall a. [a] -> [[a]]
L.permutations (Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector a
v)
lhs :: Pos
lhs = NonEmpty Pos -> Pos
forall (t :: * -> *). Foldable t => t Pos -> Pos
productP (Pos -> NonEmpty Pos
forall a. (Bounded a, Enum a) => a -> NonEmpty a
enumTo1 Pos
p)
in Vector a -> NonEmpty Pos -> Mat2 (FacT n) n a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a) -> [a] -> Vector a
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[a]]
ret) (Pos
lhs Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos
p])
findMatElems :: NS ns => (a -> Bool) -> Mat ns a -> [(FinMat ns, a)]
findMatElems :: (a -> Bool) -> Mat ns a -> [(FinMat ns, a)]
findMatElems a -> Bool
p = (FinMat ns -> a -> [(FinMat ns, a)])
-> Mat ns a -> [(FinMat ns, a)]
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap (\FinMat ns
i a
a -> [(FinMat ns, a)] -> [(FinMat ns, a)] -> Bool -> [(FinMat ns, a)]
forall a. a -> a -> Bool -> a
bool [] [(FinMat ns
i, a
a)] (a -> Bool
p a
a))
buildMat ::
forall ns a b.
NS ns =>
([FinMat ns] -> [FinMat ns] -> b -> FinMat ns -> (b, a)) ->
b ->
(b, Mat ns a)
buildMat :: ([FinMat ns] -> [FinMat ns] -> b -> FinMat ns -> (b, a))
-> b -> (b, Mat ns a)
buildMat = ([FinMat ns] -> [FinMat ns] -> b -> FinMat ns -> (b, a))
-> b -> (b, Mat ns a)
forall (f :: * -> *) a b.
(Traversable f, Representable f) =>
([Rep f] -> [Rep f] -> b -> Rep f -> (b, a)) -> b -> (b, f a)
buildRepL
cartesian ::
(a -> b -> c) ->
Mat (n ': ns) a ->
Mat (n' ': ns') b ->
Mat (n ': ns TP.++ n' ': ns') c
cartesian :: (a -> b -> c)
-> Mat (n : ns) a
-> Mat (n' : ns') b
-> Mat (n : (ns ++ (n' : ns'))) c
cartesian a -> b -> c
f (Mat Vector a
v NonEmpty Pos
ps) (Mat Vector b
v1 NonEmpty Pos
ps1) =
Vector c -> NonEmpty Pos -> Mat (n : (ns ++ (n' : ns'))) c
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ((a -> b -> c) -> Vector a -> Vector b -> Vector c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f Vector a
v Vector b
v1) (NonEmpty Pos
ps NonEmpty Pos -> NonEmpty Pos -> NonEmpty Pos
forall a. Semigroup a => a -> a -> a
<> NonEmpty Pos
ps1)
bulkMat :: Vec x (FinMat ns) -> Lens' (Mat ns a) (Vec x a)
bulkMat :: Vec x (FinMat ns) -> Lens' (Mat ns a) (Vec x a)
bulkMat Vec x (FinMat ns)
fins =
(Mat ns a -> Vec x a)
-> (Mat ns a -> Vec x a -> Mat ns a) -> Lens' (Mat ns a) (Vec x a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(Vec x (FinMat ns) -> Mat ns a -> Vec x a
forall (ns :: [Nat]) a (t :: * -> *).
Functor t =>
t (FinMat ns) -> Mat ns a -> t a
getsMat Vec x (FinMat ns)
fins)
(\Mat ns a
m Vec x a
lst -> Mat '[x] (FinMat ns, a) -> Mat ns a -> Mat ns a
forall (ns :: [Nat]) (t :: * -> *) a.
Foldable t =>
t (FinMat ns, a) -> Mat ns a -> Mat ns a
setsMat (Vec x (FinMat ns) -> Vec x a -> Mat '[x] (FinMat ns, a)
forall (ns :: [Nat]) a b. Mat ns a -> Mat ns b -> Mat ns (a, b)
zipMat Vec x (FinMat ns)
fins Vec x a
lst) Mat ns a
m)
updatesMat ::
forall ns t a b.
Foldable t =>
(FinMat ns -> a -> b -> a) ->
t (FinMat ns, b) ->
Mat ns a ->
Mat ns a
updatesMat :: (FinMat ns -> a -> b -> a)
-> t (FinMat ns, b) -> Mat ns a -> Mat ns a
updatesMat FinMat ns -> a -> b -> a
f = (Mat ns a -> t (FinMat ns, b) -> Mat ns a)
-> t (FinMat ns, b) -> Mat ns a -> Mat ns a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Mat ns a -> (FinMat ns, b) -> Mat ns a)
-> Mat ns a -> t (FinMat ns, b) -> Mat ns a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Mat ns a -> (FinMat ns, b) -> Mat ns a
g)
where
g :: Mat ns a -> (FinMat ns, b) -> Mat ns a
g Mat ns a
m (FinMat ns
fm, b
b) = (a -> a) -> FinMat ns -> Mat ns a -> Mat ns a
forall a (ns :: [Nat]).
(a -> a) -> FinMat ns -> Mat ns a -> Mat ns a
updateMat (\a
a -> FinMat ns -> a -> b -> a
f FinMat ns
fm a
a b
b) FinMat ns
fm Mat ns a
m
getsMat :: forall ns a t. Functor t => t (FinMat ns) -> Mat ns a -> t a
getsMat :: t (FinMat ns) -> Mat ns a -> t a
getsMat t (FinMat ns)
lst Mat ns a
m = (FinMat ns -> Mat ns a -> a
forall (ns :: [Nat]) a. FinMat ns -> Mat ns a -> a
`indexMat` Mat ns a
m) (FinMat ns -> a) -> t (FinMat ns) -> t a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (FinMat ns)
lst
setsMat ::
forall ns t a.
Foldable t =>
t (FinMat ns, a) ->
Mat ns a ->
Mat ns a
setsMat :: t (FinMat ns, a) -> Mat ns a -> Mat ns a
setsMat = (Mat ns a -> t (FinMat ns, a) -> Mat ns a)
-> t (FinMat ns, a) -> Mat ns a -> Mat ns a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Mat ns a -> (FinMat ns, a) -> Mat ns a)
-> Mat ns a -> t (FinMat ns, a) -> Mat ns a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Mat ns a -> (FinMat ns, a) -> Mat ns a
g)
where
g :: Mat ns a -> (FinMat ns, a) -> Mat ns a
g :: Mat ns a -> (FinMat ns, a) -> Mat ns a
g Mat ns a
m (FinMat ns
fm, a
a) = a -> FinMat ns -> Mat ns a -> Mat ns a
forall a (ns :: [Nat]). a -> FinMat ns -> Mat ns a -> Mat ns a
setMat a
a FinMat ns
fm Mat ns a
m
type MatTupleT :: [Nat] -> Type -> Type
type family MatTupleT ns a where
MatTupleT '[] _ = GL.TypeError ( 'GL.Text "MatTupleT '[]: undefined for empty indices")
MatTupleT '[n] a = ListTupleT n a
MatTupleT (n ': n1 ': ns) a = ListTupleT n (MatTupleT (n1 ': ns) a)
type MatTupleC :: [Nat] -> Type -> Constraint
class MatTupleC ns a where
toTupleC ::
Mat ns a ->
MatTupleT ns a
fromTupleC ::
MatTupleT ns a ->
Mat ns a
fmapTupleMatC ::
(a -> b) ->
MatTupleT ns a ->
MatTupleT ns b
traversalTupleMatC ::
Traversal (MatTupleT ns a) (MatTupleT ns b) a b
instance GL.TypeError ( 'GL.Text "MatTupleC '[]: undefined for empty indices") => MatTupleC '[] a where
toTupleC :: Mat '[] a -> MatTupleT '[] a
toTupleC = String -> Mat '[] a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"MatTupleC:toTupleC"
fromTupleC :: MatTupleT '[] a -> Mat '[] a
fromTupleC = String -> (TypeError ...) -> Mat '[] a
forall a. HasCallStack => String -> a
compileError String
"MatTupleC:fromTupleC"
fmapTupleMatC :: (a -> b) -> MatTupleT '[] a -> MatTupleT '[] b
fmapTupleMatC = String -> (a -> b) -> (TypeError ...) -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"MatTupleC:fmapTupleMatC"
traversalTupleMatC :: (a -> f b) -> MatTupleT '[] a -> f (MatTupleT '[] b)
traversalTupleMatC = String -> (a -> f b) -> (TypeError ...) -> f (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"MatTupleC:traversalTupleMatC"
instance ListTupleCInternal n => MatTupleC '[n] a where
toTupleC :: Mat '[n] a -> MatTupleT '[n] a
toTupleC = Mat '[n] a -> MatTupleT '[n] a
forall (n :: Nat) a.
ListTupleCInternal n =>
Vec n a -> ListTupleT n a
toTupleCInternal
fromTupleC :: MatTupleT '[n] a -> Mat '[n] a
fromTupleC = MatTupleT '[n] a -> Mat '[n] a
forall (n :: Nat) a.
ListTupleCInternal n =>
ListTupleT n a -> Vec n a
fromTupleCInternal
fmapTupleMatC :: (a -> b) -> MatTupleT '[n] a -> MatTupleT '[n] b
fmapTupleMatC = (a -> b) -> MatTupleT '[n] a -> MatTupleT '[n] b
forall (n :: Nat) a b.
ListTupleCInternal n =>
(a -> b) -> ListTupleT n a -> ListTupleT n b
fmapTupleInternal
traversalTupleMatC :: (a -> f b) -> MatTupleT '[n] a -> f (MatTupleT '[n] b)
traversalTupleMatC = (a -> f b) -> MatTupleT '[n] a -> f (MatTupleT '[n] b)
forall (n :: Nat) a b.
ListTupleCInternal n =>
Traversal (ListTupleT n a) (ListTupleT n b) a b
traversalTupleCInternal
instance
(ListTupleCInternal n, NS (n1 ': ns), MatTupleC (n1 ': ns) a) =>
MatTupleC (n ': n1 ': ns) a
where
toTupleC :: Mat (n : n1 : ns) a -> MatTupleT (n : n1 : ns) a
toTupleC Mat (n : n1 : ns) a
lst = Vec n (MatTupleT (n1 : ns) a)
-> ListTupleT n (MatTupleT (n1 : ns) a)
forall (n :: Nat) a.
ListTupleCInternal n =>
Vec n a -> ListTupleT n a
toTupleCInternal @n ((Mat (n1 : ns) a -> MatTupleT (n1 : ns) a)
-> Mat '[n] (Mat (n1 : ns) a) -> Vec n (MatTupleT (n1 : ns) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (ns :: [Nat]) a.
MatTupleC ns a =>
Mat ns a -> MatTupleT ns a
forall a.
MatTupleC (n1 : ns) a =>
Mat (n1 : ns) a -> MatTupleT (n1 : ns) a
toTupleC @(n1 ': ns)) (Mat (n : n1 : ns) a -> Mat '[n] (Mat (n1 : ns) a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Vec n (Mat (m : ns) a)
rows @n Mat (n : n1 : ns) a
lst))
fromTupleC :: MatTupleT (n : n1 : ns) a -> Mat (n : n1 : ns) a
fromTupleC MatTupleT (n : n1 : ns) a
x =
let Mat Vector (Mat (n1 : ns) a)
v (Pos
n' :| [Pos]
_) = ListTupleT n (Mat (n1 : ns) a) -> Mat '[n] (Mat (n1 : ns) a)
forall (n :: Nat) a.
ListTupleCInternal n =>
ListTupleT n a -> Vec n a
fromTupleCInternal ((MatTupleT (n1 : ns) a -> Mat (n1 : ns) a)
-> ListTupleT n (MatTupleT (n1 : ns) a)
-> ListTupleT n (Mat (n1 : ns) a)
forall (n :: Nat) a b.
ListTupleCInternal n =>
(a -> b) -> ListTupleT n a -> ListTupleT n b
fmapTupleInternal (forall (ns :: [Nat]) a.
MatTupleC ns a =>
MatTupleT ns a -> Mat ns a
forall a.
MatTupleC (n1 : ns) a =>
MatTupleT (n1 : ns) a -> Mat (n1 : ns) a
fromTupleC @(n1 ': ns)) ListTupleT n (MatTupleT (n1 : ns) a)
MatTupleT (n : n1 : ns) a
x)
xs :: Vector a
xs = (Mat (n1 : ns) a -> Vector a)
-> Vector (Mat (n1 : ns) a) -> Vector a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Mat (n1 : ns) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec Vector (Mat (n1 : ns) a)
v
ps1 :: NonEmpty Pos
ps1 = Pos
n' Pos -> NonEmpty Pos -> NonEmpty Pos
forall a. a -> NonEmpty a -> NonEmpty a
N.<| NS (n1 : ns) => NonEmpty Pos
forall (ns :: [Nat]). NS ns => NonEmpty Pos
fromNSP @(n1 ': ns)
in Vector a -> NonEmpty Pos -> Mat (n : n1 : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU @(n ': n1 ': ns) Vector a
xs NonEmpty Pos
ps1
fmapTupleMatC :: (a -> b) -> MatTupleT (n : n1 : ns) a -> MatTupleT (n : n1 : ns) b
fmapTupleMatC a -> b
f MatTupleT (n : n1 : ns) a
x = (MatTupleT (n1 : ns) a -> MatTupleT (n1 : ns) b)
-> ListTupleT n (MatTupleT (n1 : ns) a)
-> ListTupleT n (MatTupleT (n1 : ns) b)
forall (n :: Nat) a b.
ListTupleCInternal n =>
(a -> b) -> ListTupleT n a -> ListTupleT n b
fmapTupleInternal ((a -> b) -> MatTupleT (n1 : ns) a -> MatTupleT (n1 : ns) b
forall (ns :: [Nat]) a b.
MatTupleC ns a =>
(a -> b) -> MatTupleT ns a -> MatTupleT ns b
fmapTupleMatC @(n1 ': ns) a -> b
f) ListTupleT n (MatTupleT (n1 : ns) a)
MatTupleT (n : n1 : ns) a
x
traversalTupleMatC :: (a -> f b)
-> MatTupleT (n : n1 : ns) a -> f (MatTupleT (n : n1 : ns) b)
traversalTupleMatC a -> f b
afa = (MatTupleT (n1 : ns) a -> f (MatTupleT (n1 : ns) b))
-> ListTupleT n (MatTupleT (n1 : ns) a)
-> f (ListTupleT n (MatTupleT (n1 : ns) b))
forall (n :: Nat) a b.
ListTupleCInternal n =>
Traversal (ListTupleT n a) (ListTupleT n b) a b
traversalTupleCInternal @n ((a -> f b) -> MatTupleT (n1 : ns) a -> f (MatTupleT (n1 : ns) b)
forall (ns :: [Nat]) a b.
MatTupleC ns a =>
Traversal (MatTupleT ns a) (MatTupleT ns b) a b
traversalTupleMatC @(n1 ': ns) a -> f b
afa)
fmapTupleInternal :: ListTupleCInternal n => (a -> b) -> ListTupleT n a -> ListTupleT n b
fmapTupleInternal :: (a -> b) -> ListTupleT n a -> ListTupleT n b
fmapTupleInternal a -> b
f = Identity (ListTupleT n b) -> ListTupleT n b
forall a. Identity a -> a
runIdentity (Identity (ListTupleT n b) -> ListTupleT n b)
-> (ListTupleT n a -> Identity (ListTupleT n b))
-> ListTupleT n a
-> ListTupleT n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Identity b) -> ListTupleT n a -> Identity (ListTupleT n b)
forall (n :: Nat) a b.
ListTupleCInternal n =>
Traversal (ListTupleT n a) (ListTupleT n b) a b
traversalTupleCInternal (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b) -> (a -> b) -> a -> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
type ListTupleCInternal :: Nat -> Constraint
class ListTupleCInternal n where
toTupleCInternal :: Vec n a -> ListTupleT n a
fromTupleCInternal :: ListTupleT n a -> Vec n a
traversalTupleCInternal :: Traversal (ListTupleT n a) (ListTupleT n b) a b
instance ListTupleCInternal 1 where
toTupleCInternal :: Vec 1 a -> ListTupleT 1 a
toTupleCInternal (Vec 1 a -> NonEmpty a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat -> a
a :| []) = a -> One a
forall a. a -> One a
One a
a
toTupleCInternal Vec 1 a
_o = String -> One a
forall a. HasCallStack => String -> a
programmError String
"ListTupleCInternal 1"
fromTupleCInternal :: ListTupleT 1 a -> Vec 1 a
fromTupleCInternal (One a) = a -> Vec 1 a
forall a. a -> Vec 1 a
se1 a
a
traversalTupleCInternal :: (a -> f b) -> ListTupleT 1 a -> f (ListTupleT 1 b)
traversalTupleCInternal a -> f b
afa (One a) = b -> One b
forall a. a -> One a
One (b -> One b) -> f b -> f (One b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afa a
a
instance ListTupleCInternal 2 where
toTupleCInternal :: Vec 2 a -> ListTupleT 2 a
toTupleCInternal (Vec 2 a -> NonEmpty a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat -> a
a1 :| [a
a2]) = (a
a1, a
a2)
toTupleCInternal Vec 2 a
_o = String -> (a, a)
forall a. HasCallStack => String -> a
programmError String
"ListTupleCInternal 2"
fromTupleCInternal :: ListTupleT 2 a -> Vec 2 a
fromTupleCInternal (a1, a2) = a
a1 a -> a -> Vec 2 a
forall a a'. (a ~ a') => a -> a' -> Vec 2 a'
.| a
a2
traversalTupleCInternal :: (a -> f b) -> ListTupleT 2 a -> f (ListTupleT 2 b)
traversalTupleCInternal a -> f b
afa (a1, a2) = (,) (b -> b -> (b, b)) -> f b -> f (b -> (b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afa a
a1 f (b -> (b, b)) -> f b -> f (b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a2
instance ListTupleCInternal 3 where
toTupleCInternal :: Vec 3 a -> ListTupleT 3 a
toTupleCInternal (Vec 3 a -> NonEmpty a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat -> a
a1 :| [a
a2, a
a3]) = (a
a1, a
a2, a
a3)
toTupleCInternal Vec 3 a
_o = String -> (a, a, a)
forall a. HasCallStack => String -> a
programmError String
"ListTupleCInternal 3"
fromTupleCInternal :: ListTupleT 3 a -> Vec 3 a
fromTupleCInternal (a1, a2, a3) = a
a1 a -> Vec 2 a -> Vec (1 + 2) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a2 a -> a -> Vec 2 a
forall a a'. (a ~ a') => a -> a' -> Vec 2 a'
.| a
a3
traversalTupleCInternal :: (a -> f b) -> ListTupleT 3 a -> f (ListTupleT 3 b)
traversalTupleCInternal a -> f b
afa (a1, a2, a3) = (,,) (b -> b -> b -> (b, b, b)) -> f b -> f (b -> b -> (b, b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afa a
a1 f (b -> b -> (b, b, b)) -> f b -> f (b -> (b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a2 f (b -> (b, b, b)) -> f b -> f (b, b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a3
instance ListTupleCInternal 4 where
toTupleCInternal :: Vec 4 a -> ListTupleT 4 a
toTupleCInternal (Vec 4 a -> NonEmpty a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat -> a
a1 :| [a
a2, a
a3, a
a4]) = (a
a1, a
a2, a
a3, a
a4)
toTupleCInternal Vec 4 a
_o = String -> (a, a, a, a)
forall a. HasCallStack => String -> a
programmError String
"ListTupleCInternal 4"
fromTupleCInternal :: ListTupleT 4 a -> Vec 4 a
fromTupleCInternal (a1, a2, a3, a4) = a
a1 a -> Vec 3 a -> Vec (1 + 3) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a2 a -> Vec 2 a -> Vec (1 + 2) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a3 a -> a -> Vec 2 a
forall a a'. (a ~ a') => a -> a' -> Vec 2 a'
.| a
a4
traversalTupleCInternal :: (a -> f b) -> ListTupleT 4 a -> f (ListTupleT 4 b)
traversalTupleCInternal a -> f b
afa (a1, a2, a3, a4) = (,,,) (b -> b -> b -> b -> (b, b, b, b))
-> f b -> f (b -> b -> b -> (b, b, b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afa a
a1 f (b -> b -> b -> (b, b, b, b))
-> f b -> f (b -> b -> (b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a2 f (b -> b -> (b, b, b, b)) -> f b -> f (b -> (b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a3 f (b -> (b, b, b, b)) -> f b -> f (b, b, b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a4
instance ListTupleCInternal 5 where
toTupleCInternal :: Vec 5 a -> ListTupleT 5 a
toTupleCInternal (Vec 5 a -> NonEmpty a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat -> a
a1 :| [a
a2, a
a3, a
a4, a
a5]) = (a
a1, a
a2, a
a3, a
a4, a
a5)
toTupleCInternal Vec 5 a
_o = String -> (a, a, a, a, a)
forall a. HasCallStack => String -> a
programmError String
"ListTupleCInternal 5"
fromTupleCInternal :: ListTupleT 5 a -> Vec 5 a
fromTupleCInternal (a1, a2, a3, a4, a5) = a
a1 a -> Vec 4 a -> Vec (1 + 4) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a2 a -> Vec 3 a -> Vec (1 + 3) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a3 a -> Vec 2 a -> Vec (1 + 2) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a4 a -> a -> Vec 2 a
forall a a'. (a ~ a') => a -> a' -> Vec 2 a'
.| a
a5
traversalTupleCInternal :: (a -> f b) -> ListTupleT 5 a -> f (ListTupleT 5 b)
traversalTupleCInternal a -> f b
afa (a1, a2, a3, a4, a5) = (,,,,) (b -> b -> b -> b -> b -> (b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> (b, b, b, b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afa a
a1 f (b -> b -> b -> b -> (b, b, b, b, b))
-> f b -> f (b -> b -> b -> (b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a2 f (b -> b -> b -> (b, b, b, b, b))
-> f b -> f (b -> b -> (b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a3 f (b -> b -> (b, b, b, b, b)) -> f b -> f (b -> (b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a4 f (b -> (b, b, b, b, b)) -> f b -> f (b, b, b, b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a5
instance ListTupleCInternal 6 where
toTupleCInternal :: Vec 6 a -> ListTupleT 6 a
toTupleCInternal (Vec 6 a -> NonEmpty a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat -> a
a1 :| [a
a2, a
a3, a
a4, a
a5, a
a6]) = (a
a1, a
a2, a
a3, a
a4, a
a5, a
a6)
toTupleCInternal Vec 6 a
_o = String -> (a, a, a, a, a, a)
forall a. HasCallStack => String -> a
programmError String
"ListTupleCInternal 6"
fromTupleCInternal :: ListTupleT 6 a -> Vec 6 a
fromTupleCInternal (a1, a2, a3, a4, a5, a6) = a
a1 a -> Vec 5 a -> Vec (1 + 5) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a2 a -> Vec 4 a -> Vec (1 + 4) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a3 a -> Vec 3 a -> Vec (1 + 3) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a4 a -> Vec 2 a -> Vec (1 + 2) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a5 a -> a -> Vec 2 a
forall a a'. (a ~ a') => a -> a' -> Vec 2 a'
.| a
a6
traversalTupleCInternal :: (a -> f b) -> ListTupleT 6 a -> f (ListTupleT 6 b)
traversalTupleCInternal a -> f b
afa (a1, a2, a3, a4, a5, a6) = (,,,,,) (b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> b -> (b, b, b, b, b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afa a
a1 f (b -> b -> b -> b -> b -> (b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> (b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a2 f (b -> b -> b -> b -> (b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> (b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a3 f (b -> b -> b -> (b, b, b, b, b, b))
-> f b -> f (b -> b -> (b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a4 f (b -> b -> (b, b, b, b, b, b))
-> f b -> f (b -> (b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a5 f (b -> (b, b, b, b, b, b)) -> f b -> f (b, b, b, b, b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a6
instance ListTupleCInternal 7 where
toTupleCInternal :: Vec 7 a -> ListTupleT 7 a
toTupleCInternal (Vec 7 a -> NonEmpty a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat -> a
a1 :| [a
a2, a
a3, a
a4, a
a5, a
a6, a
a7]) = (a
a1, a
a2, a
a3, a
a4, a
a5, a
a6, a
a7)
toTupleCInternal Vec 7 a
_o = String -> (a, a, a, a, a, a, a)
forall a. HasCallStack => String -> a
programmError String
"ListTupleCInternal 7"
fromTupleCInternal :: ListTupleT 7 a -> Vec 7 a
fromTupleCInternal (a1, a2, a3, a4, a5, a6, a7) = a
a1 a -> Vec 6 a -> Vec (1 + 6) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a2 a -> Vec 5 a -> Vec (1 + 5) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a3 a -> Vec 4 a -> Vec (1 + 4) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a4 a -> Vec 3 a -> Vec (1 + 3) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a5 a -> Vec 2 a -> Vec (1 + 2) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a6 a -> a -> Vec 2 a
forall a a'. (a ~ a') => a -> a' -> Vec 2 a'
.| a
a7
traversalTupleCInternal :: (a -> f b) -> ListTupleT 7 a -> f (ListTupleT 7 b)
traversalTupleCInternal a -> f b
afa (a1, a2, a3, a4, a5, a6, a7) = (,,,,,,) (b -> b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afa a
a1 f (b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> b -> (b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a2 f (b -> b -> b -> b -> b -> (b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> (b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a3 f (b -> b -> b -> b -> (b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> (b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a4 f (b -> b -> b -> (b, b, b, b, b, b, b))
-> f b -> f (b -> b -> (b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a5 f (b -> b -> (b, b, b, b, b, b, b))
-> f b -> f (b -> (b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a6 f (b -> (b, b, b, b, b, b, b)) -> f b -> f (b, b, b, b, b, b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a7
instance ListTupleCInternal 8 where
toTupleCInternal :: Vec 8 a -> ListTupleT 8 a
toTupleCInternal (Vec 8 a -> NonEmpty a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat -> a
a1 :| [a
a2, a
a3, a
a4, a
a5, a
a6, a
a7, a
a8]) = (a
a1, a
a2, a
a3, a
a4, a
a5, a
a6, a
a7, a
a8)
toTupleCInternal Vec 8 a
_o = String -> (a, a, a, a, a, a, a, a)
forall a. HasCallStack => String -> a
programmError String
"ListTupleCInternal 8"
fromTupleCInternal :: ListTupleT 8 a -> Vec 8 a
fromTupleCInternal (a1, a2, a3, a4, a5, a6, a7, a8) = a
a1 a -> Vec 7 a -> Vec (1 + 7) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a2 a -> Vec 6 a -> Vec (1 + 6) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a3 a -> Vec 5 a -> Vec (1 + 5) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a4 a -> Vec 4 a -> Vec (1 + 4) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a5 a -> Vec 3 a -> Vec (1 + 3) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a6 a -> Vec 2 a -> Vec (1 + 2) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a7 a -> a -> Vec 2 a
forall a a'. (a ~ a') => a -> a' -> Vec 2 a'
.| a
a8
traversalTupleCInternal :: (a -> f b) -> ListTupleT 8 a -> f (ListTupleT 8 b)
traversalTupleCInternal a -> f b
afa (a1, a2, a3, a4, a5, a6, a7, a8) = (,,,,,,,) (b -> b -> b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b))
-> f b
-> f (b -> b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afa a
a1 f (b -> b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b))
-> f b
-> f (b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a2 f (b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a3 f (b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> (b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a4 f (b -> b -> b -> b -> (b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> (b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a5 f (b -> b -> b -> (b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> (b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a6 f (b -> b -> (b, b, b, b, b, b, b, b))
-> f b -> f (b -> (b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a7 f (b -> (b, b, b, b, b, b, b, b))
-> f b -> f (b, b, b, b, b, b, b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a8
instance ListTupleCInternal 9 where
toTupleCInternal :: Vec 9 a -> ListTupleT 9 a
toTupleCInternal (Vec 9 a -> NonEmpty a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat -> a
a1 :| [a
a2, a
a3, a
a4, a
a5, a
a6, a
a7, a
a8, a
a9]) = (a
a1, a
a2, a
a3, a
a4, a
a5, a
a6, a
a7, a
a8, a
a9)
toTupleCInternal Vec 9 a
_o = String -> (a, a, a, a, a, a, a, a, a)
forall a. HasCallStack => String -> a
programmError String
"ListTupleCInternal 9"
fromTupleCInternal :: ListTupleT 9 a -> Vec 9 a
fromTupleCInternal (a1, a2, a3, a4, a5, a6, a7, a8, a9) = a
a1 a -> Vec 8 a -> Vec (1 + 8) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a2 a -> Vec 7 a -> Vec (1 + 7) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a3 a -> Vec 6 a -> Vec (1 + 6) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a4 a -> Vec 5 a -> Vec (1 + 5) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a5 a -> Vec 4 a -> Vec (1 + 4) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a6 a -> Vec 3 a -> Vec (1 + 3) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a7 a -> Vec 2 a -> Vec (1 + 2) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a8 a -> a -> Vec 2 a
forall a a'. (a ~ a') => a -> a' -> Vec 2 a'
.| a
a9
traversalTupleCInternal :: (a -> f b) -> ListTupleT 9 a -> f (ListTupleT 9 b)
traversalTupleCInternal a -> f b
afa (a1, a2, a3, a4, a5, a6, a7, a8, a9) = (,,,,,,,,) (b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> (b, b, b, b, b, b, b, b, b))
-> f b
-> f (b
-> b -> b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afa a
a1 f (b
-> b -> b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b))
-> f b
-> f (b
-> b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a2 f (b -> b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b))
-> f b
-> f (b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a3 f (b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a4 f (b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a5 f (b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> (b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a6 f (b -> b -> b -> (b, b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> (b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a7 f (b -> b -> (b, b, b, b, b, b, b, b, b))
-> f b -> f (b -> (b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a8 f (b -> (b, b, b, b, b, b, b, b, b))
-> f b -> f (b, b, b, b, b, b, b, b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a9
instance ListTupleCInternal 10 where
toTupleCInternal :: Vec 10 a -> ListTupleT 10 a
toTupleCInternal (Vec 10 a -> NonEmpty a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat -> a
a1 :| [a
a2, a
a3, a
a4, a
a5, a
a6, a
a7, a
a8, a
a9, a
a10]) = (a
a1, a
a2, a
a3, a
a4, a
a5, a
a6, a
a7, a
a8, a
a9, a
a10)
toTupleCInternal Vec 10 a
_o = String -> (a, a, a, a, a, a, a, a, a, a)
forall a. HasCallStack => String -> a
programmError String
"ListTupleCInternal 10"
fromTupleCInternal :: ListTupleT 10 a -> Vec 10 a
fromTupleCInternal (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = a
a1 a -> Vec 9 a -> Vec (1 + 9) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a2 a -> Vec 8 a -> Vec (1 + 8) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a3 a -> Vec 7 a -> Vec (1 + 7) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a4 a -> Vec 6 a -> Vec (1 + 6) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a5 a -> Vec 5 a -> Vec (1 + 5) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a6 a -> Vec 4 a -> Vec (1 + 4) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a7 a -> Vec 3 a -> Vec (1 + 3) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a8 a -> Vec 2 a -> Vec (1 + 2) a
forall (n :: Nat) a a'. (a ~ a') => a -> Vec n a' -> Vec (1 + n) a'
.: a
a9 a -> a -> Vec 2 a
forall a a'. (a ~ a') => a -> a' -> Vec 2 a'
.| a
a10
traversalTupleCInternal :: (a -> f b) -> ListTupleT 10 a -> f (ListTupleT 10 b)
traversalTupleCInternal a -> f b
afa (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) = (,,,,,,,,,) (b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> (b, b, b, b, b, b, b, b, b, b))
-> f b
-> f (b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> (b, b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
afa a
a1 f (b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> (b, b, b, b, b, b, b, b, b, b))
-> f b
-> f (b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> (b, b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a2 f (b
-> b
-> b
-> b
-> b
-> b
-> b
-> b
-> (b, b, b, b, b, b, b, b, b, b))
-> f b
-> f (b
-> b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a3 f (b
-> b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b, b))
-> f b
-> f (b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a4 f (b -> b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b, b))
-> f b
-> f (b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a5 f (b -> b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a6 f (b -> b -> b -> b -> (b, b, b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> b -> (b, b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a7 f (b -> b -> b -> (b, b, b, b, b, b, b, b, b, b))
-> f b -> f (b -> b -> (b, b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a8 f (b -> b -> (b, b, b, b, b, b, b, b, b, b))
-> f b -> f (b -> (b, b, b, b, b, b, b, b, b, b))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a9 f (b -> (b, b, b, b, b, b, b, b, b, b))
-> f b -> f (b, b, b, b, b, b, b, b, b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
afa a
a10
_transposeMat :: Iso (Mat (n ': m ': ns) a) (Mat (n ': m ': ns) b) (Mat (m ': n ': ns) a) (Mat (m ': n ': ns) b)
_transposeMat :: p (Mat (m : n : ns) a) (f (Mat (m : n : ns) b))
-> p (Mat (n : m : ns) a) (f (Mat (n : m : ns) b))
_transposeMat = (Mat (n : m : ns) a -> Mat (m : n : ns) a)
-> (Mat (m : n : ns) b -> Mat (n : m : ns) b)
-> Iso
(Mat (n : m : ns) a)
(Mat (n : m : ns) b)
(Mat (m : n : ns) a)
(Mat (m : n : ns) b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Mat (n : m : ns) a -> Mat (m : n : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat Mat (m : n : ns) b -> Mat (n : m : ns) b
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat
transposeMat :: forall n m ns a. Mat (n ': m ': ns) a -> Mat (m ': n ': ns) a
transposeMat :: Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat w :: Mat (n : m : ns) a
w@(Mat Vector a
_ (Pos
n :| [Pos]
ps)) = String -> Either String (Mat (m : n : ns) a) -> Mat (m : n : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"transposeMat" (Either String (Mat (m : n : ns) a) -> Mat (m : n : ns) a)
-> Either String (Mat (m : n : ns) a) -> Mat (m : n : ns) a
forall a b. (a -> b) -> a -> b
$
case [Pos]
ps of
[] -> String -> Either String (Mat (m : n : ns) a)
forall a b. a -> Either a b
Left String
"transposeMat"
Pos
m : [Pos]
ns -> do
NonEmpty (NonEmpty a)
ys <- Pos
-> Pos
-> Mat (n : m : ns) a
-> Either String (NonEmpty (NonEmpty a))
forall a (u :: * -> *).
Foldable u =>
Pos -> Pos -> u a -> Either String (NonEmpty (NonEmpty a))
chunkNLen1 Pos
n (NonEmpty Pos -> Pos
forall (t :: * -> *). Foldable t => t Pos -> Pos
productP (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns)) Mat (n : m : ns) a
w
let zs :: NonEmpty (NonEmpty (NonEmpty a))
zs = NonEmpty (NonEmpty (NonEmpty a))
-> NonEmpty (NonEmpty (NonEmpty a))
forall a. NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty a)
N.transpose (NonEmpty (NonEmpty (NonEmpty a))
-> NonEmpty (NonEmpty (NonEmpty a)))
-> NonEmpty (NonEmpty (NonEmpty a))
-> NonEmpty (NonEmpty (NonEmpty a))
forall a b. (a -> b) -> a -> b
$ (NonEmpty a -> NonEmpty (NonEmpty a))
-> NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty (NonEmpty a))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
N.map (Pos -> NonEmpty a -> NonEmpty (NonEmpty a)
forall a. Pos -> NonEmpty a -> NonEmpty (NonEmpty a)
chunksOf1 ([Pos] -> Pos
forall (t :: * -> *). Foldable t => t Pos -> Pos
productP [Pos]
ns)) NonEmpty (NonEmpty a)
ys
Vector a -> NonEmpty Pos -> Either String (Mat (m : n : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat ([a] -> Vector a
forall a. [a] -> Vector a
V.fromList ([a] -> Vector a) -> [a] -> Vector a
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
N.toList (NonEmpty a -> [a]) -> NonEmpty a -> [a]
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty a) -> NonEmpty a
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (NonEmpty a) -> NonEmpty a)
-> NonEmpty (NonEmpty a) -> NonEmpty a
forall a b. (a -> b) -> a -> b
$ NonEmpty (NonEmpty (NonEmpty a)) -> NonEmpty (NonEmpty a)
forall a. Semigroup a => NonEmpty a -> a
sconcat NonEmpty (NonEmpty (NonEmpty a))
zs) (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| (Pos
n Pos -> [Pos] -> [Pos]
forall a. a -> [a] -> [a]
: [Pos]
ns))
nestedListToMatValidated :: forall ns a x. (x ~ ListNST ns a, ValidateNestedListC x (ValidateNestedListT x), MatConvertersC ns) => ListNST ns a -> Either String (Mat ns a)
nestedListToMatValidated :: ListNST ns a -> Either String (Mat ns a)
nestedListToMatValidated ListNST ns a
w = do
NonEmpty Pos
_ <- x -> Either String (NonEmpty Pos)
forall x.
ValidateNestedListC x (ValidateNestedListT x) =>
x -> Either String (NonEmpty Pos)
validateNestedList x
ListNST ns a
w
ListNST ns a -> Either String (Mat ns a)
forall (ns :: [Nat]) a.
MatConvertersC ns =>
ListNST ns a -> Either String (Mat ns a)
nestedListToMatC ListNST ns a
w
nestedNonEmptyToMatValidated :: forall ns a x. (x ~ NonEmptyNST ns a, ValidateNestedNonEmptyC x (ValidateNestedNonEmptyT x), MatConvertersC ns) => NonEmptyNST ns a -> Either String (Mat ns a)
nestedNonEmptyToMatValidated :: NonEmptyNST ns a -> Either String (Mat ns a)
nestedNonEmptyToMatValidated NonEmptyNST ns a
w = do
NonEmpty Pos
_ <- x -> Either String (NonEmpty Pos)
forall x.
ValidateNestedNonEmptyC x (ValidateNestedNonEmptyT x) =>
x -> Either String (NonEmpty Pos)
validateNestedNonEmpty x
NonEmptyNST ns a
w
NonEmptyNST ns a -> Either String (Mat ns a)
forall (ns :: [Nat]) a.
MatConvertersC ns =>
NonEmptyNST ns a -> Either String (Mat ns a)
nestedNonEmptyToMatC NonEmptyNST ns a
w
class MatConvertersC ns where
matToNestedVecC :: Mat ns a -> MatToNestedVecT ns a
nestedVecToMatC :: MatToNestedVecT ns a -> Mat ns a
matToNestedListC :: Mat ns a -> ListNST ns a
nestedListToMatC :: ListNST ns a -> Either String (Mat ns a)
matToNestedNonEmptyC :: Mat ns a -> NonEmptyNST ns a
nestedNonEmptyToMatC :: NonEmptyNST ns a -> Either String (Mat ns a)
instance GL.TypeError ( 'GL.Text "MatConvertersC '[]: undefined for empty indices") => MatConvertersC '[] where
matToNestedVecC :: Mat '[] a -> MatToNestedVecT '[] a
matToNestedVecC = String -> Mat '[] a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"MatConvertersC"
nestedVecToMatC :: MatToNestedVecT '[] a -> Mat '[] a
nestedVecToMatC = String -> (TypeError ...) -> Mat '[] a
forall a. HasCallStack => String -> a
compileError String
"MatConvertersC"
matToNestedListC :: Mat '[] a -> ListNST '[] a
matToNestedListC = String -> Mat '[] a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"MatConvertersC"
matToNestedNonEmptyC :: Mat '[] a -> NonEmptyNST '[] a
matToNestedNonEmptyC = String -> Mat '[] a -> (TypeError ...)
forall a. HasCallStack => String -> a
compileError String
"MatConvertersC"
nestedListToMatC :: ListNST '[] a -> Either String (Mat '[] a)
nestedListToMatC = String -> (TypeError ...) -> Either String (Mat '[] a)
forall a. HasCallStack => String -> a
compileError String
"MatConvertersC"
nestedNonEmptyToMatC :: NonEmptyNST '[] a -> Either String (Mat '[] a)
nestedNonEmptyToMatC = String -> (TypeError ...) -> Either String (Mat '[] a)
forall a. HasCallStack => String -> a
compileError String
"MatConvertersC"
instance PosC n => MatConvertersC '[n] where
matToNestedVecC :: Mat '[n] a -> MatToNestedVecT '[n] a
matToNestedVecC = Mat '[n] a -> MatToNestedVecT '[n] a
forall a. a -> a
id
nestedVecToMatC :: MatToNestedVecT '[n] a -> Mat '[n] a
nestedVecToMatC = MatToNestedVecT '[n] a -> Mat '[n] a
forall a. a -> a
id
matToNestedListC :: Mat '[n] a -> ListNST '[n] a
matToNestedListC = Mat '[n] a -> ListNST '[n] a
forall (ns :: [Nat]) a. Mat ns a -> [a]
toListMat
matToNestedNonEmptyC :: Mat '[n] a -> NonEmptyNST '[n] a
matToNestedNonEmptyC = Mat '[n] a -> NonEmptyNST '[n] a
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat
nestedListToMatC :: ListNST '[n] a -> Either String (Mat '[n] a)
nestedListToMatC = Bool -> [a] -> Either String (Mat '[n] a)
forall (ns :: [Nat]) a.
NS ns =>
Bool -> [a] -> Either String (Mat ns a)
matImpl Bool
True
nestedNonEmptyToMatC :: NonEmptyNST '[n] a -> Either String (Mat '[n] a)
nestedNonEmptyToMatC = Bool -> [a] -> Either String (Mat '[n] a)
forall (ns :: [Nat]) a.
NS ns =>
Bool -> [a] -> Either String (Mat ns a)
matImpl Bool
True ([a] -> Either String (Mat '[n] a))
-> (NonEmpty a -> [a]) -> NonEmpty a -> Either String (Mat '[n] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
N.toList
instance (PosC n, MatConvertersC (m ': ns)) => MatConvertersC (n ': m ': ns) where
matToNestedVecC :: Mat (n : m : ns) a -> MatToNestedVecT (n : m : ns) a
matToNestedVecC Mat (n : m : ns) a
lst = (Mat (m : ns) a -> MatToNestedVecT (m : ns) a)
-> Mat '[n] (Mat (m : ns) a)
-> Mat '[n] (MatToNestedVecT (m : ns) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mat (m : ns) a -> MatToNestedVecT (m : ns) a
forall (ns :: [Nat]) a.
MatConvertersC ns =>
Mat ns a -> MatToNestedVecT ns a
matToNestedVecC (Mat (n : m : ns) a -> Mat '[n] (Mat (m : ns) a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Vec n (Mat (m : ns) a)
rows @n Mat (n : m : ns) a
lst)
nestedVecToMatC :: MatToNestedVecT (n : m : ns) a -> Mat (n : m : ns) a
nestedVecToMatC lst :: MatToNestedVecT (n : m : ns) a
lst@(Mat _ (n :| _)) =
let zs :: NonEmpty (Mat (m : ns) a)
zs@(Mat Vector a
_ (Pos
m :| [Pos]
ns) :| [Mat (m : ns) a]
_) = Mat '[n] (Mat (m : ns) a) -> NonEmpty (Mat (m : ns) a)
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat (Mat '[n] (Mat (m : ns) a) -> NonEmpty (Mat (m : ns) a))
-> Mat '[n] (Mat (m : ns) a) -> NonEmpty (Mat (m : ns) a)
forall a b. (a -> b) -> a -> b
$ (MatToNestedVecT (m : ns) a -> Mat (m : ns) a)
-> Mat '[n] (MatToNestedVecT (m : ns) a)
-> Mat '[n] (Mat (m : ns) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a.
MatConvertersC (m : ns) =>
MatToNestedVecT (m : ns) a -> Mat (m : ns) a
forall (ns :: [Nat]) a.
MatConvertersC ns =>
MatToNestedVecT ns a -> Mat ns a
nestedVecToMatC @(m ': ns)) MatToNestedVecT (n : m : ns) a
Mat '[n] (MatToNestedVecT (m : ns) a)
lst
ys :: Vector a
ys = (Mat (m : ns) a -> Vector a)
-> NonEmpty (Mat (m : ns) a) -> Vector a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Mat (m : ns) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec NonEmpty (Mat (m : ns) a)
zs
in Vector a -> NonEmpty Pos -> Mat (n : m : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector a
ys (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| Pos
m Pos -> [Pos] -> [Pos]
forall a. a -> [a] -> [a]
: [Pos]
ns)
matToNestedListC :: Mat (n : m : ns) a -> ListNST (n : m : ns) a
matToNestedListC Mat (n : m : ns) a
w = Mat '[n] (ListNST (m : ns) a) -> [ListNST (m : ns) a]
forall (ns :: [Nat]) a. Mat ns a -> [a]
toListMat (Mat '[n] (ListNST (m : ns) a) -> [ListNST (m : ns) a])
-> Mat '[n] (ListNST (m : ns) a) -> [ListNST (m : ns) a]
forall a b. (a -> b) -> a -> b
$ (Mat (m : ns) a -> ListNST (m : ns) a)
-> Mat '[n] (Mat (m : ns) a) -> Mat '[n] (ListNST (m : ns) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a.
MatConvertersC (m : ns) =>
Mat (m : ns) a -> ListNST (m : ns) a
forall (ns :: [Nat]) a.
MatConvertersC ns =>
Mat ns a -> ListNST ns a
matToNestedListC @(m ': ns)) (Mat (n : m : ns) a -> Mat '[n] (Mat (m : ns) a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Vec n (Mat (m : ns) a)
rows @n Mat (n : m : ns) a
w)
matToNestedNonEmptyC :: Mat (n : m : ns) a -> NonEmptyNST (n : m : ns) a
matToNestedNonEmptyC Mat (n : m : ns) a
w = Mat '[n] (NonEmptyNST (m : ns) a)
-> NonEmpty (NonEmptyNST (m : ns) a)
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat (Mat '[n] (NonEmptyNST (m : ns) a)
-> NonEmpty (NonEmptyNST (m : ns) a))
-> Mat '[n] (NonEmptyNST (m : ns) a)
-> NonEmpty (NonEmptyNST (m : ns) a)
forall a b. (a -> b) -> a -> b
$ (Mat (m : ns) a -> NonEmptyNST (m : ns) a)
-> Mat '[n] (Mat (m : ns) a) -> Mat '[n] (NonEmptyNST (m : ns) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a.
MatConvertersC (m : ns) =>
Mat (m : ns) a -> NonEmptyNST (m : ns) a
forall (ns :: [Nat]) a.
MatConvertersC ns =>
Mat ns a -> NonEmptyNST ns a
matToNestedNonEmptyC @(m ': ns)) (Mat (n : m : ns) a -> Mat '[n] (Mat (m : ns) a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Vec n (Mat (m : ns) a)
rows @n Mat (n : m : ns) a
w)
nestedListToMatC :: ListNST (n : m : ns) a -> Either String (Mat (n : m : ns) a)
nestedListToMatC = \case
[] -> String -> Either String (Mat (n : m : ns) a)
forall a b. a -> Either a b
Left String
"nestedListToMatC: no data"
w : ws -> NonEmpty (Mat (m : ns) a) -> Either String (Mat (n : m : ns) a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a (t :: * -> *).
(Foldable1 t, PosC n) =>
t (Mat (m : ns) a) -> Either String (Mat (n : m : ns) a)
nonEmptyMatsToMat (NonEmpty (Mat (m : ns) a) -> Either String (Mat (n : m : ns) a))
-> Either String (NonEmpty (Mat (m : ns) a))
-> Either String (Mat (n : m : ns) a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ListNST (m : ns) a -> Either String (Mat (m : ns) a))
-> NonEmpty (ListNST (m : ns) a)
-> Either String (NonEmpty (Mat (m : ns) a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a.
MatConvertersC (m : ns) =>
ListNST (m : ns) a -> Either String (Mat (m : ns) a)
forall (ns :: [Nat]) a.
MatConvertersC ns =>
ListNST ns a -> Either String (Mat ns a)
nestedListToMatC @(m ': ns)) (ListNST (m : ns) a
w ListNST (m : ns) a
-> [ListNST (m : ns) a] -> NonEmpty (ListNST (m : ns) a)
forall a. a -> [a] -> NonEmpty a
:| [ListNST (m : ns) a]
ws)
nestedNonEmptyToMatC :: NonEmptyNST (n : m : ns) a -> Either String (Mat (n : m : ns) a)
nestedNonEmptyToMatC NonEmptyNST (n : m : ns) a
w = NonEmpty (Mat (m : ns) a) -> Either String (Mat (n : m : ns) a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a (t :: * -> *).
(Foldable1 t, PosC n) =>
t (Mat (m : ns) a) -> Either String (Mat (n : m : ns) a)
nonEmptyMatsToMat (NonEmpty (Mat (m : ns) a) -> Either String (Mat (n : m : ns) a))
-> Either String (NonEmpty (Mat (m : ns) a))
-> Either String (Mat (n : m : ns) a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (NonEmptyNST (m : ns) a -> Either String (Mat (m : ns) a))
-> NonEmpty (NonEmptyNST (m : ns) a)
-> Either String (NonEmpty (Mat (m : ns) a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a.
MatConvertersC (m : ns) =>
NonEmptyNST (m : ns) a -> Either String (Mat (m : ns) a)
forall (ns :: [Nat]) a.
MatConvertersC ns =>
NonEmptyNST ns a -> Either String (Mat ns a)
nestedNonEmptyToMatC @(m ': ns)) NonEmpty (NonEmptyNST (m : ns) a)
NonEmptyNST (n : m : ns) a
w
nonEmptyMatsToMat :: forall n m ns a t. (Foldable1 t, PosC n) => t (Mat (m ': ns) a) -> Either String (Mat (n ': m ': ns) a)
nonEmptyMatsToMat :: t (Mat (m : ns) a) -> Either String (Mat (n : m : ns) a)
nonEmptyMatsToMat (t (Mat (m : ns) a) -> NonEmpty (Mat (m : ns) a)
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty -> xs :: NonEmpty (Mat (m : ns) a)
xs@(Mat Vector a
_ NonEmpty Pos
ps :| [Mat (m : ns) a]
_)) = do
let n :: Pos
n = PosC n => Pos
forall (n :: Nat). PosC n => Pos
fromNP @n
NonEmpty (Mat (m : ns) a)
ret <- Pos
-> NonEmpty (Mat (m : ns) a)
-> Either String (NonEmpty (Mat (m : ns) a))
forall a. Pos -> NonEmpty a -> Either String (NonEmpty a)
lengthExact1 Pos
n NonEmpty (Mat (m : ns) a)
xs
Mat (n : m : ns) a -> Either String (Mat (n : m : ns) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Mat (n : m : ns) a -> Either String (Mat (n : m : ns) a))
-> Mat (n : m : ns) a -> Either String (Mat (n : m : ns) a)
forall a b. (a -> b) -> a -> b
$ Vector a -> NonEmpty Pos -> Mat (n : m : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (NonEmpty (Vector a) -> Vector a
forall a. Semigroup a => NonEmpty a -> a
sconcat ((Mat (m : ns) a -> Vector a)
-> NonEmpty (Mat (m : ns) a) -> NonEmpty (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mat (m : ns) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec NonEmpty (Mat (m : ns) a)
ret)) (Pos
n Pos -> NonEmpty Pos -> NonEmpty Pos
forall a. a -> NonEmpty a -> NonEmpty a
N.<| NonEmpty Pos
ps)
type MatToNestedVecT :: [Nat] -> Type -> Type
type family MatToNestedVecT ns a where
MatToNestedVecT '[] _ = GL.TypeError ( 'GL.Text "MatToNestedVecT '[]: undefined for empty indices")
MatToNestedVecT '[n] a = Vec n a
MatToNestedVecT (n ': n1 ': ns) a = Vec n (MatToNestedVecT (n1 ': ns) a)
type MatToNDT :: Nat -> [Nat] -> Type -> Type
type MatToNDT i ns a = Mat (MatToMatNTA (NatToPeanoT i) ns) (Mat (MatToMatNTB (NatToPeanoT i) ns) a)
matToNDImpl ::
forall (i :: Nat) (ns :: [Nat]) a.
PosC i =>
Mat ns a ->
MatToNDT i ns a
matToNDImpl :: Mat ns a -> MatToNDT i ns a
matToNDImpl w :: Mat ns a
w@(Mat Vector a
_ NonEmpty Pos
ps) = String -> Either String (MatToNDT i ns a) -> MatToNDT i ns a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"matToNDImpl" (Either String (MatToNDT i ns a) -> MatToNDT i ns a)
-> Either String (MatToNDT i ns a) -> MatToNDT i ns a
forall a b. (a -> b) -> a -> b
$
let i :: Pos
i = PosC i => Pos
forall (n :: Nat). PosC n => Pos
fromNP @i
(NonEmpty Pos
ps1, [Pos]
bs) = Pos -> NonEmpty Pos -> (NonEmpty Pos, [Pos])
forall a. Pos -> NonEmpty a -> (NonEmpty a, [a])
splitAt1 Pos
i NonEmpty Pos
ps
in case [Pos]
bs of
Pos
y : [Pos]
ys -> do
let ps2 :: NonEmpty Pos
ps2 = Pos
y Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ys
[Mat (MatToMatNTB (NatToPeanoT i) ns) a]
xs <- [()]
-> NonEmpty Pos
-> Mat ns a
-> Either String [Mat (MatToMatNTB (NatToPeanoT i) ns) a]
forall (ns :: [Nat]) (t :: * -> *) (x :: [Nat]) a z.
Traversable t =>
t z -> NonEmpty Pos -> Mat x a -> Either String (t (Mat ns a))
chunkNVMat (Pos -> [()]
forall (l :: * -> *) a.
(IsList (l a), Item (l a) ~ ()) =>
Pos -> l a
unitsF (NonEmpty Pos -> Pos
forall (t :: * -> *). Foldable t => t Pos -> Pos
productP NonEmpty Pos
ps1)) NonEmpty Pos
ps2 Mat ns a
w
Vector (Mat (MatToMatNTB (NatToPeanoT i) ns) a)
-> NonEmpty Pos -> Either String (MatToNDT i ns a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat ([Mat (MatToMatNTB (NatToPeanoT i) ns) a]
-> Vector (Mat (MatToMatNTB (NatToPeanoT i) ns) a)
forall a. [a] -> Vector a
V.fromList [Mat (MatToMatNTB (NatToPeanoT i) ns) a]
xs) NonEmpty Pos
ps1
[] -> String -> Either String (MatToNDT i ns a)
forall a b. a -> Either a b
Left String
"missing indices to the right"
type MatToMatNTA :: Peano -> [Nat] -> [Nat]
type family MatToMatNTA i ns where
MatToMatNTA _ '[] =
GL.TypeError ( 'GL.Text "MatToMatNTA '[]: empty indices")
MatToMatNTA ( 'S 'Z) '[_] =
GL.TypeError ( 'GL.Text "MatToMatNTA: noop as the depth 'i' is the same as the number of indices")
MatToMatNTA ( 'S 'Z) (n ': _ ': _) = '[n]
MatToMatNTA ( 'S _) '[_] =
GL.TypeError ( 'GL.Text "MatToMatNTA: depth is more than the number of indices")
MatToMatNTA ( 'S ( 'S i)) (n ': m ': ns) = n : MatToMatNTA ( 'S i) (m ': ns)
type MatToMatNTB :: Peano -> [Nat] -> [Nat]
type family MatToMatNTB i ns where
MatToMatNTB _ '[] =
GL.TypeError ( 'GL.Text "MatToMatNTB: empty indices")
MatToMatNTB ( 'S 'Z) '[_] =
GL.TypeError ( 'GL.Text "MatToMatNTB: noop as the depth 'i' is the same as the number of indices")
MatToMatNTB ( 'S 'Z) (_ ': m ': ns) = m ': ns
MatToMatNTB ( 'S _) '[_] =
GL.TypeError ( 'GL.Text "MatToMatNTB: depth is more than the number of indices")
MatToMatNTB ( 'S ( 'S i)) (_ ': m ': ns) = MatToMatNTB ( 'S i) (m ': ns)
toND :: forall i ns a. PosC i => Mat ns a -> MatToNDT i ns a
toND :: Mat ns a -> MatToNDT i ns a
toND = forall (ns :: [Nat]) a. PosC i => Mat ns a -> MatToNDT i ns a
forall (i :: Nat) (ns :: [Nat]) a.
PosC i =>
Mat ns a -> MatToNDT i ns a
matToNDImpl @i
toVec :: Mat ns a -> MatToNDT 1 ns a
toVec :: Mat ns a -> MatToNDT 1 ns a
toVec = forall (ns :: [Nat]) a. PosC 1 => Mat ns a -> MatToNDT 1 ns a
forall (i :: Nat) (ns :: [Nat]) a.
PosC i =>
Mat ns a -> MatToNDT i ns a
toND @1
toMat2 :: Mat ns a -> MatToNDT 2 ns a
toMat2 :: Mat ns a -> MatToNDT 2 ns a
toMat2 = forall (ns :: [Nat]) a. PosC 2 => Mat ns a -> MatToNDT 2 ns a
forall (i :: Nat) (ns :: [Nat]) a.
PosC i =>
Mat ns a -> MatToNDT i ns a
toND @2
toMat3 :: Mat ns a -> MatToNDT 3 ns a
toMat3 :: Mat ns a -> MatToNDT 3 ns a
toMat3 = forall (ns :: [Nat]) a. PosC 3 => Mat ns a -> MatToNDT 3 ns a
forall (i :: Nat) (ns :: [Nat]) a.
PosC i =>
Mat ns a -> MatToNDT i ns a
toND @3
concatMat ::
forall (n :: Nat) (ns :: [Nat]) (m :: Nat) (ms :: [Nat]) a.
Mat (n ': ns) (Mat (m ': ms) a) ->
Mat (n ': (ns TP.++ m ': ms)) a
concatMat :: Mat (n : ns) (Mat (m : ms) a) -> Mat (n : (ns ++ (m : ms))) a
concatMat Mat (n : ns) (Mat (m : ms) a)
w =
let Mat (m : ms) a
hd :| [Mat (m : ms) a]
tl = Mat (n : ns) (Mat (m : ms) a) -> NonEmpty (Mat (m : ms) a)
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty a
toNonEmptyMat Mat (n : ns) (Mat (m : ms) a)
w
in Vector a -> NonEmpty Pos -> Mat (n : (ns ++ (m : ms))) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ([Vector a] -> Vector a
forall a. [Vector a] -> Vector a
V.concat ((Mat (m : ms) a -> Vector a) -> [Mat (m : ms) a] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
map Mat (m : ms) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec (Mat (m : ms) a
hd Mat (m : ms) a -> [Mat (m : ms) a] -> [Mat (m : ms) a]
forall a. a -> [a] -> [a]
: [Mat (m : ms) a]
tl))) (Mat (n : ns) (Mat (m : ms) a) -> NonEmpty Pos
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty Pos
mIndices Mat (n : ns) (Mat (m : ms) a)
w NonEmpty Pos -> NonEmpty Pos -> NonEmpty Pos
forall a. Semigroup a => a -> a -> a
<> Mat (m : ms) a -> NonEmpty Pos
forall (ns :: [Nat]) a. Mat ns a -> NonEmpty Pos
mIndices Mat (m : ms) a
hd)
diagonal :: Mat (n ': n ': ns) a -> Mat (n ': ns) a
diagonal :: Mat (n : n : ns) a -> Mat (n : ns) a
diagonal (Mat Vector a
v (Pos
n :| [Pos]
ps)) = String -> Either String (Mat (n : ns) a) -> Mat (n : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"diagonal" (Either String (Mat (n : ns) a) -> Mat (n : ns) a)
-> Either String (Mat (n : ns) a) -> Mat (n : ns) a
forall a b. (a -> b) -> a -> b
$
case [Pos]
ps of
Pos
_n : [Pos]
ns -> do
let len :: Int
len = [Pos] -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt [Pos]
ns
xs :: [Vector a]
xs = (Int -> Vector a) -> [Int] -> [Vector a]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Pos -> Int
unP Pos
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len) Int
len Vector a
v) [Int
0 .. Pos -> Int
unP Pos
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
Vector a -> NonEmpty Pos -> Either String (Mat (n : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat ([Vector a] -> Vector a
forall a. [Vector a] -> Vector a
V.concat [Vector a]
xs) (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns)
[] -> String -> Either String (Mat (n : ns) a)
forall a b. a -> Either a b
Left String
"missing indices"
subsetRows ::
forall i j n ns a.
DiffTC i j n =>
Mat (n ': ns) a ->
Mat (DiffT i j n ': ns) a
subsetRows :: Mat (n : ns) a -> Mat (DiffT i j n : ns) a
subsetRows (Mat Vector a
v (Pos
_ :| [Pos]
ns)) = String
-> Either String (Mat (DiffT i j n : ns) a)
-> Mat (DiffT i j n : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"subsetRows" (Either String (Mat (DiffT i j n : ns) a)
-> Mat (DiffT i j n : ns) a)
-> Either String (Mat (DiffT i j n : ns) a)
-> Mat (DiffT i j n : ns) a
forall a b. (a -> b) -> a -> b
$ do
let i :: Pos
i = PosC i => Pos
forall (n :: Nat). PosC n => Pos
fromNP @i
j :: Pos
j = PosC j => Pos
forall (n :: Nat). PosC n => Pos
fromNP @j
n1 :: Int
n1 = (Pos -> Int
unP Pos
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Pos] -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt [Pos]
ns
Pos
n' <- (Integer -> Integer -> Integer) -> Pos -> Pos -> Either String Pos
forall a.
Num1 a =>
(Integer -> Integer -> Integer) -> a -> a -> Either String a
withOp2 ((-) (Integer -> Integer -> Integer)
-> (Integer -> Integer) -> Integer -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)) Pos
j Pos
i
let ps1 :: NonEmpty Pos
ps1 = Pos
n' Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns
Vector a
-> NonEmpty Pos -> Either String (Mat (DiffT i j n : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
n1 (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
ps1) Vector a
v) NonEmpty Pos
ps1
subsetCols ::
forall i j m n ns a.
DiffTC i j n =>
Mat (m ': n ': ns) a ->
Mat (m ': (DiffT i j n ': ns)) a
subsetCols :: Mat (m : n : ns) a -> Mat (m : DiffT i j n : ns) a
subsetCols = Mat (DiffT i j n : m : ns) a -> Mat (m : DiffT i j n : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat (Mat (DiffT i j n : m : ns) a -> Mat (m : DiffT i j n : ns) a)
-> (Mat (m : n : ns) a -> Mat (DiffT i j n : m : ns) a)
-> Mat (m : n : ns) a
-> Mat (m : DiffT i j n : ns) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat) (ns :: [Nat]) a.
DiffTC i j n =>
Mat (n : ns) a -> Mat (DiffT i j n : ns) a
forall (i :: Nat) (j :: Nat) (n :: Nat) (ns :: [Nat]) a.
DiffTC i j n =>
Mat (n : ns) a -> Mat (DiffT i j n : ns) a
subsetRows @i @j (Mat (n : m : ns) a -> Mat (DiffT i j n : m : ns) a)
-> (Mat (m : n : ns) a -> Mat (n : m : ns) a)
-> Mat (m : n : ns) a
-> Mat (DiffT i j n : m : ns) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat (m : n : ns) a -> Mat (n : m : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Mat (m : n : ns) a
transposeMat
_rows ::
forall n m ns a b.
Iso
(Mat (n ': m ': ns) a)
(Mat (n ': m ': ns) b)
(Vec n (Mat (m ': ns) a))
(Vec n (Mat (m ': ns) b))
_rows :: p (Vec n (Mat (m : ns) a)) (f (Vec n (Mat (m : ns) b)))
-> p (Mat (n : m : ns) a) (f (Mat (n : m : ns) b))
_rows = (Mat (n : m : ns) a -> Vec n (Mat (m : ns) a))
-> (Vec n (Mat (m : ns) b) -> Mat (n : m : ns) b)
-> Iso
(Mat (n : m : ns) a)
(Mat (n : m : ns) b)
(Vec n (Mat (m : ns) a))
(Vec n (Mat (m : ns) b))
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Mat (n : m : ns) a -> Vec n (Mat (m : ns) a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Vec n (Mat (m : ns) a)
rows Vec n (Mat (m : ns) b) -> Mat (n : m : ns) b
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Vec n (Mat (m : ns) a) -> Mat (n : m : ns) a
unrows
toListMat :: Mat ns a -> [a]
toListMat :: Mat ns a -> [a]
toListMat = Mat ns a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
toNonEmptyMat :: Mat ns a -> NonEmpty a
toNonEmptyMat :: Mat ns a -> NonEmpty a
toNonEmptyMat = Mat ns a -> NonEmpty a
forall (t :: * -> *) a. Foldable1 t => t a -> NonEmpty a
toNonEmpty
readVec ::
( MatConvertersC '[n]
, PosC n
, Read [a]
) =>
ReadS (Vec n a)
readVec :: ReadS (Vec n a)
readVec = ReadP (Vec n a) -> ReadS (Vec n a)
forall a. ReadP a -> ReadS a
P.readP_to_S (ShowOpts -> ReadP (Vec n a)
forall (ns :: [Nat]) a.
(MatConvertersC ns, NS ns, Read (ListNST ns a)) =>
ShowOpts -> ReadP (Mat ns a)
readMatP ShowOpts
defShowOpts)
readMat2 ::
( MatConvertersC '[n, m]
, PosC n
, PosC m
, Read [[a]]
) =>
ReadS (Mat2 n m a)
readMat2 :: ReadS (Mat2 n m a)
readMat2 = ReadP (Mat2 n m a) -> ReadS (Mat2 n m a)
forall a. ReadP a -> ReadS a
P.readP_to_S (ShowOpts -> ReadP (Mat2 n m a)
forall (ns :: [Nat]) a.
(MatConvertersC ns, NS ns, Read (ListNST ns a)) =>
ShowOpts -> ReadP (Mat ns a)
readMatP ShowOpts
defShowOpts)
readMat ::
forall ns a.
( MatConvertersC ns
, NS ns
, Read (ListNST ns a)
) =>
ReadS (Mat ns a)
readMat :: ReadS (Mat ns a)
readMat = ReadP (Mat ns a) -> ReadS (Mat ns a)
forall a. ReadP a -> ReadS a
P.readP_to_S (ShowOpts -> ReadP (Mat ns a)
forall (ns :: [Nat]) a.
(MatConvertersC ns, NS ns, Read (ListNST ns a)) =>
ShowOpts -> ReadP (Mat ns a)
readMatP ShowOpts
defShowOpts)
instance (MatConvertersC ns, NS ns, Read (ListNST ns a)) => Read (Mat ns a) where
readPrec :: ReadPrec (Mat ns a)
readPrec = (Int -> ReadP (Mat ns a)) -> ReadPrec (Mat ns a)
forall a. (Int -> ReadP a) -> ReadPrec a
PC.readP_to_Prec (ReadP (Mat ns a) -> Int -> ReadP (Mat ns a)
forall a b. a -> b -> a
const (ShowOpts -> ReadP (Mat ns a)
forall (ns :: [Nat]) a.
(MatConvertersC ns, NS ns, Read (ListNST ns a)) =>
ShowOpts -> ReadP (Mat ns a)
readMatP ShowOpts
defShowOpts))
readMatP ::
forall ns a.
( MatConvertersC ns
, NS ns
, Read (ListNST ns a)
) =>
ShowOpts ->
P.ReadP (Mat ns a)
readMatP :: ShowOpts -> ReadP (Mat ns a)
readMatP ShowOpts
opts = do
ReadP ()
P.skipSpaces
let ns :: NonEmpty Pos
ns = NS ns => NonEmpty Pos
forall (ns :: [Nat]). NS ns => NonEmpty Pos
fromNSP @ns
NonEmpty Pos
ns' <-
(String -> ReadP String
P.string String
"Mat@" ReadP String -> ReadP (NonEmpty Pos) -> ReadP (NonEmpty Pos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Char -> ReadP (NonEmpty Pos)
pPositives Char
'[' Char
']')
ReadP (NonEmpty Pos)
-> ReadP (NonEmpty Pos) -> ReadP (NonEmpty Pos)
forall a. ReadP a -> ReadP a -> ReadP a
P.+++ (String -> ReadP String
P.string String
"Vec@" ReadP String -> ReadP (NonEmpty Pos) -> ReadP (NonEmpty Pos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Pos -> NonEmpty Pos) -> ReadP Pos -> ReadP (NonEmpty Pos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pos -> NonEmpty Pos
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReadP Pos
pPosInt)
ReadP (NonEmpty Pos)
-> ReadP (NonEmpty Pos) -> ReadP (NonEmpty Pos)
forall a. ReadP a -> ReadP a -> ReadP a
P.+++ ((\Pos
n Pos
m -> Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos
m]) (Pos -> Pos -> NonEmpty Pos)
-> ReadP String -> ReadP (Pos -> Pos -> NonEmpty Pos)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> ReadP String
P.string String
"Mat2@(" ReadP (Pos -> Pos -> NonEmpty Pos)
-> ReadP Pos -> ReadP (Pos -> NonEmpty Pos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadP Pos
pPosInt ReadP (Pos -> NonEmpty Pos)
-> ReadP Char -> ReadP (Pos -> NonEmpty Pos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ReadP Char
P.char Char
',' ReadP (Pos -> NonEmpty Pos) -> ReadP Pos -> ReadP (NonEmpty Pos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadP Pos
pPosInt ReadP (NonEmpty Pos) -> ReadP Char -> ReadP (NonEmpty Pos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ReadP Char
P.char Char
')')
Bool -> ReadP () -> ReadP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NonEmpty Pos
ns NonEmpty Pos -> NonEmpty Pos -> Bool
forall a. Eq a => a -> a -> Bool
/= NonEmpty Pos
ns') ReadP ()
forall a. ReadP a
P.pfail
ListNST ns a
xs <- ReadPrec (ListNST ns a) -> Int -> ReadP (ListNST ns a)
forall a. ReadPrec a -> Int -> ReadP a
PC.readPrec_to_P (Read (ListNST ns a) => ReadPrec (ListNST ns a)
forall a. Read a => ReadPrec a
GR.readPrec @(ListNST ns a)) Int
1
Mat ns a
ret <- (String -> ReadP (Mat ns a))
-> (Mat ns a -> ReadP (Mat ns a))
-> Either String (Mat ns a)
-> ReadP (Mat ns a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ReadP (Mat ns a) -> String -> ReadP (Mat ns a)
forall a b. a -> b -> a
const ReadP (Mat ns a)
forall a. ReadP a
P.pfail) Mat ns a -> ReadP (Mat ns a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListNST ns a -> Either String (Mat ns a)
forall (ns :: [Nat]) a.
MatConvertersC ns =>
ListNST ns a -> Either String (Mat ns a)
nestedListToMatC ListNST ns a
xs)
Bool -> ReadP () -> ReadP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NonEmpty Pos -> ShowOpts -> Bool
addNewline NonEmpty Pos
ns ShowOpts
opts) (ReadP () -> ReadP ()) -> ReadP () -> ReadP ()
forall a b. (a -> b) -> a -> b
$ ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
P.char Char
'\n'
Mat ns a -> ReadP (Mat ns a)
forall (m :: * -> *) a. Monad m => a -> m a
return Mat ns a
ret
prtMat :: forall ns a. (ShowMatC ns, Show a) => ShowOpts -> Mat ns a -> IO ()
prtMat :: ShowOpts -> Mat ns a -> IO ()
prtMat = String -> IO ()
putStrLn (String -> IO ())
-> (ShowOpts -> Mat ns a -> String)
-> ShowOpts
-> Mat ns a
-> IO ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ ShowOpts -> Mat ns a -> String
forall (ns :: [Nat]) a.
(ShowMatC ns, Show a) =>
ShowOpts -> Mat ns a -> String
showMat
data ShowOpts = ShowOpts
{ ShowOpts -> Int
smIndent0 :: !Int
, ShowOpts -> Int
smIndentN :: !Int
, ShowOpts -> Bool
smDivvy :: !Bool
, ShowOpts -> Bool
smInline1D :: !Bool
, ShowOpts -> Bool
smInlineNewLineEof :: !Bool
, ShowOpts -> Bool
smOtherNewLineEof :: !Bool
}
deriving stock (Int -> ShowOpts -> String -> String
[ShowOpts] -> String -> String
ShowOpts -> String
(Int -> ShowOpts -> String -> String)
-> (ShowOpts -> String)
-> ([ShowOpts] -> String -> String)
-> Show ShowOpts
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ShowOpts] -> String -> String
$cshowList :: [ShowOpts] -> String -> String
show :: ShowOpts -> String
$cshow :: ShowOpts -> String
showsPrec :: Int -> ShowOpts -> String -> String
$cshowsPrec :: Int -> ShowOpts -> String -> String
Show, ShowOpts -> ShowOpts -> Bool
(ShowOpts -> ShowOpts -> Bool)
-> (ShowOpts -> ShowOpts -> Bool) -> Eq ShowOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowOpts -> ShowOpts -> Bool
$c/= :: ShowOpts -> ShowOpts -> Bool
== :: ShowOpts -> ShowOpts -> Bool
$c== :: ShowOpts -> ShowOpts -> Bool
Eq, Eq ShowOpts
Eq ShowOpts
-> (ShowOpts -> ShowOpts -> Ordering)
-> (ShowOpts -> ShowOpts -> Bool)
-> (ShowOpts -> ShowOpts -> Bool)
-> (ShowOpts -> ShowOpts -> Bool)
-> (ShowOpts -> ShowOpts -> Bool)
-> (ShowOpts -> ShowOpts -> ShowOpts)
-> (ShowOpts -> ShowOpts -> ShowOpts)
-> Ord ShowOpts
ShowOpts -> ShowOpts -> Bool
ShowOpts -> ShowOpts -> Ordering
ShowOpts -> ShowOpts -> ShowOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShowOpts -> ShowOpts -> ShowOpts
$cmin :: ShowOpts -> ShowOpts -> ShowOpts
max :: ShowOpts -> ShowOpts -> ShowOpts
$cmax :: ShowOpts -> ShowOpts -> ShowOpts
>= :: ShowOpts -> ShowOpts -> Bool
$c>= :: ShowOpts -> ShowOpts -> Bool
> :: ShowOpts -> ShowOpts -> Bool
$c> :: ShowOpts -> ShowOpts -> Bool
<= :: ShowOpts -> ShowOpts -> Bool
$c<= :: ShowOpts -> ShowOpts -> Bool
< :: ShowOpts -> ShowOpts -> Bool
$c< :: ShowOpts -> ShowOpts -> Bool
compare :: ShowOpts -> ShowOpts -> Ordering
$ccompare :: ShowOpts -> ShowOpts -> Ordering
$cp1Ord :: Eq ShowOpts
Ord)
defShowOpts :: ShowOpts
defShowOpts :: ShowOpts
defShowOpts =
ShowOpts :: Int -> Int -> Bool -> Bool -> Bool -> Bool -> ShowOpts
ShowOpts
{ smIndent0 :: Int
smIndent0 = Int
2
, smIndentN :: Int
smIndentN = Int
0
, smDivvy :: Bool
smDivvy = Bool
True
, smInline1D :: Bool
smInline1D = Bool
True
, smInlineNewLineEof :: Bool
smInlineNewLineEof = Bool
False
, smOtherNewLineEof :: Bool
smOtherNewLineEof = Bool
True
}
addNewline :: NonEmpty Pos -> ShowOpts -> Bool
addNewline :: NonEmpty Pos -> ShowOpts -> Bool
addNewline (Pos
_ :| [Pos]
ns) ShowOpts
opts =
if [Pos] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pos]
ns Bool -> Bool -> Bool
&& ShowOpts -> Bool
smInline1D ShowOpts
opts
then ShowOpts -> Bool
smInlineNewLineEof ShowOpts
opts
else ShowOpts -> Bool
smOtherNewLineEof ShowOpts
opts
instance (Show a, ShowMatC ns, NS ns) => Show (Mat ns a) where
show :: Mat ns a -> String
show = ShowOpts -> Mat ns a -> String
forall (ns :: [Nat]) a.
(ShowMatC ns, Show a) =>
ShowOpts -> Mat ns a -> String
showMat ShowOpts
defShowOpts
showMat :: forall ns a. (ShowMatC ns, Show a) => ShowOpts -> Mat ns a -> String
showMat :: ShowOpts -> Mat ns a -> String
showMat ShowOpts
opts w :: Mat ns a
w@(Mat Vector a
_ (Pos
n :| [Pos]
ns)) =
let s :: [String]
s = ShowOpts -> Mat ns a -> [String]
forall (ns :: [Nat]) a.
(ShowMatC ns, Show a) =>
ShowOpts -> Mat ns a -> [String]
showMatC ShowOpts
opts Mat ns a
w
zs :: String
zs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n" [String]
s
ret :: String
ret = case (ShowOpts -> Bool
smDivvy ShowOpts
opts, [Pos]
ns) of
(Bool
True, []) -> String
"Vec@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Pos -> Int
unP Pos
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
"\n" String
" " (ShowOpts -> Bool
smInline1D ShowOpts
opts)
(Bool
True, [Pos
m]) -> String
"Mat2@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Pos -> Int
unP Pos
n, Pos -> Int
unP Pos
m) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
(Bool
_, [Pos]
_) -> String
"Mat@" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show ([Pos] -> [Int]
forall (t :: * -> *). Foldable t => t Pos -> [Int]
fromPositives (Pos
n Pos -> [Pos] -> [Pos]
forall a. a -> [a] -> [a]
: [Pos]
ns)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
in String
ret String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
zs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
forall a. Monoid a => a
mempty String
"\n" (NonEmpty Pos -> ShowOpts -> Bool
addNewline (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns) ShowOpts
opts)
class ShowMatC ns where
showMatC :: Show a => ShowOpts -> Mat ns a -> [String]
showMatC = Int -> Int -> ShowOpts -> Mat ns a -> [String]
forall (ns :: [Nat]) a.
(ShowMatC ns, Show a) =>
Int -> Int -> ShowOpts -> Mat ns a -> [String]
showMatC' Int
1 Int
1
showMatC' :: Show a => Int -> Int -> ShowOpts -> Mat ns a -> [String]
instance GL.TypeError ( 'GL.Text "ShowMatC '[]: empty indices") => ShowMatC '[] where
showMatC' :: Int -> Int -> ShowOpts -> Mat '[] a -> [String]
showMatC' = String -> Int -> Int -> ShowOpts -> Mat '[] a -> [String]
forall a. HasCallStack => String -> a
compileError String
"ShowMatC '[]:showMatC'"
instance ShowMatC '[n] where
showMatC' :: Int -> Int -> ShowOpts -> Mat '[n] a -> [String]
showMatC' Int
i Int
j ShowOpts
_ (Mat Vector a
v NonEmpty Pos
_) =
let ret0 :: String
ret0 = [a] -> String
forall a. Show a => a -> String
show (Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector a
v)
in String -> [String]
L.lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
ret0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then String
forall a. Monoid a => a
mempty else String
","
instance ShowMatC (m ': ns) => ShowMatC (n ': m ': ns) where
showMatC' :: Int -> Int -> ShowOpts -> Mat (n : m : ns) a -> [String]
showMatC' Int
i Int
j ShowOpts
opts w :: Mat (n : m : ns) a
w@(Mat Vector a
_ (Pos
n :| [Pos]
_)) =
let xs :: [Mat (m : ns) a]
xs = Mat '[n] (Mat (m : ns) a) -> [Mat (m : ns) a]
forall (ns :: [Nat]) a. Mat ns a -> [a]
toListMat (Mat '[n] (Mat (m : ns) a) -> [Mat (m : ns) a])
-> Mat '[n] (Mat (m : ns) a) -> [Mat (m : ns) a]
forall a b. (a -> b) -> a -> b
$ Mat (n : m : ns) a -> Mat '[n] (Mat (m : ns) a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Vec n (Mat (m : ns) a)
rows Mat (n : m : ns) a
w
zz :: String
zz = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ShowOpts -> Int
smIndent0 ShowOpts
opts) Char
' '
f :: String -> [String]
f String
s = [Int -> Char -> String
forall a. Int -> a -> [a]
replicate (ShowOpts -> Int
smIndent0 ShowOpts
opts) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s]
opts' :: ShowOpts
opts' = ShowOpts
opts{smIndent0 :: Int
smIndent0 = ShowOpts -> Int
smIndentN ShowOpts
opts}
g :: Int -> Mat (m : ns) a -> [String]
g Int
i1 Mat (m : ns) a
x1 = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
zz String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (Int -> Int -> ShowOpts -> Mat (m : ns) a -> [String]
forall (ns :: [Nat]) a.
(ShowMatC ns, Show a) =>
Int -> Int -> ShowOpts -> Mat ns a -> [String]
showMatC' (Pos -> Int
unP Pos
n) Int
i1 ShowOpts
opts' Mat (m : ns) a
x1)
s2 :: [String]
s2 = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ (Int -> Mat (m : ns) a -> [String])
-> [Int] -> [Mat (m : ns) a] -> [[String]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Mat (m : ns) a -> [String]
g [Int
1 ..] [Mat (m : ns) a]
xs
in case (Int
i, Int
j) of
(Int
1, Int
1) -> String -> [String]
f String
"[" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
s2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
f String
"]"
(Int
_, Int
1) -> String -> [String]
f String
"[" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
s2
(Int
_, Int
_)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j -> String -> [String]
f String
"],[" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
s2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
f String
"]"
| Bool
otherwise -> String -> [String]
f String
"],[" [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
s2
class Row1 s a | s -> a where
_r1 :: Lens' s a
class Row2 s a | s -> a where
_r2 :: Lens' s a
class Row3 s a | s -> a where
_r3 :: Lens' s a
class Row4 s a | s -> a where
_r4 :: Lens' s a
class Row5 s a | s -> a where
_r5 :: Lens' s a
class Row6 s a | s -> a where
_r6 :: Lens' s a
class Row7 s a | s -> a where
_r7 :: Lens' s a
class Row8 s a | s -> a where
_r8 :: Lens' s a
class Row9 s a | s -> a where
_r9 :: Lens' s a
class Row10 s a | s -> a where
_r10 :: Lens' s a
instance FinC 1 n => Row1 (Mat (n ': m ': ns) a) (Mat (m ': ns) a) where
_r1 :: (Mat (m : ns) a -> f (Mat (m : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
_r1 = forall (ns :: [Nat]) a.
SliceC '[1] ns =>
Lens' (Mat ns a) (SliceT '[1] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @1
instance FinC 1 n => Row1 (Vec n a) a where
_r1 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r1 = forall (ns :: [Nat]) a.
SliceC '[1] ns =>
Lens' (Mat ns a) (SliceT '[1] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @1
instance FinC 2 n => Row2 (Mat (n ': m ': ns) a) (Mat (m ': ns) a) where
_r2 :: (Mat (m : ns) a -> f (Mat (m : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
_r2 = forall (ns :: [Nat]) a.
SliceC '[2] ns =>
Lens' (Mat ns a) (SliceT '[2] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @2
instance FinC 2 n => Row2 (Vec n a) a where
_r2 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r2 = forall (ns :: [Nat]) a.
SliceC '[2] ns =>
Lens' (Mat ns a) (SliceT '[2] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @2
instance FinC 3 n => Row3 (Mat (n ': m ': ns) a) (Mat (m ': ns) a) where
_r3 :: (Mat (m : ns) a -> f (Mat (m : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
_r3 = forall (ns :: [Nat]) a.
SliceC '[3] ns =>
Lens' (Mat ns a) (SliceT '[3] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @3
instance FinC 3 n => Row3 (Vec n a) a where
_r3 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r3 = forall (ns :: [Nat]) a.
SliceC '[3] ns =>
Lens' (Mat ns a) (SliceT '[3] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @3
instance FinC 4 n => Row4 (Mat (n ': m ': ns) a) (Mat (m ': ns) a) where
_r4 :: (Mat (m : ns) a -> f (Mat (m : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
_r4 = forall (ns :: [Nat]) a.
SliceC '[4] ns =>
Lens' (Mat ns a) (SliceT '[4] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @4
instance FinC 4 n => Row4 (Vec n a) a where
_r4 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r4 = forall (ns :: [Nat]) a.
SliceC '[4] ns =>
Lens' (Mat ns a) (SliceT '[4] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @4
instance FinC 5 n => Row5 (Mat (n ': m ': ns) a) (Mat (m ': ns) a) where
_r5 :: (Mat (m : ns) a -> f (Mat (m : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
_r5 = forall (ns :: [Nat]) a.
SliceC '[5] ns =>
Lens' (Mat ns a) (SliceT '[5] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @5
instance FinC 5 n => Row5 (Vec n a) a where
_r5 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r5 = forall (ns :: [Nat]) a.
SliceC '[5] ns =>
Lens' (Mat ns a) (SliceT '[5] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @5
instance FinC 6 n => Row6 (Mat (n ': m ': ns) a) (Mat (m ': ns) a) where
_r6 :: (Mat (m : ns) a -> f (Mat (m : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
_r6 = forall (ns :: [Nat]) a.
SliceC '[6] ns =>
Lens' (Mat ns a) (SliceT '[6] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @6
instance FinC 6 n => Row6 (Vec n a) a where
_r6 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r6 = forall (ns :: [Nat]) a.
SliceC '[6] ns =>
Lens' (Mat ns a) (SliceT '[6] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @6
instance FinC 7 n => Row7 (Mat (n ': m ': ns) a) (Mat (m ': ns) a) where
_r7 :: (Mat (m : ns) a -> f (Mat (m : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
_r7 = forall (ns :: [Nat]) a.
SliceC '[7] ns =>
Lens' (Mat ns a) (SliceT '[7] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @7
instance FinC 7 n => Row7 (Vec n a) a where
_r7 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r7 = forall (ns :: [Nat]) a.
SliceC '[7] ns =>
Lens' (Mat ns a) (SliceT '[7] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @7
instance FinC 8 n => Row8 (Mat (n ': m ': ns) a) (Mat (m ': ns) a) where
_r8 :: (Mat (m : ns) a -> f (Mat (m : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
_r8 = forall (ns :: [Nat]) a.
SliceC '[8] ns =>
Lens' (Mat ns a) (SliceT '[8] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @8
instance FinC 8 n => Row8 (Vec n a) a where
_r8 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r8 = forall (ns :: [Nat]) a.
SliceC '[8] ns =>
Lens' (Mat ns a) (SliceT '[8] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @8
instance FinC 9 n => Row9 (Mat (n ': m ': ns) a) (Mat (m ': ns) a) where
_r9 :: (Mat (m : ns) a -> f (Mat (m : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
_r9 = forall (ns :: [Nat]) a.
SliceC '[9] ns =>
Lens' (Mat ns a) (SliceT '[9] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @9
instance FinC 9 n => Row9 (Vec n a) a where
_r9 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r9 = forall (ns :: [Nat]) a.
SliceC '[9] ns =>
Lens' (Mat ns a) (SliceT '[9] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @9
instance FinC 10 n => Row10 (Mat (n ': m ': ns) a) (Mat (m ': ns) a) where
_r10 :: (Mat (m : ns) a -> f (Mat (m : ns) a))
-> Mat (n : m : ns) a -> f (Mat (n : m : ns) a)
_r10 = forall (ns :: [Nat]) a.
SliceC '[10] ns =>
Lens' (Mat ns a) (SliceT '[10] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @10
instance FinC 10 n => Row10 (Vec n a) a where
_r10 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r10 = forall (ns :: [Nat]) a.
SliceC '[10] ns =>
Lens' (Mat ns a) (SliceT '[10] ns a)
forall (i :: Nat) (ns :: [Nat]) a.
SliceC '[i] ns =>
Lens' (Mat ns a) (SliceT '[i] ns a)
_row @10
_c1 :: FinC 1 m => Lens' (Mat (n ': (m : ns)) a) (Mat (n ': ns) a)
_c1 :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_c1 = forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC 1 m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC i m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col @1
_c2 :: FinC 2 m => Lens' (Mat (n ': (m : ns)) a) (Mat (n ': ns) a)
_c2 :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_c2 = forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC 2 m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC i m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col @2
_c3 :: FinC 3 m => Lens' (Mat (n ': (m : ns)) a) (Mat (n ': ns) a)
_c3 :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_c3 = forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC 3 m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC i m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col @3
_c4 :: FinC 4 m => Lens' (Mat (n ': (m : ns)) a) (Mat (n ': ns) a)
_c4 :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_c4 = forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC 4 m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC i m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col @4
_c5 :: FinC 5 m => Lens' (Mat (n ': (m : ns)) a) (Mat (n ': ns) a)
_c5 :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_c5 = forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC 5 m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC i m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col @5
_c6 :: FinC 6 m => Lens' (Mat (n ': (m : ns)) a) (Mat (n ': ns) a)
_c6 :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_c6 = forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC 6 m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC i m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col @6
_c7 :: FinC 7 m => Lens' (Mat (n ': (m : ns)) a) (Mat (n ': ns) a)
_c7 :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_c7 = forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC 7 m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC i m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col @7
_c8 :: FinC 8 m => Lens' (Mat (n ': (m : ns)) a) (Mat (n ': ns) a)
_c8 :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_c8 = forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC 8 m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC i m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col @8
_c9 :: FinC 9 m => Lens' (Mat (n ': (m : ns)) a) (Mat (n ': ns) a)
_c9 :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_c9 = forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC 9 m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC i m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col @9
_c10 :: FinC 10 m => Lens' (Mat (n ': (m : ns)) a) (Mat (n ': ns) a)
_c10 :: Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_c10 = forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC 10 m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinC i m =>
Lens' (Mat (n : m : ns) a) (Mat (n : ns) a)
_col @10
data Eof1 = Eof1 deriving stock (Int -> Eof1 -> String -> String
[Eof1] -> String -> String
Eof1 -> String
(Int -> Eof1 -> String -> String)
-> (Eof1 -> String) -> ([Eof1] -> String -> String) -> Show Eof1
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Eof1] -> String -> String
$cshowList :: [Eof1] -> String -> String
show :: Eof1 -> String
$cshow :: Eof1 -> String
showsPrec :: Int -> Eof1 -> String -> String
$cshowsPrec :: Int -> Eof1 -> String -> String
Show, Eof1 -> Eof1 -> Bool
(Eof1 -> Eof1 -> Bool) -> (Eof1 -> Eof1 -> Bool) -> Eq Eof1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Eof1 -> Eof1 -> Bool
$c/= :: Eof1 -> Eof1 -> Bool
== :: Eof1 -> Eof1 -> Bool
$c== :: Eof1 -> Eof1 -> Bool
Eq, (forall x. Eof1 -> Rep Eof1 x)
-> (forall x. Rep Eof1 x -> Eof1) -> Generic Eof1
forall x. Rep Eof1 x -> Eof1
forall x. Eof1 -> Rep Eof1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Eof1 x -> Eof1
$cfrom :: forall x. Eof1 -> Rep Eof1 x
Generic)
data EofN = EofN deriving stock (Int -> EofN -> String -> String
[EofN] -> String -> String
EofN -> String
(Int -> EofN -> String -> String)
-> (EofN -> String) -> ([EofN] -> String -> String) -> Show EofN
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [EofN] -> String -> String
$cshowList :: [EofN] -> String -> String
show :: EofN -> String
$cshow :: EofN -> String
showsPrec :: Int -> EofN -> String -> String
$cshowsPrec :: Int -> EofN -> String -> String
Show, EofN -> EofN -> Bool
(EofN -> EofN -> Bool) -> (EofN -> EofN -> Bool) -> Eq EofN
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EofN -> EofN -> Bool
$c/= :: EofN -> EofN -> Bool
== :: EofN -> EofN -> Bool
$c== :: EofN -> EofN -> Bool
Eq, (forall x. EofN -> Rep EofN x)
-> (forall x. Rep EofN x -> EofN) -> Generic EofN
forall x. Rep EofN x -> EofN
forall x. EofN -> Rep EofN x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EofN x -> EofN
$cfrom :: forall x. EofN -> Rep EofN x
Generic)
type ConsMatCTA :: [Nat] -> Type -> Type
type family ConsMatCTA ns a where
ConsMatCTA '[] _ = GL.TypeError ( 'GL.Text "ConsMatCTA '[]: empty indices")
ConsMatCTA '[1] a = a
ConsMatCTA '[_] a = a
ConsMatCTA (1 ': m ': ns) a = Mat (m ': ns) a
ConsMatCTA (_ ': m ': ns) a = Mat (m ': ns) a
type ConsMatCTB :: [Nat] -> Type -> Type
type family ConsMatCTB ns a where
ConsMatCTB '[] _ = GL.TypeError ( 'GL.Text "ConsMatCTB '[]: empty indices")
ConsMatCTB '[1] _ = Eof1
ConsMatCTB '[n] a = Vec (n GN.- 1) a
ConsMatCTB (1 ': _ ': _) _ = EofN
ConsMatCTB (n ': m ': ns) a = Mat ((n GN.- 1) ': m ': ns) a
type ConsMatC :: [Nat] -> Type -> Type -> Constraint
class ConsMatC ns a b where
consMat ::
Iso
(Mat ns a)
(Mat ns b)
(ConsMatCTA ns a, ConsMatCTB ns a)
(ConsMatCTA ns b, ConsMatCTB ns b)
headMat :: a ~ b => Lens' (Mat ns a) (ConsMatCTA ns a)
headMat = ((ConsMatCTA ns b, ConsMatCTB ns b)
-> f (ConsMatCTA ns b, ConsMatCTB ns b))
-> Mat ns b -> f (Mat ns b)
forall (ns :: [Nat]) a b.
ConsMatC ns a b =>
Iso
(Mat ns a)
(Mat ns b)
(ConsMatCTA ns a, ConsMatCTB ns a)
(ConsMatCTA ns b, ConsMatCTB ns b)
consMat (((ConsMatCTA ns b, ConsMatCTB ns b)
-> f (ConsMatCTA ns b, ConsMatCTB ns b))
-> Mat ns b -> f (Mat ns b))
-> ((ConsMatCTA ns b -> f (ConsMatCTA ns b))
-> (ConsMatCTA ns b, ConsMatCTB ns b)
-> f (ConsMatCTA ns b, ConsMatCTB ns b))
-> (ConsMatCTA ns b -> f (ConsMatCTA ns b))
-> Mat ns b
-> f (Mat ns b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsMatCTA ns b -> f (ConsMatCTA ns b))
-> (ConsMatCTA ns b, ConsMatCTB ns b)
-> f (ConsMatCTA ns b, ConsMatCTB ns b)
forall a x a'. Lens (a, x) (a', x) a a'
_Fst
tailMat :: a ~ b => Lens' (Mat ns a) (ConsMatCTB ns a)
tailMat = ((ConsMatCTA ns b, ConsMatCTB ns b)
-> f (ConsMatCTA ns b, ConsMatCTB ns b))
-> Mat ns b -> f (Mat ns b)
forall (ns :: [Nat]) a b.
ConsMatC ns a b =>
Iso
(Mat ns a)
(Mat ns b)
(ConsMatCTA ns a, ConsMatCTB ns a)
(ConsMatCTA ns b, ConsMatCTB ns b)
consMat (((ConsMatCTA ns b, ConsMatCTB ns b)
-> f (ConsMatCTA ns b, ConsMatCTB ns b))
-> Mat ns b -> f (Mat ns b))
-> ((ConsMatCTB ns b -> f (ConsMatCTB ns b))
-> (ConsMatCTA ns b, ConsMatCTB ns b)
-> f (ConsMatCTA ns b, ConsMatCTB ns b))
-> (ConsMatCTB ns b -> f (ConsMatCTB ns b))
-> Mat ns b
-> f (Mat ns b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsMatCTB ns b -> f (ConsMatCTB ns b))
-> (ConsMatCTA ns b, ConsMatCTB ns b)
-> f (ConsMatCTA ns b, ConsMatCTB ns b)
forall x b b'. Lens (x, b) (x, b') b b'
_Snd
instance
{-# OVERLAPPING #-}
( ConsMatCTA '[1] a ~ a
, ConsMatCTA '[1] b ~ b
, ConsMatCTB '[1] a ~ Eof1
, ConsMatCTB '[1] b ~ Eof1
) =>
ConsMatC '[1] a b
where
consMat :: p (ConsMatCTA '[1] a, ConsMatCTB '[1] a)
(f (ConsMatCTA '[1] b, ConsMatCTB '[1] b))
-> p (Mat '[1] a) (f (Mat '[1] b))
consMat = (Mat '[1] a -> (a, Eof1))
-> ((b, Eof1) -> Mat '[1] b)
-> Iso (Mat '[1] a) (Mat '[1] b) (a, Eof1) (b, Eof1)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\Mat '[1] a
m -> (Vector a -> a
forall a. Vector a -> a
V.head (Mat '[1] a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec Mat '[1] a
m), Eof1
Eof1)) (\(b
a, Eof1
Eof1) -> b -> Mat '[1] b
forall a. a -> Vec 1 a
se1 b
a)
instance
{-# OVERLAPPABLE #-}
( ConsMatCTA '[n] a ~ a
, ConsMatCTA '[n] b ~ b
, ConsMatCTB '[n] a ~ Vec (n GN.- 1) a
, ConsMatCTB '[n] b ~ Vec (n GN.- 1) b
) =>
ConsMatC '[n] a b
where
consMat :: p (ConsMatCTA '[n] a, ConsMatCTB '[n] a)
(f (ConsMatCTA '[n] b, ConsMatCTB '[n] b))
-> p (Mat '[n] a) (f (Mat '[n] b))
consMat =
(Mat '[n] a -> (a, Vec (n - 1) a))
-> ((b, Vec (n - 1) b) -> Mat '[n] b)
-> Iso
(Mat '[n] a) (Mat '[n] b) (a, Vec (n - 1) a) (b, Vec (n - 1) b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
( \(Mat Vector a
v0 (Pos
sn :| [Pos]
ps)) -> String -> Either String (a, Vec (n - 1) a) -> (a, Vec (n - 1) a)
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"consMat '[n]" (Either String (a, Vec (n - 1) a) -> (a, Vec (n - 1) a))
-> Either String (a, Vec (n - 1) a) -> (a, Vec (n - 1) a)
forall a b. (a -> b) -> a -> b
$ do
Pos
n <- Pos -> Either String Pos
predP Pos
sn
case Vector a -> Maybe (a, Vector a)
forall a. Vector a -> Maybe (a, Vector a)
V.uncons Vector a
v0 of
Maybe (a, Vector a)
Nothing -> String -> Either String (a, Vec (n - 1) a)
forall a b. a -> Either a b
Left String
"no data"
Just (a
a, Vector a
v) -> (a
a,) (Vec (n - 1) a -> (a, Vec (n - 1) a))
-> Either String (Vec (n - 1) a)
-> Either String (a, Vec (n - 1) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> NonEmpty Pos -> Either String (Vec (n - 1) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat Vector a
v (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps)
)
(\(b
a, Mat Vector b
v (Pos
p :| [Pos]
ps)) -> Vector b -> NonEmpty Pos -> Mat '[n] b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (b -> Vector b -> Vector b
forall a. a -> Vector a -> Vector a
V.cons b
a Vector b
v) (Pos -> Pos
succP Pos
p Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps))
instance
{-# OVERLAPPING #-}
( ConsMatCTA (1 ': m ': ns) a ~ Mat (m ': ns) a
, ConsMatCTA (1 ': m ': ns) b ~ Mat (m ': ns) b
, ConsMatCTB (1 ': m ': ns) a ~ EofN
, ConsMatCTB (1 ': m ': ns) b ~ EofN
) =>
ConsMatC (1 ': n1 ': ns) a b
where
consMat :: p (ConsMatCTA (1 : n1 : ns) a, ConsMatCTB (1 : n1 : ns) a)
(f (ConsMatCTA (1 : n1 : ns) b, ConsMatCTB (1 : n1 : ns) b))
-> p (Mat (1 : n1 : ns) a) (f (Mat (1 : n1 : ns) b))
consMat =
(Mat (1 : n1 : ns) a -> (Mat (n1 : ns) a, EofN))
-> ((Mat (n1 : ns) b, EofN) -> Mat (1 : n1 : ns) b)
-> Iso
(Mat (1 : n1 : ns) a)
(Mat (1 : n1 : ns) b)
(Mat (n1 : ns) a, EofN)
(Mat (n1 : ns) b, EofN)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
( \(Mat Vector a
v (Pos
_ :| [Pos]
ps)) -> String
-> Either String (Mat (n1 : ns) a, EofN) -> (Mat (n1 : ns) a, EofN)
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"consMat '(1 ': n1 ': ns)" (Either String (Mat (n1 : ns) a, EofN) -> (Mat (n1 : ns) a, EofN))
-> Either String (Mat (n1 : ns) a, EofN) -> (Mat (n1 : ns) a, EofN)
forall a b. (a -> b) -> a -> b
$
case [Pos]
ps of
Pos
m : [Pos]
ns -> (,EofN
EofN) (Mat (n1 : ns) a -> (Mat (n1 : ns) a, EofN))
-> Either String (Mat (n1 : ns) a)
-> Either String (Mat (n1 : ns) a, EofN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> NonEmpty Pos -> Either String (Mat (n1 : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat Vector a
v (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns)
[] -> String -> Either String (Mat (n1 : ns) a, EofN)
forall a b. a -> Either a b
Left String
"missing indices"
)
(\(Mat Vector b
v NonEmpty Pos
ps, EofN
EofN) -> Vector b -> NonEmpty Pos -> Mat (1 : n1 : ns) b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector b
v (Pos
_1P Pos -> NonEmpty Pos -> NonEmpty Pos
forall a. a -> NonEmpty a -> NonEmpty a
N.<| NonEmpty Pos
ps))
instance
{-# OVERLAPPING #-}
( ConsMatCTA (n ': m ': ns) a ~ Mat (m ': ns) a
, ConsMatCTA (n ': m ': ns) b ~ Mat (m ': ns) b
, ConsMatCTB (n ': m ': ns) a ~ Mat ((n GN.- 1) ': m ': ns) a
, ConsMatCTB (n ': m ': ns) b ~ Mat ((n GN.- 1) ': m ': ns) b
) =>
ConsMatC (n ': m ': ns) a b
where
consMat :: p (ConsMatCTA (n : m : ns) a, ConsMatCTB (n : m : ns) a)
(f (ConsMatCTA (n : m : ns) b, ConsMatCTB (n : m : ns) b))
-> p (Mat (n : m : ns) a) (f (Mat (n : m : ns) b))
consMat =
(Mat (n : m : ns) a -> (Mat (m : ns) a, Mat ((n - 1) : m : ns) a))
-> ((Mat (m : ns) b, Mat ((n - 1) : m : ns) b)
-> Mat (n : m : ns) b)
-> Iso
(Mat (n : m : ns) a)
(Mat (n : m : ns) b)
(Mat (m : ns) a, Mat ((n - 1) : m : ns) a)
(Mat (m : ns) b, Mat ((n - 1) : m : ns) b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
( \(Mat Vector a
v (Pos
sn :| [Pos]
ps)) -> String
-> Either String (Mat (m : ns) a, Mat ((n - 1) : m : ns) a)
-> (Mat (m : ns) a, Mat ((n - 1) : m : ns) a)
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"consMat '(n ': m ': ns)" (Either String (Mat (m : ns) a, Mat ((n - 1) : m : ns) a)
-> (Mat (m : ns) a, Mat ((n - 1) : m : ns) a))
-> Either String (Mat (m : ns) a, Mat ((n - 1) : m : ns) a)
-> (Mat (m : ns) a, Mat ((n - 1) : m : ns) a)
forall a b. (a -> b) -> a -> b
$ do
case [Pos]
ps of
Pos
m : [Pos]
ns -> do
Pos
n <- Pos -> Either String Pos
predP Pos
sn
let ps1 :: NonEmpty Pos
ps1 = Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns
ps2 :: NonEmpty Pos
ps2 = Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| (Pos
m Pos -> [Pos] -> [Pos]
forall a. a -> [a] -> [a]
: [Pos]
ns)
(Vector a
v1, Vector a
v2) = Int -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
ps1) Vector a
v
(Mat (m : ns) a
-> Mat ((n - 1) : m : ns) a
-> (Mat (m : ns) a, Mat ((n - 1) : m : ns) a))
-> Either String (Mat (m : ns) a)
-> Either String (Mat ((n - 1) : m : ns) a)
-> Either String (Mat (m : ns) a, Mat ((n - 1) : m : ns) a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Vector a -> NonEmpty Pos -> Either String (Mat (m : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat Vector a
v1 NonEmpty Pos
ps1) (Vector a
-> NonEmpty Pos -> Either String (Mat ((n - 1) : m : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat Vector a
v2 NonEmpty Pos
ps2)
[] -> String -> Either String (Mat (m : ns) a, Mat ((n - 1) : m : ns) a)
forall a b. a -> Either a b
Left String
"missing indices"
)
(\(Mat Vector b
v1 NonEmpty Pos
_, Mat Vector b
v2 (Pos
p2 :| [Pos]
ps2)) -> Vector b -> NonEmpty Pos -> Mat (n : m : ns) b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector b
v1 Vector b -> Vector b -> Vector b
forall a. Semigroup a => a -> a -> a
<> Vector b
v2) (Pos -> Pos
succP Pos
p2 Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps2))
type SnocMatC :: [Nat] -> Type -> Type -> Constraint
class SnocMatC ns a b where
snocMat ::
Iso
(Mat ns a)
(Mat ns b)
(ConsMatCTB ns a, ConsMatCTA ns a)
(ConsMatCTB ns b, ConsMatCTA ns b)
initMat :: a ~ b => Lens' (Mat ns a) (ConsMatCTB ns a)
initMat = ((ConsMatCTB ns b, ConsMatCTA ns b)
-> f (ConsMatCTB ns b, ConsMatCTA ns b))
-> Mat ns b -> f (Mat ns b)
forall (ns :: [Nat]) a b.
SnocMatC ns a b =>
Iso
(Mat ns a)
(Mat ns b)
(ConsMatCTB ns a, ConsMatCTA ns a)
(ConsMatCTB ns b, ConsMatCTA ns b)
snocMat (((ConsMatCTB ns b, ConsMatCTA ns b)
-> f (ConsMatCTB ns b, ConsMatCTA ns b))
-> Mat ns b -> f (Mat ns b))
-> ((ConsMatCTB ns b -> f (ConsMatCTB ns b))
-> (ConsMatCTB ns b, ConsMatCTA ns b)
-> f (ConsMatCTB ns b, ConsMatCTA ns b))
-> (ConsMatCTB ns b -> f (ConsMatCTB ns b))
-> Mat ns b
-> f (Mat ns b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsMatCTB ns b -> f (ConsMatCTB ns b))
-> (ConsMatCTB ns b, ConsMatCTA ns b)
-> f (ConsMatCTB ns b, ConsMatCTA ns b)
forall a x a'. Lens (a, x) (a', x) a a'
_Fst
lastMat :: a ~ b => Lens' (Mat ns a) (ConsMatCTA ns a)
lastMat = ((ConsMatCTB ns b, ConsMatCTA ns b)
-> f (ConsMatCTB ns b, ConsMatCTA ns b))
-> Mat ns b -> f (Mat ns b)
forall (ns :: [Nat]) a b.
SnocMatC ns a b =>
Iso
(Mat ns a)
(Mat ns b)
(ConsMatCTB ns a, ConsMatCTA ns a)
(ConsMatCTB ns b, ConsMatCTA ns b)
snocMat (((ConsMatCTB ns b, ConsMatCTA ns b)
-> f (ConsMatCTB ns b, ConsMatCTA ns b))
-> Mat ns b -> f (Mat ns b))
-> ((ConsMatCTA ns b -> f (ConsMatCTA ns b))
-> (ConsMatCTB ns b, ConsMatCTA ns b)
-> f (ConsMatCTB ns b, ConsMatCTA ns b))
-> (ConsMatCTA ns b -> f (ConsMatCTA ns b))
-> Mat ns b
-> f (Mat ns b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConsMatCTA ns b -> f (ConsMatCTA ns b))
-> (ConsMatCTB ns b, ConsMatCTA ns b)
-> f (ConsMatCTB ns b, ConsMatCTA ns b)
forall x b b'. Lens (x, b) (x, b') b b'
_Snd
instance {-# OVERLAPPING #-} SnocMatC '[1] a b where
snocMat :: p (ConsMatCTB '[1] a, ConsMatCTA '[1] a)
(f (ConsMatCTB '[1] b, ConsMatCTA '[1] b))
-> p (Mat '[1] a) (f (Mat '[1] b))
snocMat =
(Mat '[1] a -> (Eof1, a))
-> ((Eof1, b) -> Mat '[1] b)
-> Iso (Mat '[1] a) (Mat '[1] b) (Eof1, a) (Eof1, b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
(\Mat '[1] a
m -> (Eof1
Eof1, Vector a -> a
forall a. Vector a -> a
V.last (Mat '[1] a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec Mat '[1] a
m)))
(\(Eof1
Eof1, b
a) -> Vector b -> NonEmpty Pos -> Mat '[1] b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (b -> Vector b
forall a. a -> Vector a
V.singleton b
a) (Pos
_1P Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| []))
instance
{-# OVERLAPPABLE #-}
( ConsMatCTB '[n] a ~ Vec (n GN.- 1) a
, ConsMatCTB '[n] b ~ Vec (n GN.- 1) b
) =>
SnocMatC '[n] a b
where
snocMat :: p (ConsMatCTB '[n] a, ConsMatCTA '[n] a)
(f (ConsMatCTB '[n] b, ConsMatCTA '[n] b))
-> p (Mat '[n] a) (f (Mat '[n] b))
snocMat =
(Mat '[n] a -> (Vec (n - 1) a, a))
-> ((Vec (n - 1) b, b) -> Mat '[n] b)
-> Iso
(Mat '[n] a) (Mat '[n] b) (Vec (n - 1) a, a) (Vec (n - 1) b, b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
( \(Mat Vector a
v0 (Pos
sn :| [Pos]
ps)) -> String -> Either String (Vec (n - 1) a, a) -> (Vec (n - 1) a, a)
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"snocMat '[n]" (Either String (Vec (n - 1) a, a) -> (Vec (n - 1) a, a))
-> Either String (Vec (n - 1) a, a) -> (Vec (n - 1) a, a)
forall a b. (a -> b) -> a -> b
$ do
Pos
n <- Pos -> Either String Pos
predP Pos
sn
case Vector a -> Maybe (Vector a, a)
forall a. Vector a -> Maybe (Vector a, a)
V.unsnoc Vector a
v0 of
Maybe (Vector a, a)
Nothing -> String -> Either String (Vec (n - 1) a, a)
forall a b. a -> Either a b
Left String
"no data"
Just (Vector a
v, a
a) -> (,a
a) (Vec (n - 1) a -> (Vec (n - 1) a, a))
-> Either String (Vec (n - 1) a)
-> Either String (Vec (n - 1) a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> NonEmpty Pos -> Either String (Vec (n - 1) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat Vector a
v (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps)
)
(\(Mat Vector b
v (Pos
p :| [Pos]
ps), b
a) -> Vector b -> NonEmpty Pos -> Mat '[n] b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector b -> b -> Vector b
forall a. Vector a -> a -> Vector a
V.snoc Vector b
v b
a) (Pos -> Pos
succP Pos
p Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps))
instance {-# OVERLAPPING #-} SnocMatC (1 ': n1 ': ns) a b where
snocMat :: p (ConsMatCTB (1 : n1 : ns) a, ConsMatCTA (1 : n1 : ns) a)
(f (ConsMatCTB (1 : n1 : ns) b, ConsMatCTA (1 : n1 : ns) b))
-> p (Mat (1 : n1 : ns) a) (f (Mat (1 : n1 : ns) b))
snocMat =
(Mat (1 : n1 : ns) a -> (EofN, Mat (n1 : ns) a))
-> ((EofN, Mat (n1 : ns) b) -> Mat (1 : n1 : ns) b)
-> Iso
(Mat (1 : n1 : ns) a)
(Mat (1 : n1 : ns) b)
(EofN, Mat (n1 : ns) a)
(EofN, Mat (n1 : ns) b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
( \(Mat Vector a
v (Pos
_ :| [Pos]
ps)) -> String
-> Either String (EofN, Mat (n1 : ns) a) -> (EofN, Mat (n1 : ns) a)
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"snocMat '(1 ': n1 ': ns)" (Either String (EofN, Mat (n1 : ns) a) -> (EofN, Mat (n1 : ns) a))
-> Either String (EofN, Mat (n1 : ns) a) -> (EofN, Mat (n1 : ns) a)
forall a b. (a -> b) -> a -> b
$ do
case [Pos]
ps of
Pos
m : [Pos]
ns ->
(EofN
EofN,) (Mat (n1 : ns) a -> (EofN, Mat (n1 : ns) a))
-> Either String (Mat (n1 : ns) a)
-> Either String (EofN, Mat (n1 : ns) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector a -> NonEmpty Pos -> Either String (Mat (n1 : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat Vector a
v (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns)
[] -> String -> Either String (EofN, Mat (n1 : ns) a)
forall a b. a -> Either a b
Left String
"missing indices"
)
(\(EofN
EofN, Mat Vector b
v NonEmpty Pos
ps) -> Vector b -> NonEmpty Pos -> Mat (1 : n1 : ns) b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector b
v (Pos
_1P Pos -> NonEmpty Pos -> NonEmpty Pos
forall a. a -> NonEmpty a -> NonEmpty a
N.<| NonEmpty Pos
ps))
instance
{-# OVERLAPPABLE #-}
( ConsMatCTB (n ': m ': ns) a ~ Mat ((n GN.- 1) ': m ': ns) a
, ConsMatCTB (n ': m ': ns) a ~ Mat ((n GN.- 1) ': m ': ns) b
) =>
SnocMatC (n ': m ': ns) a b
where
snocMat :: p (ConsMatCTB (n : m : ns) a, ConsMatCTA (n : m : ns) a)
(f (ConsMatCTB (n : m : ns) b, ConsMatCTA (n : m : ns) b))
-> p (Mat (n : m : ns) a) (f (Mat (n : m : ns) b))
snocMat =
(Mat (n : m : ns) a -> (Mat ((n - 1) : m : ns) a, Mat (m : ns) a))
-> ((Mat ((n - 1) : m : ns) b, Mat (m : ns) b)
-> Mat (n : m : ns) b)
-> Iso
(Mat (n : m : ns) a)
(Mat (n : m : ns) b)
(Mat ((n - 1) : m : ns) a, Mat (m : ns) a)
(Mat ((n - 1) : m : ns) b, Mat (m : ns) b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
( \(Mat Vector a
v (Pos
sn :| [Pos]
ps)) -> String
-> Either String (Mat ((n - 1) : m : ns) a, Mat (m : ns) a)
-> (Mat ((n - 1) : m : ns) a, Mat (m : ns) a)
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"snocMat '(n ': m ': ns)" (Either String (Mat ((n - 1) : m : ns) a, Mat (m : ns) a)
-> (Mat ((n - 1) : m : ns) a, Mat (m : ns) a))
-> Either String (Mat ((n - 1) : m : ns) a, Mat (m : ns) a)
-> (Mat ((n - 1) : m : ns) a, Mat (m : ns) a)
forall a b. (a -> b) -> a -> b
$ do
case [Pos]
ps of
Pos
m : [Pos]
ns -> do
Pos
n <- Pos -> Either String Pos
predP Pos
sn
let ps1 :: NonEmpty Pos
ps1 = Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns
ps2 :: NonEmpty Pos
ps2 = Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| (Pos
m Pos -> [Pos] -> [Pos]
forall a. a -> [a] -> [a]
: [Pos]
ns)
(Vector a
v2, Vector a
v1) = Int -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt (NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt NonEmpty Pos
ps2) Vector a
v
(Mat ((n - 1) : m : ns) a
-> Mat (m : ns) a -> (Mat ((n - 1) : m : ns) a, Mat (m : ns) a))
-> Either String (Mat ((n - 1) : m : ns) a)
-> Either String (Mat (m : ns) a)
-> Either String (Mat ((n - 1) : m : ns) a, Mat (m : ns) a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) (Vector a
-> NonEmpty Pos -> Either String (Mat ((n - 1) : m : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat Vector a
v2 NonEmpty Pos
ps2) (Vector a -> NonEmpty Pos -> Either String (Mat (m : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat Vector a
v1 NonEmpty Pos
ps1)
[] -> String -> Either String (Mat ((n - 1) : m : ns) a, Mat (m : ns) a)
forall a b. a -> Either a b
Left String
"missing indices"
)
(\(Mat Vector b
v1 (Pos
p1 :| [Pos]
ps1), Mat Vector b
v2 NonEmpty Pos
_) -> Vector b -> NonEmpty Pos -> Mat (n : m : ns) b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (Vector b
v1 Vector b -> Vector b -> Vector b
forall a. Semigroup a => a -> a -> a
<> Vector b
v2) (Pos -> Pos
succP Pos
p1 Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps1))
rowsToMat ::
forall x n m ns a.
Vec x (Fin n) ->
Mat (n ': m ': ns) a ->
Mat (x ': m ': ns) a
rowsToMat :: Vec x (Fin n) -> Mat (n : m : ns) a -> Mat (x : m : ns) a
rowsToMat w1 :: Vec x (Fin n)
w1@(Mat Vector (Fin n)
_ (Pos
x :| [Pos]
_)) w2 :: Mat (n : m : ns) a
w2@(Mat Vector a
_ (Pos
_ :| [Pos]
ps)) =
Vector a -> NonEmpty Pos -> Mat (x : m : ns) a
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ([Vector a] -> Vector a
forall a. [Vector a] -> Vector a
V.concat ([Vector a] -> Vector a) -> [Vector a] -> Vector a
forall a b. (a -> b) -> a -> b
$ Mat '[x] (Vector a) -> [Vector a]
forall (ns :: [Nat]) a. Mat ns a -> [a]
toListMat (Mat '[x] (Vector a) -> [Vector a])
-> Mat '[x] (Vector a) -> [Vector a]
forall a b. (a -> b) -> a -> b
$ (Fin n -> Vector a) -> Vec x (Fin n) -> Mat '[x] (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Fin n
fn -> Mat (m : ns) a -> Vector a
forall (ns :: [Nat]) a. Mat ns a -> Vector a
mVec (Fin n -> Mat (n : m : ns) a -> Mat (m : ns) a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Fin n -> Mat (n : m : ns) a -> Mat (m : ns) a
indexRow Fin n
fn Mat (n : m : ns) a
w2)) Vec x (Fin n)
w1) (Pos
x Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps)
indexRow :: Fin n -> Mat (n ': m ': ns) a -> Mat (m ': ns) a
indexRow :: Fin n -> Mat (n : m : ns) a -> Mat (m : ns) a
indexRow (Fin (Pos Int
i) Pos
_n) (Mat Vector a
v (Pos
_ :| [Pos]
ps)) = String -> Either String (Mat (m : ns) a) -> Mat (m : ns) a
forall a. HasCallStack => String -> Either String a -> a
forceRightP String
"indexRow" (Either String (Mat (m : ns) a) -> Mat (m : ns) a)
-> Either String (Mat (m : ns) a) -> Mat (m : ns) a
forall a b. (a -> b) -> a -> b
$
case [Pos]
ps of
Pos
m : [Pos]
ns -> do
let s :: Int
s = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len
len :: Int
len = NonEmpty Pos -> Int
forall (t :: * -> *). Foldable t => t Pos -> Int
productPInt (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns)
Vector a -> NonEmpty Pos -> Either String (Mat (m : ns) a)
forall (ns :: [Nat]) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat (Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
s Int
len Vector a
v) (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns)
[] -> String -> Either String (Mat (m : ns) a)
forall a b. a -> Either a b
Left String
"missing indices"
scanrVec :: forall n a b. (a -> b -> b) -> b -> Vec n a -> Vec (n GN.+ 1) b
scanrVec :: (a -> b -> b) -> b -> Vec n a -> Vec (n + 1) b
scanrVec a -> b -> b
f b
c (Mat Vector a
v (Pos
p :| [Pos]
ps)) =
Vector b -> NonEmpty Pos -> Vec (n + 1) b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ((a -> b -> b) -> b -> Vector a -> Vector b
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.scanr' a -> b -> b
f b
c Vector a
v) (Pos -> Pos
succP Pos
p Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps)
scanlVec :: forall n a b. (b -> a -> b) -> b -> Vec n a -> Vec (n GN.+ 1) b
scanlVec :: (b -> a -> b) -> b -> Vec n a -> Vec (n + 1) b
scanlVec b -> a -> b
f b
c (Mat Vector a
v (Pos
p :| [Pos]
ps)) =
Vector b -> NonEmpty Pos -> Vec (n + 1) b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ((b -> a -> b) -> b -> Vector a -> Vector b
forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.scanl' b -> a -> b
f b
c Vector a
v) (Pos -> Pos
succP Pos
p Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps)
postscanrMat :: forall ns a b. (a -> b -> b) -> b -> Mat ns a -> Mat ns b
postscanrMat :: (a -> b -> b) -> b -> Mat ns a -> Mat ns b
postscanrMat a -> b -> b
f b
c (Mat Vector a
v NonEmpty Pos
ps) =
Vector b -> NonEmpty Pos -> Mat ns b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ((a -> b -> b) -> b -> Vector a -> Vector b
forall a b. (a -> b -> b) -> b -> Vector a -> Vector b
V.postscanr' a -> b -> b
f b
c Vector a
v) NonEmpty Pos
ps
postscanlMat :: forall ns a b. (b -> a -> b) -> b -> Mat ns a -> Mat ns b
postscanlMat :: (b -> a -> b) -> b -> Mat ns a -> Mat ns b
postscanlMat b -> a -> b
f b
c (Mat Vector a
v NonEmpty Pos
ps) =
Vector b -> NonEmpty Pos -> Mat ns b
forall (ns :: [Nat]) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ((b -> a -> b) -> b -> Vector a -> Vector b
forall a b. (a -> b -> a) -> a -> Vector b -> Vector a
V.postscanl' b -> a -> b
f b
c Vector a
v) NonEmpty Pos
ps
dim1 :: Vec n a -> Vec n a
dim1 :: Vec n a -> Vec n a
dim1 = Vec n a -> Vec n a
forall a. a -> a
id
dim2 :: Mat2 n m a -> Mat2 n m a
dim2 :: Mat2 n m a -> Mat2 n m a
dim2 = Mat2 n m a -> Mat2 n m a
forall a. a -> a
id
dim3 :: Mat '[n, m, p] a -> Mat '[n, m, p] a
dim3 :: Mat '[n, m, p] a -> Mat '[n, m, p] a
dim3 = Mat '[n, m, p] a -> Mat '[n, m, p] a
forall a. a -> a
id
dim4 :: Mat '[n, m, p, q] a -> Mat '[n, m, p, q] a
dim4 :: Mat '[n, m, p, q] a -> Mat '[n, m, p, q] a
dim4 = Mat '[n, m, p, q] a -> Mat '[n, m, p, q] a
forall a. a -> a
id
dim5 :: Mat '[n, m, p, q, r] a -> Mat '[n, m, p, q, r] a
dim5 :: Mat '[n, m, p, q, r] a -> Mat '[n, m, p, q, r] a
dim5 = Mat '[n, m, p, q, r] a -> Mat '[n, m, p, q, r] a
forall a. a -> a
id
dim6 :: Mat '[n, m, p, q, r, s] a -> Mat '[n, m, p, q, r, s] a
dim6 :: Mat '[n, m, p, q, r, s] a -> Mat '[n, m, p, q, r, s] a
dim6 = Mat '[n, m, p, q, r, s] a -> Mat '[n, m, p, q, r, s] a
forall a. a -> a
id
dim7 :: Mat '[n, m, p, q, r, s, t] a -> Mat '[n, m, p, q, r, s, t] a
dim7 :: Mat '[n, m, p, q, r, s, t] a -> Mat '[n, m, p, q, r, s, t] a
dim7 = Mat '[n, m, p, q, r, s, t] a -> Mat '[n, m, p, q, r, s, t] a
forall a. a -> a
id
dim8 :: Mat '[n, m, p, q, r, s, t, u] a -> Mat '[n, m, p, q, r, s, t, u] a
dim8 :: Mat '[n, m, p, q, r, s, t, u] a -> Mat '[n, m, p, q, r, s, t, u] a
dim8 = Mat '[n, m, p, q, r, s, t, u] a -> Mat '[n, m, p, q, r, s, t, u] a
forall a. a -> a
id
dim9 :: Mat '[n, m, p, q, r, s, t, u, v] a -> Mat '[n, m, p, q, r, s, t, u, v] a
dim9 :: Mat '[n, m, p, q, r, s, t, u, v] a
-> Mat '[n, m, p, q, r, s, t, u, v] a
dim9 = Mat '[n, m, p, q, r, s, t, u, v] a
-> Mat '[n, m, p, q, r, s, t, u, v] a
forall a. a -> a
id
dim10 :: Mat '[n, m, p, q, r, s, t, u, v, w] a -> Mat '[n, m, p, q, r, s, t, u, v, w] a
dim10 :: Mat '[n, m, p, q, r, s, t, u, v, w] a
-> Mat '[n, m, p, q, r, s, t, u, v, w] a
dim10 = Mat '[n, m, p, q, r, s, t, u, v, w] a
-> Mat '[n, m, p, q, r, s, t, u, v, w] a
forall a. a -> a
id
rotateLeft :: Mat2 n m a -> Mat2 m n a
rotateLeft :: Mat2 n m a -> Mat2 m n a
rotateLeft = Vec m (Mat '[n] a) -> Mat2 m n a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Vec n (Mat (m : ns) a) -> Mat (n : m : ns) a
unrows (Vec m (Mat '[n] a) -> Mat2 m n a)
-> (Mat2 n m a -> Vec m (Mat '[n] a)) -> Mat2 n m a -> Mat2 m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat '[n] (Mat '[m] a) -> Vec m (Mat '[n] a)
forall (t :: * -> *) (f :: * -> *) b.
(Traversable1 t, Apply f) =>
t (f b) -> f (t b)
sequence1 (Mat '[n] (Mat '[m] a) -> Vec m (Mat '[n] a))
-> (Mat2 n m a -> Mat '[n] (Mat '[m] a))
-> Mat2 n m a
-> Vec m (Mat '[n] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mat '[m] a -> Mat '[m] a)
-> Mat '[n] (Mat '[m] a) -> Mat '[n] (Mat '[m] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mat '[m] a -> Mat '[m] a
forall a (t :: * -> *). Traversable t => t a -> t a
reverseT (Mat '[n] (Mat '[m] a) -> Mat '[n] (Mat '[m] a))
-> (Mat2 n m a -> Mat '[n] (Mat '[m] a))
-> Mat2 n m a
-> Mat '[n] (Mat '[m] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat2 n m a -> Mat '[n] (Mat '[m] a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Vec n (Mat (m : ns) a)
rows
rotateRight :: Mat2 n m a -> Mat2 m n a
rotateRight :: Mat2 n m a -> Mat2 m n a
rotateRight = Vec m (Mat '[n] a) -> Mat2 m n a
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Vec n (Mat (m : ns) a) -> Mat (n : m : ns) a
unrows (Vec m (Mat '[n] a) -> Mat2 m n a)
-> (Mat2 n m a -> Vec m (Mat '[n] a)) -> Mat2 n m a -> Mat2 m n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mat '[n] a -> Mat '[n] a)
-> Vec m (Mat '[n] a) -> Vec m (Mat '[n] a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mat '[n] a -> Mat '[n] a
forall a (t :: * -> *). Traversable t => t a -> t a
reverseT (Vec m (Mat '[n] a) -> Vec m (Mat '[n] a))
-> (Mat2 n m a -> Vec m (Mat '[n] a))
-> Mat2 n m a
-> Vec m (Mat '[n] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat '[n] (Mat '[m] a) -> Vec m (Mat '[n] a)
forall (t :: * -> *) (f :: * -> *) b.
(Traversable1 t, Apply f) =>
t (f b) -> f (t b)
sequence1 (Mat '[n] (Mat '[m] a) -> Vec m (Mat '[n] a))
-> (Mat2 n m a -> Mat '[n] (Mat '[m] a))
-> Mat2 n m a
-> Vec m (Mat '[n] a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat2 n m a -> Mat '[n] (Mat '[m] a)
forall (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
Mat (n : m : ns) a -> Vec n (Mat (m : ns) a)
rows
cofactorsL :: forall a . Pos -> [a] -> [(a, [a])]
cofactorsL :: Pos -> [a] -> [(a, [a])]
cofactorsL Pos
n [a]
xs
| Pos
n Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
_2P = String -> [(a, [a])]
forall a. HasCallStack => String -> a
programmError (String -> [(a, [a])]) -> String -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ String
"cofactorsL: n is too small: must be greater than 2 but found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pos -> String
forall a. Show a => a -> String
show Pos
n
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
len' = String -> [(a, [a])]
forall a. HasCallStack => String -> a
programmError (String -> [(a, [a])]) -> String -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ String
"cofactorsL: wrong length: expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" but found " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
| Bool
otherwise =
let ([a]
h,[a]
t) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Pos -> Int
unP Pos
n) [a]
xs
in ([(a, [a])] -> (Int, a) -> [(a, [a])])
-> [(a, [a])] -> [(Int, a)] -> [(a, [a])]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[(a, [a])]
z (Int
i,a
a) -> (a
a,Pos -> Int -> [a] -> [a]
forall a. Pos -> Int -> [a] -> [a]
deleteColumnL Pos
n Int
i [a]
t)(a, [a]) -> [(a, [a])] -> [(a, [a])]
forall a. a -> [a] -> [a]
:[(a, [a])]
z) [] ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [a]
h)
where len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
len' :: Int
len' = Pos -> Int
unP (Pos
n Pos -> Pos -> Pos
*! Pos
n)
deleteColumnL :: forall a . Pos -> Int -> [a] -> [a]
deleteColumnL :: Pos -> Int -> [a] -> [a]
deleteColumnL (Pos Int
n) Int
i [a]
ys =
let ([a]
as,[a]
bs) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [a]
ys
in [a]
as [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
L.unfoldr [a] -> Maybe ([a], [a])
g [a]
bs)
where
g :: [a] -> Maybe ([a],[a])
g :: [a] -> Maybe ([a], [a])
g = Maybe ([a], [a])
-> (a -> [a] -> Maybe ([a], [a])) -> [a] -> Maybe ([a], [a])
forall b a. b -> (a -> [a] -> b) -> [a] -> b
list Maybe ([a], [a])
forall a. Maybe a
Nothing (\a
_ -> ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (([a], [a]) -> Maybe ([a], [a]))
-> ([a] -> ([a], [a])) -> [a] -> Maybe ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
determinantL :: forall a . Num a => Pos -> [a] -> a
determinantL :: Pos -> [a] -> a
determinantL Pos
n [a]
m0
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Pos -> Int
unP (Pos
n Pos -> Pos -> Pos
*! Pos
n) = String -> a
forall a. HasCallStack => String -> a
programmError (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"determinantL: wrong length n=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pos -> String
forall a. Show a => a -> String
show Pos
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" m=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
| Bool
otherwise =
case [a]
m0 of
[a
a] -> a
a
[a
a,a
b,a
c,a
d] -> a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
d a -> a -> a
forall a. Num a => a -> a -> a
- a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
c
[a]
_o ->
(Bool, a) -> a
forall a b. (a, b) -> b
snd ((Bool, a) -> a) -> (Bool, a) -> a
forall a b. (a -> b) -> a -> b
$ ((Bool, a) -> (a, [a]) -> (Bool, a))
-> (Bool, a) -> [(a, [a])] -> (Bool, a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Bool, a) -> (a, [a]) -> (Bool, a)
f (Bool
True, a
0) (Pos -> [a] -> [(a, [a])]
forall a. Pos -> [a] -> [(a, [a])]
cofactorsL Pos
n [a]
m0)
where
f :: (Bool, a) -> (a, [a]) -> (Bool, a)
f :: (Bool, a) -> (a, [a]) -> (Bool, a)
f (Bool
sgn, a
tot) (a
a, [a]
m) =
let val :: a
val = (a -> a) -> (a -> a) -> Bool -> a -> a
forall a. a -> a -> Bool -> a
bool a -> a
forall a. a -> a
id a -> a
forall a. Num a => a -> a
negate Bool
sgn a
a a -> a -> a
forall a. Num a => a -> a -> a
* Pos -> [a] -> a
forall a. Num a => Pos -> [a] -> a
determinantL (Either String Pos -> Pos
forall a. HasCallStack => Either String a -> a
frp (Either String Pos -> Pos) -> Either String Pos -> Pos
forall a b. (a -> b) -> a -> b
$ Pos -> Either String Pos
predP Pos
n) [a]
m
in (Bool -> Bool
not Bool
sgn, a
tot a -> a -> a
forall a. Num a => a -> a -> a
+ a
val)
len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
m0
determinant :: Num a => Mat2 n n a -> a
determinant :: Mat2 n n a -> a
determinant (Mat Vector a
v (Pos
n :| [Pos]
_)) =
(a -> a) -> (a -> a) -> Bool -> a -> a
forall a. a -> a -> Bool -> a
bool a -> a
forall a. Num a => a -> a
negate a -> a
forall a. a -> a
id (Pos
n Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
<= Pos
_2P) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Pos -> [a] -> a
forall a. Num a => Pos -> [a] -> a
determinantL Pos
n (Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector a
v)