help links subscribe changes refresh edit

	SandBox
SandBoxFractionGCD ←	↑	→ SandBoxFriCAS

SandBoxFreeProduct

Edit detail for SandBoxFreeProduct revision 4 of 4

	1 2 3 4
Editor: test1 Time: 2013/03/23 00:07:41 GMT+0
Note:

changed:
-    Rep == List Union(A,B)
    Rep ==> List Union(A,B)

fricas

(1) -> <spad>

fricas

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

fricas

Compiling FriCAS source code from file 
      /var/lib/zope2.10/instance/axiom-wiki/var/LatexWiki/1109760127526461248-25px001.spad
      using old system compiler.
   FPROD abbreviates domain FreeProduct 
------------------------------------------------------------------------
   initializing NRLIB FPROD for FreeProduct 
   compiling into NRLIB FPROD 
   processing macro definition Rep ==> List Union(A,B) 
   compiling local rep : % -> List Union(A,B)
      FPROD;rep is replaced by x 
Time: 0 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 SEC.

****** Domain: A already in scope
augmenting A: (Comparable)
****** Domain: B already in scope
augmenting B: (Comparable)
   compiling exported smaller? : (%,%) -> Boolean
Time: 0 SEC.

   compiling exported = : (%,%) -> Boolean
Time: 0 SEC.

   compiling exported in1 : A -> %
Time: 0 SEC.

   compiling exported in2 : B -> %
Time: 0 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 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 SEC.

   compiling exported * : (%,%) -> %
Time: 0 SEC.

   compiling exported ^ : (%,NonNegativeInteger) -> %
Time: 0 SEC.

   compiling exported ^ : (%,PositiveInteger) -> %
Time: 0 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:  1031)
Time: 0 SEC.

   Cumulative Statistics for Constructor FreeProduct
      Time: 0.03 seconds

   finalizing NRLIB FPROD 
   Processing FreeProduct for Browser database:
--------constructor---------
--->-->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!!!!
; compiling file "/var/aw/var/LatexWiki/FPROD.NRLIB/FPROD.lsp" (written 13 SEP 2025 03:39:01 AM):

; wrote /var/aw/var/LatexWiki/FPROD.NRLIB/FPROD.fasl
; compilation finished in 0:00:00.188
------------------------------------------------------------------------
   FreeProduct is now explicitly exposed in frame initial 
   FreeProduct will be automatically loaded when needed from 
      /var/aw/var/LatexWiki/FPROD.NRLIB/FPROD

fricas

II:=FPROD(INT,INT)

$\label{eq1}\hbox{\axiomType{FreeProduct}\ } \left({\hbox{\axiomType{Integer}\ } , \: \hbox{\axiomType{Integer}\ }}\right)$

(1)

Type: Type

fricas

i1:=in1(2)$II

$\label{eq2}2$

(2)

Type: FreeProduct?(Integer,Integer)

fricas

i2:=in2(3)$II

$\label{eq3}\overline 3$

(3)

Type: FreeProduct?(Integer,Integer)

fricas

i1

$\label{eq4}2$

(4)

Type: FreeProduct?(Integer,Integer)

fricas

i2

$\label{eq5}\overline 3$

(5)

Type: FreeProduct?(Integer,Integer)

fricas

i1=i2

$\label{eq6}2 ={\overline 3}$

(6)

Type: Equation(FreeProduct?(Integer,Integer))

fricas

test(i1=i2)

$\label{eq7} \mbox{\rm false}$

(7)

Type: Boolean

fricas

test(i2=i2)

$\label{eq8} \mbox{\rm true}$

(8)

Type: Boolean

fricas

i1*i1

$\label{eq9}4$

(9)

Type: FreeProduct?(Integer,Integer)

fricas

i2*i2

$\label{eq10}\overline 9$

(10)

Type: FreeProduct?(Integer,Integer)

fricas

i1*i2

$\label{eq11}2 \ {\overline 3}$

(11)

Type: FreeProduct?(Integer,Integer)

fricas

i2*i1

$\label{eq12}{\overline 3}\ 2$

(12)

Type: FreeProduct?(Integer,Integer)

fricas

f:=FreeProduct(FreeMonoid Symbol,FreeMonoid Symbol)

$\label{eq13}\hbox{\axiomType{FreeProduct}\ } \left({{\hbox{\axiomType{FreeMonoid}\ } \left({\hbox{\axiomType{Symbol}\ }}\right)}, \:{\hbox{\axiomType{FreeMonoid}\ } \left({\hbox{\axiomType{Symbol}\ }}\right)}}\right)$

(13)

Type: Type

fricas

p:=in1('p)$f

$\label{eq14}p$

(14)

Type: FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol))

fricas

q:=in2('q)$f

$\label{eq15}\overline q$

(15)

Type: FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol))

fricas

r:=in1('r)$f

$\label{eq16}r$

(16)

Type: FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol))

fricas

(p*q*r)^2

$\label{eq17}p \ {\overline q}\ {r \ p}\ {\overline q}\ r$

(17)

Type: FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol))

fricas

(p*q)*(r*p)*(q*r)

$\label{eq18}p \ {\overline q}\ {r \ p}\ {\overline q}\ r$

(18)

Type: FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol))

fricas

