1
$\begingroup$

I am trying to write substitution rules to obtain an ordered 4-form from four 1-forms constructed by applying a total differentiation to four functions:

ClearAll[form]
form[x___, z_, y___] /; ! (Head[z] == Dt) := Module[{vrs, rls, i},
  vrs = Cases[z, _Dt, {-2}] // Union;
  rls = (#[[1]].vrs -> #[[2]] &) /@ CoefficientRules[z, vrs];
  Sum[(vrs[[i]] /. rls) form[x, vrs[[i]], y], {i, 1, Length[vrs]}]
  ]
form[x___, Dt[q1_], w___, Dt[q1_], y___] := 0
form[x___,Dt[q2_],Dt[q1_],y___] /;!({q2, q1}===Sort[{q2, q1}]):=-form[x, Dt[q1], Dt[q2], y]

Trying the input:

form[Dt[(a + b c)/d], Dt[(a - b c)/d], Dt[(d + b a)/c], Dt[d - b a]]

form[(Dt[a] + c Dt[b] + b Dt[c])/d - ((a + b c) Dt[d])/d^2, ( Dt[a] - c Dt[b] - b Dt[c])/d - ((a - b c) Dt[d])/ d^2, -(((a b + d) Dt[c])/c^2) + (b Dt[a] + a Dt[b] + Dt[d])/ c, -b Dt[a] - a Dt[b] + Dt[d]]

Does apparently nothing. I would have expected the first rule defined above to decompose all entries of form to contain only Dt[x_] terms and the remaining two rules to sort these entries. Why do the substitutions not trigger? How should I fix it so it does what I'm trying to implement?

EDIT:

Fixed my code, so that now it works as well:

ClearAll[form]
form[{x___}] := form[x];
form[x___, z_, y___] /; ! (Head[z] === Dt) := Module[{vrs, rls, i}, 
  vrs = Cases[z, _Dt, {-2}] // Union;
  rls = (#[[1]].vrs -> #[[2]] &) /@ CoefficientRules[z, vrs];
  Sum[(vrs[[i]] /. rls) form[x, vrs[[i]], y], {i, 1, Length[vrs]}]
  ]
form[x___, q1_, w___, q1_, y___] := 0
form[x___, q2_, q1_, y___] /; ! ({q2, q1} === Sort[{q2, q1}]) := -form[x, q1, q2, y]
$\endgroup$
  • 1
    $\begingroup$ What happens if you use /; Head[z] =!= Dt in the first line? $\endgroup$ – Mr.Wizard May 22 '17 at 22:28
  • $\begingroup$ @Mr.Wizard Wow, yes, now the first rule triggers, but the other two do not... $\endgroup$ – Kagaratsch May 22 '17 at 22:31
  • $\begingroup$ You are aware that by naming two appearances of a pattern both q1 you force them to match an identical expression? (I'm just looking for possible issues and not running nor attempting to fully understand this code.) $\endgroup$ – Mr.Wizard May 22 '17 at 22:34
  • $\begingroup$ @Mr.Wizard Yes, $...\wedge x\wedge ...\wedge x\wedge ...=0$ due to antisymmetry of the wedge product in a $p$-form. $\endgroup$ – Kagaratsch May 22 '17 at 22:36
  • $\begingroup$ Sorry, I don't see anything else to question and the moment and I'm signing off for the day. $\endgroup$ – Mr.Wizard May 22 '17 at 22:37
5
$\begingroup$

Perhaps you can make use of TensorProduct and TensorExpand. I also took the liberty of using Wedge (a symbol with no built-in meaning) instead of form:

Clear[Wedge];
Wedge[a__] := Module[{tp, exp, scalars},
   scalars = DeleteCases[Variables[{a}], _Dt];
   Assuming[Element[Alternatives @@ scalars, Arrays[{}]],
      tp = TensorProduct[a];
      exp = TensorExpand[tp]
   ];
   (
      exp /. TensorProduct -> Wedge
   ) /; tp =!= exp
];
Wedge[___, a_, ___, a_, ___] = 0;
Wedge[a__] /; Sort[{a}] =!= {a} := Signature[{a}] Wedge @@ Sort[{a}]

In the definition of Wedge, I used Element[.., Arrays[{}]] to declare non-Dt[__] variables as scalars, and I used Signature instead of pairwise swaps to reorder the Wedge forms. For the OP's example:

Wedge[Dt[(a+b c)/d], Dt[(a-b c)/d], Dt[(d+b a)/c], Dt[d-b a]] //TeXForm

$-\frac{4 a^2 b^2 da\wedge db\wedge dc\wedge dd}{c d^3}+\frac{2 a b da\wedge db\wedge dc\wedge dd}{c d^2}+\frac{2 da\wedge db\wedge dc\wedge dd}{c d}$

|improve this answer|||||
$\endgroup$
  • $\begingroup$ This is great, thank you! $\endgroup$ – Kagaratsch May 23 '17 at 0:05

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.