Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Hope there is a solution besides the tedious generation of nested loops. (Trying to avoid reinventing the wheel.)

Here is an example with $N = 3$ objects. There are $13$ needed orderings (first {} means first place, second {} means second place, ...):

1. {a}, {b}, {c}
2. {a}, {c}, {b}
3. {a}, {b, c}
4. {b}, {a}, {c}
5. {b}, {c}, {a}
6. {b}, {a, c}
7. {c}, {a}, {b}
8. {c}, {b}, {a}
9. {c}, {a, b}
10. {a, b}, {c}
11. {a, c}, {b}
12. {b, c}, {a}
13. {a, b, c}

How can I get all such orderings for a given $N$?

UPD: I also wonder how to get same orderings in binary relations notation, i.e., considering orderings as sets of ordered pairs (also neglecting here such pairs as $(a,a)$, $(b,b)$, ... since they don't make further difference). I found out that this notation is much easier way to further operating with rankings in Mathematica. Here are the above $13$ orderings in new notation:

1. {(a,b), (a,c), (b,c)}
2. {(a,c), (a,b), (c,b)}
3. {(a,b), (a,c), (b,c) (c,b)}
4. {(b,a), (b,c), (a,c)}
5. {(b,c), (b,a), (c,a)}
6. {(b,a), (b,c), (a,c), (c,a)}
7. {(c,a), (c,b), (a,b)}
8. {(c,b), (c,a), (b,a)}
9. {(c,a), (c,b), (a,b), (b,a)}
10. {(a,b), (b,a), (a,c), (b,c)}
11. {(a,c), (c,a), (a,b), (c,b)}
12. {(b,c), (c,b), (b,a), (c,a)}
13. {(a,b), (b,a), (a,c), (c,a), (b,c), (c,b)}
share|improve this question
add comment

1 Answer

up vote 13 down vote accepted

You can use ReplaceList with a helper function which has the Orderless attribute:

ClearAll[f]; SetAttributes[f, Orderless];

ReplaceList[f[a, b, c], f[a___, b___, c___] :> {{a}, {b}, {c}}] //
   DeleteCases[#, {}, -1] & // Union // Column

enter image description here

The DeleteCases and Union are required because the output from ReplaceList includes the empty list {} as a distinct entity.

For an arbitrary input list the pattern has to be constructed with the appropriate number of arguments:

orderings[x_] := Module[{f},
  SetAttributes[f, Orderless];
  ReplaceList[f @@ x, With[{s = Table[Unique[], {Length@x}]},
      Pattern[#, ___] & /@ f @@ s :> Evaluate[Thread[{s}]]]] //
    DeleteCases[#, {}, -1] & // Union]

Style[orderings[{1, 2, 3, 4}], Small]

enter image description here

share|improve this answer
    
My PC freezes for N=10 objects. (I know, there are over 10^8 orderings.) Is it possible somehow to manage with them? –  aeiklmkv Nov 20 '13 at 11:15
1  
@aeiklmkv, with N=10 the whole list would require something like 100GB of storage. I'm not sure what you want to do with the orderings, but I think you will need an entirely different approach, e.g. generating them one-by-one or in batches, then discarding. –  Simon Woods Nov 20 '13 at 12:30
    
I have updated the question, wondering other notation. Also, 100GB is not problem, but speed/time is problem (my PC just freezes). Nevertheless, I will try to generate orderings one-by-one in batches. –  aeiklmkv Nov 25 '13 at 9:39
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.