(****************************************************************************) (* 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 ]]]]