0
$\begingroup$

I am dealing with brackets br[arg1, arg2, ...], having a sequence of positive integers (labels) as argument. Brackets are totally antisymmetric, hence it is important - when reordering labels - to keep track of the sign of the permutation.

I want to write a very simple sorting function, such that, given an arbitrary expression involving several brackets, reorders their arguments putting a prescribed subset of labels in front.

I have a first function, sort, that works just fine when the subset of distinguished labels has length 2. 

sort[expr_, lab_List] := Block[{}, expr //. {br[a1___, lab[[1]], a2___, lab[[2]], a3___] :> Signature[{a1, lab[[1]], a2, lab[[2]], a3}]*Signature[Join[{lab[[1]], lab[[2]]}, { a1, a2, a3}]]* br @@ Join[{lab[[1]], lab[[2]]}, {a1, a2, a3}]} ]

As an example, consider

ex = br[1, 5, 7, 8, 9] br[3, 1, 5, 7, 8] br[3, 1, 4, 5] + br[2, 3, 4, 1, 6, 5] br[1, 3, 5] br[1, 7, 8, 5, 3] sort[ex, {1, 5}] 
Out[3]= -br[1, 5, 3, 4] br[1, 5, 3, 7, 8] br[1, 5, 7, 8, 9] + br[1, 5, 3] br[1, 5, 7, 8, 3] br[1, 5, 2, 3, 4, 6]

Then I tried to generalize it, to allow subset of arbitrary length to be sorted in front of every argument and this is what I came up with.

genSort[expr_, lab_List] := Block[{otherLabels}, otherLabels = Table[ToExpression@StringJoin["a", ToString[i]], {i, 1, Length[lab] + 1}]; expr //. {br @@ Riffle[(Pattern[#, ___] & /@ otherLabels), lab] :> Signature[Riffle[otherLabels, lab]]*Signature[Join[lab, otherLabels]]* br @@ Join[lab, otherLabels]} ]

Now when I try to use this more general version of the function on the previous example, I get 

ex = br[1, 5, 7, 8, 9] br[3, 1, 5, 7, 8] br[3, 1, 4, 5] + br[2, 3, 4, 1, 6, 5] br[1, 3, 5] br[1, 7, 8, 5, 3] genSort[ex, {1, 5}] 
During evaluation of In[44]:= ReplaceRepeated::rrlim: Exiting after br[3,1,4,5] br[1,5,7,8,9] br[3,1,5,7,8]+br[1,3,5] br[1,7,8,5,3] br[2,3,4,1,6,5] scanned 65536 times. Out[4]= 2 br[1, 5, a1, a2, a3]^3

Now, beside the warning about the ReplaceRepeated, obviously the problem is that I am not able to convince Mathematica to identify the a1,a2,... with appropriate (possibly empty) sequences of labels, as it was seamlessly doing with the more specific function above.
I understand that Mathematica is just using the labels a1, a2, ... ignoring the pattern matching construct, but I still believe that the implementation is correct in spirit. Is there a way to save it, or is it doomed? (I also tried to use some Evaluate command here and there, it doesn't seem to change anything.)

On a separate note, I created the list of a-indices with a rather cumbersome construct. However, this was the only one I could think of which could allow to create an a priori unspecified number of objects and to append some blanks to them to define a pattern (neither a[i], nor Subscript[a,i] would do, of course). Is there a better way out?

Thanks for your help!

Improve this question
$\endgroup$

2 Answers 2

Reset to default
1
$\begingroup$

About the issue in the code

RuleDelayed evaluates its left-hand side but not its right-hand side. In the expression

br @@ Riffle[(Pattern[#, ___] & /@ otherLabels), lab] :> Signature[Riffle[otherLabels, lab]] * Signature[Join[lab, otherLabels]] * br @@ Join[lab, otherLabels]

the pattern is correctly constructed in the left-hand side and will be of the form

br[a1___, lab[[1]], a2___, lab[[2]], ..., lab[[n - 1]], an___]

with the lab[[i]] replaced by their corresponding values.

The right-hand side, since not evaluated, does not contain the symbols a1, a2, ..., an at the time of the construction of the rule; it contains instead the unevaluated symbol otherLabels. This means that the ai hidden in otherLabels are not bound to their pattern counterpart on the left-hand side.

Specifically, when an expression matches the pattern given in the left-hand side, the subexpressions constructed from the ai___ won't be passed to the right-hand side, since there are no ai to pass them to. At the time when otherLabels is evaluated, this information is lost and only the symbols ai are returned.

A simple example of this issue is

labels = {a1, a2, a3}; rule = f[a1___, 1, a2___, 3, a3___] :> labels (* f[a1___, 1, a2___, 3, a3___] :> labels *) f[1, 2, 3, 4, 5, 6] /. rule (* {a1, a2, a3} *)

Solution

A possible solution is to use With to make in the RuleDelayed a "literal" replacement of the symbol otherLabels with its value. For the example above, doing so, we have a renaming of the patterns:

rule2 = With[{temp = labels}, f[a1___, 1, a2___, 3, a3___] :> temp] (* f[a1$___, 1, a2$___, 3, a3$___] :> {a1, a2, a3} *)

so it returns the same result:

f[1, 2, 3, 4, 5, 6] /. rule2 (* {a1, a2, a3} *)

Here are two possible work-arounds to get the renaming on the right-hand side as well:

1) Using the With-symbol to construct the pattern on the left-hand side:

rule2 = With[{temp = labels}, f @@ Riffle[(Pattern[#, ___] & /@ temp), {1, 3}] :> temp] (* f[a1$___, 1, a2$___, 3, a3$___] :> {a1$, a2$, a3$} *) f[1, 2, 3, 4, 5, 6] /. rule2 (* {2, 4, 5, 6} *)

2) Constructing the pattern in a Module and giving it to RuleDelayed:

rule2 = Module[{patt}, patt = {a1___, 1, a2___, 3, a3___}; With[{temp = labels}, f @@ patt :> temp] ] (* f[a1$___, 1, a2$___, 3, a3$___] :> {a1$, a2$, a3$} *) f[1, 2, 3, 4, 5, 6] /. rule2 (* {2, 4, 5, 6} *)

Improving the code

Since you do not need a Block or Module, we can use the first approach above, which gives for your code (ReplaceRepeated is replaced by ReplaceAll and I use Unique to create the symbols):

genSort2[expr_, lab_List] := expr /. With[{temp = Table[Unique["a"], Length[lab] + 1]}, {br @@ Riffle[Pattern[#, ___] & /@ temp, lab] :> Signature[Riffle[temp, lab]] * Signature[Join[lab, temp]] * br @@ Join[lab, temp] } ];

Taking your example we get:

ex = br[1, 5, 7, 8, 9] br[3, 1, 5, 7, 8] br[3, 1, 4, 5] + br[2, 3, 4, 1, 6, 5] br[1, 3, 5] br[1, 7, 8, 5, 3]; genSort2[ex, {1, 5}] (* -br[1, 5, 3, 4] br[1, 5, 3, 7, 8] br[1, 5, 7, 8, 9] *)

We are missing the subexpression br[1, 5, 3] br[1, 5, 7, 8, 3] br[1, 5, 2, 3, 4, 6] in the result because the right-hand side is not yet correctly constructed. The last term of it gave 0 after applying the rule,

genSort2[br[1, 5, 2, 3, 4, 6], {1, 5}] (* 0 *)

because Riffle[{2, 3, 4, 6}, {1, 5}] gave {2, 1, 3, 5, 4, 1, 6} (the elements of the second list are used cyclically), and its Signature gave in turn 0.

This will happen whenever the number of arguments of br is greater than 2 Length[lab] + 1:

genSort2[br[2, 5, 1, 3], {1}] (* 0 *)

Since Signature works on expression with heads different from List, you can simply take the expression that was matched by the pattern and passed it to the right-hand side of the rule.

Final version

Here is the final version of the code that keeps your initial idea:

genSort2[expr_, lab_List] := expr /. With[{temp = Table[Unique["a"], Length[lab] + 1]}, {lhs: br @@ Riffle[Pattern[#, ___] & /@ temp, lab] :> Signature[lhs] * Signature[Join[lab, temp]] * br @@ Join[lab, temp] } ];

We get

genSort2[ex, {1, 5}] (* -br[1, 5, 3, 4] br[1, 5, 3, 7, 8] br[1, 5, 7, 8, 9] + br[1, 5, 3] br[1, 5, 7, 8, 3] br[1, 5, 2, 3, 4, 6] *)

which agrees with your sort function:

% === sort[ex, {1, 5}] (* True *)
Improve this answer
$\endgroup$
5
  • $\begingroup$ Thank you, @Xavier, for the very thorough answer. I will accept it over QuantumDot's solution, since it directly improves the idea in my code. Thanks for bringing up Unique and the lhs : ... construct, which I didn't know and found very interesting. :-) $\endgroup$ Commented Sep 20, 2016 at 13:11
  • $\begingroup$ I have a couple questions. 1) Why doesn't Evaluate[rhs of the rule] suffice to make my original code work? 2) How does Signature[lhs] not produce zero when riffling lab in the list of a's? It seems equivalent to the previous code to me, but of course I am missing something! $\endgroup$ Commented Sep 20, 2016 at 13:25
  • $\begingroup$ @AndreaOrta 1) Evaluate[rhs] is going to evaluate the whole right-hand side expression before constructing the rule. For instance considering the subexpression Signature[Join[lab, temp]] (see final version from where it is extracted), the part Join[lab, temp] will be evaluated to produce, e.g., {1, 2, a1, a2, a3} (in the situation where lab = {1, 2}), and then Signature[{1, 2, a1, a2, a3}] will get evaluated to 1. This last evaluation was done considering the symbols ai, and so is independent from their values, because this happened before the construction of the rule. $\endgroup$ Commented Sep 20, 2016 at 18:45
  • $\begingroup$ @AndreaOrta 2) a) In the old scenario (see the end of the part "Improving the code"), the riffling is done after the elements ai are replaced by their values given by the left-hand side, not before. Consider for instance lab = {1} and br[1, 2, 3, 4]. This last expression matches the pattern br[a1___, 1, a2___], constructed from br @@ Riffle[Pattern[#, ___] & /@ {a1, a2}, {1}], and you get the assignement a1 = Sequence[] and a2 = Sequence[2, 3, 4]. $\endgroup$ Commented Sep 20, 2016 at 19:40
  • $\begingroup$ @AndreaOrta 2) b) So Riffle[{a1, a2}, {1}] (corresponding to Riffle[temp, lab] in the right-hand side) becomes Riffle[{2, 3, 4}, {1}], and gets evaluated to {2, 1, 3, 1, 4} (which has signature 0). It is not evaluated to {a1, 1, a2} first and then replaced by {1, 2, 3, 4}. $\endgroup$ Commented Sep 20, 2016 at 19:41
1
$\begingroup$

This may or may not help. I would keep the arguments of br in canonical order, rather than trying to change the order manually.

This might be done by 

unorderedq[_] := True unorderedq[_?OrderedQ] := False unorderedq[{1, 2}] (* False *) unorderedq[{2, 1}] (* True *) br[u__] /; unorderedq[{u}] := br @@ Sort[{u}] Signature[{u}]
Improve this answer
$\endgroup$
2
  • $\begingroup$ A sight modification: unorderedq[x_]:=!OrderedQ@x $\endgroup$ Commented Sep 17, 2016 at 23:32
  • $\begingroup$ Excuse me, @mikado, I am not sure I am understanding your point. I really need to violate the canonical ordering of the arguments, for then applying some other function to them. However I agree that in principle it is better to impose a standard ordering and therefore I also have a sorteverything function, doing what yours does. Is this what you wanted to point out? $\endgroup$ Commented Sep 20, 2016 at 13:29

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.