{-# 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
Description : type level indexed multi-dimensional matrix
Copyright   : (c) Grant Weyburne, 2022
License     : BSD-3
-}
module Cybus.Mat (
  type Mat,
  mVec,
  mIndices,
  pattern Mat,
  pattern MatU,
  Vec,
  Mat2,
  Mat3,
  Mat4,
  Mat5,
  Mat6,
  MatN,

  -- * cons/snoc lenses
  ConsMatC (..),
  SnocMatC (..),
  Eof1 (..),
  EofN (..),

  -- * tuple conversions
  MatTupleC (..),
  MatTupleT,
  ListTupleCInternal (..),

  -- * converters
  MatConvertersC (..),
  nestedListToMatValidated,
  nestedNonEmptyToMatValidated,
  MatToNestedVecT,

  -- * bulk construct matrix
  mkMat,
  mkMatC,
  mat,
  mat',
  vec,
  vec',
  mat2,
  mat2',
  gen',
  gen,
  mm,
  buildMat,

  -- * vector/matrix builders
  (.:),
  se1,
  (.::),
  se2,
  (.|),
  (.||),

  -- * indexing
  ixMat,
  ixMat',
  setMat,
  updateMat,
  indexMat,
  finMatRows,

  -- * reverse
  reverseRows,

  -- * sort
  sortByRows,
  multMat,
  -- dot,
  DotC (..),

  -- * zip
  zipWithMat,
  zipWithMat3,
  zipMat,
  zipWithMatA,
  izipWith,
  izipWithM,

  -- * general
  cartesian,
  pureMat,
  replicateMat,
  determinant,
--  determinantL,
--  cofactorsL,
deleteColumnL,

  -- * row operations
  deleteRow,
  deleteRow',
  insertRow,
  insertRow',
  swapRow,
  swapRow',
  _row,
  _row',
  rows,
  unrows,
  _rows,
  wrapRows1,
  indexRow,

  -- * column operations
  deleteCol,
  deleteCol',
  insertCol,
  insertCol',
  swapCol,
  swapCol',
  _col,
  _col',
  swapMat,
  swapMat',
  appendV,
  appendH,
  permutationsMat,
  findMatElems,

  -- * bulk updates
  bulkMat,
  updatesMat,
  getsMat,
  setsMat,
  nonEmptyMatsToMat,

  -- * reshape
  _transposeMat,
  transposeMat,
  toND,
  MatToNDT,
  toVec,
  toMat2,
  toMat3,
  concatMat,
  redim,
  reverseDim,
  rotateLeft,
  rotateRight,

  -- * subset and slicing
  SliceC (..),
  SliceT,
  SliceC' (..),
  SliceT',
  slice,
  sliceUpdate,
  sliceToFinMat,
  SliceToFinMatT,
  ixSlice,
  ixSlice',
  subsetRows,
  subsetCols,
  diagonal,
  rowsToMat,

  -- * splitting
  chunkNV,
  chunkNVMat,

  -- * leaf methods
  LeafC (..),
  traverseLeafSimple,
  mapLeafSimple,
  foldMapLeaf,
  foldMapLeafR,
  mapLeaf,
  mapLeafS,
  mapLeafSimpleS,
  foldLeaf,
  toLeaves,
  mapCols,
  mapCols',

  -- * read/show/print methods
  ShowMatC (..),
  ShowOpts (..),
  defShowOpts,
  prtMat,
  showMat,
  readMatP,
  readMat,
  readMat2,
  readVec,

  -- * row lenses
  Row1 (..),
  Row2 (..),
  Row3 (..),
  Row4 (..),
  Row5 (..),
  Row6 (..),
  Row7 (..),
  Row8 (..),
  Row9 (..),
  Row10 (..),

  -- * column lenses
  _c1,
  _c2,
  _c3,
  _c4,
  _c5,
  _c6,
  _c7,
  _c8,
  _c9,
  _c10,

  -- * miscellaneous
  finMatMatrix,
  finMatMatrix',

  -- * scans
  scanlVec,
  scanrVec,
  postscanlMat,
  postscanrMat,

  -- ** coercion methods to set the dimensions of a matrix
  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

-- | definition of a matrix
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)

