MathAction SandBoxAlgebraOfObservers2

• FrontPage
  • SandBox
    • SandBoxObserverAsIdempotent
      • SandBoxObserverAsIdempotent2
        • SandBoxAlgebraOfObservers2 <-- You are here.

Obs(2) is a 4 dimensional Frobenius Algebra

Generators of Obs(2)

(1) -> )set output abbreviate on
 

)set message type off

V := OrderedVariableList [p,q]

vars:List V := enumerate()$V

--Representation

M := FreeMonoid V

divisible := Record(lm: M,rm: M)

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 [ ['x1,'x2,'x3,'x4], _
 [mass i for i in vars], _
 concat [[gamma(vars i ,vars j) for i in (j+1)..#vars] for j in 1..#vars] ])

Compiling function mass with type SYMBOL -> SYMBOL

Compiling function gamma with type (SYMBOL, SYMBOL) -> SYMBOL

K := FRAC SMP(Integer,B)

MK := FreeModule(K,M)

m(x:V):K == mass(x::Symbol)

 Function declaration m : OVAR([p,q]) -> FRAC(SMP(INT,OVAR([x1,x2,x3,
 x4,mp,mq,γqp]))) has been added to workspace.
m(vars 1)

Compiling function m with type OVAR([p,q]) -> FRAC(SMP(INT,OVAR([x1,
 x2,x3,x4,mp,mq,γqp])))

γ(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([x1,x2,x3,x4,mp,mq,γqp]))) has been added to workspace.
 Compiled code for gamma has been cleared.
γ(vars 2,vars 1)

Compiling function gamma with type (SYMBOL, SYMBOL) -> SYMBOL

Compiling function γ with type (OVAR([p,q]), OVAR([p,q])) -> FRAC(
 SMP(INT,OVAR([x1,x2,x3,x4,mp,mq,γqp])))

--Basis
basis:List M := concat(vars,concat [[i::M*j::M for j in vars | i~=j] for i in vars])

Idempotent: ii --> mi γii i

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([x1,x2,x3,x4,mp,mq,
 γqp]))),FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([x1,x2,x3,
 x4,mp,mq,γqp]))),FMONOID(OVAR([p,q]))) has been added to 
 workspace.
idem(basis(1)*basis(1))

Compiling function idem with type FM(FRAC(SMP(INT,OVAR([x1,x2,x3,x4,
 mp,mq,γqp]))),FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([x1,
 x2,x3,x4,mp,mq,γqp]))),FMONOID(OVAR([p,q])))

Reductions: ijk --> mimj γijγjk/γik ik

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([x1,x2,x3,x4,mp,
 mq,γqp]))),FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([x1,x2,
 x3,x4,mp,mq,γqp]))),FMONOID(OVAR([p,q]))) has been added to 
 workspace.
reduct(basis(1)*basis(2)*basis(1))

Compiling function reduct with type FM(FRAC(SMP(INT,OVAR([x1,x2,x3,
 x4,mp,mq,γqp]))),FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([
 x1,x2,x3,x4,mp,mq,γqp]))),FMONOID(OVAR([p,q])))

An endomorphism on the K-Module is defined by the fixed point of applied rules

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([x1,x2,x3,x4,mp,mq,γqp
 ]))),FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([x1,x2,x3,x4,
 mp,mq,γqp]))),FMONOID(OVAR([p,q]))) has been added to workspace.
Y(basis(1)*basis(2))

Compiling function Y with type FM(FRAC(SMP(INT,OVAR([x1,x2,x3,x4,mp,
 mq,γqp]))),FMONOID(OVAR([p,q]))) -> FM(FRAC(SMP(INT,OVAR([x1,x2,
 x3,x4,mp,mq,γqp]))),FMONOID(OVAR([p,q])))

Matrix

Algebra is the free algebra product modulo the fixed point

MT := [[Y(i*j) for j in basis] for i in basis]; matrix MT

Structure Constants

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([x1,x2,x3,x4,mp,mq,γqp]))))) has been added to 
 workspace.
ss:=map(mat3, basis); map(matrix,ss)

Compiling function mat3 with type FMONOID(OVAR([p,q])) -> LIST(LIST(
 FRAC(SMP(INT,OVAR([x1,x2,x3,x4,mp,mq,γqp])))))

Algebra

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))

Compiling function cats with type FMONOID(OVAR([p,q])) -> SYMBOL

alternative?()$A

antiAssociative?()$A

antiCommutative?()$A

associative?()$A

commutative?()$A

flexible?()$A

jacobiIdentity?()$A

jordanAdmissible?()$A

jordanAlgebra?()$A

leftAlternative?()$A

lieAdmissible?()$A

lieAlgebra?()$A

--powerAssociative?()$A
rightAlternative?()$A

Check Multiplication

