| Copyright | (c) Grant Weyburne 2022 |
|---|---|
| License | BSD-3 |
| Safe Haskell | None |
| Language | Haskell2010 |
Cybus.FinMat
Description
Synopsis
- data FinMat ns
- fmPos :: FinMat ns -> Int
- fmNS :: FinMat ns -> NonEmpty Pos
- pattern FinMat :: forall (ns :: NonEmpty Nat). Int -> NonEmpty Pos -> FinMat ns
- pattern FinMatU :: forall (ns :: NonEmpty Nat). (HasCallStack, NSC ns) => Int -> NonEmpty Pos -> FinMat ns
- mkFinMat :: Int -> NonEmpty Pos -> Either String (FinMat ns)
- mkFinMatC :: forall ns. NSC ns => Int -> NonEmpty Pos -> Either String (FinMat ns)
- toFinMatFromPos :: forall (i :: Nat) ns. (NSC ns, i <! Product1T ns) => FinMat ns
- class FinMatC is ns where
- finMatToNonEmpty :: forall ns. FinMat ns -> NonEmpty Pos
- nonEmptyToFinMat :: forall ns. NSC ns => NonEmpty Pos -> Either String (FinMat ns)
- nonEmptyToFinMat' :: NonEmpty Pos -> NonEmpty Pos -> Either String (FinMat ns)
- showFinMat :: FinMat ns -> String
- readFinMatP :: forall ns. NSC ns => ReadP (FinMat ns)
- readFinMat :: NSC ns => ReadS (FinMat ns)
- showFinMat' :: forall ns. FinMat ns -> String
- class NSC (ns :: NonEmpty Nat) where
- class NSRangeC i ns
- _finMatFin :: forall i n ns. (PosT i, NSRangeC (NatToPeanoT i) ns) => Lens' (FinMat ns) (Fin n)
- finMatFinSet :: forall i n ns. (PosT i, NSRangeC (NatToPeanoT i) ns) => FinMat ns -> Fin n -> FinMat ns
- finMatFinGet :: forall i n ns. (PosT i, NSRangeC (NatToPeanoT i) ns) => FinMat ns -> Fin n
- relPos :: Foldable1 t => t (Pos, Pos) -> (Pos, Int)
- _i1 :: Lens' (FinMat (n :| ns)) (Fin n)
- _i2 :: Lens' (FinMat (n1 :| (n ': ns))) (Fin n)
- _i3 :: Lens' (FinMat (n1 :| (n2 ': (n ': ns)))) (Fin n)
- _i4 :: Lens' (FinMat (n1 :| (n2 ': (n3 ': (n ': ns))))) (Fin n)
- _i5 :: Lens' (FinMat (n1 :| (n2 ': (n3 ': (n4 ': (n ': ns)))))) (Fin n)
- _i6 :: Lens' (FinMat (n1 :| (n2 ': (n3 ': (n4 ': (n5 ': (n ': ns))))))) (Fin n)
- _i7 :: Lens' (FinMat (n1 :| (n2 ': (n3 ': (n4 ': (n5 ': (n6 ': (n ': ns)))))))) (Fin n)
- _i8 :: Lens' (FinMat (n1 :| (n2 ': (n3 ': (n4 ': (n5 ': (n6 ': (n7 ': (n ': ns))))))))) (Fin n)
- _i9 :: Lens' (FinMat (n1 :| (n2 ': (n3 ': (n4 ': (n5 ': (n6 ': (n7 ': (n8 ': (n ': ns)))))))))) (Fin n)
- _i10 :: Lens' (FinMat (n1 :| (n2 ': (n3 ': (n4 ': (n5 ': (n6 ': (n7 ': (n8 ': (n9 ': (n ': ns))))))))))) (Fin n)
Documentation
definition of the indices of a matrix
Instances
pattern FinMat :: forall (ns :: NonEmpty Nat). Int -> NonEmpty Pos -> FinMat ns Source #
readonly pattern synonym for finmatrix
pattern FinMatU :: forall (ns :: NonEmpty Nat). (HasCallStack, NSC ns) => Int -> NonEmpty Pos -> FinMat ns Source #
pattern synonym for validating the finmatrix before construction but uses an extra NSC constraint to check "ns"
mkFinMat :: Int -> NonEmpty Pos -> Either String (FinMat ns) Source #
create a FinMat value level "i" and "ns" values and validate that "i" is in range
mkFinMatC :: forall ns. NSC ns => Int -> NonEmpty Pos -> Either String (FinMat ns) Source #
create a FinMat value level "i" and "ns" values and validate against expected "ns"
toFinMatFromPos :: forall (i :: Nat) ns. (NSC ns, i <! Product1T ns) => FinMat ns Source #
create a FinMat using a relative type level index
finMatToNonEmpty :: forall ns. FinMat ns -> NonEmpty Pos Source #
convert a FinMat into a list of indices
nonEmptyToFinMat :: forall ns. NSC ns => NonEmpty Pos -> Either String (FinMat ns) Source #
try to convert a list of indices into a FinMat
nonEmptyToFinMat' :: NonEmpty Pos -> NonEmpty Pos -> Either String (FinMat ns) Source #
try to convert a list of indices into a FinMat
read/show methods
showFinMat :: FinMat ns -> String Source #
pretty print FinMat
showFinMat' :: forall ns. FinMat ns -> String Source #
more detailed pretty print FinMat
constructors
miscellaneous
constrain i within the size of the indices ie "i >= 1 && i <= Length ns"
Instances
| (TypeError ('Text "NSRangeC: zero is not a valid index: index must be one or greater") :: Constraint) => NSRangeC 'Z (n :| ns) Source # | |
Defined in Cybus.FinMat | |
| NSRangeC ('S 'Z) (n :| ns) Source # | |
Defined in Cybus.FinMat | |
| (TypeError ('Text "NSRangeC: index is larger than the number of matrix indices ns") :: Constraint) => NSRangeC ('S ('S i)) (n :| ('[] :: [Nat])) Source # | |
Defined in Cybus.FinMat | |
| NSRangeC ('S i) (m :| ns) => NSRangeC ('S ('S i)) (n :| (m ': ns)) Source # | |
Defined in Cybus.FinMat | |
_finMatFin :: forall i n ns. (PosT i, NSRangeC (NatToPeanoT i) ns) => Lens' (FinMat ns) (Fin n) Source #
a lens for accessing the "i" index in a indices of FinMat
finMatFinSet :: forall i n ns. (PosT i, NSRangeC (NatToPeanoT i) ns) => FinMat ns -> Fin n -> FinMat ns Source #
set the Fin at index "i" for the FinMat
finMatFinGet :: forall i n ns. (PosT i, NSRangeC (NatToPeanoT i) ns) => FinMat ns -> Fin n Source #
get the Fin at index "i" from FinMat
must rely on FinMat to get "n at index i "which saves us pulling "n" from the typelevel ie we can omit PosT n
relPos :: Foldable1 t => t (Pos, Pos) -> (Pos, Int) Source #
find the relative position in a matrix index
lens into indices of matrix
_i6 :: Lens' (FinMat (n1 :| (n2 ': (n3 ': (n4 ': (n5 ': (n ': ns))))))) (Fin n) Source #
lens for index 6
_i7 :: Lens' (FinMat (n1 :| (n2 ': (n3 ': (n4 ': (n5 ': (n6 ': (n ': ns)))))))) (Fin n) Source #
lens for index 7
_i8 :: Lens' (FinMat (n1 :| (n2 ': (n3 ': (n4 ': (n5 ': (n6 ': (n7 ': (n ': ns))))))))) (Fin n) Source #
lens for index 8