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.

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

share|improve this question
    
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}}] –  Rorschach Sep 7 '13 at 19:51

4 Answers 4

up vote 3 down vote accepted

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.

share|improve this answer

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"}}

share|improve this answer

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}}
share|improve this answer
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"}}}

share|improve this answer

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.