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>