How to enumerate all possible binary associations?

Question

Suppose I have a list of symbols like:

{a,b,c,d}

I would like to enumerate all possible binary associations (combining symbols and/or sublists pairwise):

{{{a,b},c},d}
{{a,b},{c,d}}
{a,{b,{c,d}}}
{{a,{b,c}},d}
{a,{{b,c},d}}

There should be altogether 5 solutions for this example. My question is how can I enumerate all such associations for a generic list?

I have tried

ReplaceList[{a,b,c,d},{u___,v_,w_,x___}:>{u,{v,w},x}]

But this only works for the first layer.

Kindly explain what you mean by a binary association. (I'm trying to reconcile your question with what I've found online at http://en.wikipedia.org/wiki/Class_diagram) Does Silvia's output satisfy your idea of binary association? — DavidC, Nov 27 '13 at 13:11

score 18 · Accepted Answer · answered Nov 27 '13 at 13:58

18

I propose a more compact approach

f[list__] := Join @@ ReplaceList[{list}, {x__, y__} :> Tuples@{f[x], f[y]}]
f[x_] := {x};

f[a, b, c, d] // Column

{a,{b,{c,d}}}
{a,{{b,c},d}}
{{a,b},{c,d}}
{{a,{b,c}},d}
{{{a,b},c},d}

One can note that the length of this list is the Catalan number

$$ C_n = \frac{1}{1+n}{2n\choose n} $$

Length[f @@ ConstantArray[a, 6]]
CatalanNumber[6 - 1]
WolframAlpha["answer to life the universe and everything"]

42
42
42

answered Nov 27 '13 at 13:58

ybeltukov

43,673
5
108
212

+1 Much-much-much faster than mine! – István Zachar Nov 27 '13 at 14:20
I am wondering if someone can device a non-rule based solution... – tchronis Nov 27 '13 at 14:50
1

+1 Very nice! I was looking along similar lines but trying to use Thread on the RHS of the rule. Tuples is inspired. – Simon Woods Nov 27 '13 at 14:54
@ybeltukov Great solution. Thank you very much! – Everett You Nov 27 '13 at 20:35
2

WolframAlpha["Don't panic"] – Dr. belisarius Nov 27 '13 at 21:01

score 9 · Answer 2 · answered Nov 27 '13 at 12:34

9

I think one way is to do your ReplaceList repeatedly, until the result doesn't change any more.

FixedPoint[
 DeleteDuplicates[Flatten[
    Function[lst,
      If[# === {}, {lst}, #] &[
       ReplaceList[lst,
        {u___, v_, w_, x___} /;
          Nand[{u} === {}, {x} === {}] :>
         {u, {v, w}, x}]
       ]
      ] /@ #,
    1]] &,
 {Range[5]}
 ];

TreeForm /@ %

binary association tree plots

answered Nov 27 '13 at 12:34

Silvia

27,556
3
84
164

1

Hey Silvia! Long time no see :) – Yves Klett Nov 27 '13 at 12:38
@YvesKlett Hi! Had a tough year without computers and just got my MMA home edition not long ago :) – Silvia Nov 27 '13 at 12:42
Welcome baaaack - hope you are doing fine! – Yves Klett Nov 27 '13 at 12:42
@YvesKlett Thanks a lot :) You make me feel back to home~ Everything is great now. And I even got myself a Raspberry Pi :D – Silvia Nov 27 '13 at 12:46
1

@Silvia Welcome back! Raspberry: http://www.youtube.com/watch?v=6dmhF1rqaZk – Dr. belisarius Nov 27 '13 at 13:42
@belisarius LOL Every time I watch this video, I can't stop laughing :D Thanks belisarius! – Silvia Nov 27 '13 at 13:51
@Silvia Could you take a look at my comment under the question here http://mathematica.stackexchange.com/q/37698/193 and see if you can understand what is going on, please? (my google-Chinese isn't good enough to understand if someone is abusing our drive to help) – Dr. belisarius Nov 28 '13 at 01:29

István Zachar · Answer 3 · 2013-11-27T14:18:28.790

8

How about a recursive approach?

ClearAll[a, b, c, d, func];
set = {a, b, c, d};

counter = 0;
rules = {};
func[{x_}] := x;
func[list_] := Module[{r}, DeleteDuplicates@Flatten[func /@ 
    ReplaceList[list, {a___, x_, y_, b___} :> {a, {x, y} /. 
    rules /. {x, y} :> (r = RandomReal[]; PrependTo[rules, {x, y} -> r]; r), b}],
   1]];

temp = func@set;
Fold[ReplaceAll, temp, Reverse /@ rules]

  {
   {{{a, b}, c}, d},
   {{a, b}, {c, d}},
   {{a, {b, c}}, d},
   {a, {{b, c}, d}},
   {a, {b, {c, d}}}
   }

Update Made it faster. Random reals are generated to denote parental nodes. There is an infinitesimal chance that a set of random reals might interfere with generated node-identifiers.

edited Nov 27 '13 at 14:18

answered Nov 27 '13 at 12:35

István Zachar

47,032
20
143
291

@Silvia Had to extend it to remove some redundancy. Please check. It is pretty slow for sets longer than 8 elements... Yours is definitely faster. – István Zachar Nov 27 '13 at 13:16
Sorry I used set = Range[5] for test, which caused the never stopping //.. You got my +1 :) – Silvia Nov 27 '13 at 13:23

score 4 · Answer 4 · edited Jun 16 '20 at 09:23

4

In Mathematica 11, we don't have to write a solution ourselves.

M11 has Groupings

Groupings[{a1,...,an},k]

gives all possible groupings of a1,...,an taken k at a time.

So

Groupings[{a, b, c, d}, 2] gives

{{{{a, b}, c}, d}, {a, {{b, c}, d}}, {{a, {b, c}}, 
  d}, {a, {b, {c, d}}}, {{a, b}, {c, d}}}

easy life with M11 :)

edited Jun 16 '20 at 09:23

Community

1

answered Aug 28 '16 at 10:01

matheorem

17,132
8
45
115

score 1 · Answer 5 · answered Nov 28 '13 at 00:15

I can't possibly compete with the beautiful solution provided by ybeltukov, but I had already started thinking about it, so here's what I came up with.

The first thing was to define a function to check whether a proposed partitioning has the correct properties:

twoQ[ll_List] := Length@ll == 2 && twoQ[ll[[1]]] && twoQ[ll[[2]]]
twoQ[ll_] := True;

Then, to find the partitioning:

t[{x_}] := {x}
t[ll_] := Flatten[Table[{l1, l2}, {j, 1, Length[ll] - 1},
     {l1, t@ll[[1 ;; j]]}, {l2, t@ll[[j + 1 ;; -1]]}], 2];

so that

t[{a,b,c,d}]
(* 
    {{a, {b, {c, d}}},
     {a, {{b, c}, d}},
     {{a, b}, {c, d}}, 
     {{a, {b, c}}, d}, 
     {{{a, b}, c}, d}} *)

 twoQ /@ %
 (* {True, True, True, True, True} *)

How to enumerate all possible binary associations?

5 Answers5

Linked