(****************************************************************************)
(* Simple Forms Calculator                                                  *)
(****************************************************************************)
(* $Log: forms.m%v $
# Revision 4.8  1995/02/20  01:40:56  bill
# added Laplacian, more tests, now passes trip 1.16
#
# *)
 
 
Print["   --   Simple Forms Calculator   -- William L. Burke"]
Print["$Header: d:/math/bb/forms/forms.m%v 0.4.8 1995/02/20 "]
 
(****************************************************************************)
(* Rules for Differential Forms                                             *)
(****************************************************************************)
 
(* Make forms antisymmetric by sorting the arguments                        *)
(*   invoke these rules occasionally to kill the zero terms                 *)
(*   these should be included in any operation that destroys normal order   *)
 
FSimp := {
  Form[ a__] :> Signature[ Form[a]]  Sort[Form[a]],
  TForm[ a__] :> Signature[ TForm[a]]  Sort[TForm[a]]
  }
 
Form[] := 1
 
Form[ f___, n_ /; NumberQ[n], g___] := 0
 
 
(****************************************************************************)
(* Rules for Duality of Forms and Vectors, the angle operator               *)
(****************************************************************************)
 
angle[ a_, b_ + c_] := angle[a,b] + angle[a,c]
 
angle[ a_ + b_, c_] := angle[a,c] + angle[b,c]
 
angle[ a_, Times[b___, c_Plus, d___] ] := angle[a, Expand[Times[b,c,d]]]
 
angle[ Times[b___, c_Plus, d___] , a_] := angle[ Expand[Times[b,c,d]], a]
 
angle[ a_ b_Vector, c_] := a angle[b,c]
 
angle[ a_Vector, b_ c_Form] := b angle[a,c]
 
angle[ Vector[ u_], Form[ v___, u_, w___]] :=
  -(-1)^(Position[Form[v,u,w], u][[1,1]]) Form[v, w] 
 
angle[ a_Vector, 0] := 0
 
angle[ 0, a_] := 0
 
angle[a_Vector, b_Form] := 0    (* no match above *)
 
 
(****************************************************************************)
(* Rules for Wedge Product of Diffential Forms                              *)
(*   Important to leave answers properly sorted                             *)
(****************************************************************************)
 
wedge[] := 1
 
wedge[ n_ ] := n
 
wedge[z___, a_ + b_, y___ ] :=  wedge[z, a, y] + wedge[z, b, y] 
 
wedge[ z___, a_ b_Form, y___ ] :=  a wedge[ z, b, y ]
 
wedge[a___, Times[b___, c_Plus, d___] , e___] := 
  wedge[ a, Expand[Times[b,c,d]], e]
 
wedge[ Form[a__], Form[ b__]] := Form[ a, b] /. FSimp
 
wedge[ a_, b_, c__] := wedge[ wedge[a,b], c]
 
 
  (* Treat the cases where entry is a 0-form; fall through to here  *)
wedge[ f___, n_ /; Position[n, Form]=={}, g___] := n wedge[ f, g ]
 
 
 
 
(****************************************************************************)
(* Rules for Exterior Derivatives of Differential Forms                     *)
(****************************************************************************)
 
d[ f_ ] := Dt2form[ Dt[f]]
 
d[ a_ + b_] := d[ a] + d[ b]
 
d[ Times[ b___, c_Plus, e___ ] ] := d[ Expand[Times[b,c,e]]]
 
d[ f_ Form[a___]] := wedge[Dt2form[ Dt[f]], Form[ a]]
 
  Dt2form[x_] := x /. Dt -> Dtttt /. Dtttt[y_] -> Form[y]
  (* I don't know why you can't do this directly, without Dtttt *)
 
d[ a_Form ] := 0
 
(****************************************************************************)
(* Rules for Lie Bracket of Vectors                                         *)
(****************************************************************************)
 
Lie[ Times[ b___, c_Plus, e___ ], f_] := Lie[ Expand[Times[b,c,e]], f]
 
Lie[ f_, Times[ b___, c_Plus, e___ ]] := Lie[ f, Expand[Times[b,c,e]]]
 
Lie[f_ Vector[ x_], g_ Vector[ y_]] :=
   f D[g,x] Vector[ y ] - g D[f,y] Vector[ x ]
 
Lie[Vector[ x_], g_ Vector[ y_]] := D[g,x] Vector[ y ] 
 
Lie[f_ Vector[ x_], Vector[ y_]] :=  - D[f,y] Vector[ x ]
 
Lie[Vector[ x_], Vector[ y_]] :=  0
 
 
(****************************************************************************)
(* Rules for Lie Derivatives of Differential Forms                          *)
(****************************************************************************)
 
Lie[v_+u_, w_] := Lie[v,w] + Lie[u,w]
 
Lie[v_, w_ + m_] := Lie[v,w] + Lie[v,m]
 
Lie[f_ Vector[ x_], g_ Form[ w__]] := f D[g,x] Form[w] +
  g wedge[ d[f], angle[ Vector[x], Form[w]]]
 
Lie[f_ Vector[ x_], w_Form] := wedge[ d[f], angle[ Vector[x], w]]
 
Lie[ x_Vector, g_ Form[ w__]] := D[g,x] Form[w] 
 
Lie[f_ Vector[ x_], g_ ] := f D[g,x] 
 
Lie[ Vector[ x_], g_ ] := D[g,x] 
 
 
(****************************************************************************)
(* Rules for Reducing Pullback                                              *)
(****************************************************************************)
 
Pullback[ Times[b___, c_Plus, d___], pc_] := Pullback[ Expand[b c d], pc]
 
Pullback[f_ + g__, pc_] := Pullback[f,pc] + Pullback[g, pc]
 
Pullback[ f_ g_Form, pc_ ] := (f /. pc) Pullback[ g, pc]
 
Pullback[f_Form, pc_] := wedge @@ d /@ (f /. pc)
 
 
(****************************************************************************)
(* Rules for Twisted Differential Forms                                     *)
(****************************************************************************)
 
  (* Represent these by TForm[...]             *)
  (* We add antisymmetry to our FSimp operator *)
 
  (* Wedge operator for W^W and W^F                            *)
  (* requires us to know the dimension of space                *)
  (* Define this by giving the twisted unit tmax               *)
  (* One wants to reduce the dependence of these rules on tmax *)
Unprotect[tmax]
tmax  = TForm[x,y,z]
Protect[tmax]
 
 
(****************************************************************************)
(* Rules for Duality of Twisted Forms and Vectors, the angle operator       *)
(****************************************************************************)
 
angle[ a_Vector, b_ c_TForm] := b angle[a,c]
 
angle[ Vector[ u_], TForm[ v___]] :=  TForm[v,u] /. FSimp
 
 
(****************************************************************************)
(* Rules for Wedge Products Involving Twisted Forms                         *)
(****************************************************************************)
 
wedge[ z___, a_ b_TForm, y___ ] :=  a wedge[ z, b, y ]
 
wedge[ Form[], TForm[] ] := 1
 
wedge[ a_Form, TForm[] ] := 0
 
wedge[ Form[], a_TForm ] := a
 
wedge[ Form[q_], TForm[a___, q_, b___] ] :=
  -(-1)^(Position[TForm[a,q,b], q][[1,1]] + Length[{a}] + Length[{b}]) *
     TForm[a,b] 
 
wedge[ Form[a__, q_], w_TForm ] := 
  wedge[ Form[a],  wedge[Form[q], w]]
 
wedge[ q_Form, p_TForm] := 0      (* Fall through default pattern *)
 
wedge[ p_TForm, q_TForm ] := Module[{common, puniq, quniq, answ},
  common = Intersection[q,p];
  puniq  = Complement[p, common];
  quniq  = Complement[q, common];
  answ   =
    Signature[p] * Signature[ Flatten[TForm[common, puniq]]] *
    Signature[q] * Signature[ Flatten[TForm[common, quniq]]] *
    Signature[Flatten[TForm[puniq, quniq]]] *
      Form @@ Union[puniq, quniq];
  If[Length[tmax]==Length[Union[Flatten[TForm[p,q]]]], answ, 0] 
]
 
wedge[ p_TForm, q_Form] :=
  wedge[tmax, p, q, tmax]
 
wedge[ q_TForm ] := q
 
 
(****************************************************************************)
(* Rules for Lie Derivatives of Twisted Forms                               *)
(****************************************************************************)
 
Lie[f_ Vector[ x_], g_ TForm[ w__]] := f D[g,x] TForm[w] +
  g wedge[ d[f], angle[ Vector[x], TForm[w]]]
 
Lie[f_ Vector[ x_], w_TForm] := wedge[ d[f], angle[ Vector[x], w]]
 
Lie[ x_Vector, g_ TForm[ w__]] := D[g,x] TForm[w] 
 
 
(****************************************************************************)
(* Rules for Exterior Derivatives of Twisted Forms                          *)
(****************************************************************************)
 
d[ f_ TForm[a___]] := wedge[Dt2form[ Dt[f]], TForm[ a]]
 
d[ a_TForm ] := 0
 
 
(****************************************************************************)
(* Rules for Infix Wedge Product                                            *)
(*   at present these fail for dx ** 3 dy                                   *)
(****************************************************************************)
 
Unprotect[NonCommutativeMultiply]
 
a_ ** b__ := wedge[a, b]
 
Protect[NonCommutativeMultiply];
 
 
(****************************************************************************)
(* Rules for Hodge Star, assumes orthonormal basis, t timelike              *)
(****************************************************************************)
 
star[Times[b___, c_Plus, d___]] := star[ Expand[Times[b,c,d]]]
 
star[a_ + b_] := star[a] + star[b]
 
star[a_ b_Form] := a star[b]
 
star[a_ b_TForm] := a star[b]
 
star[Form[a___]] := If[Position[{a}, t]=={}, TForm[a], -TForm[a]]
 
star[TForm[a___]] := If[Position[{a}, t]=={}, Form[a], -Form[a]] 
 
star[ n_ /; Position[n, Form]=={} ] := n TForm[]
 
(****************************************************************************)
(* Laplacian                                                                *)
(****************************************************************************)
 
Laplace[ f_ ] := star[ d[ star[ d[ f ]]]]
