# Listing sequence with rules

How would one go about listing all sequences S length 10 made up of a combination of a's and b's, where there are either at least 5 consecutive a's or 5 consecutive b's. Example sequences are:

aaaaaaaaaa
aaaaabbbba
bbaaaaaaab


etc but not

aaaaabbbbb

• @Kuba it is EITHER a or b, so it is basically a xor b (5 a's and b's therefore not allowed consecutively) Nov 30 '16 at 22:14

dionys answer is the straight-forward way of generating all the lists and pruning down to the ones you want. Here's a method that generates only those ones you want, which means it will work much faster for longer lists. Here is an example for a smaller length list (length 6 with one aaa or one bbb).

First generate all integer partitions of 6 that include one 3:

partitions = Cases[IntegerPartitions[6], {a_ /; a >= 3, ___?(# != 3 &)}]
(* {{6}, {5, 1}, {4, 2}, {4, 1, 1}, {3, 2, 1}, {3, 1, 1, 1}} *)


Now, permute each one of these:

allPartitions = Flatten[Permutations /@ partitions, 1]
(* {{6}, {5, 1}, {1, 5}, {4, 2}, {2, 4}, {4, 1, 1}, {1, 4, 1}, {1, 1, 4},
{3, 2, 1}, {3, 1, 2}, {2, 3, 1}, {2, 1, 3}, {1, 3, 2}, {1, 2, 3},
{3, 1, 1, 1}, {1, 3, 1, 1}, {1, 1, 3, 1}, {1, 1, 1, 3}} *)


Now, this list gives a list of the number of a's and b's, alternating. To make the lists, we do:

halfList = Flatten@Module[{i = 0},
Replace[#, x_ :> ConstantArray[If[EvenQ[i++], "a", "b"], {x}], 1]
] & /@ allPartitions
(* {{a, a, a, a, a, a}, {a, a, a, a, a, b}, {a, b, b, b, b, b},
{a, a, a, a, b, b}, {a, a, b, b, b, b}, {a, a, a, a, b, a},
{a, b, b, b, b, a}, {a, b, a, a, a, a}, {a, a, a, b, b, a},
{a, a, a, b, a, a}, {a, a, b, b, b, a}, {a, a, b, a, a, a},
{a, b, b, b, a, a}, {a, b, b, a, a, a}, {a, a, a, b, a, b},
{a, b, b, b, a, b}, {a, b, a, a, a, b}, {a, b, a, b, b, b}} *)


This is exactly half of the tuples. To get the other half, just switch a and b:

result = Join[halfList, halfList /. {"a" -> "b", "b" -> "a"}];
Multicolumn[result, 3]


Wrapping this all up in a function:

sequences[n_?EvenQ] :=
Join[#, # /. {"a" -> "b", "b" -> "a"}] &@Module[{m = n/2, partitions},
partitions = Cases[IntegerPartitions[n], {x_ /; x >= m, ___?(# != m &)}];
partitions = Flatten[Permutations /@ partitions, 1];
Flatten@Module[{i = 0},
Replace[#, x_ :> ConstantArray[If[EvenQ[i++], "a", "b"], {x}], 1]
] & /@ partitions
]

• I am attempting to clean up some of the code, like the part where it generates the alternating tables of a's and b's. Nov 30 '16 at 22:45
• @ChrisGeorgiou. Please see edit. I missed two of them, I think. I have also wrapped everything into a function. Nov 30 '16 at 23:56
Module[{full, a5, b5, excl},
full = Tuples[{a, b}, 10];
a5 = Cases[full, {___, a, a, a, a, a, ___}];
b5 = Cases[full, {___, b, b, b, b, b, ___}];
excl = Cases[Union[a5, b5], Except[{a, a, a, a, a, b, b, b, b, b}]];
Cases[excl, Except[{b, b, b, b, b, a, a, a, a, a}]]]

(*{{a, a, a, a, a, a, a, a, a, a}, {a, a, a, a, a, a, a, a, a, b},
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, \
{<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}, {<<10>>}}*)

• thanks, but this gives 221 outputs (if im not wrong?) how would it give an odd number of outputs if the ordering is symmetric? Nov 30 '16 at 22:23
• You probably want to exclude bbbbbaaaaa too Nov 30 '16 at 22:24
r = Cases[
Tuples[{"a", "b"},
10], {___,
Sequence @@ Table["a", 5], ___} | {{___,
Sequence @@ Table["b", 5], ___}}];
f = DeleteCases[r,
Table["a", 5]~Join~Table["b", 5] |
Table["b", 5]~Join~Table["a", 5]];
Grid[Partition[StringJoin /@ f, 10]]


Note: march pointed my clearly erroneous initial answer. I hope I have corrected this.

• I was assuming that sequences like "abababbbbb" are allowed. @ChrisGeorgiou, can you clarify? Because if only sequences of the type you've written in your post are allowed, ubdqn's answer is very nice. Nov 30 '16 at 23:01
• @march my stupid blunder! I will delete Nov 30 '16 at 23:02

A slightly different approach:

We can consider a stripe of characters of the length from 5 to 10 and then shift in a band of 10 placeholders, surrounding by all possible tuples of other characters. Also, note that we should surround this stripe by alternative characters and only then consider tuples for the remaining placeholders on the left and on the right (depending on the shift), since we don't want to create a sequence of n+1 characters. Thus we eliminate almost all redundancies.

halfList[l_, nmin_] :=
Flatten[Map[Flatten, ({n} \[Function]
(stripe[ft_, lt_, pos_] :=
Flatten@Join[
If[pos > 2, {ft}, {Nothing}],
If[pos > 1, {"b"}, {Nothing}],
Table["a", n],
If[pos < l - n + 1, {"b"}, {Nothing}],
If[pos < l - n, {lt}, {Nothing}]
];
stripeList[pos_] :=
Outer[stripe[#1, #2, pos] &,
Tuples[{"a", "b"}, Max[0, pos - 2]],
Tuples[{"a", "b"}, Max[0, l - n - pos]], 1];
shiftedList = stripeList /@ Range[1, l - n + 1]
)) /@ Range[nmin, l - 1], {-2}], 3];

Cases[StringJoin @@@ halfList[10, 5], Except["aaaaabbbbb"]]


This only does half of the list, and the Flatten piece is sloppy, but the performance is actually quite decent, on par if not better than march's code. I might improve it later on.