--Copyright The Numerical Algorithms Group Limited 1991.

-------------  Some examples of algebras in genetics  -------------

-- Literature:
-- [WB] A. Woerz-Busekros: Algebras in Genetics, LNB 36,
-- Springer-Verlag, Berlin etc. 1980.



---------------  Commutative, non-associative algebras  --



-- A Gonshor genetic algebra ([WB], p. 41-42) of dimension 4:
-- =========================================================

)clear all

-- The coefficient ring:
R := FRAC POLY INT

-- The following multiplication constants may be chosen arbitrarily
-- (notice that we write ckij for c_(i,j)^k):

(c100, c101, _
c200, c201, c202, c211, _
c300, c301, c302, c303, c311, c312, c322) : R

----------------------------------------------------------------
c100 :=  1 ;     c101 := -1 ;
----------------------------------------------------------------
c200 :=  0 ;     c201 :=  1 ;     c202 := -1 ;
                 c211 :=  2 ;
----------------------------------------------------------------
c300 :=  1 ;     c301 :=  0 ;     c302 := -1 ;     c303 :=  1 ;
                 c311 :=  1 ;     c312 :=  0 ;
                                  c322 :=  2 ;
----------------------------------------------------------------

-- The matrices of the multiplication constants:

gonshor : List SquareMatrix(4,R) :=
  [matrix [ [1, 0, 0, 0], [0, 0, 0, 0],_
            [0, 0, 0, 0], [0, 0, 0, 0] ],_
   matrix [ [c100, c101, 0, 0], [c101, 0, 0, 0],_
            [0, 0, 0, 0], [0, 0, 0, 0] ],_
   matrix [ [c200, c201, c202, 0], [c201, c211, 0, 0],_
            [c202, 0, 0, 0], [0, 0, 0, 0] ],_
   matrix [ [c300, c301, c302, c303], [c301, c311, c312, 0],_
            [c302, c312, c322, 0], [c303, 0, 0, 0] ] ] ;


basisSymbols : List Symbol := [subscript(e,[i]) for i in 0..3]

GonshorGenetic := ALGSC(R, 4, basisSymbols, gonshor)

commutative?()$GonshorGenetic
associative?()$GonshorGenetic

-- The canonical basis:
e0 : GonshorGenetic := [1, 0, 0, 0] :: Vector R 
e1 : GonshorGenetic := [0, 1, 0, 0] :: Vector R 
e2 : GonshorGenetic := [0, 0, 1, 0] :: Vector R 
e3 : GonshorGenetic := [0, 0, 0, 1] :: Vector R 


-- A generic element of the algebra:
x  : GonshorGenetic := x0*e0 + x1*e1 + x2*e2 + x3*e3

-- The matrix of the left multiplication with x :
Lx := leftRegularRepresentation x

-- leftRegularRepresentationt 8 : GonshorGenetic -> R be the weight homomorphism
-- defined by 8(e0) := 1 and 8(ei) := 0 for i = 1,2,3 .
-- The coefficients of the characteristic polynomial
-- of Lx depend only on 8(x) = x0 :
p := characteristicPolynomial(Lx,Y)

-- The left minimal polynomial of x divides Y * p(Y) :
leftMinimalPolynomial x


)clear prop A a b c r s
A := GonshorGenetic
a := x
b := (1/4)*e1 + (1/5)*e2 + (3/20)*e3 + (2/5)*e0
c := (1/3)*e1 + (1/7)*e2 + (8/21)*e3 + (1/7)*e0
r  : R := r
s  : R := s

b*c
(b*c)*b
b*(c*b)

-- A: Algebra
-- a,b,c : A
-- r,s : R

)clear prop AP
AP := ALGPKG(R,A)

r*a
a*r

a*b
b*c

12 * c
(-3) * a

d  :=  a ** 12
-d

a + b
d-c

(a*(a*a) = leftPower(a,3)) :: Boolean
(a ** 11 =  (a**8 * a**2) * a) :: Boolean
(a ** 11 =  a**8 * (a**2 * a)) :: Boolean


zero := 0$A
zero : A := 0

alternative?()$A
antiCommutative?()$A
associative?()$A
commutative?()$A

commutator(a,b)
antiCommutator(a,b)
associator(a,b,c)
basis()$A

n := rank()$A
v : Vector R := [i for i in 1..n]
g : A := represents  v

coordinates a
coordinates [a,b]

a.3

flexible?()$A
leftAlternative?()$A

rightAlternative?()$A
sB := someBasis()$A
zero? a
associatorDependence()$A
--conditionsForIdempotents()$A
jacobiIdentity?()$A
jordanAlgebra?()$A
jordanAdmissible?()$A
lieAdmissible?()$A
--conditionsForIdempotents sB
b2 := [reduce(+,[sB.i for i in 1..k]) for k in 1..n]
coordinates  (a ,b2 :: Vector A)
coordinates  ([a,b] ,bb := (b2 :: Vector A))
leftMinimalPolynomial a
leftPower (a,10)
rightPower(a,10)
leftRegularRepresentation a
leftRegularRepresentation (a,bb)
leftUnit()$A
represents (v,bb)
rightMinimalPolynomial a
rightRegularRepresentation a
rightRegularRepresentation (a,bb)
rightUnit()$A
structuralConstants()$A
structuralConstants(bb)
unit()$A


-- functions from ALGPKG

biRank  a
leftRank a
doubleRank a
rightRank a
weakBiRank a


basisOfCenter()$AP
basisOfLeftNucleus()$AP
basisOfNucleus()$AP
basisOfRightNucleus()$AP
basisOfCentroid()$AP
basisOfCommutingElements()$AP
basisOfLeftNucloid()$AP
basisOfMiddleNucleus()$AP
basisOfRightNucloid()$AP


