Copyright | (c) Erich Gut |
---|---|
License | BSD3 |
Maintainer | zerich.gut@gmail.com |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
entries of matrices and viewing them as a column of rows respectively as a row of columns.
Synopsis
- newtype Entries i j x = Entries (PSequence (i, j) x)
- etsxs :: Entries i j x -> [(x, i, j)]
- etsEmpty :: Entries i j x
- etsAdd :: (Additive x, Ord i, Ord j) => Entries i j x -> Entries i j x -> Entries i j x
- etsMlt :: (Distributive x, Ord k) => Col i (Row k x) -> Row j (Col k x) -> Col i (Row j x)
- etsJoin :: (i ~ N, j ~ N) => ProductSymbol i -> ProductSymbol j -> Entries i j (Entries i j x) -> Entries i j x
- etscr :: Eq i => Entries i j x -> Col i (Row j x)
- etsrc :: (Ord i, Ord j) => Entries i j x -> Row j (Col i x)
- crets :: Col i (Row j x) -> Entries i j x
- rcets :: (Ord i, Ord j) => Row j (Col i x) -> Entries i j x
- etsElimZeros :: Additive x => Entries i j x -> Entries i j x
- newtype Row j x = Row (PSequence j x)
- rowxs :: Row j x -> [(x, j)]
- rowEmpty :: Row j x
- rowIsEmpty :: Row j x -> Bool
- rowHead :: Row j x -> (x, j)
- rowTail :: Row j x -> Row j x
- rowFilter :: (x -> Bool) -> Row j x -> Row j x
- rowMapShift :: Number j => j -> ((x, j) -> y) -> Row j x -> Row j y
- rowAppend :: Row j x -> Row j x -> Row j x
- rowInterlace :: Ord j => (x -> y -> z) -> (x -> z) -> (y -> z) -> Row j x -> Row j y -> Row j z
- rowElimZeros :: Additive a => Row i a -> Row i a
- rowSwap :: Ord j => j -> j -> Row j x -> Row j x
- rowAdd :: (Additive a, Ord j) => Row j a -> Row j a -> Row j a
- rowMltl :: Distributive a => a -> Row j a -> Row j a
- rowShear :: Ord j => (Maybe x -> s -> Maybe x) -> (Maybe x -> Maybe x -> Maybe x) -> j -> j -> s -> s -> s -> s -> Row j x -> Row j x
- rowScale :: Ord j => (x -> s -> Maybe x) -> j -> s -> Row j x -> Row j x
- newtype Col i x = Col (PSequence i x)
- colxs :: Col i x -> [(x, i)]
- colEmpty :: Col i x
- colIsEmpty :: Col i x -> Bool
- colHead :: Col i x -> (x, i)
- colTail :: Col i x -> Col i x
- colFilter :: (x -> Bool) -> Col i x -> Col i x
- colMapShift :: Number i => i -> ((x, i) -> y) -> Col i x -> Col i y
- colAppend :: Col i x -> Col i x -> Col i x
- colInterlace :: Ord i => (x -> y -> z) -> (x -> z) -> (y -> z) -> Col i x -> Col i y -> Col i z
- colElimZeros :: Additive a => Col i a -> Col i a
- colSwap :: Ord i => i -> i -> Col i x -> Col i x
- colAdd :: (Additive a, Ord i) => Col i a -> Col i a -> Col i a
- colMltr :: Distributive a => Col i a -> a -> Col i a
- colShear :: Ord i => (s -> Maybe x -> Maybe x) -> (Maybe x -> Maybe x -> Maybe x) -> i -> i -> s -> s -> s -> s -> Col i x -> Col i x
- colScale :: Ord i => (s -> x -> Maybe x) -> i -> s -> Col i x -> Col i x
- crHeadColAt :: Eq j => j -> Col i (Row j a) -> Col i a
- crHeadRowAt :: Eq i => i -> Col i (Row j a) -> Row j a
- coEntries :: (Ord i, Ord j) => Entries i j x -> Dual (Entries i j x)
- coEntriesInv :: (Ord i, Ord j) => Dual (Entries i j x) -> Entries i j x
Entries
newtype Entries i j x Source #
two dimensional partial sequence.
Instances
Functor (Entries i j) Source # | |
(Show x, Show i, Show j) => Show (Entries i j x) Source # | |
(Eq x, Eq i, Eq j) => Eq (Entries i j x) Source # | |
(Ord x, Ord i, Ord j) => Ord (Entries i j x) Source # | |
Defined in OAlg.Entity.Matrix.Entries compare :: Entries i j x -> Entries i j x -> Ordering # (<) :: Entries i j x -> Entries i j x -> Bool # (<=) :: Entries i j x -> Entries i j x -> Bool # (>) :: Entries i j x -> Entries i j x -> Bool # (>=) :: Entries i j x -> Entries i j x -> Bool # | |
(Transposable x, Ord n) => Transposable (Entries n n x) Source # | |
LengthN (Entries i j x) Source # | |
(Entity x, Entity i, Entity j, Ord i, Ord j) => Validable (Entries i j x) Source # | |
(Entity x, Entity i, Entity j, Ord i, Ord j) => Entity (Entries i j x) Source # | |
Defined in OAlg.Entity.Matrix.Entries | |
type Dual (Entries i j x :: TYPE LiftedRep) Source # | |
etsAdd :: (Additive x, Ord i, Ord j) => Entries i j x -> Entries i j x -> Entries i j x Source #
adding two entries.
Property Let zs =
, then holds:etsAdd
xs ys
- Pre
- For all
(i,j)
in(i,j)
where there exists an(x,i,j)
inxs
and a(y,i,j)
inys
holds:
.root
x==
root
y - Post
zs
isvalid
.For all
(i,j)
in(i,j)
holds:- If exists a
(x,i,j)
inxs
but not exists a(y,i,j)
inys
then there exists a(z,i,j)
inzs
withz
.==
x - If exists a
(y,i,j)
inys
but not exists a(x,i,j)
inxs
then there exists a(z,i,j)
inzs
withz
.==
y - If exists a
(x,i,j)
inxs
and(y,i,j)
inys
then there exists a(z,i,j)
inzs
withz
.==
x+
y
- If exists a
etsMlt :: (Distributive x, Ord k) => Col i (Row k x) -> Row j (Col k x) -> Col i (Row j x) Source #
multiplication.
etsJoin :: (i ~ N, j ~ N) => ProductSymbol i -> ProductSymbol j -> Entries i j (Entries i j x) -> Entries i j x Source #
rcets :: (Ord i, Ord j) => Row j (Col i x) -> Entries i j x Source #
the entries given by a row of columns.
Row
viewing a partial sequence as a row.
Instances
Functor (Row j) Source # | |
Ord j => Sequence (Row j) j x Source # | |
(Entity x, Entity j, Ord j) => PermutableSequence (Row j) j x Source # | |
Defined in OAlg.Entity.Matrix.Entries | |
Ord j => Opr (Permutation j) (Row j x) Source # | |
Defined in OAlg.Entity.Matrix.Entries | |
(Entity x, Entity j, Ord j) => TotalOpr (Permutation j) (Row j x) Source # | |
Defined in OAlg.Entity.Matrix.Entries | |
(Show x, Show j) => Show (Row j x) Source # | |
(Eq x, Eq j) => Eq (Row j x) Source # | |
LengthN (Row j x) Source # | |
(Entity x, Entity j, Ord j) => Validable (Row j x) Source # | |
(Entity x, Entity j, Ord j) => Entity (Row j x) Source # | |
Defined in OAlg.Entity.Matrix.Entries | |
type Dual (Row j (Col i x) :: TYPE LiftedRep) Source # | |
rowIsEmpty :: Row j x -> Bool Source #
check for being empty.
rowMapShift :: Number j => j -> ((x, j) -> y) -> Row j x -> Row j y Source #
mapping and shifting of a row.
rowInterlace :: Ord j => (x -> y -> z) -> (x -> z) -> (y -> z) -> Row j x -> Row j y -> Row j z Source #
interlacing two rows.
rowMltl :: Distributive a => a -> Row j a -> Row j a Source #
multiplies each element of the row by the given factor from the left.
rowShear :: Ord j => (Maybe x -> s -> Maybe x) -> (Maybe x -> Maybe x -> Maybe x) -> j -> j -> s -> s -> s -> s -> Row j x -> Row j x Source #
rowScale :: Ord j => (x -> s -> Maybe x) -> j -> s -> Row j x -> Row j x Source #
scales the entry at the given position by the given factor.
Col
viewing a partial sequence as a column.
Instances
Functor (Col i) Source # | |
Ord i => Sequence (Col i) i x Source # | |
(Entity x, Entity i, Ord i) => PermutableSequence (Col i) i x Source # | |
Defined in OAlg.Entity.Matrix.Entries | |
Ord i => Opr (Permutation i) (Col i x) Source # | |
Defined in OAlg.Entity.Matrix.Entries | |
(Entity x, Entity i, Ord i) => TotalOpr (Permutation i) (Col i x) Source # | |
Defined in OAlg.Entity.Matrix.Entries | |
(Show x, Show i) => Show (Col i x) Source # | |
(Eq x, Eq i) => Eq (Col i x) Source # | |
LengthN (Col i x) Source # | |
(Entity x, Entity i, Ord i) => Validable (Col i x) Source # | |
(Entity x, Entity i, Ord i) => Entity (Col i x) Source # | |
Defined in OAlg.Entity.Matrix.Entries | |
type Dual (Row j (Col i x) :: TYPE LiftedRep) Source # | |
colIsEmpty :: Col i x -> Bool Source #
check for being empty.
colMapShift :: Number i => i -> ((x, i) -> y) -> Col i x -> Col i y Source #
mapping and shifting of a column.
colInterlace :: Ord i => (x -> y -> z) -> (x -> z) -> (y -> z) -> Col i x -> Col i y -> Col i z Source #
interlacing two columns.
colSwap :: Ord i => i -> i -> Col i x -> Col i x Source #
swapping two entries of a column.
Pre k < l
.
colMltr :: Distributive a => Col i a -> a -> Col i a Source #
multiplies each element of the column by the given factor from the right.
colShear :: Ord i => (s -> Maybe x -> Maybe x) -> (Maybe x -> Maybe x -> Maybe x) -> i -> i -> s -> s -> s -> s -> Col i x -> Col i x Source #
colScale :: Ord i => (s -> x -> Maybe x) -> i -> s -> Col i x -> Col i x Source #
scales the entry at the given position by the given factor.
Col Row
crHeadColAt :: Eq j => j -> Col i (Row j a) -> Col i a Source #
get the head column at j
.
Pre for all j'
in rws
holds: j
.<=
j'
crHeadRowAt :: Eq i => i -> Col i (Row j a) -> Row j a Source #
get the head row at i
.
Pre for all i'
in rws
holdst: i
.<=
i'