login  home  contents  what's new  discussion  bug reports     help  links  subscribe  changes  refresh  edit

Edit detail for SandBoxFreeProduct revision 2 of 4

1 2 3 4
Editor: Bill Page
Time: 2009/09/23 00:45:44 GMT-7
Note: revision

added:
    RetractableTo(A)
    RetractableTo(B)

added:
    factors: % -> List %
    if A has Comparable and B has Comparable then Comparable

added:

    if A has Comparable and B has Comparable then
      smaller?(x:%,y:%):Boolean ==
        r1:=rep(x); r2:=rep(y)
        for s1 in r1 for s2 in r2 repeat
          if s1 case A then
            if s2 case A then
              if smaller?(s1::A, s2::A) then return true
            if s2 case B then return true
          else if s1 case B then
            if s2 case B then
              if smaller?(s1::B, s2::B) then return true
            if s2 case A then return false
        if #r1 < #r2 then return true
        return false

changed:
-
-    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
    coerce(x:A):% == in1(x)
    coerce(x:B):% == in2(x)
    is1(x:%):Boolean == first(rep x) case A
    is2(x:%):Boolean == first(rep x) case B
    retract(x:%):A == if x=1 or not is1(x) then 1 else coerce(first rep x)@A
    retract(x:%):B == if x=1 or not is2(x) then 1 else coerce(first rep x)@B
    factors(x:%):List % == [per [s] for s in rep(x)]

changed:
-      if x=1 or n=0 then return 1
-      return x*x^(n-1)::NonNegativeInteger
      if x=1 then return 1
      if n>0 then return x*x^(n-1)::NonNegativeInteger
      return 1

changed:
-      return x*x^(n-1)::NonNegativeInteger
      if n>1 then return x*x^((n-1)::PositiveInteger)
      return x

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 -> %
    RetractableTo(A)
    RetractableTo(B)
    is1: % -> Boolean
    is2: % -> Boolean
    factors: % -> List %
    if A has Comparable and B has Comparable then Comparable
  == 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])
if A has Comparable and B has Comparable then smaller?(x:%,y:%):Boolean == r1:=rep(x); r2:=rep(y) for s1 in r1 for s2 in r2 repeat if s1 case A then if s2 case A then if smaller?(s1::A, s2::A) then return true if s2 case B then return true else if s1 case B then if s2 case B then if smaller?(s1::B, s2::B) then return true if s2 case A then return false if #r1 < #r2 then return true return false
(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]] coerce(x:A):% == in1(x) coerce(x:B):% == in2(x) is1(x:%):Boolean == first(rep x) case A is2(x:%):Boolean == first(rep x) case B retract(x:%):A == if x=1 or not is1(x) then 1 else coerce(first rep x)@A retract(x:%):B == if x=1 or not is2(x) then 1 else coerce(first rep x)@B factors(x:%):List % == [per [s] for s in rep(x)]
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 then return 1 if n>0 then return x*x^(n-1)::NonNegativeInteger return 1
(x:% ^ n:PositiveInteger):% == if x=1 then return 1 if n>1 then return x*x^((n-1)::PositiveInteger) return x
spad
   Compiling FriCAS source code from file 
      /var/zope2/var/LatexWiki/7597684502788721203-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.05 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.11 SEC.
****** Domain: A already in scope augmenting A: (Comparable) ****** Domain: B already in scope augmenting B: (Comparable) compiling exported smaller? : ($,$) -> Boolean Time: 0.01 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 coerce : A -> $ Time: 0 SEC.
compiling exported coerce : B -> $ Time: 0 SEC.
compiling exported is1 : $ -> Boolean Time: 0 SEC.
compiling exported is2 : $ -> Boolean Time: 0 SEC.
compiling exported retract : $ -> A Time: 0.004 SEC.
compiling exported retract : $ -> B Time: 0 SEC.
compiling exported factors : $ -> List $ Time: 0 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.03 SEC.
compiling exported ^ : ($,NonNegativeInteger) -> $ Time: 0.004 SEC.
compiling exported ^ : ($,PositiveInteger) -> $ Time: 0.004 SEC.
****** Domain: A already in scope augmenting A: (Comparable) ****** Domain: B already in scope augmenting B: (Comparable) ****** 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.01 SEC.
Cumulative Statistics for Constructor FreeProduct Time: 0.24 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!!!! --->-->FreeProduct((factors ((List %) %))): Not documented!!!! --------constructor--------- ; compiling file "/var/zope2/var/LatexWiki/FPROD.NRLIB/FPROD.lsp" (written 23 SEP 2009 12:45:31 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;smaller?;2$B;5| ...) ; compiling (DEFUN |FPROD;=;2$B;6| ...) ; compiling (DEFUN |FPROD;in1;A$;7| ...) ; compiling (DEFUN |FPROD;in2;B$;8| ...) ; compiling (DEFUN |FPROD;coerce;A$;9| ...) ; compiling (DEFUN |FPROD;coerce;B$;10| ...) ; compiling (DEFUN |FPROD;is1;$B;11| ...) ; compiling (DEFUN |FPROD;is2;$B;12| ...) ; compiling (DEFUN |FPROD;retract;$A;13| ...) ; compiling (DEFUN |FPROD;retract;$B;14| ...) ; compiling (DEFUN |FPROD;factors;$L;15| ...) ; compiling (DEFUN |FPROD;inv;2$;16| ...) ; compiling (DEFUN |FPROD;*;3$;17| ...) ; compiling (DEFUN |FPROD;^;$Nni$;18| ...) ; compiling (DEFUN |FPROD;^;$Pi$;19| ...) ; 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.221 ------------------------------------------------------------------------ FreeProduct is now explicitly exposed in frame initial FreeProduct will be automatically loaded when needed from /var/zope2/var/LatexWiki/FPROD.NRLIB/FPROD

