|
|
|
last edited 12 years ago by test1 |
| 1 2 3 4 | ||
|
Editor: Bill Page
Time: 2009/09/18 03:25:23 GMT-7 |
||
| Note: new | ||
changed: - \begin{spad} )abbrev domain FPROD FreeProduct ++ Description: ++ This domain implements the free product of monoids (groups) ++ It is the coproduct in the category of monoids (groups). ++ FreeProduct(A,B) is the monoid (group) whose elements are ++ the reduced words in A and B, under the operation of concatenation ++ followed by reduction: ++ * Remove identity elements (of either A or B) ++ * Replace a1a2 by its product in A and b1b2 by its product in B ++ Ref: http://en.wikipedia.org/wiki/Free_product FreeProduct(A:Monoid,B:Monoid):Monoid with if A has Group and B has Group then Group in1: A -> % in2: B -> % is1: % -> Boolean is2: % -> Boolean == add Rep == List Union(A,B) rep(x:%):Rep == x pretend Rep per(x:Rep):% == x pretend % One() == per [] coerce(x:%):OutputForm == r:=rep(x) if empty?(r) then return coerce(1$InputForm) else if #r=1 then s:=first r if s case A then return coerce(s::A) else if s case B then return overbar(coerce(s::B)) return blankSeparate([coerce(per [s]) for s in r]) (x:% = y:%):Boolean == r1:=rep(x); r2:=rep(y) if #r1 ~= #r2 then return false for s1 in r1 for s2 in r2 repeat if s1 case A then if s2 case A then if (s1::A) ~= (s2::A) then return false if s2 case B then return false else if s1 case B then if s2 case B then if (s1::B) ~= (s2::B) then return false if s2 case A then return false return true in1(x:A):% == if x=1 then 1 else per [[x]] in2(y:B):% == if y=1 then 1 else per [[y]] is1(x:%):Boolean == r:=rep(x) #r=1 and first(r) case A is2(x:%):Boolean == r:=rep(x) #r=1 and first(r) case B if A has Group and B has Group then inv(x:%):% == if x=1 then return 1 return per [( _ s case A => inv(s::A); _ s case B => inv(s::B)) _ for s in reverse rep(x)] (x:% * y:%):% == if x=1 then return y if y=1 then return x r1:=rep(x); r2:=rep(y) f1:=first(r1,(#r1-1)::NonNegativeInteger); l1:=last r1 f2:=first r2; l2:=last(r2,(#r2-1)::NonNegativeInteger) -- reduction if l1 case A and f2 case A then return per(f1)*in1((l1::A)*(f2::A))*per(l2) if l1 case B and f2 case B then return per(f1)*in2((l1::B)*(f2::B))*per(l2) return per concat(r1,r2) (x:% ^ n:NonNegativeInteger):% == if x=1 or n=0 then return 1 return x*x^(n-1)::NonNegativeInteger (x:% ^ n:PositiveInteger):% == if x=1 then return 1 return x*x^(n-1)::NonNegativeInteger \end{spad} \begin{axiom} II:=FPROD(INT,INT) i1:=in1(2)$II i2:=in2(3)$II i1 i2 i1=i2 test(i1=i2) test(i2=i2) i1*i1 i2*i2 i1*i2 i2*i1 \end{axiom} \begin{axiom} f:=FreeProduct(FreeMonoid Symbol,FreeMonoid Symbol) p:=in1('p)$f q:=in2('q)$f r:=in1('r)$f (p*q*r)^2 (p*q)*(r*p)*(q*r) a:FreeMonoid Symbol:='a b:FreeMonoid Symbol:='b a*b p*q p*q^2 g:=MonoidRing(Integer,f) m:=(in1('m)$f)::g n:=(in2('n)$f)::g nm:=m*n-n*m nm^2 \end{axiom} \begin{axiom} g:=FreeProduct(FreeGroup Symbol,FreeGroup Symbol) g1:=(in1('g1)$g) g2:=(in2('g2)$g) g1*g2*g1^(-1) h:=MonoidRing(Integer,g) h1:=g1::h h2:=g2::h hh:=h2*h1-h1*h2 hh^2 recip(h1)*recip(h2) h1*recip(h1) h1*h2 recip(h1*h2) h1*h2*recip(h1*h2) \end{axiom}
)abbrev domain FPROD FreeProduct
++ Description:
++ This domain implements the free product of monoids (groups)
++ It is the coproduct in the category of monoids (groups).
++ FreeProduct(A,B) is the monoid (group) whose elements are
++ the reduced words in A and B, under the operation of concatenation
++ followed by reduction:
++ * Remove identity elements (of either A or B)
++ * Replace a1a2 by its product in A and b1b2 by its product in B
++ Ref: http://en.wikipedia.org/wiki/Free_product
FreeProduct(A:Monoid,B:Monoid):Monoid with
if A has Group and B has Group then Group
in1: A -> %
in2: B -> %
is1: % -> Boolean
is2: % -> Boolean
== add
Rep == List Union(A,B)
rep(x:%):Rep == x pretend Rep
per(x:Rep):% == x pretend %
One() == per []
coerce(x:%):OutputForm ==
r:=rep(x)
if empty?(r) then
return coerce(1$InputForm)
else if #r=1 then
s:=first r
if s case A then
return coerce(s::A)
else if s case B then
return overbar(coerce(s::B))
return blankSeparate([coerce(per [s]) for s in r])
(x:% = y:%):Boolean ==
r1:=rep(x); r2:=rep(y)
if #r1 ~= #r2 then return false
for s1 in r1 for s2 in r2 repeat
if s1 case A then
if s2 case A then
if (s1::A) ~= (s2::A) then return false
if s2 case B then return false
else if s1 case B then
if s2 case B then
if (s1::B) ~= (s2::B) then return false
if s2 case A then return false
return true
in1(x:A):% == if x=1 then 1 else per [[x]]
in2(y:B):% == if y=1 then 1 else per [[y]]
is1(x:%):Boolean ==
r:=rep(x)
#r=1 and first(r) case A
is2(x:%):Boolean ==
r:=rep(x)
#r=1 and first(r) case B
if A has Group and B has Group then
inv(x:%):% ==
if x=1 then return 1
return per [( _
s case A => inv(s::A); _
s case B => inv(s::B)) _
for s in reverse rep(x)]
(x:% * y:%):% ==
if x=1 then return y
if y=1 then return x
r1:=rep(x); r2:=rep(y)
f1:=first(r1,(#r1-1)::NonNegativeInteger); l1:=last r1
f2:=first r2; l2:=last(r2,(#r2-1)::NonNegativeInteger)
-- reduction
if l1 case A and f2 case A then
return per(f1)*in1((l1::A)*(f2::A))*per(l2)
if l1 case B and f2 case B then
return per(f1)*in2((l1::B)*(f2::B))*per(l2)
return per concat(r1,r2)
(x:% ^ n:NonNegativeInteger):% ==
if x=1 or n=0 then return 1
return x*x^(n-1)::NonNegativeInteger
(x:% ^ n:PositiveInteger):% ==
if x=1 then return 1
return x*x^(n-1)::NonNegativeInteger
Compiling FriCAS source code from file
/var/zope2/var/LatexWiki/8967793923830499421-25px001.spad using
old system compiler.
FPROD abbreviates domain FreeProduct
------------------------------------------------------------------------
initializing NRLIB FPROD for FreeProduct
compiling into NRLIB FPROD
compiling local rep : $ -> List Union(A,B)
FPROD;rep is replaced by x
Time: 0.04 SEC.
compiling local per : List Union(A,B) -> $
FPROD;per is replaced by x
Time: 0 SEC.
compiling exported One : () -> $
Time: 0 SEC.
compiling exported coerce : $ -> OutputForm
Time: 0.10 SEC.
compiling exported = : ($,$) -> Boolean
Time: 0.01 SEC.
compiling exported in1 : A -> $
Time: 0 SEC.
compiling exported in2 : B -> $
Time: 0.004 SEC.
compiling exported is1 : $ -> Boolean
Time: 0.004 SEC.
compiling exported is2 : $ -> Boolean
Time: 0.004 SEC.
****** Domain: A already in scope
augmenting A: (Group)
****** Domain: B already in scope
augmenting B: (Group)
compiling exported inv : $ -> $
Time: 0.004 SEC.
compiling exported * : ($,$) -> $
Time: 0.02 SEC.
compiling exported ^ : ($,NonNegativeInteger) -> $
Time: 0.004 SEC.
compiling exported ^ : ($,PositiveInteger) -> $
Time: 0.004 SEC.
****** Domain: A already in scope
augmenting A: (Group)
****** Domain: B already in scope
augmenting B: (Group)
(time taken in buildFunctor: 4)
;;; *** |FreeProduct| REDEFINED
;;; *** |FreeProduct| REDEFINED
Time: 0.004 SEC.
Cumulative Statistics for Constructor FreeProduct
Time: 0.21 seconds
finalizing NRLIB FPROD
Processing FreeProduct for Browser database:
--->-->FreeProduct((in1 (% A))): Not documented!!!!
--->-->FreeProduct((in2 (% B))): Not documented!!!!
--->-->FreeProduct((is1 ((Boolean) %))): Not documented!!!!
--->-->FreeProduct((is2 ((Boolean) %))): Not documented!!!!
--------constructor---------
; compiling file "/var/zope2/var/LatexWiki/FPROD.NRLIB/FPROD.lsp" (written 18 SEP 2009 03:25:24 AM):
; compiling (/VERSIONCHECK 2)
; compiling (PUT (QUOTE |FPROD;rep|) ...)
; compiling (DEFUN |FPROD;rep| ...)
; compiling (PUT (QUOTE |FPROD;per|) ...)
; compiling (DEFUN |FPROD;per| ...)
; compiling (DEFUN |FPROD;One;$;3| ...)
; compiling (DEFUN |FPROD;coerce;$Of;4| ...)
; compiling (DEFUN |FPROD;=;2$B;5| ...)
; compiling (DEFUN |FPROD;in1;A$;6| ...)
; compiling (DEFUN |FPROD;in2;B$;7| ...)
; compiling (DEFUN |FPROD;is1;$B;8| ...)
; compiling (DEFUN |FPROD;is2;$B;9| ...)
; compiling (DEFUN |FPROD;inv;2$;10| ...)
; compiling (DEFUN |FPROD;*;3$;11| ...)
; compiling (DEFUN |FPROD;^;$Nni$;12| ...)
; compiling (DEFUN |FPROD;^;$Pi$;13| ...)
; compiling (DEFUN |FreeProduct| ...)
; compiling (DEFUN |FreeProduct;| ...)
; compiling (MAKEPROP (QUOTE |FreeProduct|) ...)
; /var/zope2/var/LatexWiki/FPROD.NRLIB/FPROD.fasl written
; compilation finished in 0:00:00.181
------------------------------------------------------------------------
FreeProduct is now explicitly exposed in frame initial
FreeProduct will be automatically loaded when needed from
/var/zope2/var/LatexWiki/FPROD.NRLIB/FPRODII:=FPROD(INT,INT)
| (1) |
i1:=in1(2)$II
| (2) |
i2:=in2(3)$II
| (3) |
i1
| (4) |
i2
| (5) |
i1=i2
| (6) |
test(i1=i2)
| (7) |
test(i2=i2)
| (8) |
i1*i1
| (9) |
i2*i2
| (10) |
i1*i2
| (11) |
i2*i1
| (12) |
f:=FreeProduct(FreeMonoid Symbol,FreeMonoid Symbol)
| (13) |
p:=in1('p)$f
| (14) |
q:=in2('q)$f
| (15) |
r:=in1('r)$f
| (16) |
(p*q*r)^2
| (17) |
(p*q)*(r*p)*(q*r)
| (18) |
a:FreeMonoid Symbol:='a
| (19) |
b:FreeMonoid Symbol:='b
| (20) |
a*b
| (21) |
p*q
| (22) |
p*q^2
| (23) |
g:=MonoidRing(Integer,f)
| (24) |
m:=(in1('m)$f)::g
| (25) |
n:=(in2('n)$f)::g
| (26) |
nm:=m*n-n*m
| (27) |
nm^2
| (28) |
g:=FreeProduct(FreeGroup Symbol,FreeGroup Symbol)
| (29) |
g1:=(in1('g1)$g)
| (30) |
g2:=(in2('g2)$g)
| (31) |
g1*g2*g1^(-1)
| (32) |
h:=MonoidRing(Integer,g)
| (33) |
h1:=g1::h
| (34) |
h2:=g2::h
| (35) |
hh:=h2*h1-h1*h2
| (36) |
hh^2
| (37) |
recip(h1)*recip(h2)
| (38) |
h1*recip(h1)
| (39) |
h1*h2
| (40) |
recip(h1*h2)
| (41) |
h1*h2*recip(h1*h2)
| (42) |