4
$\begingroup$

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
Improve this question
$\endgroup$
1
  • $\begingroup$ @Kuba it is EITHER a or b, so it is basically a xor b (5 a's and b's therefore not allowed consecutively) $\endgroup$
    – J.S.K
    Commented Nov 30, 2016 at 22:14

4 Answers 4

Reset to default
7
$\begingroup$

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]

enter image description here

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
   ]
Improve this answer
$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – march
    Commented Nov 30, 2016 at 22:45
  • $\begingroup$ @ChrisGeorgiou. Please see edit. I missed two of them, I think. I have also wrapped everything into a function. $\endgroup$
    – march
    Commented Nov 30, 2016 at 23:56
5
$\begingroup$ 
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>>}}*)
Improve this answer
$\endgroup$
2
  • $\begingroup$ thanks, but this gives 221 outputs (if im not wrong?) how would it give an odd number of outputs if the ordering is symmetric? $\endgroup$
    – J.S.K
    Commented Nov 30, 2016 at 22:23
  • $\begingroup$ You probably want to exclude bbbbbaaaaa too $\endgroup$
    – Simon Woods
    Commented Nov 30, 2016 at 22:24
3
$\begingroup$ 
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]]

enter image description here

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

Improve this answer
$\endgroup$
2
  • $\begingroup$ 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. $\endgroup$
    – march
    Commented Nov 30, 2016 at 23:01
  • $\begingroup$ @march my stupid blunder! I will delete $\endgroup$
    – ubpdqn
    Commented Nov 30, 2016 at 23:02
3
$\begingroup$

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.

Improve this answer
$\endgroup$

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.