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

Question

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?

Answer 1

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

Answer 2

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

Answer 3

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