There is are some domains in Axiom for doing computations with
non-commuting variables developed by Michel Petitot. You can find
some examples in the Axiom book under the title XPolynomial? but
unfortunately the explanations are a little terse. You can
also check for documentation in the source files:
http://wiki.axiom-developer.org/axiom--test--1/src/input/XpolyInput
http://wiki.axiom-developer.org/axiom--test--1/src/algebra/XpolySpad
http://wiki.axiom-developer.org/axiom--test--1/src/input/LpolyInput
http://wiki.axiom-developer.org/axiom--test--1/src/algebra/XLpolySpad
Missing div
The version of OrderedFreeMonoid? in the Axiom library is missing
the implementation of the function "div" which provides left and right
quotients. Below we include a version of div based on divide from
'FreeMonoid?':
http://wiki.axiom-developer.org/axiom--test--1/src/algebra/FreeSpad
We need left and right quotients to implement the substitution rules
in the example below.
spad
)abbrev domain OFMONOID OrderedFreeMonoid
++ Author: Michel Petitot petitot@lifl.fr
++ Date Created: 91
++ Date Last Updated: 7 Juillet 92
++ Fix History: compilation v 2.1 le 13 dec 98
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ The free monoid on a set \spad{S} is the monoid of finite products of
++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's
++ are non-negative integers. The multiplication is not commutative.
++ For two elements \spad{x} and \spad{y} the relation \spad{x < y}
++ holds if either \spad{length(x) < length(y)} holds or if these lengths
++ are equal and if \spad{x} is smaller than \spad{y} w.r.t. the lexicographical
++ ordering induced by \spad{S}.
++ This domain inherits implementation from \spadtype{FreeMonoid}.
++ Author: Michel Petitot (petitot@lifl.fr)
OrderedFreeMonoid(S: OrderedSet): OFMcategory == OFMdefinition where
NNI ==> NonNegativeInteger
REC ==> Record(gen:S, exp:NNI)
OFMcategory == Join(OrderedMonoid, RetractableTo S) with
"*": (S, %) -> %
++ \spad{s * x} returns the product of \spad{x} by \spad{s} on the left.
"*": (%, S) -> %
++ \spad{x * s} returns the product of \spad{x} by \spad{s} on the right.
"**": (S, NNI) -> %
++ \spad{s ** n} returns the product of \spad{s} by itself \spad{n} times.
first: % -> S
++ \spad{first(x)} returns the first letter of \spad{x}.
rest: % -> %
++ \spad{rest(x)} returns \spad{x} except the first letter.
mirror: % -> %
++ \spad{mirror(x)} returns the reversed word of \spad{x}.
lexico: (%,%) -> Boolean
++ \spad{lexico(x,y)} returns \spad{true} iff \spad{x} is smaller than \spad{y}
++ w.r.t. the pure lexicographical ordering induced by \spad{S}.
hclf: (%, %) -> %
++ \spad{hclf(x, y)} returns the highest common left factor
++ of \spad{x} and \spad{y},
++ that is the largest \spad{d} such that \spad{x = d a} and \spad{y = d b}.
hcrf: (%, %) -> %
++ \spad{hcrf(x, y)} returns the highest common right
++ factor of \spad{x} and \spad{y},
++ that is the largest \spad{d} such that \spad{x = a d} and \spad{y = b d}.
lquo: (%, %) -> Union(%, "failed")
++ \spad{lquo(x, y)} returns the exact left quotient of \spad{x}
++ by \spad{y} that is \spad{q} such that \spad{x = y * q},
++ "failed" if \spad{x} is not of the form \spad{y * q}.
rquo: (%, %) -> Union(%, "failed")
++ \spad{rquo(x, y)} returns the exact right quotient of \spad{x}
++ by \spad{y} that is \spad{q} such that \spad{x = q * y},
++ "failed" if \spad{x} is not of the form \spad{q * y}.
lquo: (%, S) -> Union(%, "failed")
++ \spad{lquo(x, s)} returns the exact left quotient of \spad{x}
++ by \spad{s}.
rquo: (%, S) -> Union(%, "failed")
++ \spad{rquo(x, s)} returns the exact right quotient
++ of \spad{x} by \spad{s}.
"div": (%, %) -> Union(ok:Record(lm: %, rm: %), bad:"failed")
++ \spad{divide(x, y)} returns the left and right exact quotients of
++ \spad{x} by \spad{y}, that is \spad{[l, r]} such that \spad{x = l * y * r}.
++ "failed" is returned iff \spad{x} is not of the form \spad{l * y * r}.
overlap: (%, %) -> Record(lm: %, mm: %, rm: %)
++ \spad{overlap(x, y)} returns \spad{[l, m, r]} such that
++ \spad{x = l * m} and \spad{y = m * r} hold and such that
++ \spad{l} and \spad{r} have no overlap,
++ that is \spad{overlap(l, r) = [l, 1, r]}.
size: % -> NNI
++ \spad{size(x)} returns the number of monomials in \spad{x}.
nthExpon: (%, Integer) -> NNI
++ \spad{nthExpon(x, n)} returns the exponent of the
++ \spad{n-th} monomial of \spad{x}.
nthFactor: (%, Integer) -> S
++ \spad{nthFactor(x, n)} returns the factor of the \spad{n-th}
++ monomial of \spad{x}.
factors: % -> List REC
++ \spad{factors(a1\^e1,...,an\^en)} returns \spad{[[a1, e1],...,[an, en]]}.
length: % -> NNI
++ \spad{length(x)} returns the length of \spad{x}.
varList: % -> List S
++ \spad{varList(x)} returns the list of variables of \spad{x}.
OFMdefinition == FreeMonoid(S) add
Rep := ListMonoidOps(S, NNI, 1)
-- definitions
lquo(w:%, l:S) ==
x: List REC := listOfMonoms(w)$Rep
null x => "failed"
fx: REC := first x
fx.gen ^= l => "failed"
fx.exp = 1 => makeMulti rest(x)
makeMulti [[fx.gen, (fx.exp - 1)::NNI ]$REC, :rest x]
rquo(w:%, l:S) ==
u:% := reverse w
(r := lquo (u,l)) case "failed" => "failed"
reverse_! (r::%)
-- Inserted by Bill Page, based on 'divide' from 'FreeMonoid'
lar:% div a:% ==
(a = 1) => [[lar, 1]]
Na : Integer := #(la := listOfMonoms(a)$Rep)
Nlar : Integer := #(llar := listOfMonoms(lar)$Rep)
l:List(REC) := empty()
while Na <= Nlar repeat
if llar.first.gen = la.first.gen and
llar.first.exp >= la.first.exp then
-- Can match a portion of this lar factor.
-- Now match tail.
(q:=lquo(makeMulti rest llar,makeMulti rest la))case $ =>
if llar.first.exp > la.first.exp then
l := concat_!(l, [la.first.gen,
(llar.first.exp - la.first.exp)::NNI])
return [[makeMulti l, q::%]]
l := concat_!(l, first llar)
llar := rest llar
Nlar := Nlar - 1
["failed"]
length x == reduce("+" ,[f.exp for f in listOfMonoms x], 0)
varList x ==
le: List S := [t.gen for t in listOfMonoms x]
sort_! removeDuplicates(le)
first w ==
x: List REC := listOfMonoms w
null x => error "empty word !!!"
x.first.gen
rest w ==
x: List REC := listOfMonoms w
null x => error "empty word !!!"
fx: REC := first x
fx.exp = 1 => makeMulti rest x
makeMulti [[fx.gen , (fx.exp - 1)::NNI ]$REC , :rest x]
lexico(a,b) == -- ordre lexicographique
la := listOfMonoms a
lb := listOfMonoms b
while (not null la) and (not null lb) repeat
la.first.gen > lb.first.gen => return false
la.first.gen < lb.first.gen => return true
if la.first.exp = lb.first.exp then
la:=rest la
lb:=rest lb
else if la.first.exp > lb.first.exp then
la:=concat([la.first.gen,
(la.first.exp - lb.first.exp)::NNI], rest lb)
lb:=rest lb
else
lb:=concat([lb.first.gen,
(lb.first.exp-la.first.exp)::NNI], rest la)
la:=rest la
empty? la and not empty? lb
a < b == -- ordre lexicographique par longueur
la:NNI := length a; lb:NNI := length b
la = lb => lexico(a,b)
la < lb
mirror x == reverse(x)$Rep
spad
Compiling FriCAS source code from file
/var/zope2/var/LatexWiki/5801890838121915026-25px001.spad using
old system compiler.
OFMONOID abbreviates domain OrderedFreeMonoid
processing macro definition NNI ==> NonNegativeInteger
processing macro definition REC ==> Record(gen: S,exp: NonNegativeInteger)
------------------------------------------------------------------------
initializing NRLIB OFMONOID for OrderedFreeMonoid
compiling into NRLIB OFMONOID
compiling exported lquo : ($,S) -> Union($,failed)
Time: 0.02 SEC.
compiling exported rquo : ($,S) -> Union($,failed)
Time: 0 SEC.
compiling exported div : ($,$) -> Union(ok: Record(lm: $,rm: $),bad: failed)
Time: 0.10 SEC.
compiling exported length : $ -> NonNegativeInteger
Time: 0 SEC.
compiling exported varList : $ -> List S
Time: 0.04 SEC.
compiling exported first : $ -> S
Time: 0.01 SEC.
compiling exported rest : $ -> $
Time: 0.01 SEC.
compiling exported lexico : ($,$) -> Boolean
Time: 0.02 SEC.
compiling exported < : ($,$) -> Boolean
Time: 0 SEC.
compiling exported mirror : $ -> $
Time: 0 SEC.
(time taken in buildFunctor: 0)
;;; *** |OrderedFreeMonoid| REDEFINED
;;; *** |OrderedFreeMonoid| REDEFINED
Time: 0.04 SEC.
Warnings:
[1] div: l has no value
Cumulative Statistics for Constructor OrderedFreeMonoid
Time: 0.24 seconds
--------------non extending category----------------------
.. OrderedFreeMonoid #1 of cat
(|Join| (|OrderedMonoid|) (|RetractableTo| |#1|)
(CATEGORY |domain| (SIGNATURE * ($ |#1| $))
(SIGNATURE * ($ $ |#1|))
(SIGNATURE ** ($ |#1| (|NonNegativeInteger|)))
(SIGNATURE |first| (|#1| $)) (SIGNATURE |rest| ($ $))
(SIGNATURE |mirror| ($ $))
(SIGNATURE |lexico| ((|Boolean|) $ $))
(SIGNATURE |hclf| ($ $ $)) (SIGNATURE |hcrf| ($ $ $))
(SIGNATURE |lquo| ((|Union| $ "failed") $ $))
(SIGNATURE |rquo| ((|Union| $ "failed") $ $))
(SIGNATURE |lquo| ((|Union| $ "failed") $ |#1|))
(SIGNATURE |rquo| ((|Union| $ "failed") $ |#1|))
(SIGNATURE |div|
((|Union| (|:| |ok|
(|Record| (|:| |lm| $) (|:| |rm| $)))
(|:| |bad| "failed"))
$ $))
(SIGNATURE |overlap|
((|Record| (|:| |lm| $) (|:| |mm| $) (|:| |rm| $)) $ $))
(SIGNATURE |size| ((|NonNegativeInteger|) $))
(SIGNATURE |nthExpon|
((|NonNegativeInteger|) $ (|Integer|)))
(SIGNATURE |nthFactor| (|#1| $ (|Integer|)))
(SIGNATURE |factors|
((|List| (|Record| (|:| |gen| |#1|)
(|:| |exp| (|NonNegativeInteger|))))
$))
(SIGNATURE |length| ((|NonNegativeInteger|) $))
(SIGNATURE |varList| ((|List| |#1|) $)))) has no divide : (%,%) -> Union(Record(lm: %,rm: %),"failed")
finalizing NRLIB OFMONOID
Processing OrderedFreeMonoid for Browser database:
--------(* (% S %))---------
--------(* (% % S))---------
--------(** (% S NNI))---------
--------(first (S %))---------
--------(rest (% %))---------
--------(mirror (% %))---------
--------(lexico ((Boolean) % %))---------
--------(hclf (% % %))---------
--------(hcrf (% % %))---------
--------(lquo ((Union % failed) % %))---------
--------(rquo ((Union % failed) % %))---------
--------(lquo ((Union % failed) % S))---------
--------(rquo ((Union % failed) % S))---------
--------(div ((Union (: ok (Record (: lm %) (: rm %))) (: bad failed)) % %))---------
--------(overlap ((Record (: lm %) (: mm %) (: rm %)) % %))---------
--------(size (NNI %))---------
--------(nthExpon (NNI % (Integer)))---------
--------(nthFactor (S % (Integer)))---------
--------(factors ((List REC) %))---------
--------(length (NNI %))---------
--------(varList ((List S) %))---------
--------constructor---------
------------------------------------------------------------------------
OrderedFreeMonoid is now explicitly exposed in frame initial
OrderedFreeMonoid will be automatically loaded when needed from
/var/zope2/var/LatexWiki/OFMONOID.NRLIB/code
Test left and right exact quotients.
axiom
m1:=(x*y*y*z)$OFMONOID(Symbol)
Type: OrderedFreeMonoid
? Symbol
axiom
m2:=(x*y)$OFMONOID(Symbol)
Type: OrderedFreeMonoid
? Symbol
axiom
lquo(m1,m2)
Type: Union(OrderedFreeMonoid
? Symbol,...)
axiom
m3:=(y*y)$OFMONOID(Symbol)
Type: OrderedFreeMonoid
? Symbol
axiom
div(m1,m2)
Type: Union(ok: Record(lm: OrderedFreeMonoid
? Symbol,rm: OrderedFreeMonoid
? Symbol),...)
axiom
div(m1,m3)
Type: Union(ok: Record(lm: OrderedFreeMonoid
? Symbol,rm: OrderedFreeMonoid
? Symbol),...)
axiom
m4:=(y^3)$OFMONOID(Symbol)
Type: OrderedFreeMonoid
? Symbol
axiom
div(m1,m4)
Type: Union(bad: failed,...)
This option is required to compile the functions that follow.
axiom
)set function compile on
On Tuesday, February 28, 2006 6:54 AM Fabio S. wrote:
I would like to build the non-commutative algebra h=k[x,y] and
then I would like to make computations in h using some predefined
rules for x and y. As an example, take the three equations
x*y*x=y*x*y
x*x=a*x+b
y*y=a*y+b
where a and b are (generic, if possible) elements of k.
Then, I would like to be able to reduce polynomials in x and
y according to the previous rules. For example,
(x+y)^2 (=x^2+x*y+y*x+y^2)
should reduce to
a*(x+y)+2*b+x*y+y*x
axiom
--Generic elements of k
--OVAR = OrderedVariableList
C==>OVAR [a,b]
Type: Void
axiom
--Commutative Field: k=Q[a,b]
--Q = FRAC INT = Fration Integer
--SMP = SparseMultivariatePolynomials
K==>SMP(FRAC INT,C)
Type: Void
axiom
--Non-commutative variables
V==>OVAR [x,y]
Type: Void
axiom
--Non-commutative Algebra: h=k[x,y]
--XDPOLY XDistributedPolynomial
H==>XDPOLY(V,K)
Type: Void
axiom
--Free monoid
M==>OFMONOID V
Type: Void
axiom
--Substitution rules are applied to words from the monoid over
--the variables and return polynomials
subs(w:M):H ==
--x*y*x=y*x*y
n:=div(w,(x::V*y::V*x::V)$M)$M
n case ok => monom(n.ok.lm,1)$H *
(y::V*x::V*y::V)$H * monom(n.ok.rm,1)$H
--x*x=a*x+b
n:=div(w,(x::V^2)$M)$M
n case ok => monom(n.ok.lm,1)$H *
(a::K*x::V+b::K)$H * monom(n.ok.rm,1)$H
--y*y=a*y+b
n:=div(w,(y::V^2)$M)$M
n case ok => monom(n.ok.lm,1)$H *
(a::K*y::V+b::K)$H * monom(n.ok.rm,1)$H
--no change
monom(w,1)$H
Function declaration subs : OrderedFreeMonoid OrderedVariableList [x
,y] -> XDistributedPolynomial(OrderedVariableList [x,y],
SparseMultivariatePolynomial(Fraction Integer,OrderedVariableList
[a,b])) has been added to workspace.
Type: Void
axiom
--Apply rules to a term. Keep coefficients
newterm(x:Record(k:M,c:K)):H==x.c*subs(x.k)
Function declaration newterm : Record(k: OrderedFreeMonoid
OrderedVariableList [x,y],c: SparseMultivariatePolynomial(
Fraction Integer,OrderedVariableList [a,b])) ->
XDistributedPolynomial(OrderedVariableList [x,y],
SparseMultivariatePolynomial(Fraction Integer,OrderedVariableList
[a,b])) has been added to workspace.
Type: Void
axiom
--Reconstruct polynomial, term-by-term
newpoly(t:H):H==reduce(+,map(newterm,ListOfTerms(t)))
Function declaration newpoly : XDistributedPolynomial(
OrderedVariableList [x,y],SparseMultivariatePolynomial(Fraction
Integer,OrderedVariableList [a,b])) -> XDistributedPolynomial(
OrderedVariableList [x,y],SparseMultivariatePolynomial(Fraction
Integer,OrderedVariableList [a,b])) has been added to workspace.
Type: Void
Example calculations:
axiom
p1:=(x::V+y::V)$H^2
Type: XDistributedPolynomial
?(OrderedVariableList
? [x,y]
?,SparseMultivariatePolynomial
?(Fraction Integer,OrderedVariableList
? [a,b]
?))
axiom
newpoly(p1)
axiom
Compiling function newpoly with type XDistributedPolynomial(
OrderedVariableList [x,y],SparseMultivariatePolynomial(Fraction
Integer,OrderedVariableList [a,b])) -> XDistributedPolynomial(
OrderedVariableList [x,y],SparseMultivariatePolynomial(Fraction
Integer,OrderedVariableList [a,b]))
axiom
Compiling function subs with type OrderedFreeMonoid
OrderedVariableList [x,y] -> XDistributedPolynomial(
OrderedVariableList [x,y],SparseMultivariatePolynomial(Fraction
Integer,OrderedVariableList [a,b]))
axiom
Compiling function newterm with type Record(k: OrderedFreeMonoid
OrderedVariableList [x,y],c: SparseMultivariatePolynomial(
Fraction Integer,OrderedVariableList [a,b])) ->
XDistributedPolynomial(OrderedVariableList [x,y],
SparseMultivariatePolynomial(Fraction Integer,OrderedVariableList
[a,b]))
Type: XDistributedPolynomial
?(OrderedVariableList
? [x,y]
?,SparseMultivariatePolynomial
?(Fraction Integer,OrderedVariableList
? [a,b]
?))
axiom
p2:=(x::V+y::V)$H^3
Type: XDistributedPolynomial
?(OrderedVariableList
? [x,y]
?,SparseMultivariatePolynomial
?(Fraction Integer,OrderedVariableList
? [a,b]
?))
axiom
newpoly(p2)
Type: XDistributedPolynomial
?(OrderedVariableList
? [x,y]
?,SparseMultivariatePolynomial
?(Fraction Integer,OrderedVariableList
? [a,b]
?))
Oops, I just noticed that some of your rules should be
applied more than once - I presume that you use the
convention with the rules that they should be applied
until no more changes are possible - right?
Let's try this:
axiom
pNew := newpoly(p2)
Type: XDistributedPolynomial
?(OrderedVariableList
? [x,y]
?,SparseMultivariatePolynomial
?(Fraction Integer,OrderedVariableList
? [a,b]
?))
axiom
while pNew ~= p2 repeat
p2 := pNew
pNew := newpoly(p2)
Type: Void
axiom
pNew
Type: XDistributedPolynomial
?(OrderedVariableList
? [x,y]
?,SparseMultivariatePolynomial
?(Fraction Integer,OrderedVariableList
? [a,b]
?))
axiom
reduce(p:H):H ==
p2 := newpoly(p)
p3 := newpoly(p2)
while p3 ~= p2 repeat
p2 := p3
p3 := newpoly(p2)
p3
Function declaration reduce : XDistributedPolynomial(
OrderedVariableList [x,y],SparseMultivariatePolynomial(Fraction
Integer,OrderedVariableList [a,b])) -> XDistributedPolynomial(
OrderedVariableList [x,y],SparseMultivariatePolynomial(Fraction
Integer,OrderedVariableList [a,b])) has been added to workspace.
Compiled code for newpoly has been cleared.
Type: Void