AB := entries basis()$A

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([x1,x2,x3,x4,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([x1,x2,x3,x4,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]))

Compiling function A2MK with type ALGSC(FRAC(SMP(INT,OVAR([x1,x2,x3,
 x4,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([x1,x2,x3
 ,x4,mp,mq,γqp]))),FMONOID(OVAR([p,q])))

Trace

[rightTrace(i)$A for i in AB]

[leftTrace(i)$A for i in AB]

trace(i)==rightTrace(i) / #vars

[trace(i) for i in AB]

Compiling function trace with type ALGSC(FRAC(SMP(INT,OVAR([x1,x2,x3
 ,x4,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([x1,x2,x3,
 x4,mp,mq,γqp])))

p:=AB(1); q:=AB(2);

test(p*p=trace(p)*p)

test(q*q=trace(q)*q)

Center

C:=basisOfCenter()$AlgebraPackage(K,A); # C

c:=C(1)

[c*i-i*c for i in AB]

c*c

test(c*c=c)

Unit

n := #vars/trace(c) * c

test(n = unit()$A)

trace(n)

test(n*n=n)

f:=gcd map(x+->denom x,coordinates(n))

--Silberstein symmetric matrix
ff:= matrix [[(i=j => 1$K; γ(i,j)) for j in vars] for i in vars]

test(f = - determinant(ff))

(f*n)::OutputForm / f::OutputForm

Orthogonal Observers

dual(p) == trace(p)*n - p

--dual(p) == n - (1/trace(p))*p
p' := dual p

Compiling function dual with type ALGSC(FRAC(SMP(INT,OVAR([x1,x2,x3,
 x4,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([x1,x2
 ,x3,x4,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]]])

trace p'

p'' := dual p'

trace p''

test(p' * p' = trace(p')*p')

p * p'

p' * p

q' := dual q

trace(q')

test(q' * q' = trace(q')*q')

q * q'

q' * q

p' * q'

q' * p'

p' * q

q * p'

p * q'

q' * p

Orthogonal Observers are Derivations if there are only two observers

test(p'*(p*q) = (p'*p)*q + p*(p'*q))

test(q'*(p*q) = (q'*p)*q + p*(q'*q))

test((p*q)*p' = (p*p')*q + p*(q*p'))

test((p*q)*q' = (p*q')*q + p*(q*q'))

Momentum

P:=reduce(+,concat [[1/γ(basis i,basis j)*AB(i)*AB(j) for j in 1..size()$V] for i in 1..size()$V])

trace(P)

u:=1/trace(P)*P

u*u-u

trace(u)

All idempotents

x:=x1*p+x2*q+x3*p*q+x4*q*p

 Compiled code for A2MK has been cleared.
 Compiled code for cats has been cleared.
 Compiled code for mat3 has been cleared.

ideq:=conditionsForIdempotents()$GCNAALG(K,#(basis)::PI,map(cats,basis),ss::Vector(Matrix K))

Compiling function cats with type FMONOID(OVAR([p,q])) -> SYMBOL

gbs:=groebnerFactorize ideq;

#gbs

gbs.9

s9:=solve(gbs.9);

i9:=represents(reverse map(rhs,s9.1))$A

test(i9=n)

gbs.8

s8:=solve(gbs.8);

i8:=represents(reverse map(rhs,s8.1))$A

test(i8=n-1/trace(p*q)*p*q)

gbs.7

s7:=solve(gbs.7);

i7:=represents(reverse map(rhs,s7.1))$A

test(i7=n-1/trace(q*p)*q*p)

gbs.6

s6:=solve(gbs.6);

i6:=represents(reverse map(rhs,s6.1))$A

test(i6=1/trace(q*p)*q*p)

gbs.5

s5:=solve(gbs.5)

gbs.4

s4:=solve(gbs.4);

i4:=represents(reverse map(rhs,s4.1))$A

gbs.3

s3:=solve(gbs.3);

i3:=represents(reverse map(rhs,s3.1))$A

test(i3=1/trace(p*q)*p*q)

gbs.2

-- 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

-- 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

i2':=represents(map(x+->interpret(rhs(x)::InputForm)$InputFormFunctions1(K),s2.2))$A

test(n=i2+i2')

i2*i2'

i2'*i2

-- decomposition
i2*x

i2'*x

test(i2*p+i2'*p=p)

test(i2*q+i2'*q=q)

test(i2*(p*q)+i2'*(p*q)=p*q)

test(i2*(q*p)+i2'*(q*p)=q*p)

expr2:=map(x+->interpret(x::InputForm)$InputFormFunctions1(EXPR INT)=0,concat(gbs.2,[]));

s2b:=solve(expr2,[%x1,%x2,%x3]);

#s2b

s2b.1

s2b.2

gbs.1

s1:=solve(concat(gbs.1,[%x1-m('p)/trace(P),%x2-m('q)/trace(P)]));

 >> Error detected within library code:
 factor for this domain is unimplemented

)set output tex off
 

)set output algebra on

expr1a:=map(x+->interpret(x::InputForm)$InputFormFunctions1(EXPR INT)=0,concat(gbs.1,[]));

solve(expr1a,[%x1,%x2])

 (142)
 [
 [
 %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
 /
 2 mp
 ,

 %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
 /
 2 mq
 ]
 ,

 [
 %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
 /
 2 mp
 ,

 %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
 /
 2 mq
 ]
 ]

expr1b:=map(x+->interpret(x::InputForm)$InputFormFunctions1(EXPR INT)=0,concat(gbs.1,[%x3-%x4]));

solve(expr1b,[%x1,%x2,%x3])

 (144)
 [
 [
 %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
 /
 2 mp
 ,

 %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
 /
 2 mq
 ,
 %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
 /
 2 mp
 ,

 %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
 /
 2 mq
 ,
 %x3 = %x4]
 ]