fricas
(1) -> <spad>
---)lisp (setq |$inclAssertions| nil)
--- https://en.wikipedia.org/wiki/Tensor_algebra
fricas
)abbrev category TENALGC TensorAlgebraCategory
TensorAlgebraCategory(R : CommutativeRing,
                    M : Module(R)) : Category == Module(R) with
        tensor : (List M) -> %
          ++ \spad{tensor([x1, x2, ..., xn])} constructs the tensor
          ++ product of \spad{x1, x2, ..., xn}.
        if M has Algebra(R) then Algebra(R)
        TensorProductCategory(R, M, M)
    add
        tensor(a : M, b : M) : % ==
            tensor [a, b]
fricas
)abbrev domain TENSALG TensorAlgebra
TensorAlgebra(R : CommutativeRing, B : OrderedSet, _
    M : FreeModuleCategory(R, B)) : TPcat == TPimp where
    TPcat == Join(TensorAlgebraCategory(R, M), GradedAlgebra(R, M),
                  FreeModuleCategory(R, Vector(B))) with
        tensor : List B -> %
        coerce : B -> %  --NEW
        _* : (%,%) -> %  --NEW
    TERM1 ==> Record(k : B, c : R)
    Bn ==> Vector B
    Bntmp ==> List B
    TERM  ==> Record(k : Bn, c : R)
    TERMtmp ==> Record(k : Bntmp, c : R)
    GARM  ==> GradedAlgebra(R, M) --NEW
    TPimp == FreeModule(R, Bn) add
        --NEW  
        prodTERM2(a:TERM,b:TERM):% ==
          la:List B:=entries(a.k)
          lb:List B:=entries(b.k)
          lab:List B:=concat(la,lb)
          a.c*b.c*tensor(lab)   
        --NEW from GradedAlgebra  
        product(x:%,y:%):% ==
          tx:=listOfTerms x
          ty:=listOfTerms y
          r:=0$%
          for a in tx repeat
            for b in ty repeat
              r:=r+prodTERM2(a,b) 
          return(r)
        x*y == product(x,y)
        --NEW 
        coerce(b:B):% == tensor([b])
        coerce(r:R):% == construct [[[],r]$TERM]
        coerce(x : %) : OutputForm ==
            zero? x => (0$R) :: OutputForm
            le : List OutputForm := []
            rec : TERM
            for rec in reverse listOfTerms x repeat
              if not empty?(rec.k) then  --NEW
                ko : OutputForm :=
                  reduce(tensor, [b::OutputForm for b in parts rec k])
              else
                ko : OutputForm := outputForm(1)$OutputForm  --NEW 
              rec.c = 1 => le := cons(ko, le)
              le := cons(rec.c :: OutputForm * ko, le)
            reduce("+",le)
        partialTensor : (List B, List M)->List TERMtmp
        partialTensor(bb : List B, xx : List M) : List TERMtmp ==
            res : List TERMtmp
            x1 : M := first xx
            xr : List M := rest xx
            s1 : List TERM1
            tt : List TERMtmp
            if empty? xr then
                for s1 in listOfTerms x1 repeat
                    res := cons([ cons(s1.k, bb), s1.c], res)
              else
                for s1 in listOfTerms x1 repeat
                    for tt in partialTensor(cons(s1.k, bb), xr) repeat
                        res := cons([tt k, s1 c*tt c], res)
            reverse res
        tensor(bb : List B) : % == monomial(1, vector bb)
        -- Always satisfied, but compiler is too weak to notice this
        if Vector(B) has Comparable then
            tensor(xx : List M) : % ==
                --not size?(xx,n) => error "wrong size"
                any?(zero?, xx) => 0
                res : List TERM := []
                tt : TERMtmp
                for tt in partialTensor(empty()$(List B), xx) repeat
                    res := cons([vector reverse tt k, tt c], res)
                constructOrdered reverse res
        -- Multiplication in the algebra
        -- We must reconstruct the elements of the factors. Take all terms,
        -- extract the coefficients, take the product of the basis elements
        -- in the algebras and tensorize.
        if M has Algebra(R) then
            (x1 : % * x2 : %) : % ==
                res : List TERM := empty()
                for t1 in listOfTerms x1 repeat
                    for t2 in listOfTerms x2 repeat
                        -- the coefficients
                        t1c : R := t1.c
                        t2c : R := t2.c
                        -- the basis elements
                        t1k : Bn := t1.k
                        t2k : Bn := t2.k
                        t1t2 : % :=  (t1 c)*(t2 c)*tensor([monomial(1, b1)*
                              monomial(1, b2) _
                            for b1 in parts t1 k for b2 in parts t2 k])
                        for t in listOfTerms t1t2 repeat
                            res := cons(t, res)
                construct res</spad>
