6
$\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$
1
  • $\begingroup$ I think it is very similar to this $\endgroup$
    – Kuba
    Jun 29, 2013 at 20:44

2 Answers 2

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$
2
  • $\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, 2013 at 14:09
  • $\begingroup$ @MichaelE2 I agree, I just had to add this as I can't stand those Sequence@@ :) $\endgroup$
    – Kuba
    Nov 5, 2013 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$
3
  • $\begingroup$ There's probably no chance to push n==9 to higher n? $\endgroup$ Nov 5, 2013 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, 2013 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$ Nov 5, 2013 at 13:48

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.