# How to get "Signature" of each element of "Permutation" output

I need to sum over all possible permutations, multiplied by the Signature of each permutation of a given list of symbols. But, I don't know how to determine the Signature of each particular permutation with respect to the original given list (because the original input list may not be in canonical order).

Here's my code that does the job without including the appropriate minus signs:

input = {b, a, c};
Total[Map[(*signature factor here*)function[#] &, Permutations[input]]]

(*function[{a, b, c}] + function[{a, c, b}] + function[{b, a, c}] +
function[{b, c, a}] + function[{c, a, b}] + function[{c, b, a}]*)


1. How do I include the appropriate minus sign? For input={b, a, c} The output should be:

(* -function[{a, b, c}] + function[{a, c, b}] + function[{b, a, c}] -
function[{b, c, a}] - function[{c, a, b}] + function[{c, b, a}]*)


For input={a, b, c} , the output should be

(* function[{a, b, c}] - function[{a, c, b}] - function[{b, a, c}] +
function[{b, c, a}] + function[{c, a, b}] - function[{c, b, a}]*)

2. Also, since input may be large, is it possible to get the signature during runtime (of Permutations) for higher performance?

• Closely related: (60111) Oct 27, 2014 at 15:53
• @Mr.Wizard Sorry it took a while; I wanted to be fair about which answer I found to be most useful... Nov 2, 2014 at 9:41

Applying the method I described in: How to define even permutations correctly?:

fW[a_List] :=
With[{p = Permutations @ Range @ Length @ a},
Dot[Signature /@ p, func /@ Extract[a, p ~Partition~ 1]]
]


This is faster than both of kguler's functions (which are in turn faster than belisarius's code):

f1 = Function[{k}, Total[Map[Signature[ #[[Ordering @ k]] ] func[#] &, Permutations[k]]]];
f2 = Function[{k}, Total[Map[Signature[#] Signature[k] func[#] &, Permutations[k]]]];

(res1 = f1 /@ Permutations[{a, b, c, d, e, x}]); // AbsoluteTiming // First

(res2 = f2 /@ Permutations[{a, b, c, d, e, x}]); // AbsoluteTiming // First

(resW = fW /@ Permutations[{a, b, c, d, e, x}]); // AbsoluteTiming // First

Equal @@ {res1, res2, resW}

2.290631

2.320133

1.121564

True


Note: my code uses an undocumented syntax for Extract which works in Mathematica 8 or later. If you have an earlier version please use:

fW[a_List] :=
With[{p = Permutations @ Range @ Length @ a},
Dot[Signature /@ p, func /@ (a[[#]] & /@ p)]
]

input = {b, a, c};


Perhaps

Total[Map[Signature[ #[[Ordering @ input]] ] func[#] &, Permutations[input]]]
(* -func[{a, b, c}] + func[{a, c, b}] + func[{b, a, c}] -
func[{b, c, a}] - func[{c, a, b}] + func[{c, b, a}] *)


or

Total[Map[Signature[#]Signature[input] func[#] &, Permutations[input]]]
(* same result *)


or

Signature[input] Total[Map[Signature[#] func[#] &, Permutations[input]]]
(* same result *)

Function[{k}, {Row@k, Total[Map[Signature[ #[[Ordering @ k]] ] func[#] &,
Permutations[k]]]}] /@ Permutations[{a, b, c}] // TableForm


Timing comparisons:

f1 = Function[{k},Total[Map[Signature[ #[[Ordering @ k]] ] func[#] &, Permutations[k]]]];
f2 = Function[{k},Total[Map[Signature[#] Signature[k] func[#] &, Permutations[k]]]];
f3 = Function[{k},Signature[k] Total[Map[Signature[#]  func[#] &, Permutations[k]]]];
fB = Function[{k},Total[Map[Signature[# /. mapping[k]] func[#] &, Permutations[k]]]];
fW[a_List] := With[{p = Permutations @ Range @ Length @ a},
Dot[Signature /@ p, func /@ Extract[a, p ~Partition~ 1]] ];


All permutations of length 5 and 6:

(res1 = f1 /@ Permutations[{a, b, c, d, e}] ); // AbsoluteTiming // First
(* 0.062501 *)
(res2 = f2 /@ Permutations[{a, b, c, d, e}] ); //AbsoluteTiming // First
(* 0.061893 *)
(res3 = f3 /@ Permutations[{a, b, c, d, e}] ); // AbsoluteTiming // First
(resB = fB /@ Permutations[{a, b, c, d, e}] ); // AbsoluteTiming // First
(* 0.171893 *)
(resW = fW /@ Permutations[{a, b, c, d, e}] ); // AbsoluteTiming // First
Equal @@ {res1, res2, res3, resB, resW}
(* True *)

(res1 = f1 /@ Permutations[{a, b, c, d, e, x}]); // AbsoluteTiming // First
(* 2.245413 *)
(res2 = f2 /@ Permutations[{a, b, c, d, e, x}]); // AbsoluteTiming // First
(* 2.410684 *)
(res3 = f3 /@ Permutations[{a, b, c, d, e, x}]); // AbsoluteTiming // First
(* 1.674195 *)
(resB = fB /@ Permutations[{a, b, c, d, e, x}]); // AbsoluteTiming // First
(* 7.132036 *)
(resW = fW /@ Permutations[{a, b, c, d, e, x}]); // AbsoluteTiming // First
(* 1.101775 *)
Equal @@ {res1, res2, res3, resB, resW}
(* True *)


Random permutations of length 9 and 10:

rp = PermutationList[RandomPermutation[9], 9];
(res1 = f1@rp); // AbsoluteTiming // First
(* 2.332165 *)
(res2 = f2@rp); // AbsoluteTiming // First
(* 2.111594 *)
(res3 = f3@rp); // AbsoluteTiming // First
(* 2.024557 *)
(resB = fB@rp); // AbsoluteTiming // First
(* 7.328174 *)
(resW = fW@rp); // AbsoluteTiming // First
(* 2.007417 *)
Equal @@ {res1, res2, res3, resB, resW}
(*True*)

rp = PermutationList[RandomPermutation[10], 10];
(res1 = f1@rp); // AbsoluteTiming // First
(* 24.681737 *)
(res2 = f2@rp); // AbsoluteTiming // First
(* 22.776874 *)
(res3 = f3@rp); // AbsoluteTiming // First
(* 20.031120 *)
(resB = fB@rp); // AbsoluteTiming // First
(* 78.861839 *)
(resW = fW@rp); // AbsoluteTiming // First
(* 21.637332 *)
Equal @@ {res1, res2, res3, resB, resW}
(*True*)

• Oops, I forgot to clarify that input is an arbitrary list of symbols. Thus, I can't hard-code the minus sign. e.g If input={a,b,c} then the sign in front of f[{a,b,c}] should be +1 (I have edited the question to clarify this). Oct 27, 2014 at 13:03
• @QuantumDot, could you please check if the updated post works as you expect?
– kglr
Oct 27, 2014 at 13:47
• Yes this works very nicely! Many thanks for your help. Oct 27, 2014 at 14:05
• I slightly modified your code formatting in the interest of readability. I hope you approve. Oct 27, 2014 at 15:57
mapping[set_] := Dispatch@Thread[set -> Range@Length@set]
input = {a, b, c};
Total[Map[Signature[# /. mapping[input]] function[#] &, Permutations[input]]]

(* function[{a, b, c}] - function[{a, c, b}] - function[{b, a, c}] +
function[{b, c, a}] + function[{c, a, b}] - function[{c, b, a}]*)