Edit detail for SandBoxDifferentialGeometry revision 2 of 10

)abbrev domain DIFGEOM DifferentialGeometry

DifferentialGeometry(CoefRing, listIndVar : List Symbol, g:SMR) : Export == Implement where
  CoefRing :  Join(IntegralDomain, Comparable)
  ASY     ==> AntiSymm(R, listIndVar)
  DERHAM ==> DeRhamComplex(CoefRing, listIndVar)
  DIFRING ==> DifferentialRing
  LALG    ==> LeftAlgebra
  FMR     ==> FreeMod(R, EAB)
  I       ==> Integer
  L       ==> List
  EAB     ==> ExtAlgBasis  -- these are exponents of basis elements in order
  NNI     ==> NonNegativeInteger
  O       ==> OutputForm
  R       ==> Expression(CoefRing)
  SMR     ==> SquareMatrix(#listIndVar,R)   -- 

  Export == Join(LALG(R), RetractableTo(R)) with
      leadingCoefficient : %           -> R
        ++ leadingCoefficient(df) returns the leading
        ++ coefficient of differential form df.
      leadingBasisTerm   : %           -> %
        ++ leadingBasisTerm(df) returns the leading
        ++ basis term of differential form df.
      reductum           : %           -> %
        ++ reductum(df), where df is a differential form,
        ++ returns df minus the leading
        ++ term of df if df has two or more terms, and
        ++ 0 otherwise.
      coefficient        : (%, %)     -> R
        ++ coefficient(df, u), where df is a differential form,
        ++ returns the coefficient of df containing the basis term u
        ++ if such a term exists, and 0 otherwise.
      generator          : NNI         -> %
        ++ generator(n) returns the nth basis term for a differential form.
      homogeneous?       : %           -> Boolean
        ++  homogeneous?(df) tests if all of the terms of
        ++  differential form df have the same degree.
      retractable?       : %           -> Boolean
        ++  retractable?(df) tests if differential form df is a 0-form,
        ++  i.e., if degree(df) = 0.
      degree             : %           -> NNI
        ++  changed from I to NNI , then works
        ++  degree(df) returns the homogeneous degree of differential form df.
      map                : (R -> R, %) -> %
        ++  map(f, df) replaces each coefficient x of differential
        ++  form df by \spad{f(x)}.
      totalDifferential    : R -> %
        ++  totalDifferential(x) returns the total differential
        ++  (gradient) form for element x.
      exteriorDifferential : % -> %
        ++  exteriorDifferential(df) returns the exterior
        ++  derivative (gradient, curl, divergence, ...) of
        ++  the differential form df.

--=-=-=-=-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-=       
      dim : % -> NNI
        ++ dimension of underlying space
        ++ that is dim ExtAlg = 2^dim

      hodgeStar : (%) -> %
        ++ computes the Hodge dual of the differential form % with respect
        ++ to a metric g.

      dot : (%,%) -> R
        ++ computes the inner product of two differential forms w.r.t. g

--=-=-=-=-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-==-=-=

  Implement == DERHAM add
      Rep := DERHAM

      dim := #listIndVar

      terms : % -> List Record(k : EAB, c : R)
      terms(a) ==
        -- it is the case that there are at least two terms in a
        a pretend List Record(k : EAB, c : R)

      -- error messages
      err2:="Not implemented"
      err3:="Degenerate metric"

      -- coord space dimension 
      dim(f) == dim

      -- flip 0->1, 1->0 
      flip(b:ExtAlgBasis):ExtAlgBasis ==
        bl := b pretend List(NNI)
        [(i+1) rem 2 for i in bl] pretend ExtAlgBasis

      -- list the positions of a's (a=0,1) in x
      pos(x:EAB, a:NNI):List(NNI) ==
        y:= x pretend List(NNI) 
        [j for j in 1..#y | y.j=a]

      -- compute factors for hodgeStar  
      facs(cc:Record(k : EAB, c : R)):R ==
        not diagonal? g => error(err2)
        G := reduce("*", [g(j,j) for j in 1..dim]::List(R)) 
        G = 0 => error(err3)
        --
        idx := pos(cc.k,0) -- pos of 0 since already flipped
        eps := concat(pos(cc.k,1),pos(cc.k,0))::List(NNI)
        dom := [j for j in 1..dim]::List(NNI)
        sgn := sign(coercePreimagesImages([dom,eps])::Permutation(NNI))::R
        if idx ~= [] then
          fg:R:= sgn*reduce("*",[1/g(j,j) for j in idx]::List(R))
        else
          fg:R:=sgn
        fg * sqrt(abs(G)) * cc.c

      -- export
      hodgeStar(x) ==
        t := terms(x)
        s := [copy(r) for r in t] -- we need a copy of x!
        for j in 1..#t repeat
          s.j.k := flip(s.j.k)
          s.j.c := facs(s.j)  -- builtin g
        s pretend %

      -- compute dot of singletons
      dot1(r:Record(k : EAB, c : R),s:Record(k : EAB, c : R)):R ==
        test(r.k ~= s.k) => 0::R
        idx := pos(r.k,1)
        reduce("*",[1/g(j,j) for j in idx]::List(R)) * r.c * s.c

      -- export
      dot(x,y) ==
        tx := terms(x)
        ty := terms(y)
        reduce("+",[dot1(tx.j,ty.j) for j in 1..#tx])

   Compiling FriCAS source code from file 
      /var/lib/zope2.10/instance/axiom-wiki/var/LatexWiki/7409824215686792721-25px001.spad
      using old system compiler.
   DIFGEOM abbreviates domain DifferentialGeometry 
------------------------------------------------------------------------
   initializing NRLIB DIFGEOM for DifferentialGeometry 
   compiling into NRLIB DIFGEOM 
****** Domain: CoefRing already in scope
   compiling local terms : $ -> List Record(k: ExtAlgBasis,c: Expression CoefRing)
      DIFGEOM;terms is replaced by a 
Time: 0.05 SEC.

   compiling exported dim : $ -> NonNegativeInteger
Time: 0 SEC.

   compiling local flip : ExtAlgBasis -> ExtAlgBasis
Time: 0.02 SEC.

   compiling local pos : (ExtAlgBasis,NonNegativeInteger) -> List NonNegativeInteger
Time: 0.03 SEC.

   compiling local facs : Record(k: ExtAlgBasis,c: Expression CoefRing) -> Expression CoefRing
Time: 0.11 SEC.

   compiling exported hodgeStar : $ -> $
Time: 0.01 SEC.

   compiling local dot1 : (Record(k: ExtAlgBasis,c: Expression CoefRing),Record(k: ExtAlgBasis,c: Expression CoefRing)) -> Expression CoefRing
Time: 0.61 SEC.

   compiling exported dot : ($,$) -> Expression CoefRing
Time: 0.01 SEC.

(time taken in buildFunctor:  10)

;;;     ***       |DifferentialGeometry| REDEFINED

;;;     ***       |DifferentialGeometry| REDEFINED
Time: 0.01 SEC.

   Warnings: 
      [1] facs:  k has no value
      [2] facs:  c has no value
      [3] dot1:  k has no value
      [4] dot1:  c has no value

   Cumulative Statistics for Constructor DifferentialGeometry
      Time: 0.85 seconds

--------------non extending category----------------------
.. DifferentialGeometry(#1,#2,#3) of cat 
(|Join| (|LeftAlgebra| (|Expression| |#1|))
        (|RetractableTo| (|Expression| |#1|))
        (CATEGORY |domain|
         (SIGNATURE |leadingCoefficient| ((|Expression| |#1|) $))
         (SIGNATURE |leadingBasisTerm| ($ $)) (SIGNATURE |reductum| ($ $))
         (SIGNATURE |coefficient| ((|Expression| |#1|) $ $))
         (SIGNATURE |generator| ($ (|NonNegativeInteger|)))
         (SIGNATURE |homogeneous?| ((|Boolean|) $))
         (SIGNATURE |retractable?| ((|Boolean|) $))
         (SIGNATURE |degree| ((|NonNegativeInteger|) $))
         (SIGNATURE |map|
          ($ (|Mapping| (|Expression| |#1|) (|Expression| |#1|)) $))
         (SIGNATURE |totalDifferential| ($ (|Expression| |#1|)))
         (SIGNATURE |exteriorDifferential| ($ $))
         (SIGNATURE |dim| ((|NonNegativeInteger|) $))
         (SIGNATURE |hodgeStar| ($ $))
         (SIGNATURE |dot| ((|Expression| |#1|) $ $))))    has no  degree : % -> Integer 
   finalizing NRLIB DIFGEOM 
   Processing DifferentialGeometry for Browser database:
--->-->DifferentialGeometry(constructor): Not documented!!!!
--------(leadingCoefficient ((Expression CoefRing) %))---------
--------(leadingBasisTerm (% %))---------
--------(reductum (% %))---------
--------(coefficient ((Expression CoefRing) % %))---------
--------(generator (% (NonNegativeInteger)))---------
--------(homogeneous? ((Boolean) %))---------
--------(retractable? ((Boolean) %))---------
--------(degree ((NonNegativeInteger) %))---------
--->-->DifferentialGeometry((degree ((NonNegativeInteger) %))): Improper first word in comments: changed
"changed from \\spad{I} to NNI ,{} then works degree(\\spad{df}) returns the homogeneous degree of differential form \\spad{df}."
--------(map (% (Mapping (Expression CoefRing) (Expression CoefRing)) %))---------
--------(totalDifferential (% (Expression CoefRing)))---------
--------(exteriorDifferential (% %))---------
--------(dim ((NonNegativeInteger) %))---------
--->-->DifferentialGeometry((dim ((NonNegativeInteger) %))): Improper first word in comments: dimension
"dimension of underlying space that is dim ExtAlg = 2^dim"
--------(hodgeStar (% %))---------
--->-->DifferentialGeometry((hodgeStar (% %))): Improper first word in comments: computes
"computes the Hodge dual of the differential form \\% with respect to a metric \\spad{g}."
--------(dot ((Expression CoefRing) % %))---------
--->-->DifferentialGeometry((dot ((Expression CoefRing) % %))): Improper first word in comments: computes
"computes the inner product of two differential forms \\spad{w}.\\spad{r}.\\spad{t}. \\spad{g}"
--->-->DifferentialGeometry(): Missing Description
; compiling file "/var/aw/var/LatexWiki/DIFGEOM.NRLIB/DIFGEOM.lsp" (written 07 OCT 2014 10:45:28 PM):

; /var/aw/var/LatexWiki/DIFGEOM.NRLIB/DIFGEOM.fasl written
; compilation finished in 0:00:00.068
------------------------------------------------------------------------
   DifferentialGeometry is now explicitly exposed in frame initial 
   DifferentialGeometry will be automatically loaded when needed from 
      /var/aw/var/LatexWiki/DIFGEOM.NRLIB/DIFGEOM

)set output tex off
 

)set output algebra on

G:=diagonalMatrix([1,1,1])

        +1  0  0+
        |       |
   (1)  |0  1  0|
        |       |
        +0  0  1+

X := DIFGEOM(Integer,[x,y,z],G)

   (2)
  DifferentialGeometry(Integer,[x,y,z],#2A((((0 . 1) . #1=(0 . 1)) #2=((0 . 0) 
  . #1#) #2#)
    (#2# ((0 . 1) . #1#) #2#)
    (#2# #2# ((0 . 1) . #1#))))

[dx,dy,dz] := [generator(i)$X for i in 1..3]

   (3)  [dx,dy,dz]

(#2# ((0 . 1) . #1#) #2#)
    (#2# #2# ((0 . 1) . #1#)))))
f : BOP := operator('f);

g : BOP := operator('g);

h : BOP := operator('h);

sigma := f(x,y,z) * dx + g(x,y,z) * dy + h(x,y,z) * dz

   (7)  h(x,y,z)dz + g(x,y,z)dy + f(x,y,z)dx

(#2# ((0 . 1) . #1#) #2#)
    (#2# #2# ((0 . 1) . #1#))))
dot(sigma,sigma)

                2           2           2
   (8)  h(x,y,z)  + g(x,y,z)  + f(x,y,z)

hodgeStar(sigma)

   (9)  h(x,y,z)dx dy - g(x,y,z)dx dz + f(x,y,z)dy dz

(#2# ((0 . 1) . #1#) #2#)
    (#2# #2# ((0 . 1) . #1#))))