8

How do I create a list of tuples with an ordering imposed on them, where each element is from a generating set? Specifically, I'm trying to create a listing of tuples $(x_1, x_2, ..., x_n)$ such that $x_1 > x_2$, $x_2 \leq x_3 \leq \cdots x_n$ where each $x_i$ is in (say) $X = \{a,b,c,d\}$. The elements of $X$ are in lexicographic order.

Code:

rank = 4;
weight = 3;

X = Range[rank]; 
bc = Tuples[X, weight];
Cases[bc, {x1_, x2_, x3_} /; x1 > x2 && x2 <= x3]

Issues 1. rank and weight are independent; they don't need to be =. 2. I'd like to say x1_, .., xrank_, but I'm not sure how to specify x_rank. Also x2 <= x3 <= ... <= xrank. (I'll loop on rank and weight, so these won't be hard-coded values.) 3. At the end, 1, 2, ..., rank should be traded for a, b, ... (whatever letter).

  • Considering that your tuples are of length of your list, you can try something like this,Block[{k = {a, b, c, d} /. {a -> 1, b -> 2, c -> 3, d -> 4}, ca}, {ca = Tuples[k, Length[k]]; Cases[ca, {a_, b_, c_, d_} /; a > b && b < c < d] /. {1 -> a, 2 -> b, 3 -> c, 4 -> d}}] – Pankaj Sejwal Sep 07 '13 at 19:51

4 Answers4

5

If I understand the question generating all Tuples and then filtering is wasteful, and will "blow up" for long sets. Since you want all but one element in canonical order I believe you should generate those, then prefix as needed to complete the sequence.

Here is a mundane loop-based way to build the tuples; I couldn't think of anything that ran faster.

tuples[rank_Integer, k_Integer] :=
  Block[{i},
    i[0] = 1;
    Flatten[
      Table @@ Join[{First /@ #}, #] &@Array[{i[#], i[# - 1], rank} &, k - 1],
      k - 2
    ]
  ] // Join @@ (Table[{i, ##}, {i, # + 1, rank}] & @@@ #) &

Example:

tuples[5, 3]
{{2, 1, 1}, {3, 1, 1}, {4, 1, 1}, {5, 1, 1}, {2, 1, 2}, {3, 1, 2}, {4, 1, 2}, {5, 1, 2},
 {2, 1, 3}, {3, 1, 3}, {4, 1, 3}, {5, 1, 3}, {2, 1, 4}, {3, 1, 4}, {4, 1, 4}, {5, 1, 4},
 {2, 1, 5}, {3, 1, 5}, {4, 1, 5}, {5, 1, 5}, {3, 2, 2}, {4, 2, 2}, {5, 2, 2}, {3, 2, 3},
 {4, 2, 3}, {5, 2, 3}, {3, 2, 4}, {4, 2, 4}, {5, 2, 4}, {3, 2, 5}, {4, 2, 5}, {5, 2, 5},
 {4, 3, 3}, {5, 3, 3}, {4, 3, 4}, {5, 3, 4}, {4, 3, 5}, {5, 3, 5}, {5, 4, 4}, {5, 4, 5}}

You can fill these tuples with arbitrary expressions like this:

x = {"a", "b", "c", "d", "e"};

x[[#]] & /@ tuples[5, 3]
{{"b", "a", "a"}, {"c", "a", "a"}, {"d", "a", "a"}, . . .
   {"e", "c", "e"}, {"e", "d", "d"}, {"e", "d", "e"}}

The function will work on values that would not work with Tuples:

tuples[12, 8] // Length

306306

Using Tuples before filtering would generate 12^8 = 429,981,696 sets.

Mr.Wizard
  • 271,378
  • 34
  • 587
  • 1,371
1

It's a brute force approach:

set = CharacterRange["A", "E"];
n = 4;
tuples = Tuples[set, n];

Select[tuples, Order[#[[1]], #[[2]]] == 1 && And @@ Negative@Differences@Ordering@Rest[#] &]

{"A", "C", "B", "A"}, {"A", "D", "B", "A"}, {"A", "D", "C", "A"}, {"A", "D", "C", "B"}, {"A", "E", "B", "A"}, {"A", "E", "C", "A"}, {"A", "E", "C", "B"}, {"A", "E", "D", "A"}, {"A", "E", "D", "B"}, {"A", "E", "D", "C"}, {"B", "C", "B", "A"}, {"B", "D", "B", "A"}, {"B", "D", "C", "A"}, {"B", "D", "C", "B"}, {"B", "E", "B", "A"}, {"B", "E", "C", "A"}, {"B", "E", "C", "B"}, {"B", "E", "D", "A"}, {"B", "E", "D", "B"}, {"B", "E", "D", "C"}, {"C", "D", "B", "A"}, {"C", "D", "C", "A"}, {"C", "D", "C", "B"}, {"C", "E", "B", "A"}, {"C", "E", "C", "A"}, {"C", "E", "C", "B"}, {"C", "E", "D", "A"}, {"C", "E", "D", "B"}, {"C", "E", "D", "C"}, {"D", "E", "B", "A"}, {"D", "E", "C", "A"}, {"D", "E", "C", "B"}, {"D", "E", "D", "A"}, {"D", "E", "D", "B"}, {"D", "E", "D", "C"}}

C. E.
  • 70,533
  • 6
  • 140
  • 264
1

Use Rest in the condition:

rank = 4;
weight = 3;

X = Range@rank;
subst = Thread[X -> {a, b, c, d}];
bc = Tuples[X, weight]
Cases[bc, x_ /; x[[1]] > x[[2]] && LessEqual @@ Rest@x] /. subst
{{b, a, a}, {b, a, b}, {b, a, c}, {b, a, d}, {c, a, a}, {c, a, b},
 {c, a, c}, {c, a, d}, {c, b, b}, {c, b, c}, {c, b, d}, {d, a, a},
 {d, a, b}, {d, a, c}, {d, a, d}, {d, b, b}, {d, b, c}, {d, b, d},
 {d, c, c}, {d, c, d}}
István Zachar
  • 47,032
  • 20
  • 143
  • 291
1
Block[{k = 
   CharacterRange["A", "D"] /. 
    Thread[CharacterRange["A", "D"] -> 
      Range[Length[CharacterRange["A", "D"]]]], 
  ca}, {ca = Tuples[k, Length[k]]; 
  Cases[ca, {a_, b_, c_, d_} /; a > b && b < c < d] /. 
   Thread[CharacterRange["A", "D"] -> 
      Range[Length[CharacterRange["A", "D"]]] // Reverse]}]

{{{"B", "A", "B", "C"}, {"B", "A", "B", "D"}, {"B", "A", "C", "D"}, {"C", "A", "B", "C"}, {"C", "A", "B", "D"}, {"C", "A", "C", "D"}, {"C", "B", "C", "D"}, {"D", "A", "B", "C"}, {"D", "A", "B", "D"}, {"D", "A", "C", "D"}, {"D", "B", "C", "D"}}}

Pankaj Sejwal
  • 2,063
  • 14
  • 23