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$
6
  • 1
    $\begingroup$ What happens if you use /; Head[z] =!= Dt in the first line? $\endgroup$
    – Mr.Wizard
    May 22, 2017 at 22:28
  • $\begingroup$ @Mr.Wizard Wow, yes, now the first rule triggers, but the other two do not... $\endgroup$
    – Kagaratsch
    May 22, 2017 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, 2017 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, 2017 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, 2017 at 22:37

1 Answer 1

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}$

$\endgroup$
1
  • $\begingroup$ This is great, thank you! $\endgroup$
    – Kagaratsch
    May 23, 2017 at 0:05

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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