-- | accessor for the relative position within a matrix
mVec :: Mat ns a -> Vector a
mVec :: Mat ns a -> Vector a
mVec (MatUnsafe Vector a
v NonEmpty Pos
_) = Vector a
v

-- | accessor for the indices of a matrix
mIndices :: Mat ns a -> NonEmpty Pos
mIndices :: Mat ns a -> NonEmpty Pos
mIndices (MatUnsafe Vector a
_ NonEmpty Pos
ns) = NonEmpty Pos
ns

-- | convenient type synonym for a 1d matrix
type Vec :: Nat -> Type -> Type
type Vec n = Mat '[n]

-- | convenient type synonym for a 2d matrix
type Mat2 :: Nat -> Nat -> Type -> Type
type Mat2 n m = Mat '[n, m]

-- | convenient type synonym for a 3d matrix
type Mat3 :: Nat -> Nat -> Nat -> Type -> Type
type Mat3 n m p = Mat '[n, m, p]

-- | convenient type synonym for a 4d matrix
type Mat4 :: Nat -> Nat -> Nat -> Nat -> Type -> Type
type Mat4 n m p q = Mat '[n, m, p, q]

-- | convenient type synonym for a 5d matrix
type Mat5 :: Nat -> Nat -> Nat -> Nat -> Nat -> Type -> Type
type Mat5 n m p q r = Mat '[n, m, p, q, r]

-- | convenient type synonym for a 6d matrix
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]

-- | convenient type synonym for specifying the dimensions of a matrix using each digit as a dimension
type MatN :: Nat -> Type -> Type
type MatN n = Mat (NN n)

-- | readonly pattern synonym for a matrix
{-# 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 #-}

-- | bidirectional pattern synonym for simple validation of a matrix before construction
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 #-}

-- | bidirectional pattern synonym for validating a matrix before construction with 'NS' constraint for additional typelevel validation
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 -- need this as Enum is only Int but containers can be larger ie Integer

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

-- | generate a 'Mat' using a list
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

-- | used by 'pure' so dont call pure from here
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

-- | creates a matrix of first dimension "n" by replicating the input matrix "n" times
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 -- ziplist style

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

-- | zip two matrices using a combining function
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

-- | zip three matrices using a combining function
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

-- | zip two matrices
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 (,)

-- | 'zipWithMat' with an Applicative or use 'Primus.Fold.zipWithT' but that needs a 'NS' constraint
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

-- | 'zipWithMat' with an index or use 'Primus.Rep.izipWithR'
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

-- | 'zipWithMatA' with an index or use 'Primus.Rep.izipWithR' if "f" is 'Data.Distributive.Distributive'
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 -- cant be empty (dont use 'toNonEmpty')

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

-- todo: write a dedicated version
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 ())

-- | index into a matrix
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

-- | create a matrix of matrix indices for a given size "ns"
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 ())

-- | fill an existing matrix with indices
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

-- | validate before creating a matrix
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"

-- | validate before creating a matrix with extra 'NS' constraint to check that "ns" and 'mIndices' match
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)

-- | generate a matrix passing the indices at that element to a user callback function
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)

-- | generate a matrix passing a relative position of the element to a user callback function
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)

-- | generate a matrix using relative position starting at one
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)

-- | lens that accesses a value inside a mat given a concrete mat index
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)

-- | lens that accesses a value inside a mat using a type level index
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)

-- | sets a value in a matrix
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

-- | updates a value in a matrix
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

-- | cons a value with a 1d matrix
(.:) :: 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 .:

-- | cons a matrix with a one-higher dimension matrix
(.::) :: 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 .::

-- | combine two values together into 1d matrix
(.|) :: 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 .|

-- | combine two matrices
(.||) :: 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 .||

-- | last element in a 1d matrix
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
:| [])

-- | last element in a 2d or greater matrix
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)

-- | create a 1d matrix from a list of values
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]

-- | create a 1d matrix from a list of values with the exact number of elements
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]

-- | create a 2d matrix from a list of values
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]