a:FreeMonoid Symbol:='a

$\label{eq19}a$

(19)

Type: FreeMonoid(Symbol)

fricas

b:FreeMonoid Symbol:='b

$\label{eq20}b$

(20)

Type: FreeMonoid(Symbol)

fricas

a*b

$\label{eq21}a \ b$

(21)

Type: FreeMonoid(Symbol)

fricas

p*q

$\label{eq22}p \ {\overline q}$

(22)

Type: FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol))

fricas

p*q^2

$\label{eq23}p \ {\overline{{q}^{2}}}$

(23)

Type: FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol))

fricas

g:=MonoidRing(Integer,f)

$\label{eq24}\hbox{\axiomType{MonoidRing}\ } \left({\hbox{\axiomType{Integer}\ } , \:{\hbox{\axiomType{FreeProduct}\ } \left({{\hbox{\axiomType{FreeMonoid}\ } \left({\hbox{\axiomType{Symbol}\ }}\right)}, \:{\hbox{\axiomType{FreeMonoid}\ } \left({\hbox{\axiomType{Symbol}\ }}\right)}}\right)}}\right)$

(24)

Type: Type

fricas

m:=(in1('m)$f)::g

$\label{eq25}m$

(25)

Type: MonoidRing?(Integer,FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol)))

fricas

n:=(in2('n)$f)::g

$\label{eq26}\overline n$

(26)

Type: MonoidRing?(Integer,FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol)))

fricas

nm:=m*n-n*m

$\label{eq27}-{\left({\overline n}\ m \right)}+{\left(m \ {\overline n}\right)}$

(27)

Type: MonoidRing?(Integer,FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol)))

fricas

nm^2

$\label{eq28}{\left({\overline n}\ m \ {\overline n}\ m \right)}-{\left({\overline n}\ {{m}^{2}}\ {\overline n}\right)}-{\left(m \ {\overline{{n}^{2}}}\ m \right)}+{\left(m \ {\overline n}\ m \ {\overline n}\right)}$

(28)

Type: MonoidRing?(Integer,FreeProduct?(FreeMonoid(Symbol),FreeMonoid(Symbol)))

fricas

g:=FreeProduct(FreeGroup Symbol,FreeGroup Symbol)

$\label{eq29}\hbox{\axiomType{FreeProduct}\ } \left({{\hbox{\axiomType{FreeGroup}\ } \left({\hbox{\axiomType{Symbol}\ }}\right)}, \:{\hbox{\axiomType{FreeGroup}\ } \left({\hbox{\axiomType{Symbol}\ }}\right)}}\right)$

(29)

Type: Type

fricas

g1:=(in1('g1)$g)

$\label{eq30}g 1$

(30)

Type: FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol))

fricas

g2:=(in2('g2)$g)

$\label{eq31}\overline g 2$

(31)

Type: FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol))

fricas

g1*g2*g1^(-1)

$\label{eq32}g 1 \ {\overline g 2}\ {{g 1}^{- 1}}$

(32)

Type: FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol))

fricas

h:=MonoidRing(Integer,g)

$\label{eq33}\hbox{\axiomType{MonoidRing}\ } \left({\hbox{\axiomType{Integer}\ } , \:{\hbox{\axiomType{FreeProduct}\ } \left({{\hbox{\axiomType{FreeGroup}\ } \left({\hbox{\axiomType{Symbol}\ }}\right)}, \:{\hbox{\axiomType{FreeGroup}\ } \left({\hbox{\axiomType{Symbol}\ }}\right)}}\right)}}\right)$

(33)

Type: Type

fricas

h1:=g1::h

$\label{eq34}g 1$

(34)

Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))

fricas

h2:=g2::h

$\label{eq35}\overline g 2$

(35)

Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))

fricas

hh:=h2*h1-h1*h2

$\label{eq36}{\left({\overline g 2}\ g 1 \right)}-{\left(g 1 \ {\overline g 2}\right)}$

(36)

Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))

fricas

hh^2

$\label{eq37}{\left({\overline g 2}\ g 1 \ {\overline g 2}\ g 1 \right)}-{\left({\overline g 2}\ {{g 1}^{2}}\ {\overline g 2}\right)}-{\left(g 1 \ {\overline{{g 2}^{2}}}\ g 1 \right)}+{\left(g 1 \ {\overline g 2}\ g 1 \ {\overline g 2}\right)}$

(37)

Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))

fricas

recip(h1)*recip(h2)

$\label{eq38}{{g 1}^{- 1}}\ {\overline{{g 2}^{- 1}}}$

(38)

Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))

fricas

h1*recip(h1)

$\label{eq39}1$

(39)

Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))

fricas

h1*h2

$\label{eq40}g 1 \ {\overline g 2}$

(40)

Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))

fricas

recip(h1*h2)

$\label{eq41}{\overline{{g 2}^{- 1}}}\ {{g 1}^{- 1}}$

(41)

Type: Union(MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol))),...)

fricas

h1*h2*recip(h1*h2)

$\label{eq42}1$

(42)

Type: MonoidRing?(Integer,FreeProduct?(FreeGroup?(Symbol),FreeGroup?(Symbol)))

See also --Bill Page, Wed, 23 Sep 2009 00:48:07 -0700 reply

SandBoxFreeSum