Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

aggregation of related elements in a list

• To: mathgroup at smc.vnet.net
• Subject: [mg61542] aggregation of related elements in a list
• From: leigh pascoe <leigh at cephb.fr>
• Date: Sat, 22 Oct 2005 00:35:27 -0400 (EDT)
• Sender: owner-wri-mathgroup at wolfram.com

Dear Mathgroup,

I would like to construct a function to transform a list of integers 
into a list of lists of related members. Suppose we have the finite list

{x1,x2,x3,..........xN}

and a test function ( relatedQ[x_,y_,n_] ) that decides whether two 
elements are related. The actual test may vary, but returns True or 
False for any two elements as a function of n (n is an independent 
variable not the number of elements in the list}.

I would like to process this list to aggregate those members that are 
related either directly to each other or to a common element. For 
example if x1 is unrelated to any other element in the list, x2 is 
related to x5 but not x7 and x5 is related to x7 etc. would produce the 
list of lists

{{x1},{x2,x5,x7),.......}

To take a specific example, assume we have the list

list={1,2,6,7,8,9,11,16}

and that application of the relatedQ, test to all possible pairs yields 
the list of related pairs

prlist={{1,2},{1,6},{2,6},{2,7},{6,7},{6,11},{7,8},{7,11},{11,16}}

Using the list and the list of related pairs we can deduce the desired 
list of lists as

{{1,2,6,7,8,11,16},{9}}

If 6 were not in the original list we would get instead

{{1,2},{7,8,11,16},{9}}

I have tried to develop a Mathematica function or procedure to produce 
this list, but am having trouble achieving it. Can anyone help?

The algorithm I have been trying to implement is:
- form a list of all related pairs and singletons in the original list 
by comparing all pairs to prlist
- then compare the first element in the resulting list with each of the 
others in that list and form the Union of all those where (Intersection 
!={})
- delete all pairs retained for the Union.
- repeat the process for the next element in the list and so on.

The following ugly code seems to work on some lists, but with others 
gives me an error message, presumably an objection to a dynamic 
redefinition of the list inside a Do statement.

In[87]:=
chains[n_]:=Block[{lst,tmp,tmp2,lst2},
    lst={1,2,6,7,8,9,11,16};
    tmp=Flatten[
        Part[Reap[
            Do[{If[Intersection[{{Part[lst,i],Part[lst,j]}},
                      Edges[gr1[n]]]\[NotEqual]{},
                  
Sow[{Part[lst,i],Part[lst,j]}]],Sow},{i,1,Length[lst]-1},{j,
                i+1,Length[lst]}]],2],1];
    tmp2=Part[
        Reap[Do[If[Intersection[{lst[[i]]},Flatten[tmp]]\[Equal]{},
              Sow[lst[[i]]]],{i,1,Length[lst]}]],2];
    lst2=Union[tmp,tmp2];
    Do
      [
      {
        If
          [
          Intersection[lst2[[i]],lst2[[j]]]\[NotEqual]{},
          {lst2[[i]]=Union[lst2[[i]],lst2[[j]]],lst2=Delete[lst2,j]}
          ]
        },
      {i,1,Length[lst2]-1},
      {j,i+1,Length[lst2]}
      ];
    lst2
    ]
chains[4]
I have been doing much Intersecting, Unions, Deletions, nested loops and 
Sowing, but have so far been unable to Reap the result that I want! 
There should be a simple recursive function that will do what I want, 
but I can't find it.

Thanks for any help

LP

• Follow-Ups:
  • Re: aggregation of related elements in a list
    • From: Daniel Lichtblau <danl@wolfram.com>