-- | create a 2d matrix from a list of values with the exact number of elements
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]

-- | map each column
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

-- | map each column with user state
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

-- | traverse over a nested leaf matrix only allowing changes to "a"
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

-- | map over a nested leaf matrix only allowing changes to "a"
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)

-- | foldmap over a nested leaf matrix
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)

-- | map over a nested leaf matrix
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)

-- | map over a nested leaf matrix with state
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))

-- | map over a nested leaf matrix only allowing changes to "a" and access to user state
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))

-- | fold over a nested leaf matrix
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, ())

-- | convert to nested matrix with 1d leaves
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)

-- | methods for accessing all the leaf rows of a matrix: restricted to 2d hence this class
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

-- | get the start index for each row in a mat
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

-- | reverse each row in a matrix
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)

-- | sort each row of a mat using underlying 'Vec'
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)

-- | visit each leaf row with a function from a nonempty to a nonempty list
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))

-- | reverse the dimensions of a matrix
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)

-- | resize a mat
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)

{- | describes the resulting type of taking a slice from the mat
 but the indices must match pointwise unlike SliceT so we can use the concrete FinMat to specify the indices
-}
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
-- todo: this condition doesnt fire in SliceC'
-- sliceC' (finMatC @(NN 11) @(NN 29)) (mm @(NN 235))
  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
      )

{- | allows viewing and updating a slice of a mat using concrete indices
 inference is better with n ~ n' but since we have committed to a instance
 we are missing nice errors when the indices dont match: eg
 sliceC' @'[1] @'[7] (FinMat 0 (_7P :| [])) (mm @(NN 7))
-}
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
    -- carve out the piece that is to be updated and pass that down then patch it all back together
    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'"

-- | describes the resulting type of taking a slice from the matrix
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)

-- | converts a typelevel slice to a concrete 'FinMat'
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)

-- | get a slice by converting a typelevel slice to a concrete FinMat based slice
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)

-- | update a slice by converting a typelevel slice to a concrete FinMat based slice
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)

-- | describes the resulting type of taking a slice from the mat
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

-- | allows viewing and updating a slice of a mat
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
    -- carve out the piece that is to be updated and pass that down then patch it all back together
    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)"

-- | a lens indexing the outermost slice
_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]

-- | a lens for acccessing a column
_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

-- | a lens for accessing a slice of a mat
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)

-- | a lens indexing a row using a concrete index 'Fin'
_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
:| []))

-- | a lens for acccessing a column
_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

-- | a lens for accessing a slice of a mat
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)

-- | break up into rows
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"

-- | unbust from rows see 'rows'
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

-- | split up a matrix into matrix chunks of dimension "ps" and fill a container "tz"
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

-- | split up a vector into chunks of size "n" and fill a container "tz"
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

-- 4 conditions:
--   1: (n:|[m]) a X (m:|[p]) b == (n:|[p]) (a->b->c)
--   2: (n:|m:q:ns) a X (m:|[p]) b == (n:|[p]) ((q:|ns) a -> b -> c)
--   3: (n:|m:q:ns) a X (m:|p:r:xs) b == (n:|[p]) ((q:|ns) a -> (r:|xs) b -> c)
--   4: (n:|[m]) a X (m:|p:r:xs) b == (n:|[p]) (a -> (r:|xs) b -> c)

-- | generalised dot product
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)

-- | base case for generalised dot product
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

-- | multiply two matrices together
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

-- | delete a row
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))

-- | delete a row using a concrete index
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)

-- | delete a row from a matrix
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))

-- | same as 'insertRow' but using a typelevel witness for the index
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)

-- | delete a column from a matrix (2d or higher)
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))

-- | same as 'deleteCol' but using a typelevel witness for the index
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)

-- | insert a column into a mat (2d and above)
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))

-- | same as 'insertCol' but using a typelevel witness 'Fin'
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

-- | swaps mat rows (1d or more)
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)

-- | swaps mat rows (1d or more)
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

-- | swaps mat rows (2d or more)
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)

-- | swaps mat rows (2d or more)
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

-- | swaps a single value "a" from any location to any other location using type level indexes
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)

