Obs(2) is a 4 dimensional Frobenius Algebra
Generators of Obs(2)
fricas
)set output abbreviate on
fricas
)set message type off
V := OrderedVariableList [p,q]
fricas
vars:List V := enumerate()$V
--Representation
fricas
M := FreeMonoid V
fricas
divisible := Record(lm: M,rm: M)
fricas
gamma(i:Symbol,j:Symbol):Symbol ==
concat([string 'γ,string i,string j])::Symbol
Function declaration gamma : (SYMBOL,SYMBOL) -> SYMBOL has been
added to workspace.
--subscript('γ,[concat(string i, string j)::Symbol])
mass(i:Symbol):Symbol ==
concat("m",string i)::Symbol
Function declaration mass : SYMBOL -> SYMBOL has been added to
workspace.
--subscript('m,[i])
B := OrderedVariableList(concat [ _
[mass i for i in vars], _
concat [[gamma(vars i ,vars j) for i in (j+1)..#vars] for j in 1..#vars] ])
fricas
Compiling function mass with type SYMBOL -> SYMBOL
fricas
Compiling function gamma with type (SYMBOL,SYMBOL) -> SYMBOL
fricas
K := FRAC SMP(Integer,B)
fricas
MK := FreeModule(K,M)
fricas
m(x:V):K == mass(x::Symbol)
Function declaration m : OVAR([p,q]) -> FRAC(SMP(INT,OVAR([mp,mq,γqp
]))) has been added to workspace.
m(vars 1)
fricas
Compiling function m with type OVAR([p,q]) -> FRAC(SMP(INT,OVAR([mp,
mq,γqp])))
fricas
γ(x:V,y:V):K ==
if x<y then
return variable(gamma(x::Symbol,y::Symbol))$B
if x>y then
return variable(gamma(y::Symbol,x::Symbol))$B
return 1
Function declaration γ : (OVAR([p,q]),OVAR([p,q])) -> FRAC(SMP(INT,
OVAR([mp,mq,γqp]))) has been added to workspace.
Compiled code for gamma has been cleared.
γ(vars 2,vars 1)
fricas
Compiling function gamma with type (SYMBOL,SYMBOL) -> SYMBOL
fricas
Compiling function γ with type (OVAR([p,q]),OVAR([p,q])) -> FRAC(SMP
(INT,OVAR([mp,mq,γqp])))
fricas
--Basis
basis:List M := concat(vars,concat [[i::M*j::M for j in vars | i~=j] for i in vars])
Idempotent: ii --> mᵢ γᵢᵢ i
fricas
idem(p:MK):MK ==
-- p = c*q
q := leadingSupport p
c := leadingCoefficient p
for i in vars::List M repeat
f := divide(q, i*i)
if f case divisible then -- q = f.lm * ii * f.rm
return monomial(c * m i * γ(i,i), elt(f,lm) * i * elt(f,rm))
--return monomial(c * γ(i,i), elt(f,lm) * i * elt(f,rm))
return p
Function declaration idem : FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),
FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),
FMONOID(OVAR([p,q]))) has been added to workspace.
idem(basis(1)*basis(1))
fricas
Compiling function idem with type FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))
),FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),
FMONOID(OVAR([p,q])))
Reductions: ijk --> mᵢmⱼ γᵢⱼγⱼₖ/γᵢₖ ik
fricas
reduct(p:MK):MK ==
q := leadingSupport p
c := leadingCoefficient p
for i in vars repeat
for j in vars::List M | j ~= i repeat
for k in vars::List M | k ~= j repeat
f:=divide(q, i*j*k)
if f case divisible then
return monomial(c * m j * γ(i,j) * γ(j,k) / γ(i,k), _
--return monomial(c * γ(i,j) * γ(j,k) / γ(i,k), _
elt(f,lm) * i * k * elt(f,rm))
return p
Function declaration reduct : FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),
FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),
FMONOID(OVAR([p,q]))) has been added to workspace.
reduct(basis(1)*basis(2)*basis(1))
fricas
Compiling function reduct with type FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]
))),FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),
FMONOID(OVAR([p,q])))
An endomorphism on the K-Module is defined by the fixed point of applied rules
fricas
Y(p:MK):MK ==
repeat
r := p; p := idem reduct r
if r=p then return p
Function declaration Y : FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),FMONOID
(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),FMONOID(
OVAR([p,q]))) has been added to workspace.
Y(basis(1)*basis(2))
fricas
Compiling function Y with type FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),
FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),
FMONOID(OVAR([p,q])))
Matrix
Algebra is the free algebra product modulo the fixed point
fricas
MT := [[Y(i*j) for j in basis] for i in basis]; matrix MT
Structure Constants
fricas
mat3(y:M):List List K == map(z+->map(x+->coefficient(x,y),z),MT)
Function declaration mat3 : FMONOID(OVAR([p,q])) -> LIST(LIST(FRAC(
SMP(INT,OVAR([mp,mq,γqp]))))) has been added to workspace.
ss:=map(mat3, basis); map(matrix,ss)
fricas
Compiling function mat3 with type FMONOID(OVAR([p,q])) -> LIST(LIST(
FRAC(SMP(INT,OVAR([mp,mq,γqp])))))
Algebra
fricas
cats(m:M):Symbol==concat(map(x+->string(x.gen::Symbol),factors m))::Symbol
Function declaration cats : FMONOID(OVAR([p,q])) -> SYMBOL has been
added to workspace.
A:=AlgebraGivenByStructuralConstants(K,#(basis)::PI,map(cats,basis),ss::Vector(Matrix K))
fricas
Compiling function cats with type FMONOID(OVAR([p,q])) -> SYMBOL
fricas
alternative?()$A
algebra satisfies 2*associator(a,b,b) = 0 = 2*associator(a,a,b) = 0
fricas
antiAssociative?()$A
algebra is not anti-associative
fricas
antiCommutative?()$A
algebra is not anti-commutative
fricas
associative?()$A
algebra is associative
fricas
commutative?()$A
algebra is not commutative
fricas
flexible?()$A
algebra is flexible
fricas
jacobiIdentity?()$A
Jacobi identity does not hold
fricas
jordanAdmissible?()$A
algebra is not Jordan admissible
fricas
jordanAlgebra?()$A
algebra is not commutative
this is not a Jordan algebra
fricas
leftAlternative?()$A
algebra is left alternative
fricas
lieAdmissible?()$A
algebra is Lie admissible
fricas
lieAlgebra?()$A
algebra is not anti-commutative
this is not a Lie algebra
fricas
--powerAssociative?()$A
rightAlternative?()$A
algebra is right alternative
Check Multiplication
fricas
AB := entries basis()$A
fricas
A2MK(z:A):MK==reduce(+,map((x:K,y:M):MK+->(x::K)*y,coordinates(z),basis))
Function declaration A2MK : ALGSC(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),4
,[p,q,pq,qp],[[[mp,0,0,γqp^2*mq*mp],[0,0,0,0],[γqp^2*mq*mp,0,0,
γqp^2*mq^2*mp],[0,0,0,0]],[[0,0,0,0],[0,mq,γqp^2*mq*mp,0],[0,0,0,
0],[0,γqp^2*mq*mp,γqp^2*mq*mp^2,0]],[[0,1,mp,0],[0,0,0,0],[0,mq,
γqp^2*mq*mp,0],[0,0,0,0]],[[0,0,0,0],[1,0,0,mq],[0,0,0,0],[mp,0,0
,γqp^2*mq*mp]]]) -> FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),FMONOID(
OVAR([p,q]))) has been added to workspace.
test(MT=map(x+->map(A2MK,x),[[i*j for j in AB] for i in AB]))
fricas
Compiling function A2MK with type ALGSC(FRAC(SMP(INT,OVAR([mp,mq,γqp
]))),4,[p,q,pq,qp],[[[mp,0,0,γqp^2*mq*mp],[0,0,0,0],[γqp^2*mq*mp,
0,0,γqp^2*mq^2*mp],[0,0,0,0]],[[0,0,0,0],[0,mq,γqp^2*mq*mp,0],[0,
0,0,0],[0,γqp^2*mq*mp,γqp^2*mq*mp^2,0]],[[0,1,mp,0],[0,0,0,0],[0,
mq,γqp^2*mq*mp,0],[0,0,0,0]],[[0,0,0,0],[1,0,0,mq],[0,0,0,0],[mp,
0,0,γqp^2*mq*mp]]]) -> FM(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),
FMONOID(OVAR([p,q])))
Trace
fricas
[rightTrace(i)$A for i in AB]
fricas
[leftTrace(i)$A for i in AB]
fricas
trace(i)==rightTrace(i) / #vars
[trace(i) for i in AB]
fricas
Compiling function trace with type ALGSC(FRAC(SMP(INT,OVAR([mp,mq,
γqp]))),4,[p,q,pq,qp],[[[mp,0,0,γqp^2*mq*mp],[0,0,0,0],[γqp^2*mq*
mp,0,0,γqp^2*mq^2*mp],[0,0,0,0]],[[0,0,0,0],[0,mq,γqp^2*mq*mp,0],
[0,0,0,0],[0,γqp^2*mq*mp,γqp^2*mq*mp^2,0]],[[0,1,mp,0],[0,0,0,0],
[0,mq,γqp^2*mq*mp,0],[0,0,0,0]],[[0,0,0,0],[1,0,0,mq],[0,0,0,0],[
mp,0,0,γqp^2*mq*mp]]]) -> FRAC(SMP(INT,OVAR([mp,mq,γqp])))
fricas
p:=AB(1); q:=AB(2);
test(p*p=trace(p)*p)
fricas
test(q*q=trace(q)*q)
Center
fricas
C:=basisOfCenter()$AlgebraPackage(K,A); # C
fricas
c:=C(1)
fricas
[c*i-i*c for i in AB]
fricas
c*c
fricas
test(c*c=c)
Unit
fricas
n := #vars/trace(c) * c
fricas
test(n = unit()$A)
fricas
trace(n)
fricas
test(n*n=n)
fricas
f:=gcd map(x+->denom x,coordinates(n))
fricas
--Silberstein symmetric matrix
ff:= matrix [[(i=j => 1$K; γ(i,j)) for j in vars] for i in vars]
fricas
test(f = - determinant(ff))
fricas
(f*n)::OutputForm / f::OutputForm
Orthogonal Observers
fricas
dual(p) == trace(p)*n - p
--dual(p) == n - (1/trace(p))*p
p' := dual p
fricas
Compiling function dual with type ALGSC(FRAC(SMP(INT,OVAR([mp,mq,γqp
]))),4,[p,q,pq,qp],[[[mp,0,0,γqp^2*mq*mp],[0,0,0,0],[γqp^2*mq*mp,
0,0,γqp^2*mq^2*mp],[0,0,0,0]],[[0,0,0,0],[0,mq,γqp^2*mq*mp,0],[0,
0,0,0],[0,γqp^2*mq*mp,γqp^2*mq*mp^2,0]],[[0,1,mp,0],[0,0,0,0],[0,
mq,γqp^2*mq*mp,0],[0,0,0,0]],[[0,0,0,0],[1,0,0,mq],[0,0,0,0],[mp,
0,0,γqp^2*mq*mp]]]) -> ALGSC(FRAC(SMP(INT,OVAR([mp,mq,γqp]))),4,[
p,q,pq,qp],[[[mp,0,0,γqp^2*mq*mp],[0,0,0,0],[γqp^2*mq*mp,0,0,γqp^
2*mq^2*mp],[0,0,0,0]],[[0,0,0,0],[0,mq,γqp^2*mq*mp,0],[0,0,0,0],[
0,γqp^2*mq*mp,γqp^2*mq*mp^2,0]],[[0,1,mp,0],[0,0,0,0],[0,mq,γqp^2
*mq*mp,0],[0,0,0,0]],[[0,0,0,0],[1,0,0,mq],[0,0,0,0],[mp,0,0,γqp^
2*mq*mp]]])
fricas
trace p'
fricas
p'' := dual p'
fricas
trace p''
fricas
test(p' * p' = trace(p')*p')
fricas
p * p'
fricas
p' * p
fricas
q' := dual q
fricas
trace(q')
fricas
test(q' * q' = trace(q')*q')
fricas
q * q'
fricas
q' * q
fricas
p' * q'
fricas
q' * p'
fricas
p' * q
fricas
q * p'
fricas
p * q'
fricas
q' * p
Orthogonal Observers are Derivations if there are only two observers
fricas
test(p'*(p*q) = (p'*p)*q + p*(p'*q))
fricas
test(q'*(p*q) = (q'*p)*q + p*(q'*q))
fricas
test((p*q)*p' = (p*p')*q + p*(q*p'))
fricas
test((p*q)*q' = (p*q')*q + p*(q*q'))
Momentum
fricas
P:=reduce(+,concat [[1/γ(basis i,basis j)*AB(i)*AB(j) for j in 1..size()$V] for i in 1..size()$V])
fricas
trace(P)
fricas
u:=1/trace(P)*P
fricas
u*u-u
fricas
trace(u)
All idempotents
fricas
ideq:=conditionsForIdempotents()$GCNAALG(K,#(basis)::PI,map(cats,basis),ss::Vector(Matrix K))
fricas
gbs:=groebnerFactorize ideq;
#gbs
fricas
gbs.9
fricas
s9:=solve(gbs.9);
i9:=represents(reverse map(rhs,s9.1))$A
fricas
test(i9=n)
fricas
gbs.8
fricas
s8:=solve(gbs.8);
i8:=represents(reverse map(rhs,s8.1))$A
fricas
test(i8=n-1/trace(p*q)*p*q)
fricas
gbs.7
fricas
s7:=solve(gbs.7);
i7:=represents(reverse map(rhs,s7.1))$A
fricas
test(i7=n-1/trace(q*p)*q*p)
fricas
gbs.6
fricas
s6:=solve(gbs.6);
i6:=represents(reverse map(rhs,s6.1))$A
fricas
test(i6=1/trace(q*p)*q*p)
fricas
gbs.5
fricas
s5:=solve(gbs.5)
fricas
gbs.4
fricas
s4:=solve(gbs.4);
i4:=represents(reverse map(rhs,s4.1))$A
fricas
gbs.3
fricas
s3:=solve(gbs.3);
i3:=represents(reverse map(rhs,s3.1))$A
fricas
test(i3=1/trace(p*q)*p*q)
fricas
gbs.2
fricas
-- apparently we need to look for solutions in a larger ring
ex2:=map(x+->interpret(x::InputForm)$InputFormFunctions1(FRAC POLY INT),concat(gbs.2,[%x3-%x4]));
s2:=solve(ex2,[%x1,%x2,%x3,%x4]);
#s2
fricas
-- need this to convert solution back to K
(mp,mq,γqp):K
i2:=represents(map(x+->interpret(rhs(x)::InputForm)$InputFormFunctions1(K),s2.1))$A
fricas
i2':=represents(map(x+->interpret(rhs(x)::InputForm)$InputFormFunctions1(K),s2.2))$A
fricas
test(n=i2+i2')
fricas
i2*i2'
fricas
i2'*i2
fricas
-- decomposition
test(i2*p+i2'*p=p)
fricas
test(i2*q+i2'*q=q)
fricas
test(i2*(p*q)+i2'*(p*q)=p*q)
fricas
test(i2*(q*p)+i2'*(q*p)=q*p)
fricas
expr2:=map(x+->interpret(x::InputForm)$InputFormFunctions1(EXPR INT)=0,concat(gbs.2,[]));
s2b:=solve(expr2,[%x1,%x2,%x3]);
#s2b
fricas
s2b.1
fricas
s2b.2
fricas
gbs.1
fricas
s1:=solve(concat(gbs.1,[%x1-m('p)/trace(P),%x2-m('q)/trace(P)]));
i1:=represents(reverse map(rhs,s1.1))$A
fricas
test(i1=u)
fricas
eval(gbs.1,[x=e for x in [%x1,%x2,%x3,%x4] for e in entries coordinates(u)])
fricas
eval(gbs.1,[x=e for x in [%x1,%x2,%x3,%x4] for e in entries coordinates(n-u)])
fricas
)set output tex off
fricas
)set output algebra on
fricas
expr1a:=map(x+->interpret(x::InputForm)$InputFormFunctions1(EXPR INT)=0,concat(gbs.1,[]));
solve(expr1a,[%x1,%x2])
(144)
[
[
%x1
=
ROOT
2 2 2 2 4
(%x4 + 2%x3 %x4 + %x3 )mp mq γqp
+
2 2 2
(- 4%x3 %x4 mp mq + (- 2%x4 - 2%x3)mp mq)γqp + 1
+
2
(- %x4 - %x3)mp mq γqp + 1
/
2mp
,
%x2
=
-
ROOT
2 2 2 2 4
(%x4 + 2%x3 %x4 + %x3 )mp mq γqp
+
2 2 2
(- 4%x3 %x4 mp mq + (- 2%x4 - 2%x3)mp mq)γqp + 1
+
2
(- %x4 - %x3)mp mq γqp + 1
/
2mq
]
,
[
%x1
=
-
ROOT
2 2 2 2 4
(%x4 + 2%x3 %x4 + %x3 )mp mq γqp
+
2 2 2
(- 4%x3 %x4 mp mq + (- 2%x4 - 2%x3)mp mq)γqp + 1
+
2
(- %x4 - %x3)mp mq γqp + 1
/
2mp
,
%x2
=
ROOT
2 2 2 2 4
(%x4 + 2%x3 %x4 + %x3 )mp mq γqp
+
2 2 2
(- 4%x3 %x4 mp mq + (- 2%x4 - 2%x3)mp mq)γqp + 1
+
2
(- %x4 - %x3)mp mq γqp + 1
/
2mq
]
]
expr1b:=map(x+->interpret(x::InputForm)$InputFormFunctions1(EXPR INT)=0,concat(gbs.1,[%x3-%x4]));
solve(expr1b,[%x1,%x2,%x3])
(146)
[
[
%x1
=
+------------------------------------------------------+
| 2 2 2 4 2 2 2 2
- \|4%x4 mp mq γqp + (- 4%x4 mp mq - 4%x4 mp mq)γqp + 1
+
2
- 2%x4 mp mq γqp + 1
/
2mp
,
%x2
=
+------------------------------------------------------+
| 2 2 2 4 2 2 2 2
\|4%x4 mp mq γqp + (- 4%x4 mp mq - 4%x4 mp mq)γqp + 1
+
2
- 2%x4 mp mq γqp + 1
/
2mq
,
%x3 = %x4]
,
[
%x1
=
+------------------------------------------------------+
| 2 2 2 4 2 2 2 2
\|4%x4 mp mq γqp + (- 4%x4 mp mq - 4%x4 mp mq)γqp + 1
+
2
- 2%x4 mp mq γqp + 1
/
2mp
,
%x2
=
+------------------------------------------------------+
| 2 2 2 4 2 2 2 2
- \|4%x4 mp mq γqp + (- 4%x4 mp mq - 4%x4 mp mq)γqp + 1
+
2
- 2%x4 mp mq γqp + 1
/
2mq
,
%x3 = %x4]
]