{-# 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 #-}

{- |
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',
  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,

  -- * 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,

  -- * 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.Extra
import Primus.Fold
import Primus.Lens
import Primus.NonEmpty
import Primus.Num1
import Primus.One
import Primus.Rep
import qualified Primus.TypeLevel as TP (Cons1T, Init1T, Last1T, type (++))
import qualified Text.ParserCombinators.ReadP as P
import qualified Text.ParserCombinators.ReadPrec as PC

-- | definition of a matrix
type Mat :: NonEmpty 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 a b. a -> Mat ns b -> Mat ns a
forall a b. (a -> b) -> Mat ns a -> Mat ns b
forall (ns :: NonEmpty Nat) a b. a -> Mat ns b -> Mat ns a
forall (ns :: NonEmpty Nat) 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 :: NonEmpty Nat) a b. a -> Mat ns b -> Mat ns a
fmap :: (a -> b) -> Mat ns a -> Mat ns b
$cfmap :: forall (ns :: NonEmpty 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 :: NonEmpty Nat). Functor (Mat ns)
forall (ns :: NonEmpty Nat). Foldable (Mat ns)
forall (ns :: NonEmpty Nat) (m :: * -> *) a.
Monad m =>
Mat ns (m a) -> m (Mat ns a)
forall (ns :: NonEmpty Nat) (f :: * -> *) a.
Applicative f =>
Mat ns (f a) -> f (Mat ns a)
forall (ns :: NonEmpty Nat) (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Mat ns a -> m (Mat ns b)
forall (ns :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty Nat) (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Mat ns a -> f (Mat ns b)
$cp2Traversable :: forall (ns :: NonEmpty Nat). Foldable (Mat ns)
$cp1Traversable :: forall (ns :: NonEmpty 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 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 (ns :: NonEmpty Nat) a. Eq a => a -> Mat ns a -> Bool
forall (ns :: NonEmpty Nat) a. Num a => Mat ns a -> a
forall (ns :: NonEmpty Nat) a. Ord a => Mat ns a -> a
forall (ns :: NonEmpty Nat) m. Monoid m => Mat ns m -> m
forall (ns :: NonEmpty Nat) a. Mat ns a -> Bool
forall (ns :: NonEmpty Nat) a. Mat ns a -> Int
forall (ns :: NonEmpty Nat) a. Mat ns a -> [a]
forall (ns :: NonEmpty Nat) a. (a -> a -> a) -> Mat ns a -> a
forall (ns :: NonEmpty Nat) m a.
Monoid m =>
(a -> m) -> Mat ns a -> m
forall (ns :: NonEmpty Nat) b a.
(b -> a -> b) -> b -> Mat ns a -> b
forall (ns :: NonEmpty Nat) 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 :: NonEmpty Nat) a. Num a => Mat ns a -> a
sum :: Mat ns a -> a
$csum :: forall (ns :: NonEmpty Nat) a. Num a => Mat ns a -> a
minimum :: Mat ns a -> a
$cminimum :: forall (ns :: NonEmpty Nat) a. Ord a => Mat ns a -> a
maximum :: Mat ns a -> a
$cmaximum :: forall (ns :: NonEmpty Nat) a. Ord a => Mat ns a -> a
elem :: a -> Mat ns a -> Bool
$celem :: forall (ns :: NonEmpty Nat) a. Eq a => a -> Mat ns a -> Bool
length :: Mat ns a -> Int
$clength :: forall (ns :: NonEmpty Nat) a. Mat ns a -> Int
null :: Mat ns a -> Bool
$cnull :: forall (ns :: NonEmpty Nat) a. Mat ns a -> Bool
toList :: Mat ns a -> [a]
$ctoList :: forall (ns :: NonEmpty Nat) a. Mat ns a -> [a]
foldl1 :: (a -> a -> a) -> Mat ns a -> a
$cfoldl1 :: forall (ns :: NonEmpty Nat) a. (a -> a -> a) -> Mat ns a -> a
foldr1 :: (a -> a -> a) -> Mat ns a -> a
$cfoldr1 :: forall (ns :: NonEmpty Nat) a. (a -> a -> a) -> Mat ns a -> a
foldl' :: (b -> a -> b) -> b -> Mat ns a -> b
$cfoldl' :: forall (ns :: NonEmpty Nat) b a.
(b -> a -> b) -> b -> Mat ns a -> b
foldl :: (b -> a -> b) -> b -> Mat ns a -> b
$cfoldl :: forall (ns :: NonEmpty Nat) b a.
(b -> a -> b) -> b -> Mat ns a -> b
foldr' :: (a -> b -> b) -> b -> Mat ns a -> b
$cfoldr' :: forall (ns :: NonEmpty Nat) a b.
(a -> b -> b) -> b -> Mat ns a -> b
foldr :: (a -> b -> b) -> b -> Mat ns a -> b
$cfoldr :: forall (ns :: NonEmpty Nat) a b.
(a -> b -> b) -> b -> Mat ns a -> b
foldMap' :: (a -> m) -> Mat ns a -> m
$cfoldMap' :: forall (ns :: NonEmpty Nat) m a.
Monoid m =>
(a -> m) -> Mat ns a -> m
foldMap :: (a -> m) -> Mat ns a -> m
$cfoldMap :: forall (ns :: NonEmpty Nat) m a.
Monoid m =>
(a -> m) -> Mat ns a -> m
fold :: Mat ns m -> m
$cfold :: forall (ns :: NonEmpty 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 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
forall (ns :: NonEmpty Nat) a x. Rep (Mat ns a) x -> Mat ns a
forall (ns :: NonEmpty Nat) a x. Mat ns a -> Rep (Mat ns a) x
$cto :: forall (ns :: NonEmpty Nat) a x. Rep (Mat ns a) x -> Mat ns a
$cfrom :: forall (ns :: NonEmpty 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 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
forall (ns :: NonEmpty Nat) a. Rep1 (Mat ns) a -> Mat ns a
forall (ns :: NonEmpty Nat) a. Mat ns a -> Rep1 (Mat ns) a
$cto1 :: forall (ns :: NonEmpty Nat) a. Rep1 (Mat ns) a -> Mat ns a
$cfrom1 :: forall (ns :: NonEmpty 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 a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (ns :: NonEmpty Nat) a. Eq a => Mat ns a -> Mat ns a -> Bool
/= :: Mat ns a -> Mat ns a -> Bool
$c/= :: forall (ns :: NonEmpty Nat) a. Eq a => Mat ns a -> Mat ns a -> Bool
== :: Mat ns a -> Mat ns a -> Bool
$c== :: forall (ns :: NonEmpty 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 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
forall (ns :: NonEmpty Nat) a. Ord a => Eq (Mat ns a)
forall (ns :: NonEmpty Nat) a.
Ord a =>
Mat ns a -> Mat ns a -> Bool
forall (ns :: NonEmpty Nat) a.
Ord a =>
Mat ns a -> Mat ns a -> Ordering
forall (ns :: NonEmpty Nat) a.
Ord a =>
Mat ns a -> Mat ns a -> Mat ns a
min :: Mat ns a -> Mat ns a -> Mat ns a
$cmin :: forall (ns :: NonEmpty 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 :: NonEmpty Nat) a.
Ord a =>
Mat ns a -> Mat ns a -> Mat ns a
>= :: Mat ns a -> Mat ns a -> Bool
$c>= :: forall (ns :: NonEmpty Nat) a.
Ord a =>
Mat ns a -> Mat ns a -> Bool
> :: Mat ns a -> Mat ns a -> Bool
$c> :: forall (ns :: NonEmpty Nat) a.
Ord a =>
Mat ns a -> Mat ns a -> Bool
<= :: Mat ns a -> Mat ns a -> Bool
$c<= :: forall (ns :: NonEmpty Nat) a.
Ord a =>
Mat ns a -> Mat ns a -> Bool
< :: Mat ns a -> Mat ns a -> Bool
$c< :: forall (ns :: NonEmpty Nat) a.
Ord a =>
Mat ns a -> Mat ns a -> Bool
compare :: Mat ns a -> Mat ns a -> Ordering
$ccompare :: forall (ns :: NonEmpty Nat) a.
Ord a =>
Mat ns a -> Mat ns a -> Ordering
$cp1Ord :: forall (ns :: NonEmpty Nat) a. Ord a => Eq (Mat ns a)
Ord)
  deriving anyclass (Mat ns a -> ()
(Mat ns a -> ()) -> NFData (Mat ns a)
forall a. (a -> ()) -> NFData a
forall (ns :: NonEmpty Nat) a. NFData a => Mat ns a -> ()
rnf :: Mat ns a -> ()
$crnf :: forall (ns :: NonEmpty Nat) a. NFData a => Mat ns a -> ()
NFData, (forall a. (a -> ()) -> Mat ns a -> ()) -> NFData1 (Mat ns)
forall a. (a -> ()) -> Mat ns a -> ()
forall (ns :: NonEmpty Nat) a. (a -> ()) -> Mat ns a -> ()
forall (f :: * -> *).
(forall a. (a -> ()) -> f a -> ()) -> NFData1 f
liftRnf :: (a -> ()) -> Mat ns a -> ()
$cliftRnf :: forall (ns :: NonEmpty 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 the 'NN' type family
type MatN :: Nat -> Type -> Type
type MatN n = Mat (NN n)

-- | readonly pattern synonym for a matrix
{-# COMPLETE Mat #-}

pattern Mat ::
  forall (ns :: NonEmpty Nat) a.
  Vector a ->
  NonEmpty Pos ->
  Mat ns a
pattern $mMat :: forall r (ns :: NonEmpty 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 :: NonEmpty Nat) a.
  HasCallStack =>
  Vector a ->
  NonEmpty Pos ->
  Mat ns a
pattern $bMatIU :: Vector a -> NonEmpty Pos -> Mat ns a
$mMatIU :: forall r (ns :: NonEmpty 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 :: NonEmpty Nat) a.
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMat -- dont change this: frp is needed

{-# COMPLETE MatU #-}

-- | bidirectional pattern synonym for validating a matrix before construction with 'NSC' constraint for additional typelevel validation
pattern MatU ::
  forall (ns :: NonEmpty Nat) a.
  (NSC ns, HasCallStack) =>
  Vector a ->
  NonEmpty Pos ->
  Mat ns a
pattern $bMatU :: Vector a -> NonEmpty Pos -> Mat ns a
$mMatU :: forall r (ns :: NonEmpty Nat) a.
(NSC 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 :: NonEmpty Nat) a.
NSC ns =>
Vector a -> NonEmpty Pos -> Either String (Mat ns a)
mkMatC -- dont change this: frp is needed

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, NSC 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 (NSC 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, NSC ns) => IsString (Mat ns c) where
  fromString :: String -> Mat ns c
fromString = String -> Mat ns c
forall (ns :: NonEmpty Nat) a.
(HasCallStack, NSC ns) =>
[a] -> Mat ns a
mat

-- | generate a 'Mat' using a list
mat, mat' :: forall ns a. (HasCallStack, NSC 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 :: NonEmpty Nat) a.
NSC 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 :: NonEmpty Nat) a.
NSC ns =>
Bool -> [a] -> Either String (Mat ns a)
matImpl Bool
True

matImpl :: forall ns a. NSC 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 = NSC ns => NonEmpty Pos
forall (ns :: NonEmpty Nat). NSC 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 :: NonEmpty Nat) a.
(NSC 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. NSC ns => a -> Mat ns a
pureMat :: a -> Mat ns a
pureMat a
a =
  let ns :: NonEmpty Pos
ns = NSC ns => NonEmpty Pos
forall (ns :: NonEmpty Nat). NSC ns => NonEmpty Pos
fromNSP @ns
   in Vector a -> NonEmpty Pos -> Mat ns a
forall (ns :: NonEmpty Nat) a.
(NSC 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. PosT 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 = PosT n => Pos
forall (n :: Nat). PosT n => Pos
fromNP @n
   in Vector a -> NonEmpty Pos -> Mat (n ':| (n1 : ns)) a
forall (ns :: NonEmpty 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 (NSC 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 (NSC 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 NSC ns => Applicative (Mat ns) where
  pure :: a -> Mat ns a
pure = a -> Mat ns a
forall (ns :: NonEmpty Nat) a. NSC 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 :: NonEmpty 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 :: NonEmpty 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 :: NSC 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 :: NonEmpty 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 :: NonEmpty Nat) a b.
Mat ns (a -> b) -> Mat ns a -> Mat ns b
ap2

instance NSC 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 :: NonEmpty Nat) a b.
NSC ns =>
(a -> Mat ns b) -> Mat ns a -> Mat ns b
ap3

instance NSC 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 :: NonEmpty Nat) a b.
NSC ns =>
(a -> Mat ns b) -> Mat ns a -> Mat ns b
ap3

instance NSC 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 'NSC' 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 :: NonEmpty Nat) a b.
Mat ns a -> Mat ns b -> Mat ns (a, b)
zipMat

-- | 'zipWithMat' with an index or use 'Primus.Rep.izipWithR'
izipWith ::
  NSC 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 :: NonEmpty 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 :: NonEmpty Nat). NSC ns => Mat ns (FinMat ns)
finMatMatrix

-- | 'zipWithMatA' with an index or use 'Primus.Rep.izipWithR' if "f" is 'Data.Distributive.Distributive'
izipWithM ::
  (NSC 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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, NSC 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 NSC 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 :: NonEmpty Nat).
(HasCallStack, NSC ns) =>
Int -> NonEmpty Pos -> FinMat ns
FinMatU Int
i (NSC ns => NonEmpty Pos
forall (ns :: NonEmpty Nat). NSC ns => NonEmpty Pos
fromNSP @ns)) a
a)) Int
0

instance NSC 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 NSC 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 NSC 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty Nat) a. Mat ns a -> Vector a
mVec

-- | create a matrix of matrix indices for a given size "ns"
finMatMatrix :: forall ns. NSC ns => Mat ns (FinMat ns)
finMatMatrix :: Mat ns (FinMat ns)
finMatMatrix = Mat ns () -> Mat ns (FinMat ns)
forall (ns :: NonEmpty Nat) x.
NSC 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. NSC 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 NSC 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 :: NonEmpty Nat) a. FinMat ns -> Mat ns a -> a
indexMat

instance NSC 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 :: NonEmpty 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 :: NonEmpty 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 'NSC' constraint to check that "ns" and 'mIndices' match
mkMatC :: forall ns a. NSC 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 = NSC ns => NonEmpty Pos
forall (ns :: NonEmpty Nat). NSC 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 :: NonEmpty 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 using indices
gen' :: forall ns a. NSC 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 :: NonEmpty Nat). FinMat ns -> NonEmpty Pos
finMatToNonEmpty @ns)

-- | generate a matrix using relative position
gen :: forall ns a. NSC 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 :: NonEmpty Nat). FinMat ns -> Int
fmPos)

-- | lens that accesses a value inside a mat given a concrete mat index
ixMat :: forall (ns :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty Nat) (ns :: NonEmpty 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 :: NonEmpty Nat) a. FinMat ns -> Lens' (Mat ns a) a
ixMat (FinMatC is ns => FinMat ns
forall k (is :: k) (ns :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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) =
  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
   in 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 -> Mat ns a
forall (ns :: NonEmpty 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
<> 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 -> Mat ns a
forall a. HasCallStack => String -> a
programmError (String -> Mat ns a) -> String -> Mat ns a
forall a b. (a -> b) -> a -> b
$ String
"updateMat: 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty Nat) a.
(NSC 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 :: NonEmpty 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 :: NonEmpty Nat) a.
(NSC 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 :: NonEmpty 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, PosT n) => [a] -> Vec n a
vec :: [a] -> Vec n a
vec = forall a.
(HasCallStack, NSC (n ':| '[])) =>
[a] -> Mat (n ':| '[]) a
forall (ns :: NonEmpty Nat) a.
(HasCallStack, NSC ns) =>
[a] -> Mat ns a
mat @(n ':| '[])

-- | create a 1d matrix from a list of values with the exact number of elements
vec' :: forall n a. (HasCallStack, PosT n) => [a] -> Vec n a
vec' :: [a] -> Vec n a
vec' = forall a.
(HasCallStack, NSC (n ':| '[])) =>
[a] -> Mat (n ':| '[]) a
forall (ns :: NonEmpty Nat) a.
(HasCallStack, NSC ns) =>
[a] -> Mat ns a
mat' @(n ':| '[])

-- | create a 2d matrix from a list of values
mat2 :: forall n m a. (HasCallStack, PosT n, PosT m) => [a] -> Mat2 n m a
mat2 :: [a] -> Mat2 n m a
mat2 = forall a.
(HasCallStack, NSC (n ':| '[m])) =>
[a] -> Mat (n ':| '[m]) a
forall (ns :: NonEmpty Nat) a.
(HasCallStack, NSC ns) =>
[a] -> Mat ns 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, PosT n, PosT m) => [a] -> Mat2 n m a
mat2' :: [a] -> Mat2 n m a
mat2' = forall a.
(HasCallStack, NSC (n ':| '[m])) =>
[a] -> Mat (n ':| '[m]) a
forall (ns :: NonEmpty Nat) a.
(HasCallStack, NSC ns) =>
[a] -> Mat ns a
mat' @(n ':| m ': '[])

-- | map each column
mapCols ::
  forall n m ns a b.
  (FinMat (m ':| n ': ns) -> Vec (TP.Last1T (n ':| ns)) a -> Vec (TP.Last1T (n ':| ns)) b) ->
  Mat (n ':| m ': ns) a ->
  Mat (n ':| m ': ns) b
mapCols :: (FinMat (m ':| (n : ns))
 -> Vec (Last1T (n ':| ns)) a -> Vec (Last1T (n ':| ns)) b)
-> Mat (n ':| (m : ns)) a -> Mat (n ':| (m : ns)) b
mapCols FinMat (m ':| (n : ns))
-> Vec (Last1T (n ':| ns)) a -> Vec (Last1T (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 (Last1T (m ':| (n : ns))) a
 -> Vec (Last1T (m ':| (n : ns))) b)
-> Mat (m ':| (n : ns)) a -> Mat (m ':| (n : ns)) b
forall (ns :: NonEmpty Nat) a b.
LeafC ns =>
(FinMat ns -> Vec (Last1T ns) a -> Vec (Last1T ns) b)
-> Mat ns a -> Mat ns b
mapLeafSimple FinMat (m ':| (n : ns))
-> Vec (Last1T (n ':| ns)) a -> Vec (Last1T (n ':| ns)) b
FinMat (m ':| (n : ns))
-> Vec (Last1T (m ':| (n : ns))) a
-> Vec (Last1T (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.Last1T (n ':| ns)) a -> (c, Vec (TP.Last1T (n ':| ns)) b)) ->
  c ->
  Mat (n ':| m ': ns) a ->
  (c, Mat (n ':| m ': ns) b)
mapCols' :: (FinMat (m ':| (n : ns))
 -> c
 -> Vec (Last1T (n ':| ns)) a
 -> (c, Vec (Last1T (n ':| ns)) b))
-> c -> Mat (n ':| (m : ns)) a -> (c, Mat (n ':| (m : ns)) b)
mapCols' FinMat (m ':| (n : ns))
-> c -> Vec (Last1T (n ':| ns)) a -> (c, Vec (Last1T (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 (Last1T (m ':| (n : ns))) a
 -> (c, Vec (Last1T (m ':| (n : ns))) b))
-> c -> Mat (m ':| (n : ns)) a -> (c, Mat (m ':| (n : ns)) b)
forall (ns :: NonEmpty Nat) c a b.
LeafC ns =>
(FinMat ns -> c -> Vec (Last1T ns) a -> (c, Vec (Last1T ns) b))
-> c -> Mat ns a -> (c, Mat ns b)
mapLeafSimpleS FinMat (m ':| (n : ns))
-> c -> Vec (Last1T (n ':| ns)) a -> (c, Vec (Last1T (n ':| ns)) b)
FinMat (m ':| (n : ns))
-> c
-> Vec (Last1T (m ':| (n : ns))) a
-> (c, Vec (Last1T (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.Last1T ns) a -> m (Vec (TP.Last1T ns) b)) ->
  Mat ns a ->
  m (Mat ns b)
traverseLeafSimple :: (FinMat ns -> Vec (Last1T ns) a -> m (Vec (Last1T ns) b))
-> Mat ns a -> m (Mat ns b)
traverseLeafSimple FinMat ns -> Vec (Last1T ns) a -> m (Vec (Last1T ns) b)
f = (Mat (Init1T ns) (Vec (Last1T ns) b) -> Mat ns b)
-> m (Mat (Init1T ns) (Vec (Last1T ns) b)) -> m (Mat ns b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Mat (Init1T ns) (Vec (Last1T ns) b) -> Mat ns b
forall (ns :: NonEmpty Nat) a.
LeafC ns =>
Mat (Init1T ns) (Vec (Last1T ns) a) -> Mat ns a
fromLeavesInternalC (m (Mat (Init1T ns) (Vec (Last1T ns) b)) -> m (Mat ns b))
-> (Mat ns a -> m (Mat (Init1T ns) (Vec (Last1T ns) b)))
-> Mat ns a
-> m (Mat ns b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (Last1T ns) a -> m (Vec (Last1T ns) b))
-> Mat ns a -> m (Mat (Init1T ns) (Vec (Last1T ns) b))
forall (ns :: NonEmpty Nat) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (Last1T ns) a -> m b)
-> Mat ns a -> m (Mat (Init1T ns) b)
traverseLeafC FinMat ns -> Vec (Last1T ns) a -> m (Vec (Last1T ns) b)
f

-- | map over a nested leaf matrix only allowing changes to "a"
mapLeafSimple ::
  LeafC ns =>
  (FinMat ns -> Vec (TP.Last1T ns) a -> Vec (TP.Last1T ns) b) ->
  Mat ns a ->
  Mat ns b
mapLeafSimple :: (FinMat ns -> Vec (Last1T ns) a -> Vec (Last1T ns) b)
-> Mat ns a -> Mat ns b
mapLeafSimple FinMat ns -> Vec (Last1T ns) a -> Vec (Last1T ns) b
f = Mat (Init1T ns) (Vec (Last1T ns) b) -> Mat ns b
forall (ns :: NonEmpty Nat) a.
LeafC ns =>
Mat (Init1T ns) (Vec (Last1T ns) a) -> Mat ns a
fromLeavesInternalC (Mat (Init1T ns) (Vec (Last1T ns) b) -> Mat ns b)
-> (Mat ns a -> Mat (Init1T ns) (Vec (Last1T ns) b))
-> Mat ns a
-> Mat ns b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Mat (Init1T ns) (Vec (Last1T ns) b))
-> Mat (Init1T ns) (Vec (Last1T ns) b)
forall a. Identity a -> a
runIdentity (Identity (Mat (Init1T ns) (Vec (Last1T ns) b))
 -> Mat (Init1T ns) (Vec (Last1T ns) b))
-> (Mat ns a -> Identity (Mat (Init1T ns) (Vec (Last1T ns) b)))
-> Mat ns a
-> Mat (Init1T ns) (Vec (Last1T ns) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (Last1T ns) a -> Identity (Vec (Last1T ns) b))
-> Mat ns a -> Identity (Mat (Init1T ns) (Vec (Last1T ns) b))
forall (ns :: NonEmpty Nat) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (Last1T ns) a -> m b)
-> Mat ns a -> m (Mat (Init1T ns) b)
traverseLeafC (Vec (Last1T ns) b -> Identity (Vec (Last1T ns) b)
forall a. a -> Identity a
Identity (Vec (Last1T ns) b -> Identity (Vec (Last1T ns) b))
-> (FinMat ns -> Vec (Last1T ns) a -> Vec (Last1T ns) b)
-> FinMat ns
-> Vec (Last1T ns) a
-> Identity (Vec (Last1T ns) b)
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ FinMat ns -> Vec (Last1T ns) a -> Vec (Last1T ns) b
f)

-- | foldmap over a nested leaf matrix
foldMapLeaf
  , foldMapLeafR ::
    (Monoid z, LeafC ns) =>
    (FinMat ns -> Vec (TP.Last1T ns) a -> z) ->
    Mat ns a ->
    z
foldMapLeaf :: (FinMat ns -> Vec (Last1T ns) a -> z) -> Mat ns a -> z
foldMapLeaf FinMat ns -> Vec (Last1T ns) a -> z
f = Const z (Mat (Init1T ns) Any) -> z
forall a k (b :: k). Const a b -> a
getConst (Const z (Mat (Init1T ns) Any) -> z)
-> (Mat ns a -> Const z (Mat (Init1T ns) Any)) -> Mat ns a -> z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (Last1T ns) a -> Const z Any)
-> Mat ns a -> Const z (Mat (Init1T ns) Any)
forall (ns :: NonEmpty Nat) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (Last1T ns) a -> m b)
-> Mat ns a -> m (Mat (Init1T ns) b)
traverseLeafC (z -> Const z Any
forall k a (b :: k). a -> Const a b
Const (z -> Const z Any)
-> (FinMat ns -> Vec (Last1T ns) a -> z)
-> FinMat ns
-> Vec (Last1T ns) a
-> Const z Any
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ FinMat ns -> Vec (Last1T ns) a -> z
f)
foldMapLeafR :: (FinMat ns -> Vec (Last1T ns) a -> z) -> Mat ns a -> z
foldMapLeafR FinMat ns -> Vec (Last1T ns) a -> z
f = Const z (Mat (Init1T ns) Any) -> z
forall a k (b :: k). Const a b -> a
getConst (Const z (Mat (Init1T ns) Any) -> z)
-> (Mat ns a -> Const z (Mat (Init1T ns) Any)) -> Mat ns a -> z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Backwards (Const z) (Mat (Init1T ns) Any)
-> Const z (Mat (Init1T ns) Any)
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards (Const z) (Mat (Init1T ns) Any)
 -> Const z (Mat (Init1T ns) Any))
-> (Mat ns a -> Backwards (Const z) (Mat (Init1T ns) Any))
-> Mat ns a
-> Const z (Mat (Init1T ns) Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (Last1T ns) a -> Backwards (Const z) Any)
-> Mat ns a -> Backwards (Const z) (Mat (Init1T ns) Any)
forall (ns :: NonEmpty Nat) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (Last1T ns) a -> m b)
-> Mat ns a -> m (Mat (Init1T 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 (Last1T ns) a -> z)
-> FinMat ns
-> Vec (Last1T ns) a
-> Backwards (Const z) Any
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ FinMat ns -> Vec (Last1T ns) a -> z
f)

-- | map over a nested leaf matrix
mapLeaf ::
  LeafC ns =>
  (FinMat ns -> Vec (TP.Last1T ns) a -> b) ->
  Mat ns a ->
  Mat (TP.Init1T ns) b
mapLeaf :: (FinMat ns -> Vec (Last1T ns) a -> b)
-> Mat ns a -> Mat (Init1T ns) b
mapLeaf FinMat ns -> Vec (Last1T ns) a -> b
f = Identity (Mat (Init1T ns) b) -> Mat (Init1T ns) b
forall a. Identity a -> a
runIdentity (Identity (Mat (Init1T ns) b) -> Mat (Init1T ns) b)
-> (Mat ns a -> Identity (Mat (Init1T ns) b))
-> Mat ns a
-> Mat (Init1T ns) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (Last1T ns) a -> Identity b)
-> Mat ns a -> Identity (Mat (Init1T ns) b)
forall (ns :: NonEmpty Nat) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (Last1T ns) a -> m b)
-> Mat ns a -> m (Mat (Init1T ns) b)
traverseLeafC (b -> Identity b
forall a. a -> Identity a
Identity (b -> Identity b)
-> (FinMat ns -> Vec (Last1T ns) a -> b)
-> FinMat ns
-> Vec (Last1T ns) a
-> Identity b
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ FinMat ns -> Vec (Last1T ns) a -> b
f)

-- | map over a nested leaf matrix with state
mapLeafS ::
  LeafC ns =>
  (FinMat ns -> c -> Vec (TP.Last1T ns) a -> (c, b)) ->
  c ->
  Mat ns a ->
  (c, Mat (TP.Init1T ns) b)
mapLeafS :: (FinMat ns -> c -> Vec (Last1T ns) a -> (c, b))
-> c -> Mat ns a -> (c, Mat (Init1T ns) b)
mapLeafS FinMat ns -> c -> Vec (Last1T ns) a -> (c, b)
f c
c0 = (Mat (Init1T ns) b, c) -> (c, Mat (Init1T ns) b)
forall a b. (a, b) -> (b, a)
swap ((Mat (Init1T ns) b, c) -> (c, Mat (Init1T ns) b))
-> (Mat ns a -> (Mat (Init1T ns) b, c))
-> Mat ns a
-> (c, Mat (Init1T ns) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State c (Mat (Init1T ns) b) -> c -> (Mat (Init1T ns) b, c))
-> c -> State c (Mat (Init1T ns) b) -> (Mat (Init1T ns) b, c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State c (Mat (Init1T ns) b) -> c -> (Mat (Init1T ns) b, c)
forall s a. State s a -> s -> (a, s)
S.runState c
c0 (State c (Mat (Init1T ns) b) -> (Mat (Init1T ns) b, c))
-> (Mat ns a -> State c (Mat (Init1T ns) b))
-> Mat ns a
-> (Mat (Init1T ns) b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns -> Vec (Last1T ns) a -> StateT c Identity b)
-> Mat ns a -> State c (Mat (Init1T ns) b)
forall (ns :: NonEmpty Nat) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (Last1T ns) a -> m b)
-> Mat ns a -> m (Mat (Init1T ns) b)
traverseLeafC (\FinMat ns
i Vec (Last1T 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 (Last1T ns) a -> (c, b)
f FinMat ns
i c
c Vec (Last1T 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.Last1T ns) a -> (c, Vec (TP.Last1T ns) b)) ->
  c ->
  Mat ns a ->
  (c, Mat ns b)
mapLeafSimpleS :: (FinMat ns -> c -> Vec (Last1T ns) a -> (c, Vec (Last1T ns) b))
-> c -> Mat ns a -> (c, Mat ns b)
mapLeafSimpleS FinMat ns -> c -> Vec (Last1T ns) a -> (c, Vec (Last1T ns) b)
f c
c0 =
  (Mat (Init1T ns) (Vec (Last1T ns) b) -> Mat ns b)
-> (c, Mat (Init1T ns) (Vec (Last1T ns) b)) -> (c, Mat ns b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Mat (Init1T ns) (Vec (Last1T ns) b) -> Mat ns b
forall (ns :: NonEmpty Nat) a.
LeafC ns =>
Mat (Init1T ns) (Vec (Last1T ns) a) -> Mat ns a
fromLeavesInternalC ((c, Mat (Init1T ns) (Vec (Last1T ns) b)) -> (c, Mat ns b))
-> (Mat ns a -> (c, Mat (Init1T ns) (Vec (Last1T ns) b)))
-> Mat ns a
-> (c, Mat ns b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mat (Init1T ns) (Vec (Last1T ns) b), c)
-> (c, Mat (Init1T ns) (Vec (Last1T ns) b))
forall a b. (a, b) -> (b, a)
swap ((Mat (Init1T ns) (Vec (Last1T ns) b), c)
 -> (c, Mat (Init1T ns) (Vec (Last1T ns) b)))
-> (Mat ns a -> (Mat (Init1T ns) (Vec (Last1T ns) b), c))
-> Mat ns a
-> (c, Mat (Init1T ns) (Vec (Last1T ns) b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State c (Mat (Init1T ns) (Vec (Last1T ns) b))
 -> c -> (Mat (Init1T ns) (Vec (Last1T ns) b), c))
-> c
-> State c (Mat (Init1T ns) (Vec (Last1T ns) b))
-> (Mat (Init1T ns) (Vec (Last1T ns) b), c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State c (Mat (Init1T ns) (Vec (Last1T ns) b))
-> c -> (Mat (Init1T ns) (Vec (Last1T ns) b), c)
forall s a. State s a -> s -> (a, s)
S.runState c
c0 (State c (Mat (Init1T ns) (Vec (Last1T ns) b))
 -> (Mat (Init1T ns) (Vec (Last1T ns) b), c))
-> (Mat ns a -> State c (Mat (Init1T ns) (Vec (Last1T ns) b)))
-> Mat ns a
-> (Mat (Init1T ns) (Vec (Last1T ns) b), c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FinMat ns
 -> Vec (Last1T ns) a -> StateT c Identity (Vec (Last1T ns) b))
-> Mat ns a -> State c (Mat (Init1T ns) (Vec (Last1T ns) b))
forall (ns :: NonEmpty Nat) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (Last1T ns) a -> m b)
-> Mat ns a -> m (Mat (Init1T ns) b)
traverseLeafC (\FinMat ns
i Vec (Last1T ns) a
a -> (c -> (Vec (Last1T ns) b, c))
-> StateT c Identity (Vec (Last1T ns) b)
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
S.state ((c -> (Vec (Last1T ns) b, c))
 -> StateT c Identity (Vec (Last1T ns) b))
-> (c -> (Vec (Last1T ns) b, c))
-> StateT c Identity (Vec (Last1T ns) b)
forall a b. (a -> b) -> a -> b
$ \c
c -> (c, Vec (Last1T ns) b) -> (Vec (Last1T ns) b, c)
forall a b. (a, b) -> (b, a)
swap (FinMat ns -> c -> Vec (Last1T ns) a -> (c, Vec (Last1T ns) b)
f FinMat ns
i c
c Vec (Last1T ns) a
a))

-- | fold over a nested leaf matrix
foldLeaf ::
  LeafC ns =>
  (FinMat ns -> c -> Vec (TP.Last1T ns) a -> c) ->
  c ->
  Mat ns a ->
  c
foldLeaf :: (FinMat ns -> c -> Vec (Last1T ns) a -> c) -> c -> Mat ns a -> c
foldLeaf FinMat ns -> c -> Vec (Last1T ns) a -> c
f = (c, Mat (Init1T ns) ()) -> c
forall a b. (a, b) -> a
fst ((c, Mat (Init1T ns) ()) -> c)
-> (c -> Mat ns a -> (c, Mat (Init1T ns) ())) -> c -> Mat ns a -> c
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.@ (FinMat ns -> c -> Vec (Last1T ns) a -> (c, ()))
-> c -> Mat ns a -> (c, Mat (Init1T ns) ())
forall (ns :: NonEmpty Nat) c a b.
LeafC ns =>
(FinMat ns -> c -> Vec (Last1T ns) a -> (c, b))
-> c -> Mat ns a -> (c, Mat (Init1T ns) b)
mapLeafS FinMat ns -> c -> Vec (Last1T ns) a -> (c, ())
g
 where
  g :: FinMat ns -> c -> Vec (Last1T ns) a -> (c, ())
g FinMat ns
fn c
c Vec (Last1T ns) a
m = (FinMat ns -> c -> Vec (Last1T ns) a -> c
f FinMat ns
fn c
c Vec (Last1T ns) a
m, ())

-- | convert to nested matrix with 1d leaves
toLeaves ::
  LeafC ns =>
  Mat ns a ->
  Mat (TP.Init1T ns) (Vec (TP.Last1T ns) a)
toLeaves :: Mat ns a -> Mat (Init1T ns) (Vec (Last1T ns) a)
toLeaves = (FinMat ns -> Vec (Last1T ns) a -> Vec (Last1T ns) a)
-> Mat ns a -> Mat (Init1T ns) (Vec (Last1T ns) a)
forall (ns :: NonEmpty Nat) a b.
LeafC ns =>
(FinMat ns -> Vec (Last1T ns) a -> b)
-> Mat ns a -> Mat (Init1T ns) b
mapLeaf ((Vec (Last1T ns) a -> Vec (Last1T ns) a)
-> FinMat ns -> Vec (Last1T ns) a -> Vec (Last1T ns) a
forall a b. a -> b -> a
const Vec (Last1T ns) a -> Vec (Last1T 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.Last1T ns) a -> m b) ->
    Mat ns a ->
    m (Mat (TP.Init1T ns) b)
  fromLeavesInternalC ::
    Mat (TP.Init1T ns) (Vec (TP.Last1T ns) a) ->
    Mat ns a

instance
  GL.TypeError ( 'GL.Text "LeafC: rows for 1D are not supported") =>
  LeafC (n ':| '[])
  where
  traverseLeafC :: (FinMat (n ':| '[]) -> Vec (Last1T (n ':| '[])) a -> m b)
-> Mat (n ':| '[]) a -> m (Mat (Init1T (n ':| '[])) b)
traverseLeafC = String
-> (FinMat (n ':| '[]) -> Mat (n ':| '[]) a -> m b)
-> Mat (n ':| '[]) a
-> m (Mat (n ':| (TypeError ...)) b)
forall a. HasCallStack => String -> a
compileError String
"LeafC:traverseLeafC"
  fromLeavesInternalC :: Mat (Init1T (n ':| '[])) (Vec (Last1T (n ':| '[])) a)
-> Mat (n ':| '[]) a
fromLeavesInternalC = String
-> Mat (n ':| (TypeError ...)) (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 (Last1T (n ':| (m : ns))) a -> m b)
-> Mat (n ':| (m : ns)) a -> m (Mat (Init1T (n ':| (m : ns))) b)
traverseLeafC FinMat (n ':| (m : ns)) -> Vec (Last1T (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 (Last1T (m ':| ns) ':| '[]) a -> StateT Int Identity (m b)
g Mat (Last1T (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 (Last1T (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 :: NonEmpty 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 (Last1T (n ':| (m : ns))) a
Mat (Last1T (m ':| ns) ':| '[]) a
x, Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Pos -> Int
unP Pos
nx)
            zs :: NonEmpty (Mat (Last1T (m ':| ns) ':| '[]) a)
zs = Either String (NonEmpty (Mat (Last1T (m ':| ns) ':| '[]) a))
-> NonEmpty (Mat (Last1T (m ':| ns) ':| '[]) a)
forall a. HasCallStack => Either String a -> a
frp (Either String (NonEmpty (Mat (Last1T (m ':| ns) ':| '[]) a))
 -> NonEmpty (Mat (Last1T (m ':| ns) ':| '[]) a))
-> Either String (NonEmpty (Mat (Last1T (m ':| ns) ':| '[]) a))
-> NonEmpty (Mat (Last1T (m ':| ns) ':| '[]) a)
forall a b. (a -> b) -> a -> b
$ NonEmpty ()
-> NonEmpty Pos
-> Mat (n ':| (m : ns)) a
-> Either String (NonEmpty (Mat (Last1T (m ':| ns) ':| '[]) a))
forall (ns :: NonEmpty Nat) (t :: * -> *) (x :: NonEmpty 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 (Last1T (m ':| ns) ':| '[]) a -> StateT Int Identity (m b))
-> NonEmpty (Mat (Last1T (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 (Last1T (m ':| ns) ':| '[]) a -> StateT Int Identity (m b)
g NonEmpty (Mat (Last1T (m ':| ns) ':| '[]) a)
zs
         in (\NonEmpty b
zz -> Vector b -> NonEmpty Pos -> Mat (n ':| InitT (m : ns)) b
forall (ns :: NonEmpty 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 (Init1T (n ':| (m : ns))) (Vec (Last1T (n ':| (m : ns))) a)
-> Mat (n ':| (m : ns)) a
fromLeavesInternalC = Mat (n ':| (InitT (m : ns) ++ '[Last1T (m ':| ns)])) a
-> Mat (n ':| (m : ns)) a
coerce (Mat (n ':| (InitT (m : ns) ++ '[Last1T (m ':| ns)])) a
 -> Mat (n ':| (m : ns)) a)
-> (Mat (n ':| InitT (m : ns)) (Mat (Last1T (m ':| ns) ':| '[]) a)
    -> Mat (n ':| (InitT (m : ns) ++ '[Last1T (m ':| ns)])) a)
-> Mat (n ':| InitT (m : ns)) (Mat (Last1T (m ':| ns) ':| '[]) a)
-> Mat (n ':| (m : ns)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mat (n ':| InitT (m : ns)) (Mat (Last1T (m ':| ns) ':| '[]) a)
-> Mat (n ':| (InitT (m : ns) ++ '[Last1T (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. NSC ns => NonEmpty (FinMat ns)
finMatRows :: NonEmpty (FinMat ns)
finMatRows =
  let ([Pos]
xs, Pos
_) = NonEmpty Pos -> ([Pos], Pos)
forall a. NonEmpty a -> ([a], a)
unsnoc1 (NSC ns => NonEmpty Pos
forall (ns :: NonEmpty Nat). NSC 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 :: NonEmpty Nat).
NSC 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 (Last1T ns) a -> Vec (Last1T ns) a)
-> Mat ns a -> Mat ns a
forall (ns :: NonEmpty Nat) a b.
LeafC ns =>
(FinMat ns -> Vec (Last1T ns) a -> Vec (Last1T ns) b)
-> Mat ns a -> Mat ns b
mapLeafSimple (\FinMat ns
_ (MatUnsafe Vector a
v NonEmpty Pos
ps) -> Vector a -> NonEmpty Pos -> Vec (Last1T ns) a
forall (ns :: NonEmpty 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 :: NonEmpty 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 (Last1T ns) a -> Either String (Vec (Last1T ns) b))
-> Mat ns a -> Either String (Mat ns b)
forall (ns :: NonEmpty Nat) (m :: * -> *) a b.
(LeafC ns, Applicative m) =>
(FinMat ns -> Vec (Last1T ns) a -> m (Vec (Last1T ns) b))
-> Mat ns a -> m (Mat ns b)
traverseLeafSimple ((Vec (Last1T ns) a -> Either String (Vec (Last1T ns) b))
-> FinMat ns
-> Vec (Last1T ns) a
-> Either String (Vec (Last1T ns) b)
forall a b. a -> b -> a
const ((NonEmpty a -> NonEmpty b)
-> Vec (Last1T ns) a -> Either String (Vec (Last1T 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 (Reverse1T ns) a
reverseDim :: Mat ns a -> Mat (Reverse1T ns) a
reverseDim (Mat Vector a
v NonEmpty Pos
ps) = Vector a -> NonEmpty Pos -> Mat (Reverse1T ns) a
forall (ns :: NonEmpty 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. (NSC ms, Product1T ns ~ Product1T 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 :: NonEmpty Nat) a.
(NSC ns, HasCallStack) =>
Vector a -> NonEmpty Pos -> Mat ns a
MatU Vector a
v (NSC ms => NonEmpty Pos
forall (ns :: NonEmpty Nat). NSC 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' :: NonEmpty Nat -> NonEmpty Nat -> Type -> Type
type family SliceT' ns' ns a where
  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 @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' @(NS '[1]) @(NS '[7]) (FinMat 0 (_7P :| [])) (mm @7)
-}
type SliceC' :: NonEmpty Nat -> NonEmpty 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 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': 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 =
    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
     in 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 -> Mat (n ':| '[]) a
forall (ns :: NonEmpty 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
<> 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 -> Mat (n ':| '[]) a
forall a. HasCallStack => String -> a
programmError (String -> Mat (n ':| '[]) a) -> String -> Mat (n ':| '[]) a
forall a b. (a -> b) -> a -> b
$ String
"sliceUpdateC': 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)) =
    case [Pos]
ps of
      Pos
m : [Pos]
ns ->
        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
         in Vector a -> NonEmpty Pos -> Mat (m ':| ns) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (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 -> Mat (m ':| ns) a
forall a. HasCallStack => String -> a
programmError (String -> Mat (m ':| ns) a) -> String -> Mat (m ':| ns) 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
": 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 =
    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
     in Vector a -> NonEmpty Pos -> Mat (n ':| (m : ns)) a
forall (ns :: NonEmpty 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 :: NonEmpty 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]
_)) =
    let Pos
x :| [Pos]
xs = FinMat (n ':| (n1' : ns')) -> NonEmpty Pos
forall (ns :: NonEmpty 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
     in case ([Pos]
xs, [Pos]
n1ns') of
          (Pos
x1 : [Pos]
x1s, Pos
n1 : [Pos]
ns') ->
            let fn1 :: FinMat (n1' ':| ns')
fn1 = Either String (FinMat (n1' ':| ns')) -> FinMat (n1' ':| ns')
forall a. HasCallStack => Either String a -> a
frp (Either String (FinMat (n1' ':| ns')) -> FinMat (n1' ':| ns'))
-> Either String (FinMat (n1' ':| ns')) -> FinMat (n1' ':| ns')
forall a b. (a -> b) -> a -> b
$ NonEmpty Pos
-> NonEmpty Pos -> Either String (FinMat (n1' ':| ns'))
forall (ns :: NonEmpty 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')
             in FinMat (n1' ':| ns')
-> Mat (n1 ':| ns) a -> SliceT' (n1' ':| ns') (n1 ':| ns) a
forall (ns' :: NonEmpty Nat) (ns :: NonEmpty 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' :: NonEmpty Nat) (ns :: NonEmpty Nat) a.
SliceC' ns' ns =>
FinMat ns' -> Mat ns a -> SliceT' ns' ns a
sliceC' @(n' ':| '[]) @(n ':| n1 ': ns) (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 :: NonEmpty Nat).
Int -> NonEmpty Pos -> Either String (FinMat ns)
mkFinMat Int
i (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [])) Mat (n ':| (n1 : ns)) a
Mat (n' ':| (n1 : ns)) a
w)
          ([], [Pos]
_) -> String -> SliceT' (n1' ':| ns') (n1 ':| ns) a
forall a. HasCallStack => String -> a
programmError String
"sliceC': missing ns' indices"
          ([Pos]
_, []) -> String -> SliceT' (n1' ':| ns') (n1 ':| ns) a
forall a. HasCallStack => String -> a
programmError String
"sliceC': 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 =
    -- 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 :: NonEmpty Nat). FinMat ns -> NonEmpty Pos
finMatToNonEmpty FinMat (n ':| (n1' : ns'))
fm
        i :: Int
i = Pos -> Int
unP Pos
x
     in case ([Pos]
ps0, [Pos]
xs, [Pos]
n1ns') of
          (Pos
_ : [Pos]
ns, Pos
x1 : [Pos]
x1s, Pos
n1 : [Pos]
ns') ->
            let fn1 :: FinMat (n1' ':| ns')
fn1 = Either String (FinMat (n1' ':| ns')) -> FinMat (n1' ':| ns')
forall a. HasCallStack => Either String a -> a
frp (Either String (FinMat (n1' ':| ns')) -> FinMat (n1' ':| ns'))
-> Either String (FinMat (n1' ':| ns')) -> FinMat (n1' ':| ns')
forall a b. (a -> b) -> a -> b
$ NonEmpty Pos
-> NonEmpty Pos -> Either String (FinMat (n1' ':| ns'))
forall (ns :: NonEmpty 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')
                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
                m1 :: Mat (n1 ':| ns) a
m1 = Vector a -> NonEmpty Pos -> Mat (n1 ':| ns) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (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
                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' :: NonEmpty Nat) (ns :: NonEmpty 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
             in Vector a -> NonEmpty Pos -> Mat (n' ':| (n1 : ns)) a
forall (ns :: NonEmpty 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 (n1 ':| ns) a -> Vector a
forall (ns :: NonEmpty 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 -> Mat (n' ':| (n1 : ns)) a
forall a. HasCallStack => String -> a
programmError String
"sliceUpdateC': missing matrix indices"
          ([Pos]
_, [], [Pos]
_) -> String -> Mat (n' ':| (n1 : ns)) a
forall a. HasCallStack => String -> a
programmError String
"sliceUpdateC': missing ns' indices"
          ([Pos]
_, [Pos]
_, []) -> String -> Mat (n' ':| (n1 : ns)) a
forall a. HasCallStack => String -> a
programmError String
"sliceUpdateC': missing finmat indices"

instance (GL.TypeError ( 'GL.Text "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 :: NonEmpty Nat -> NonEmpty Nat -> NonEmpty Nat
type family SliceToFinMatT is ns where
  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) = TP.Cons1T n (SliceToFinMatT (i1 ':| is) (n1 ':| ns))

-- | converts a typelevel slice to a concrete 'FinMat'
sliceToFinMat ::
  forall is ns.
  (NSC (SliceToFinMatT is ns), NSC is, NSC ns) =>
  FinMat (SliceToFinMatT is ns)
sliceToFinMat :: FinMat (SliceToFinMatT is ns)
sliceToFinMat =
  let is :: NonEmpty Pos
is = NSC is => NonEmpty Pos
forall (ns :: NonEmpty Nat). NSC ns => NonEmpty Pos
fromNSP @is
      ns :: NonEmpty Pos
ns = NSC ns => NonEmpty Pos
forall (ns :: NonEmpty Nat). NSC 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 :: NonEmpty Nat).
NSC 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, NSC is, NSC ns, NSC 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' :: NonEmpty Nat) (ns :: NonEmpty Nat) a.
SliceC' ns' ns =>
FinMat ns' -> Mat ns a -> SliceT' ns' ns a
sliceC' ((NSC (SliceToFinMatT is ns), NSC is, NSC ns) =>
FinMat (SliceToFinMatT is ns)
forall (is :: NonEmpty Nat) (ns :: NonEmpty Nat).
(NSC (SliceToFinMatT is ns), NSC is, NSC 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, NSC is, NSC ns, NSC 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' :: NonEmpty Nat) (ns :: NonEmpty Nat) a.
SliceC' ns' ns =>
FinMat ns' -> Mat ns a -> SliceT' ns' ns a -> Mat ns a
sliceUpdateC' ((NSC (SliceToFinMatT is ns), NSC is, NSC ns) =>
FinMat (SliceToFinMatT is ns)
forall (is :: NonEmpty Nat) (ns :: NonEmpty Nat).
(NSC (SliceToFinMatT is ns), NSC is, NSC ns) =>
FinMat (SliceToFinMatT is ns)
sliceToFinMat @is @ns)

-- | describes the resulting type of taking a slice from the mat
type SliceT :: NonEmpty Nat -> NonEmpty Nat -> Type -> Type
type family SliceT is ns a where
  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 :: NonEmpty Nat -> NonEmpty 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 FinT 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 = PosT i => Int
forall (n :: Nat). PosT 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 =
    let i :: Int
i = PosT i => Int
forall (n :: Nat). PosT 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
     in 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 -> Mat (n ':| '[]) a
forall (ns :: NonEmpty 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
<> 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 -> Mat (n ':| '[]) a
forall a. HasCallStack => String -> a
programmError (String -> Mat (n ':| '[]) a) -> String -> Mat (n ':| '[]) a
forall a b. (a -> b) -> a -> b
$ String
"sliceUpdateC: 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 FinT 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)) =
    case [Pos]
ps of
      Pos
m : [Pos]
ns ->
        let i :: Int
i = PosT i => Int
forall (n :: Nat). PosT 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
         in Vector a -> NonEmpty Pos -> Mat (m ':| ns) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (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 -> Mat (m ':| ns) a
forall a. HasCallStack => String -> a
programmError (String -> Mat (m ':| ns) a) -> String -> Mat (m ':| ns) a
forall a b. (a -> b) -> a -> b
$ String
"sliceUpdateC: index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (PosT i => Int
forall (n :: Nat). PosT 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 = PosT i => Int
forall (n :: Nat). PosT 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 :: NonEmpty 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 :: NonEmpty 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
  (FinT 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 :: NonEmpty Nat) (ns :: NonEmpty 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 :: NonEmpty Nat) (ns :: NonEmpty 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 =
    -- 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 ->
        let i :: Int
i = PosT i => Int
forall (n :: Nat). PosT 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
            m1 :: Mat (n1 ':| ns) a
m1 = Vector a -> NonEmpty Pos -> Mat (n1 ':| ns) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (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
            mx :: Mat (n1 ':| ns) a
mx = Mat (n1 ':| ns) a
-> SliceT (i1 ':| is) (n1 ':| ns) a -> Mat (n1 ':| ns) a
forall (is :: NonEmpty Nat) (ns :: NonEmpty 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
         in Vector a -> NonEmpty Pos -> Mat (n ':| (n1 : ns)) a
forall (ns :: NonEmpty 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 (n1 ':| ns) a -> Vector a
forall (ns :: NonEmpty 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 -> Mat (n ':| (n1 : ns)) a
forall a. HasCallStack => String -> a
programmError (String -> Mat (n ':| (n1 : ns)) a)
-> String -> Mat (n ':| (n1 : ns)) a
forall a b. (a -> b) -> a -> b
$ String
"sliceUpdateC: index " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (PosT i => Int
forall (n :: Nat). PosT 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 :: NonEmpty Nat) a.
  (SliceC (i ':| '[]) ns) =>
  Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
_row :: Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
_row = forall (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (is :: NonEmpty Nat) (ns :: NonEmpty Nat) a.
SliceC is ns =>
Lens' (Mat ns a) (SliceT is ns a)
ixSlice @(i ':| '[])

-- | a lens for acccessing a column
_col ::
  forall (i :: Nat) n m ns a.
  (FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty 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 :: NonEmpty Nat) (ns :: NonEmpty 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 :: NonEmpty Nat) a.
SliceC is ns =>
Mat ns a -> SliceT is ns a
forall (is :: NonEmpty Nat) (ns :: NonEmpty Nat) a.
SliceC is ns =>
Mat ns a -> SliceT is ns a
sliceC @is)
    (forall (ns :: NonEmpty Nat) a.
SliceC is ns =>
Mat ns a -> SliceT is ns a -> Mat ns a
forall (is :: NonEmpty Nat) (ns :: NonEmpty 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 :: NonEmpty 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' :: NonEmpty Nat) (ns :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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' :: NonEmpty Nat) (ns :: NonEmpty 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' :: NonEmpty Nat) (ns :: NonEmpty 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' :: NonEmpty Nat) (ns :: NonEmpty 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)) =
  case [Pos]
ps of
    Pos
m : [Pos]
ns ->
      let zs :: [Mat (m ':| ns) a]
zs = Either String [Mat (m ':| ns) a] -> [Mat (m ':| ns) a]
forall a. HasCallStack => Either String a -> a
frp (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
$ [()]
-> NonEmpty Pos
-> Mat (n ':| (m : ns)) a
-> Either String [Mat (m ':| ns) a]
forall (ns :: NonEmpty Nat) (t :: * -> *) (x :: NonEmpty 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
       in Vector (Mat (m ':| ns) a)
-> NonEmpty Pos -> Vec n (Mat (m ':| ns) a)
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ([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 -> Vec n (Mat (m ':| ns) a)
forall a. HasCallStack => String -> a
programmError String
"rows: 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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)) =
  case ([Pos]
ps1, [Pos]
ps2) of
    ([Pos
m], [Pos
p]) ->
      let z1 :: NonEmpty (NonEmpty a)
z1 = Either String (NonEmpty (NonEmpty a)) -> NonEmpty (NonEmpty a)
forall a. HasCallStack => Either String a -> a
frp (Either String (NonEmpty (NonEmpty a)) -> NonEmpty (NonEmpty a))
-> Either String (NonEmpty (NonEmpty a)) -> NonEmpty (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ 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
          z2 :: 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))
-> NonEmpty (NonEmpty b) -> NonEmpty (NonEmpty b)
forall a b. (a -> b) -> a -> b
$ Either String (NonEmpty (NonEmpty b)) -> NonEmpty (NonEmpty b)
forall a. HasCallStack => Either String a -> a
frp (Either String (NonEmpty (NonEmpty b)) -> NonEmpty (NonEmpty b))
-> Either String (NonEmpty (NonEmpty b)) -> NonEmpty (NonEmpty b)
forall a b. (a -> b) -> a -> 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
          w :: NonEmpty d
w = (NonEmpty a -> NonEmpty b -> d)
-> NonEmpty (NonEmpty a) -> NonEmpty (NonEmpty b) -> NonEmpty d
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((NonEmpty c -> d
g (NonEmpty c -> d)
-> (Either String (NonEmpty c) -> NonEmpty c)
-> Either String (NonEmpty c)
-> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String (NonEmpty c) -> NonEmpty c
forall a. HasCallStack => Either String a -> a
frp) (Either String (NonEmpty c) -> d)
-> (NonEmpty a -> NonEmpty b -> Either String (NonEmpty c))
-> NonEmpty a
-> NonEmpty b
-> 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
       in Vector d -> NonEmpty Pos -> Mat2 n p d
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ([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 -> Mat2 n p d
forall a. HasCallStack => String -> a
programmError (String -> Mat2 n p d) -> String -> Mat2 n p d
forall a b. (a -> b) -> a -> b
$ String
"dot: 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.
  FinT 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' (FinT i (1 + n) => Fin (1 + n)
forall (i :: Nat) (n :: Nat). FinT 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)) =
  let n :: Pos
n = 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
sn
      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
   in Vector a -> NonEmpty Pos -> Mat (n ':| ns) a
forall (ns :: NonEmpty 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
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.
  FinT 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' (FinT i (1 + n) => Fin (1 + n)
forall (i :: Nat) (n :: Nat). FinT 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 :: NonEmpty 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.
  FinT 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' (FinT i (1 + n1) => Fin (1 + n1)
forall (i :: Nat) (n :: Nat). FinT 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.
  FinT 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' (FinT i (1 + n1) => Fin (1 + n1)
forall (i :: Nat) (n :: Nat). FinT 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.
  (FinT i n, FinT 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). FinT i n => Fin n
forall (i :: Nat) (n :: Nat). FinT i n => Fin n
finC @i) (forall (n :: Nat). FinT j n => Fin n
forall (i :: Nat) (n :: Nat). FinT 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 :: NonEmpty 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.
  (FinT i n1, FinT 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). FinT i n => Fin n
forall (i :: Nat) (n :: Nat). FinT i n => Fin n
finC @i) (forall (n :: Nat). FinT j n => Fin n
forall (i :: Nat) (n :: Nat). FinT 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 :: NonEmpty Nat) (js :: NonEmpty 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 :: NonEmpty Nat) a.
FinMat ns -> FinMat ns -> Mat ns a -> Mat ns a
swapMat' (FinMatC is ns => FinMat ns
forall k (is :: k) (ns :: NonEmpty Nat). FinMatC is ns => FinMat ns
finMatC @is @ns) (FinMatC js ns => FinMat ns
forall k (is :: k) (ns :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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))
  | Pos
n Pos -> Pos -> Bool
forall a. Eq a => a -> a -> Bool
== Pos
n' =
      case ([Pos]
ps, [Pos]
ps1) of
        ([], [Pos]
_) -> String -> Mat (n ':| ((m + m') : ns)) a
forall a. HasCallStack => String -> a
programmError String
"appendH:lhs missing indices"
        ([Pos]
_, []) -> String -> Mat (n ':| ((m + m') : ns)) a
forall a. HasCallStack => String -> a
programmError String
"appendH: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' ->
              let x1 :: [Vector a]
x1 = Either String [Vector a] -> [Vector a]
forall a. HasCallStack => Either String a -> a
frp (Either String [Vector a] -> [Vector a])
-> Either String [Vector a] -> [Vector a]
forall a b. (a -> b) -> a -> b
$ [()] -> 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 :: NonEmpty Nat) a. Mat ns a -> Vector a
mVec Mat (n ':| (m : ns)) a
w)
                  x2 :: [Vector a]
x2 = Either String [Vector a] -> [Vector a]
forall a. HasCallStack => Either String a -> a
frp (Either String [Vector a] -> [Vector a])
-> Either String [Vector a] -> [Vector a]
forall a b. (a -> b) -> a -> b
$ [()] -> 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 :: NonEmpty Nat) a. Mat ns a -> Vector a
mVec Mat (n ':| (m' : ns)) a
w1)
                  ret :: [Vector a]
ret = Either String [Vector a] -> [Vector a]
forall a. HasCallStack => Either String a -> a
frp (Either String [Vector a] -> [Vector a])
-> Either String [Vector a] -> [Vector a]
forall a b. (a -> b) -> a -> b
$ (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
                  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)
               in Vector a -> NonEmpty Pos -> Mat (n ':| ((m + m') : ns)) a
forall (ns :: NonEmpty 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]
ret) NonEmpty Pos
ps2
          | Bool
otherwise -> String -> Mat (n ':| ((m + m') : ns)) a
forall a. HasCallStack => String -> a
programmError (String -> Mat (n ':| ((m + m') : ns)) a)
-> String -> Mat (n ':| ((m + m') : ns)) a
forall a b. (a -> b) -> a -> b
$ String
"appendH:ns/=ns' " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([Pos], [Pos]) -> String
forall a. Show a => a -> String
show ([Pos]
ns, [Pos]
ns')
  | Bool
otherwise = String -> Mat (n ':| ((m + m') : ns)) a
forall a. HasCallStack => String -> a
programmError (String -> Mat (n ':| ((m + m') : ns)) a)
-> String -> Mat (n ':| ((m + m') : ns)) a
forall a b. (a -> b) -> a -> b
$ String
"appendH: 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 :: NonEmpty 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 :: NSC 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.
  NSC 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty Nat -> Type -> Type
type family MatTupleT ns a where
  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 :: NonEmpty 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 ListTupleCInternal n => MatTupleC (n ':| '[]) a where
  toTupleC :: Mat (n ':| '[]) a -> MatTupleT (n ':| '[]) a
toTupleC Mat (n ':| '[]) a
lst = Mat (n ':| '[]) a -> ListTupleT n a
forall (n :: Nat) a.
ListTupleCInternal n =>
Vec n a -> ListTupleT n a
toTupleCInternal Mat (n ':| '[]) a
lst
  fromTupleC :: MatTupleT (n ':| '[]) a -> Mat (n ':| '[]) a
fromTupleC MatTupleT (n ':| '[]) a
x = ListTupleT n a -> Mat (n ':| '[]) a
forall (n :: Nat) a.
ListTupleCInternal n =>
ListTupleT n a -> Vec n a
fromTupleCInternal ListTupleT n a
MatTupleT (n ':| '[]) a
x
  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, NSC (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 a.
MatTupleC (n1 ':| ns) a =>
Mat (n1 ':| ns) a -> MatTupleT (n1 ':| ns) a
forall (ns :: NonEmpty Nat) a.
MatTupleC ns a =>
Mat ns a -> MatTupleT 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 a.
MatTupleC (n1 ':| ns) a =>
MatTupleT (n1 ':| ns) a -> Mat (n1 ':| ns) a
forall (ns :: NonEmpty Nat) a.
MatTupleC ns a =>
MatTupleT ns a -> Mat 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 :: NonEmpty 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.<| NSC (n1 ':| ns) => NonEmpty Pos
forall (ns :: NonEmpty Nat). NSC ns => NonEmpty Pos
fromNSP @(n1 ':| ns)
     in Vector a -> NonEmpty Pos -> Mat (n ':| (n1 : ns)) a
forall (ns :: NonEmpty 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 :: NonEmpty 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 -- below requires @(NS ns) cos i need to explicitly specify @(n1 ':| ns) here
  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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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)) =
  case [Pos]
ps of
    [] -> String -> Mat (m ':| (n : ns)) a
forall a. HasCallStack => String -> a
programmError String
"transposeMat"
    Pos
m : [Pos]
ns ->
      let ys :: NonEmpty (NonEmpty a)
ys = Either String (NonEmpty (NonEmpty a)) -> NonEmpty (NonEmpty a)
forall a. HasCallStack => Either String a -> a
frp (Either String (NonEmpty (NonEmpty a)) -> NonEmpty (NonEmpty a))
-> Either String (NonEmpty (NonEmpty a)) -> NonEmpty (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ 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
          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
       in Vector a -> NonEmpty Pos -> Mat (m ':| (n : ns)) a
forall (ns :: NonEmpty 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
$ 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 x a. (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 :: NonEmpty 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 x a. (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 :: NonEmpty 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 PosT 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 :: NonEmpty Nat) a. Mat ns a -> [a]
toListMat
  matToNestedNonEmptyC :: Mat (n ':| '[]) a -> NonEmptyNST (n ':| '[]) a
matToNestedNonEmptyC = Mat (n ':| '[]) a -> NonEmptyNST (n ':| '[]) a
forall (ns :: NonEmpty 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 :: NonEmpty Nat) a.
NSC 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 :: NonEmpty Nat) a.
NSC 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 (PosT 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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, PosT 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 :: NonEmpty 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, PosT 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 :: NonEmpty 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, PosT 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 = PosT n => Pos
forall (n :: Nat). PosT 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty Nat -> Type -> Type
type family MatToNestedVecT ns a where
  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 -> NonEmpty 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 :: NonEmpty Nat) a.
  PosT 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) =
  let i :: Pos
i = PosT i => Pos
forall (n :: Nat). PosT 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 ->
          let ps2 :: NonEmpty Pos
ps2 = Pos
y Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ys
              xs :: [Mat (MatToMatNTB (NatToPeanoT i) ns) a]
xs = Either String [Mat (MatToMatNTB (NatToPeanoT i) ns) a]
-> [Mat (MatToMatNTB (NatToPeanoT i) ns) a]
forall a. HasCallStack => Either String a -> a
frp (Either String [Mat (MatToMatNTB (NatToPeanoT i) ns) a]
 -> [Mat (MatToMatNTB (NatToPeanoT i) ns) a])
-> Either String [Mat (MatToMatNTB (NatToPeanoT i) ns) a]
-> [Mat (MatToMatNTB (NatToPeanoT i) ns) a]
forall a b. (a -> b) -> a -> b
$ [()]
-> NonEmpty Pos
-> Mat ns a
-> Either String [Mat (MatToMatNTB (NatToPeanoT i) ns) a]
forall (ns :: NonEmpty Nat) (t :: * -> *) (x :: NonEmpty 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
           in Vector (Mat (MatToMatNTB (NatToPeanoT i) ns) a)
-> NonEmpty Pos -> MatToNDT i ns a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU ([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 -> MatToNDT i ns a
forall a. HasCallStack => String -> a
programmError String
"toND:missing indices to the right"

type MatToMatNTA :: Peano -> NonEmpty Nat -> NonEmpty Nat
type family MatToMatNTA i ns where
  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) = TP.Cons1T n (MatToMatNTA ( 'S i) (m ':| ns))

type MatToMatNTB :: Peano -> NonEmpty Nat -> NonEmpty Nat
type family MatToMatNTB i ns where
  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. i <=! i => Mat ns a -> MatToNDT i ns a
toND :: Mat ns a -> MatToNDT i ns a
toND = forall (i :: Nat) (ns :: NonEmpty Nat) a.
PosT i =>
Mat ns a -> MatToNDT i ns a
forall (ns :: NonEmpty Nat) a.
PosT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
(i <=! i) =>
Mat ns a -> MatToNDT i ns a
forall (ns :: NonEmpty Nat) a.
(1 <=! 1) =>
Mat ns a -> MatToNDT 1 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 (i :: Nat) (ns :: NonEmpty Nat) a.
(i <=! i) =>
Mat ns a -> MatToNDT i ns a
forall (ns :: NonEmpty Nat) a.
(2 <=! 2) =>
Mat ns a -> MatToNDT 2 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 (i :: Nat) (ns :: NonEmpty Nat) a.
(i <=! i) =>
Mat ns a -> MatToNDT i ns a
forall (ns :: NonEmpty Nat) a.
(3 <=! 3) =>
Mat ns a -> MatToNDT 3 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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)) =
  case [Pos]
ps of
    Pos
_n : [Pos]
ns ->
      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]
       in Vector a -> NonEmpty Pos -> Mat (n ':| ns) a
forall (ns :: NonEmpty 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]
xs) (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns)
    [] -> String -> Mat (n ':| ns) a
forall a. HasCallStack => String -> a
programmError String
"diagonal: 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)) =
  let i :: Pos
i = PosT i => Pos
forall (n :: Nat). PosT n => Pos
fromNP @i
      j :: Pos
j = PosT j => Pos
forall (n :: Nat). PosT 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
      n' :: Pos
n' = 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
$ (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
      ps1 :: NonEmpty Pos
ps1 = Pos
n' Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns
   in Vector a -> NonEmpty Pos -> Mat (DiffT i j n ':| ns) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (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

{- | shortcut way to construct a matrix with indices as the individual digits of the 'Nat' value
 @see 'gen''
-}
mm' :: forall n. NSC (NN n) => Mat (NN n) [Int]
mm' :: Mat (NN n) [Int]
mm' = ([Int] -> [Int]) -> Mat (NN n) [Int]
forall (ns :: NonEmpty Nat) a. NSC ns => ([Int] -> a) -> Mat ns a
gen' [Int] -> [Int]
forall a. a -> a
id

{- | shortcut way to construct a matrix with indices as the individual digits of the 'Nat' value
 @see 'gen'
-}
mm :: forall n. NSC (NN n) => Mat (NN n) Int
mm :: Mat (NN n) Int
mm = (Int -> Int) -> Mat (NN n) Int
forall (ns :: NonEmpty Nat) a. NSC ns => (Int -> a) -> Mat ns a
gen (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | 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 ':| '[])
  , PosT 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 :: NonEmpty Nat) a.
(MatConvertersC ns, NSC ns, Read (ListNST ns a)) =>
ShowOpts -> ReadP (Mat ns a)
readMatP ShowOpts
defShowOpts)

-- | specialised version of 'readMat' for 'Mat2'
readMat2 ::
  ( MatConvertersC (n ':| '[m])
  , PosT n
  , PosT 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 :: NonEmpty Nat) a.
(MatConvertersC ns, NSC 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
  , NSC 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 :: NonEmpty Nat) a.
(MatConvertersC ns, NSC ns, Read (ListNST ns a)) =>
ShowOpts -> ReadP (Mat ns a)
readMatP ShowOpts
defShowOpts)

instance (MatConvertersC ns, NSC 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 :: NonEmpty Nat) a.
(MatConvertersC ns, NSC ns, Read (ListNST ns a)) =>
ShowOpts -> ReadP (Mat ns a)
readMatP ShowOpts
defShowOpts))

-- | reader for 'showFin'
readMatP ::
  forall ns a.
  ( MatConvertersC ns
  , NSC 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 = NSC ns => NonEmpty Pos
forall (ns :: NonEmpty Nat). NSC 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 :: NonEmpty 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 :: NonEmpty 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, NSC ns) => Show (Mat ns a) where
  show :: Mat ns a -> String
show = ShowOpts -> Mat ns a -> String
forall (ns :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 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 :: NonEmpty 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 :: NonEmpty 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 FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (1 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (1 ':| '[]) ns a)
_row @1

-- |  lens into the first element in a 1d matrix
instance FinT 1 n => Row1 (Vec n a) a where
  _r1 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r1 = forall (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (1 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (1 ':| '[]) ns a)
_row @1

instance (FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (2 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (2 ':| '[]) ns a)
_row @2

instance (FinT 2 n) => Row2 (Vec n a) a where
  _r2 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r2 = forall (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (2 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (2 ':| '[]) ns a)
_row @2

instance (FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (3 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (3 ':| '[]) ns a)
_row @3

instance (FinT 3 n) => Row3 (Vec n a) a where
  _r3 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r3 = forall (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (3 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (3 ':| '[]) ns a)
_row @3

instance (FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (4 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (4 ':| '[]) ns a)
_row @4

instance (FinT 4 n) => Row4 (Vec n a) a where
  _r4 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r4 = forall (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (4 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (4 ':| '[]) ns a)
_row @4

instance (FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (5 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (5 ':| '[]) ns a)
_row @5

instance (FinT 5 n) => Row5 (Vec n a) a where
  _r5 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r5 = forall (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (5 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (5 ':| '[]) ns a)
_row @5

instance (FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (6 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (6 ':| '[]) ns a)
_row @6

instance (FinT 6 n) => Row6 (Vec n a) a where
  _r6 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r6 = forall (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (6 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (6 ':| '[]) ns a)
_row @6

instance (FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (7 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (7 ':| '[]) ns a)
_row @7

instance (FinT 7 n) => Row7 (Vec n a) a where
  _r7 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r7 = forall (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (7 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (7 ':| '[]) ns a)
_row @7

instance (FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (8 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (8 ':| '[]) ns a)
_row @8

instance (FinT 8 n) => Row8 (Vec n a) a where
  _r8 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r8 = forall (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (8 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (8 ':| '[]) ns a)
_row @8

instance (FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (9 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (9 ':| '[]) ns a)
_row @9

instance (FinT 9 n) => Row9 (Vec n a) a where
  _r9 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r9 = forall (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (9 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (9 ':| '[]) ns a)
_row @9

instance (FinT 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 (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (10 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (10 ':| '[]) ns a)
_row @10

instance (FinT 10 n) => Row10 (Vec n a) a where
  _r10 :: (a -> f a) -> Vec n a -> f (Vec n a)
_r10 = forall (i :: Nat) (ns :: NonEmpty Nat) a.
SliceC (i ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (i ':| '[]) ns a)
forall (ns :: NonEmpty Nat) a.
SliceC (10 ':| '[]) ns =>
Lens' (Mat ns a) (SliceT (10 ':| '[]) ns a)
_row @10

-- | lens into column 1 of a matrix
_c1 :: FinT 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.
FinT 1 m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinT i m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
_col @1

-- | lens into column 2 of a matrix
_c2 :: FinT 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.
FinT 2 m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinT i m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
_col @2

-- | lens into column 3 of a matrix
_c3 :: FinT 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.
FinT 3 m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinT i m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
_col @3

-- | lens into column 4 of a matrix
_c4 :: FinT 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.
FinT 4 m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinT i m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
_col @4

-- | lens into column 5 of a matrix
_c5 :: FinT 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.
FinT 5 m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinT i m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
_col @5

-- | lens into column 6 of a matrix
_c6 :: FinT 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.
FinT 6 m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinT i m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
_col @6

-- | lens into column 7 of a matrix
_c7 :: FinT 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.
FinT 7 m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinT i m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
_col @7

-- | lens into column 8 of a matrix
_c8 :: FinT 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.
FinT 8 m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinT i m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
_col @8

-- | lens into column 9 of a matrix
_c9 :: FinT 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.
FinT 9 m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinT i m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
_col @9

-- | lens into column 10 of a matrix
_c10 :: FinT 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.
FinT 10 m =>
Lens' (Mat (n ':| (m : ns)) a) (Mat (n ':| ns) a)
forall (i :: Nat) (n :: Nat) (m :: Nat) (ns :: [Nat]) a.
FinT 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 :: NonEmpty Nat -> Type -> Type
type family ConsMatCTA ns a where
  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 :: NonEmpty Nat -> Type -> Type
type family ConsMatCTB ns a where
  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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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)) ->
          let n :: Pos
n = 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
sn
           in 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 -> (a, Vec (n - 1) a)
forall a. HasCallStack => String -> a
programmError String
"consMat (1 GN.+ n ':| '[]): no data"
                Just (a
a, Vector a
v) -> (a
a, Vector a -> NonEmpty Pos -> Vec (n - 1) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU 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 :: NonEmpty 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)) ->
          case [Pos]
ps of
            Pos
m : [Pos]
ns -> (Vector a -> NonEmpty Pos -> Mat (n1 ':| ns) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector a
v (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns), EofN
EofN)
            [] -> String -> (Mat (n1 ':| ns) a, EofN)
forall a. HasCallStack => String -> a
programmError String
"consMat (1 ':| m ': ns): missing indices"
      )
      (\(Mat Vector b
v NonEmpty Pos
ps, EofN
EofN) -> Vector b -> NonEmpty Pos -> Mat (1 ':| (n1 : ns)) b
forall (ns :: NonEmpty 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)) ->
          case [Pos]
ps of
            Pos
m : [Pos]
ns ->
              let n :: Pos
n = 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
sn
                  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
               in ( Vector a -> NonEmpty Pos -> Mat (m ':| ns) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector a
v1 NonEmpty Pos
ps1
                  , Vector a -> NonEmpty Pos -> Mat ((n - 1) ':| (m : ns)) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector a
v2 NonEmpty Pos
ps2
                  )
            [] -> String -> (Mat (m ':| ns) a, Mat ((n - 1) ':| (m : ns)) a)
forall a. HasCallStack => String -> a
programmError String
"consMatX:(1 GN.+ n ':| m ': ns): 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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)) ->
          let n :: Pos
n = 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
sn
           in 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 -> (Vec (n - 1) a, a)
forall a. HasCallStack => String -> a
programmError String
"snocMat (1 GN.+ n ':| '[]): no data"
                Just (Vector a
v, a
a) -> (Vector a -> NonEmpty Pos -> Vec (n - 1) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector a
v (Pos
n Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ps), a
a)
      )
      (\(Mat Vector b
v (Pos
p :| [Pos]
ps), b
a) -> Vector b -> NonEmpty Pos -> Mat (n ':| '[]) b
forall (ns :: NonEmpty 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)) ->
          case [Pos]
ps of
            Pos
m : [Pos]
ns ->
              (EofN
EofN, Vector a -> NonEmpty Pos -> Mat (n1 ':| ns) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector a
v (Pos
m Pos -> [Pos] -> NonEmpty Pos
forall a. a -> [a] -> NonEmpty a
:| [Pos]
ns))
            [] -> String -> (EofN, Mat (n1 ':| ns) a)
forall a. HasCallStack => String -> a
programmError String
"snocMat (1 GN.+ n ':| '[]): missing indices"
      )
      (\(EofN
EofN, Mat Vector b
v NonEmpty Pos
ps) -> Vector b -> NonEmpty Pos -> Mat (1 ':| (n1 : ns)) b
forall (ns :: NonEmpty 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)) ->
          case [Pos]
ps of
            Pos
m : [Pos]
ns ->
              let n :: Pos
n = 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
sn
                  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
               in ( Vector a -> NonEmpty Pos -> Mat ((n - 1) ':| (m : ns)) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector a
v2 NonEmpty Pos
ps2
                  , Vector a -> NonEmpty Pos -> Mat (m ':| ns) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU Vector a
v1 NonEmpty Pos
ps1
                  )
            [] -> String -> (Mat ((n - 1) ':| (m : ns)) a, Mat (m ':| ns) a)
forall a. HasCallStack => String -> a
programmError String
"snocMat:(1 GN.+ n ':| m ': ns): 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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)) =
  case [Pos]
ps of
    Pos
m : [Pos]
ns ->
      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)
       in Vector a -> NonEmpty Pos -> Mat (m ':| ns) a
forall (ns :: NonEmpty Nat) a.
HasCallStack =>
Vector a -> NonEmpty Pos -> Mat ns a
MatIU (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 -> Mat (m ':| ns) a
forall a. HasCallStack => String -> a
programmError String
"indexRow: 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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 :: NonEmpty 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