-- | same as 'swapMat' but using typelevel witnesses 'FinMat'
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

-- | append two matrices vertically
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)

-- | append two matrices horizontally
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')

-- | return a mat as a permutation of a list (1d only) todo: extend to multidimensions
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])

-- | find all elements in a mat that match the predicate
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))

-- | generate a 'Mat' with the given past and future rep values and a user state
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 product of two matrices with a combining function
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)

-- | lens for bulk updates/gets on a matrix
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)

-- | bulk updates on a mat
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

-- | bulk gets from a mat: replaces the container of indices with the corresponding values
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

-- | bulk updates on a mat
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

-- | convert a matrix to a nested tuple
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)

-- | convert a between a matrix and a nested tuple
type MatTupleC :: [Nat] -> Type -> Constraint
class MatTupleC ns a where
  toTupleC ::
    Mat ns a ->
    -- | convert a 'Mat' to a nested tuple
    MatTupleT ns a
  fromTupleC ::
    MatTupleT ns a ->
    -- | convert a well-formed nested tuple of type "a" to 'Mat'
    Mat ns a
  fmapTupleMatC ::
    (a -> b) ->
    MatTupleT ns a ->
    -- | fmap over a well-formed nested tuple
    MatTupleT ns b
  traversalTupleMatC ::
    -- | traversal over a well-formed nested tuple
    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)

-- | fmap over a n-tuple
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)

-- | conversions between n-tuple and 'Vec'
type ListTupleCInternal :: Nat -> Constraint
class ListTupleCInternal n where
  -- | convert a 'Vec' to a tuple
  toTupleCInternal :: Vec n a -> ListTupleT n a

  -- | convert a tuple of type "a" to 'Vec'
  fromTupleCInternal :: ListTupleT n a -> Vec n a

  -- | traversal over a tuple
  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

-- | an iso for transposing a matrix
_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

-- | transpose a 2d or larger matrix
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))

-- | validate and convert from a nested list to a matrix
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

-- | validate and convert from a nested nonempty list to a matrix
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 with methods to convert to and from Mat using nested structures
class MatConvertersC ns where
  -- | convert a 'Mat' to nested 'Vec'
  matToNestedVecC :: Mat ns a -> MatToNestedVecT ns a

  -- | convert a nested 'Vec' to a 'Mat'
  nestedVecToMatC :: MatToNestedVecT ns a -> Mat ns a

  -- | convert a 'Mat' to a nested list
  matToNestedListC :: Mat ns a -> ListNST ns a

  -- | convert a nested list to a 'Mat'
  nestedListToMatC :: ListNST ns a -> Either String (Mat ns a)

  -- | convert a 'Mat' to a nested nonempty list
  matToNestedNonEmptyC :: Mat ns a -> NonEmptyNST ns a

  -- | convert a nested nonempty list to a 'Mat'
  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

-- | create a matrix of one dimension higher from rows of a sub matrix
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)

-- | converts mat dimensions to a nested list
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 synonym for the result of nesting a matrix: see 'toND'
type MatToNDT :: Nat -> [Nat] -> Type -> Type
type MatToNDT i ns a = Mat (MatToMatNTA (NatToPeanoT i) ns) (Mat (MatToMatNTB (NatToPeanoT i) ns) a)

-- | create a nested matrix going "i" levels down: noop is not supported ie 4D matrix to a 4D matrix
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)

-- | create a nd matrix using a Nat see 'toND
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

-- | create a nested 1d matrix see 'toND
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

-- | create a nested 2d matrix see 'toND
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

-- | create a nested 3d matrix see 'toND
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

-- | squash a single nested matrix together into one
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)

-- | gets the diagonal elements of a 2d or greater square matrix: the diagonal of a n * n * ns matrix results in a n * ns matrix
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"

-- | take a subset of a matrix using the start and end rows
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

-- todo use FinMat versions of subsetRows and subsetCols ie not just typelevel: need typelevel for the count of rows/cols so no point

-- | take a subset of a matrix using the start and end columns
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

-- | isomorphism for nesting/unnesting a matrix one level deep
_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

-- | specialised version of 'readMat' for 'Vec'
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)