fricas
Compiling FriCAS source code from file 
      /var/lib/zope2.10/instance/axiom-wiki/var/LatexWiki/2207534258142468822-25px001.spad
      using old system compiler.
   TENALGC abbreviates category TensorAlgebraCategory 
------------------------------------------------------------------------
   initializing NRLIB TENALGC for TensorAlgebraCategory 
   compiling into NRLIB TENALGC 
;;;     ***       |TensorAlgebraCategory| REDEFINED
Time: 0 SEC.
   TENALGC- abbreviates domain TensorAlgebraCategory& 
------------------------------------------------------------------------
   initializing NRLIB TENALGC- for TensorAlgebraCategory& 
   compiling into NRLIB TENALGC- 
   compiling exported tensor : (M,M) -> S
Time: 0.01 SEC.
(time taken in buildFunctor:  0)
;;;     ***       |TensorAlgebraCategory&| REDEFINED
Time: 0 SEC.
   Cumulative Statistics for Constructor TensorAlgebraCategory&
      Time: 0.01 seconds
   finalizing NRLIB TENALGC- 
   Processing TensorAlgebraCategory& for Browser database:
--->-->TensorAlgebraCategory&(constructor): Not documented!!!!
--------(tensor (% (List M)))---------
--->-->TensorAlgebraCategory&(): Missing Description
; compiling file "/var/aw/var/LatexWiki/TENALGC-.NRLIB/TENALGC-.lsp" (written 25 FEB 2025 05:20:53 AM):
; wrote /var/aw/var/LatexWiki/TENALGC-.NRLIB/TENALGC-.fasl
; compilation finished in 0:00:00.004
------------------------------------------------------------------------
   TensorAlgebraCategory& is now explicitly exposed in frame initial 
   TensorAlgebraCategory& will be automatically loaded when needed from
      /var/aw/var/LatexWiki/TENALGC-.NRLIB/TENALGC-
   finalizing NRLIB TENALGC 
   Processing TensorAlgebraCategory for Browser database:
--->-->TensorAlgebraCategory(constructor): Not documented!!!!
--------(tensor (% (List M)))---------
--->-->TensorAlgebraCategory(): Missing Description
; compiling file "/var/aw/var/LatexWiki/TENALGC.NRLIB/TENALGC.lsp" (written 25 FEB 2025 05:20:54 AM):
; wrote /var/aw/var/LatexWiki/TENALGC.NRLIB/TENALGC.fasl
; compilation finished in 0:00:00.004
------------------------------------------------------------------------
   TensorAlgebraCategory is now explicitly exposed in frame initial 
   TensorAlgebraCategory will be automatically loaded when needed from 
      /var/aw/var/LatexWiki/TENALGC.NRLIB/TENALGC
   TENSALG abbreviates domain TensorAlgebra 
------------------------------------------------------------------------
   initializing NRLIB TENSALG for TensorAlgebra 
   compiling into NRLIB TENSALG 
   compiling local prodTERM2 : (Record(k: Vector B,c: R),Record(k: Vector B,c: R)) -> %
Time: 0.02 SEC.
   compiling exported product : (%,%) -> %
Time: 0 SEC.
   compiling exported * : (%,%) -> %
Time: 0 SEC.
   compiling exported coerce : B -> %
Time: 0 SEC.
   compiling exported coerce : R -> %
Time: 0 SEC.
   compiling exported coerce : % -> OutputForm
Time: 0 SEC.
   compiling local partialTensor : (List B,List M) -> List Record(k: List B,c: R)
Time: 0 SEC.
   compiling exported tensor : List B -> %
