Skip to main content
replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/
Source Link

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

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

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

deleted 627 characters in body
Source Link
march
  • 24.2k
  • 2
  • 46
  • 102
partitions = Cases[IntegerPartitions[6], {a_ /; a >= 3, _____?(# != 3 &)}]
(* {{6}, {5, 1}, {4, 2}, {4, 1, 1}, {3, 2, 1}, {3, 1, 1, 1}} *)
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}} *)
halfList = Flatten@Module[{i = 0}, 
  Replace[#, x_ :> If[Mod[i++ConstantArray[If[EvenQ[i++], 2] == 0"a", Table[a"b"], {x}], Table[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}} *)
result = Join[halfList, halfList /. {a"a" -> b"b", b"b" -> 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"},];
    {a, b, a, a, a, a}, {a, a, a, b, bMulticolumn[result, a},3]
    {a, a, a, b, a, a}, {a, a, b, b, b, a}, {a, a, b, a,

enter image description here


Wrapping this all up in a function:

sequences[n_?EvenQ] a,:= a},
    {a, b, b, bJoin[#, a,# a},/. {a,"a" b,-> b"b", a,"b" a,-> a"a"},] &@Module[{a, a, a,m b,= an/2, bpartitions},
    {a, b, b, b,partitions a,= b}Cases[IntegerPartitions[n], {a, b, a, a,x_ a,/; b},x {a,>= bm, a,___?(# b,!= b,m b&)}, ];
    {b, b, b, b, b, a}, {b, a, a, a, a, a}, {b,partitions b,= b,Flatten[Permutations b,/@ apartitions, a},1];
    {b, b, a, a, a, a}, {b, b, b, b, a, b}, Flatten@Module[{b, a, a, a,i a,= b0},
    {b, a, b, b, b, b}, {b, b, b, a, a, b}, 
    {bReplace[#, b,x_ b,:> aConstantArray[If[EvenQ[i++], b"a", b}"b"], {b, b, a, a, a, bx}, {b, b, a, b, b], b},1]
    {b, a, a, a, b, b}, {b, a, a, b, b, b}, {b, b, b,] a,& b,/@ a},partitions
    {b, a, a, a, b, a}, {b, a, b, b, b, a}, {b, a, b, a, a, a}} *)]
partitions = Cases[IntegerPartitions[6], {a_ /; a >= 3, __?(# != 3 &)}]
(* {{5, 1}, {4, 2}, {4, 1, 1}, {3, 2, 1}, {3, 1, 1, 1}} *)
allPartitions = Flatten[Permutations /@ partitions, 1]
(* {{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}} *)
halfList = Flatten@Module[{i = 0}, 
  Replace[#, x_ :> If[Mod[i++, 2] == 0, Table[a, {x}], Table[b, {x}]], 1]
 ] & /@ allPartitions
(* {{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}} *)
Join[halfList, halfList /. {a -> b, b -> 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}, 
    {b, b, b, b, b, a}, {b, a, a, a, a, a}, {b, b, b, b, a, a},
    {b, b, a, a, a, a}, {b, b, b, b, a, b}, {b, a, a, a, a, b},
    {b, a, b, b, b, b}, {b, b, b, a, a, b}, 
    {b, b, b, a, b, b}, {b, b, a, a, a, b}, {b, b, a, b, b, b},
    {b, a, a, a, b, b}, {b, a, a, b, b, b}, {b, b, b, a, b, a},
    {b, a, a, a, b, a}, {b, a, b, b, b, a}, {b, a, b, a, a, a}} *)
partitions = Cases[IntegerPartitions[6], {a_ /; a >= 3, ___?(# != 3 &)}]
(* {{6}, {5, 1}, {4, 2}, {4, 1, 1}, {3, 2, 1}, {3, 1, 1, 1}} *)
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}} *)
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}} *)
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
   ]
deleted 4 characters in body
Source Link
march
  • 24.2k
  • 2
  • 46
  • 102
halfList = Flatten@Module[{i = 0}, 
  Replace[#, a_x_ :> If[Mod[i++, 2] == 0, Table["a"Table[a, {ax}], Table["b"Table[b, {ax}]], 1]
 ] & /@ allPartitions
(* {{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}} *)
halfList = Flatten@Module[{i = 0}, 
  Replace[#, a_ :> If[Mod[i++, 2] == 0, Table["a", {a}], Table["b", {a}]], 1]
 ] & /@ allPartitions
(* {{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}} *)
halfList = Flatten@Module[{i = 0}, 
  Replace[#, x_ :> If[Mod[i++, 2] == 0, Table[a, {x}], Table[b, {x}]], 1]
 ] & /@ allPartitions
(* {{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}} *)
deleted 64 characters in body
Source Link
march
  • 24.2k
  • 2
  • 46
  • 102
Loading
Source Link
march
  • 24.2k
  • 2
  • 46
  • 102
Loading