-- | specialised version of 'readMat' for 'Mat2'
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)

-- | read in a matrix as a nested list using default 'ShowOpts'
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))

-- | reader for 'showFin'
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

-- | print a matrix
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

-- | show options for 'Mat'
data ShowOpts = ShowOpts
  { ShowOpts -> Int
smIndent0 :: !Int
  -- ^ first indentation
  , ShowOpts -> Int
smIndentN :: !Int
  -- ^ every subsequent indentation
  , ShowOpts -> Bool
smDivvy :: !Bool
  -- ^ split out into 'Vec' and 'Mat2' otherwise lump everything into 'Mat'
  , ShowOpts -> Bool
smInline1D :: !Bool
  -- ^ inline vector: large impact to output
  , ShowOpts -> Bool
smInlineNewLineEof :: !Bool
  -- ^ newline after each inlined vector: large impact to output
  , ShowOpts -> Bool
smOtherNewLineEof :: !Bool
  -- ^ newline after each except if inlined:large impact to output
  }
  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)

-- | default show options for 'Mat'
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

-- | show a matrix
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 with methods to convert to and from Mat using nested structures
class ShowMatC ns where
  -- | show a matrix
  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
' ' -- 3 == length of "],["
        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

-- | lens into row 1
class Row1 s a | s -> a where
  _r1 :: Lens' s a

-- | lens into row 2
class Row2 s a | s -> a where
  _r2 :: Lens' s a

-- | lens into row 3
class Row3 s a | s -> a where
  _r3 :: Lens' s a

-- | lens into row 4
class Row4 s a | s -> a where
  _r4 :: Lens' s a

-- | lens into row 5
class Row5 s a | s -> a where
  _r5 :: Lens' s a

-- | lens into row 6
class Row6 s a | s -> a where
  _r6 :: Lens' s a

-- | lens into row 7
class Row7 s a | s -> a where
  _r7 :: Lens' s a

-- | lens into row 8
class Row8 s a | s -> a where
  _r8 :: Lens' s a

-- | lens into row 9
class Row9 s a | s -> a where
  _r9 :: Lens' s a

-- | lens into row 10
class Row10 s a | s -> a where
  _r10 :: Lens' s a

-- | lens into the first row in a 2d or greater matrix
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

-- |  lens into the first element in a 1d matrix
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

-- | lens into column 1 of a matrix
_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

-- | lens into column 2 of a matrix
_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

-- | lens into column 3 of a matrix
_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

-- | lens into column 4 of a matrix
_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

-- | lens into column 5 of a matrix
_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

-- | lens into column 6 of a matrix
_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

-- | lens into column 7 of a matrix
_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

-- | lens into column 8 of a matrix
_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

-- | lens into column 9 of a matrix
_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

-- | lens into column 10 of a matrix
_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

-- | marker representing the last value in a 1d matrix ie singleton
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)

-- | marker representing the last row in a nd matrix ie singleton
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

-- | iso and lenses to uncons a matrix
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 -- stay within Vector
                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))

-- | iso and lenses to unsnoc a matrix
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))

-- | construct a new matrix based on a 1d matrix of row witnesses
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)

-- | get a row from a matrix using a concrete index see '_row''
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"

-- | 'Data.List.scanr' for a vector
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)

-- | 'Data.List.scanl'' for a vector
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)

{- | see 'Data.Vector.postscanr''
 concrete version of 'Primus.Fold.postscanr
-}
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

{- | see 'Data.Vector.postscanl''
 concrete version of 'Primus.Fold.postscanl'
-}
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

-- | matrix of dimension 1
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

-- | matrix of dimension 2
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

-- | matrix of dimension 3
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

-- | matrix of dimension 4
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

-- | matrix of dimension 5
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

-- | matrix of dimension 6
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

-- | matrix of dimension 7
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

-- | matrix of dimension 8
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

-- | matrix of dimension 9
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

-- | matrix of dimension 10
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

-- | left rotate a matrix
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

-- | right rotate a matrix
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)

-- | delete column "i" from a list of width "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

-- | get the determinant of a matrix
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)