Time: 0 SEC.
****** Domain: (Vector B) already in scope
augmenting (Vector B): (Comparable)
   compiling exported tensor : List M -> %
Time: 0 SEC.
****** Domain: M already in scope
augmenting M: (Algebra R)
   compiling exported * : (%,%) -> %
Time: 0 SEC.
****** Domain: R already in scope
augmenting R: (Comparable)
****** Domain: (Vector B) already in scope
augmenting (Vector B): (Comparable)
****** Domain: (Vector B) already in scope
augmenting (Vector B): (Comparable)
****** Domain: M already in scope
augmenting M: (Algebra R)
(time taken in buildFunctor:  3637)
;;;     ***       |TensorAlgebra| REDEFINED
;;;     ***       |TensorAlgebra| REDEFINED
Time: 0 SEC.
   Warnings: 
      [1] prodTERM2:  k has no value
      [2] prodTERM2:  c has no value
      [3] *: signature of lhs not unique:     chosen
      [4] coerce:  k has no value
      [5] coerce:  c has no value
      [6] partialTensor:  k has no value
      [7] partialTensor:  c has no value
      [8] partialTensor:  res has no value
      [9] tensor:  k has no value
      [10] tensor:  c has no value
      [11] *:  c has no value
      [12] *:  k has no value
   Cumulative Statistics for Constructor TensorAlgebra
      Time: 0.06 seconds
--------------non extending category----------------------
.. TensorAlgebra(#1,#2,#3) of cat 
(|Join| (|TensorAlgebraCategory| |#1| |#3|) (|GradedAlgebra| |#1| |#3|)
        (|FreeModuleCategory| |#1| (|Vector| |#2|))
        (CATEGORY |domain| (SIGNATURE |tensor| (% (|List| |#2|)))
         (SIGNATURE |coerce| (% |#2|)) (SIGNATURE * (% % %))))   has no 
(IF (|has| |#1| (|CommutativeRing|))
    (ATTRIBUTE (|Module| |#1|))
    |noBranch|)    finalizing NRLIB TENSALG 
   Processing TensorAlgebra for Browser database:
--->-->TensorAlgebra(constructor): Not documented!!!!
--->-->TensorAlgebra((tensor (% (List B)))): Not documented!!!!
--->-->TensorAlgebra((coerce (% B))): Not documented!!!!
--->-->TensorAlgebra((* (% % %))): Not documented!!!!
--->-->TensorAlgebra(): Missing Description
; compiling file "/var/aw/var/LatexWiki/TENSALG.NRLIB/TENSALG.lsp" (written 25 FEB 2025 05:20:54 AM):
; wrote /var/aw/var/LatexWiki/TENSALG.NRLIB/TENSALG.fasl
; compilation finished in 0:00:00.028
------------------------------------------------------------------------
   TensorAlgebra is now explicitly exposed in frame initial 
   TensorAlgebra will be automatically loaded when needed from 
      /var/aw/var/LatexWiki/TENSALG.NRLIB/TENSALG 
fricas
B:=OrderedVariableList [e[i] for i in 1..3]
Type: Type
fricas
e:=enumerate()$B
fricas
R:=Expression Integer
Type: Type
fricas
R has CommutativeRing
Type: Boolean
fricas
M:=FreeModule(R, B)
Type: Type
fricas
TA:=TensorAlgebra(R,B,M)
Type: Type
fricas
--t1:=tensor([e.1,e.2,e.3,e.1,e.2])$TA
--t2:=tensor([e.1,e.2,e.3,e.1])$TA
--t3:=tensor([e.1,e.2,e.3,e.2])$TA
--t4:=tensor([e.1,e.2,e.3])$TA
--T:=x*t1+y^2*t2+z^3*t3-u*t4
b:=[a::TA for a in e]
fricas
T:=x*b.1+y*b.2-z*b.3
fricas
S:=y^n*b.1-cos(x)*b.2
fricas
U:=sin(x+y+z)*b.3
fricas
p1:=product(T,T)
fricas
p2:=product(product(S,T),U)
fricas
p3:=tan(x)*1$TA
fricas
s1:=p1+p2+p3
fricas
TA has GradedAlgebra(R,M)
Type: Boolean
fricas
T*S*U*T