5
$\begingroup$

I have n variables and a function that has all of them as variables. n-3 of them in terms of the entries of two lists. The possible entries in the lists $\alpha$ and $\beta$ range from {2,...n-2}. Now I want to sum over all possible permutations of these n-3 elements (aka $P_{n-3})$, i.e.

$$f=\sum_{\alpha,\beta \in P_{n-3}}A[1,\alpha,n-1,n]S[\beta,\alpha]A[n,\beta,n-1,1]$$

with A and S some other functions. How do I program this into mathematica.

I thought about writing f as a pure function. But then how to implement this sum over permutations?

Thanks for any advice!

$\endgroup$
  • $\begingroup$ I think it is very similar to this $\endgroup$ – Kuba Jun 29 '13 at 20:44
3
$\begingroup$

I'm going to show solution similar to one I have shown here.

n=5;
A[1, Sequence@@#1,n-1,n] S[Sequence@@#2, Sequence@@#1] B[1,Sequence@@#2, n-1,n] & @@@ (
Tuples[#, 2] &@Permutations[Range[2, n - 2]]) // Total

A[1, 2, 3, 4, 5] B[1, 2, 3, 4, 5] S[2, 3, 2, 3] + A[1, 3, 2, 4, 5] B[1, 2, 3, 4, 5] S[2, 3, 3, 2] + A[1, 2, 3, 4, 5] B[1, 3, 2, 4, 5] S[3, 2, 2, 3] + A[1, 3, 2, 4, 5] B[1, 3, 2, 4, 5] S[3, 2, 3, 2]


In this case a straightforward solution looks clearer:

Sum[
    A[1, Sequence@@a, n-1, n] S[Sequence@@b, Sequence@@a] B[1, Sequence@@b, n-1, n]
    , {a, #}, {b, #}] &@ Permutations[Range[2, n - 2]];

and is faster.


Edit

another variation to makes things clearer:

(A[1, #1, n - 1, n] S[#2, #1] B[1, #2, n - 1, n]
) & @@@ Apply[Hold@Sequence, Tuples[Permutations[Range[2, n - 2]], 2], {2}] 
// ReleaseHold // Total

which is the same as:

Composition[
  Total,
  ReleaseHold,
  Apply[A[1, #1, n - 1, n] S[#2, #1] B[1, #2, n - 1, n] &, #, {1}] &,
  Apply[Hold@Sequence, #, {2}] &,
  #~Tuples~{2} &,
  Permutations,
  2~Range~(# - 2) &
][n]
$\endgroup$
  • $\begingroup$ The Composition does make it attractively clear (but it's quite a bit slower than your Sum method, which itself is a fairly clear and straightforward translation of the task). $\endgroup$ – Michael E2 Nov 5 '13 at 14:09
  • $\begingroup$ @MichaelE2 I agree, I just had to add this as I can't stand those Sequence@@ :) $\endgroup$ – Kuba Nov 5 '13 at 14:15
2
$\begingroup$

Here's a way, assuming $S[\beta,\alpha]$ means that the function has two arguments, each of which is a List.

ClearAll[a, s];
SetAttributes[a, Listable];
f[n_] := Module[{perm, alpha, beta},
  perm = Permutations[Range[2, n - 2]];
  alpha = Transpose @ ArrayPad[perm, {0, {1, 2}}, PadRight[{n - 1, n, 1}, n]];
  beta  = Transpose @ ArrayPad[perm, {0, {1, 2}}, PadRight[{n - 1, 1, n}, n]];
  Outer[s, perm, perm, 1] . a @@ alpha . a @@ beta
  ]

f[5] // Expand
 (* a[1, 2, 3, 4, 5] a[5, 2, 3, 4, 1] s[{2, 3}, {2, 3}] + 
    a[1, 3, 2, 4, 5] a[5, 2, 3, 4, 1] s[{2, 3}, {3, 2}] + 
    a[1, 2, 3, 4, 5] a[5, 3, 2, 4, 1] s[{3, 2}, {2, 3}] + 
    a[1, 3, 2, 4, 5] a[5, 3, 2, 4, 1] s[{3, 2}, {3, 2}]  *)

If you would rather have s[2, 3, 3, 2] instead of s[{2, 3}, {3, 2}], then you can use this:

ClearAll[a, s];
SetAttributes[a, Listable];
f[n_] := Module[{perm, alpha, beta},
  perm = Permutations[Range[2, n - 2]];
  alpha = Transpose @ ArrayPad[perm, {0, {1, 2}}, PadRight[{n - 1, n, 1}, n]];
  beta  = Transpose @ ArrayPad[perm, {0, {1, 2}}, PadRight[{n - 1, 1, n}, n]];
  Apply[s, Flatten[Outer[List, perm, perm, 1], {{1}, {2}, {3, 4}}], {2}] .
    a @@ alpha . a @@ beta
  ]

f[5] // Expand
 (* a[1, 2, 3, 4, 5] a[5, 2, 3, 4, 1] s[2, 3, 2, 3] + 
    a[1, 3, 2, 4, 5] a[5, 2, 3, 4, 1] s[2, 3, 3, 2] + 
    a[1, 2, 3, 4, 5] a[5, 3, 2, 4, 1] s[3, 2, 2, 3] + 
    a[1, 3, 2, 4, 5] a[5, 3, 2, 4, 1] s[3, 2, 3, 2] *)

Remark: If more was known about the functions $A$ and $S$, then perhaps more could be said about an efficient way to compute the sum. As it is, once you get above n == 9, the computation takes a lot of memory and time.

$\endgroup$
  • $\begingroup$ There's probably no chance to push n==9 to higher n? $\endgroup$ – A friendly helper Nov 5 '13 at 8:32
  • $\begingroup$ For f[10], the pairs of permutations, Flatten[Outer[List, perm, perm, 1], {{1}, {2}, {3, 4}}], take 2+GB to store and 5+GB to calculate, about 60 times more than f[9]. They are stored in packed arrays using about 8 bytes per integer. Applying the functions $A$ and $S$ takes 6-7 times more memory. If $A$ and $S$ were numeric functions, one could save a lot of space (probably at the expense of time) using Sum, Do, and/or Compile by accumulating the numerical results as they are generated instead of storing them separately. $\endgroup$ – Michael E2 Nov 5 '13 at 13:13
  • $\begingroup$ Thanks...unfortunately I can't use numerics for what I want to do...let's just hope that n=9 is enough :) $\endgroup$ – A friendly helper Nov 5 '13 at 13:48

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.