Copyright | (c) Erich Gut |
---|---|
License | BSD3 |
Maintainer | zerich.gut@gmail.com |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
Synopsis
- data Transformation x where
- Permute :: Distributive x => Dim x (Point x) -> Dim x (Point x) -> Permutation N -> Transformation x
- Scale :: Distributive x => Dim x (Point x) -> N -> Inv x -> Transformation x
- Shear :: Galoisian x => Dim x (Point x) -> N -> N -> GL2 x -> Transformation x
- type GL x = Inv (Matrix x)
- data GL2 x = GL2 x x x x
- data GLT x
- permute :: Distributive x => Dim' x -> Dim' x -> Permutation N -> GLT x
- permuteFT :: Distributive x => Dim' x -> Dim' x -> Permutation N -> FT x
- scale :: Distributive x => Dim' x -> N -> Inv x -> GLT x
- shear :: Galoisian x => Dim' x -> N -> N -> GL2 x -> GLT x
- rdcGLTForm :: Oriented x => GLTForm x -> GLTForm x
- type GLTForm x = ProductForm Z (Transformation x)
- gltfTrsp :: TransposableDistributive r => GLTForm r -> GLTForm r
- type FT x = Product Z (Transformation x)
- data TrApp x y where
- TrFT :: Oriented x => TrApp (Transformation x) (FT x)
- TrGL :: Distributive x => TrApp (Transformation x) (GL x)
- TrGLT :: Oriented x => TrApp (Transformation x) (GLT x)
- trGLT :: Oriented x => Transformation x -> GLT x
- data GLApp x y where
Transformation
data Transformation x where Source #
elementary linear transformation over a Distributive
structure x
.
Property Let f
be in
then holds:Transformation
x
If
f
matches
then holds:Permute
r c pIf
f
matches
then holds:Scale
d k sIf
f
matches
then holds:Shear
d k l g
Note
represents the square matrix Shear
d k l (GL2
s t u v)m
of dimension d
where m k k
, ==
sm k l
, ==
tm l k
, ==
um l l
and
for all ==
vi, j
not in [k,l]
holds: If i
then /=
jm i j
is zero
else m i i
is one
.
Permute :: Distributive x => Dim x (Point x) -> Dim x (Point x) -> Permutation N -> Transformation x | |
Scale :: Distributive x => Dim x (Point x) -> N -> Inv x -> Transformation x | |
Shear :: Galoisian x => Dim x (Point x) -> N -> N -> GL2 x -> Transformation x |
Instances
GL
the general linear group of 2x2
matrices for a Galoisian
structure x
.
Property Let
be in GL2
s t u v
for a GL2
xGaloisian
structure
x
, then holds: s
is invertible.*
v -
u*
t
Example Let g =
:GL2
3 5 4 7 :: GL2
Z
>>>
invert g
GL2 7 -5 -4 3
>>>
g * invert g
GL2 1 0 0 1
Note
represents the GL2
(s t u v)2x2
-matrix
[s t] [u v]
and is obtained by GL2GL
.
GL2 x x x x |
Instances
GLT
quotient groupoid of the free groupoid of Transformation
(see FTGLT
) given by the
relations:
wherepermuteFT
d c p*
permuteFT
b a q ~permuteFT
d a (q*
p)b
and==
c
,Permute
d c p
arePermute
b a qvalid
(Note: the permutationsp
andq
are switched on the right side of the equation).- ...
Property Let g
be in GLT
, then holds:
Example Let d =
,
dim
[()] ^
10 :: Dim'
Z
a =
, permuteFT
d d (swap
2 8)b =
and
permuteFT
d d (swap
2 3)c =
then:permuteFT
d d (swap
2 3 * swap
2 8)
>>>
a * b == c
False
but in GLT
holds: let a' =
, amap
FTGLT
ab' =
and
amap
FTGLT
bc' =
inamap
FTGLT
c
>>>
a' * b' == c'
True
and
>>>
amap GLTGL (a' * b') == amap GLTGL a' * amap GLTGL b'
True
Note: As a consequence of the property (1.), GLT
can be canonically embedded
via
- in to prj
.
form
. ProductForm
N
(Transformation
x)
Instances
Oriented x => Show (GLT x) Source # | |
Oriented x => Eq (GLT x) Source # | |
Oriented x => Constructable (GLT x) Source # | |
Exposable (GLT x) Source # | |
Oriented x => Validable (GLT x) Source # | |
Oriented x => Entity (GLT x) Source # | |
Defined in OAlg.Entity.Matrix.GeneralLinearGroup | |
Oriented x => Exponential (GLT x) Source # | |
Oriented x => Cayleyan (GLT x) Source # | |
Defined in OAlg.Entity.Matrix.GeneralLinearGroup | |
Oriented x => Invertible (GLT x) Source # | |
Oriented x => Multiplicative (GLT x) Source # | |
Oriented x => Oriented (GLT x) Source # | |
Embeddable (GLT x) (ProductForm N (Transformation x)) Source # | |
Defined in OAlg.Entity.Matrix.GeneralLinearGroup inj :: GLT x -> ProductForm N (Transformation x) Source # | |
type Form (GLT x) Source # | |
Defined in OAlg.Entity.Matrix.GeneralLinearGroup | |
type Exponent (GLT x) Source # | |
Defined in OAlg.Entity.Matrix.GeneralLinearGroup | |
type Point (GLT x) Source # | |
Defined in OAlg.Entity.Matrix.GeneralLinearGroup |
permute :: Distributive x => Dim' x -> Dim' x -> Permutation N -> GLT x Source #
permutation of the given dimensions.
Property Let r
, c
be in
and Dim'
xp
in
for
a Permutation
N
Distributive
structure x
, then holds:
If
is Permute
r c pvalid
then
is permute
r c pvalid
.
Example Let t =
with permute
r c p
is Permute
r c pvalid
then its
associated matrix (see GLTGL
) has the orientation c
and the form:>
r
k l [1 ] [ . ] [ . ] [ 1 ] [ 1 ] k [ 1 ] [ . ] [ . ] [ 1 ] [ 1 ] l [ 1 ] [ . ] [ . ] [ 1]
Note r
dose not have to be equal to c
, but from r
follows that
both have the same length.==
c <*
p
permuteFT :: Distributive x => Dim' x -> Dim' x -> Permutation N -> FT x Source #
the induce element in the free groupoid of transformations.
scale :: Distributive x => Dim' x -> N -> Inv x -> GLT x Source #
scaling.
Property Let d
be in
, Dim'
xk
in N
and s
in
, then
holds: If Inv
x
is Scale
d k svalid
then
is scale
d k svalid
.
Example Let t =
with scale
d k s
is Scale
d k svalid
then its associated
matrix (see GLTGL
) is an endo with dimension d
and has the form
k [1 ] [ . ] [ . ] [ 1 ] [ s' ] k [ 1 ] [ . ] [ . ] [ 1]
shear :: Galoisian x => Dim' x -> N -> N -> GL2 x -> GLT x Source #
shearing.
Property Let d
be in
, Dim'
xk
, l
in N
and g
in
then holds: If GL2
x
is Shear
d k l gvalid
then
is shear
d k l gvalid
.
Example Let t =
where shear
d k l g
is Shear
d k l gvalid
then its
associated matrix (see GLTGL
) is an endo with dimension d
and has the form
k l [1 ] [ . ] [ . ] [ 1 ] [ s t ] k [ 1 ] [ . ] [ . ] [ 1 ] [ u v ] l [ 1 ] [ . ] [ . ] [ 1]
rdcGLTForm :: Oriented x => GLTForm x -> GLTForm x Source #
reduces a
to its normal form.GLTForm
x
Property Let f
be in
for a GLTForm
xOriented
structure x
,
then holds:
.rdcGLTForm
(rdcGLTForm
f)==
rdcGLTForm
f- For all exponents
z
in
holds:rdcGLTForm
f0
.<
z
type GLTForm x = ProductForm Z (Transformation x) Source #
form of GLT
.
gltfTrsp :: TransposableDistributive r => GLTForm r -> GLTForm r Source #
transposition of a product of elementary transformation.
FT
type FT x = Product Z (Transformation x) Source #
the free groupoid of Transformation
s.
Homomorphism
Ort
Oriented
homomorphisms.
TrFT :: Oriented x => TrApp (Transformation x) (FT x) | |
TrGL :: Distributive x => TrApp (Transformation x) (GL x) | |
TrGLT :: Oriented x => TrApp (Transformation x) (GLT x) |
Instances
Mlt
Multiplicative
homomorphisms.
FTGL :: Distributive x => GLApp (FT x) (GL x) | |
FTGLT :: Oriented x => GLApp (FT x) (GLT x) | |
GLTGL :: Distributive x => GLApp (GLT x) (GL x) | |
GL2GL :: Galoisian x => GLApp (GL2 x) (GL x) |