[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
Prev by Date:
**Re: Re: Double integral of a piecewise-constant function**
Next by Date:
**Apply and up/down value questions**
Previous by thread:
**tracking precision through ndsolve, findfit, regress, etc**
Next by thread:
**Re: aggregation of related elements in a list**
| |