axiom
II:=FPROD(INT,INT)
LatexWiki Image(1)
Type: Domain
axiom
i1:=in1(2)$II
LatexWiki Image(2)
Type: FreeProduct?(Integer,Integer)
axiom
i2:=in2(3)$II
LatexWiki Image(3)
Type: FreeProduct?(Integer,Integer)
axiom
i1
LatexWiki Image(4)
Type: FreeProduct?(Integer,Integer)
axiom
i2
LatexWiki Image(5)
Type: FreeProduct?(Integer,Integer)
axiom
i1=i2
LatexWiki Image(6)
Type: Equation(FreeProduct?(Integer,Integer))
axiom
test(i1=i2)
LatexWiki Image(7)
Type: Boolean
axiom
test(i2=i2)
LatexWiki Image(8)
Type: Boolean
axiom
i1*i1
LatexWiki Image(9)
Type: FreeProduct?(Integer,Integer)
axiom
i2*i2
LatexWiki Image(10)
Type: FreeProduct?(Integer,Integer)
axiom
i1*i2
LatexWiki Image(11)
Type: FreeProduct?(Integer,Integer)
axiom
i2*i1
LatexWiki Image(12)
Type: FreeProduct?(Integer,Integer)

axiom
f:=FreeProduct(FreeMonoid Symbol,FreeMonoid Symbol)
LatexWiki Image(13)
Type: Domain
axiom
p:=in1('p)$f
LatexWiki Image(14)
Type: FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol))
axiom
q:=in2('q)$f
LatexWiki Image(15)
Type: FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol))
axiom
r:=in1('r)$f
LatexWiki Image(16)
Type: FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol))
axiom
(p*q*r)^2
LatexWiki Image(17)
Type: FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol))
axiom
(p*q)*(r*p)*(q*r)
LatexWiki Image(18)
Type: FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol))
axiom
a:FreeMonoid Symbol:='a
LatexWiki Image(19)
Type: FreeMonoid?(Symbol)
axiom
b:FreeMonoid Symbol:='b
LatexWiki Image(20)
Type: FreeMonoid?(Symbol)
axiom
a*b
LatexWiki Image(21)
Type: FreeMonoid?(Symbol)
axiom
p*q
LatexWiki Image(22)
Type: FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol))
axiom
p*q^2
LatexWiki Image(23)
Type: FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol))
axiom
g:=MonoidRing(Integer,f)
LatexWiki Image(24)
Type: Domain
axiom
m:=(in1('m)$f)::g
LatexWiki Image(25)
Type: MonoidRing?(Integer,FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol)))
axiom
n:=(in2('n)$f)::g
LatexWiki Image(26)
Type: MonoidRing?(Integer,FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol)))
axiom
nm:=m*n-n*m
LatexWiki Image(27)
Type: MonoidRing?(Integer,FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol)))
axiom
nm^2
LatexWiki Image(28)
Type: MonoidRing?(Integer,FreeProduct?(FreeMonoid?(Symbol),FreeMonoid?(Symbol)))

axiom
g:=FreeProduct(FreeGroup Symbol,FreeGroup Symbol)
LatexWiki Image(29)
Type: Domain
axiom
g1:=(in1('g1)$g)
LatexWiki Image(30)
Type: FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol))
axiom
g2:=(in2('g2)$g)
LatexWiki Image(31)
Type: FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol))
axiom
g1*g2*g1^(-1)
LatexWiki Image(32)
Type: FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol))
axiom
h:=MonoidRing(Integer,g)
LatexWiki Image(33)
Type: Domain
axiom
h1:=g1::h
LatexWiki Image(34)
Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))
axiom
h2:=g2::h
LatexWiki Image(35)
Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))
axiom
hh:=h2*h1-h1*h2
LatexWiki Image(36)
Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))
axiom
hh^2
LatexWiki Image(37)
Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))
axiom
recip(h1)*recip(h2)
LatexWiki Image(38)
Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))
axiom
h1*recip(h1)
LatexWiki Image(39)
Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))
axiom
h1*h2
LatexWiki Image(40)
Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))
axiom
recip(h1*h2)
LatexWiki Image(41)
Type: Union(MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol))),...)
axiom
h1*h2*recip(h1*h2)
LatexWiki Image(42)
Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))