Re: Computing sets of equivalences
- To: mathgroup at smc.vnet.net
- Subject: [mg46535] Re: [mg46437] Computing sets of equivalences
- From: Andrzej Kozlowski <akoz at mimuw.edu.pl>
- Date: Sun, 22 Feb 2004 11:27:34 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
On 18 Feb 2004, at 06:37, Mariusz Jankowski wrote:
> Dear Mathgroup, I think this falls into the "classic algorithms"
> category,
> so I hope some of you will find this interesting. I checked archives
> and
> mathsource but did not find anything useful.
>
> I have a list of lists, each sublist implying an equivalence. I am
> trying to
> split the list into lists of equivalences (this is part of a connected
> components algorithm). For example, given
>
> {{1,2},{1,5},{2,3},{3,4},{5,6},{7,8},{11,12},{12,13},{10,14}}
>
> I want
>
> {{1,2,3,4,5,6},{7,8},{10,14},{11,12,13}}.
>
> Here is my currently "best" attempt. I accumulate the equivalences by
> comparing pairs of list, merging them if they have common elements. At
> the
> end of each iteration I remove all merged pairs from original list and
> repeat.
>
> iselectEquivalences[v_]:=Module[{x,y,tmp,pos},
> x=v;y={};
> While[x=!={},
> tmp=x[[1]];
> pos={{1}};
> Do[
> If[Intersection[tmp,x[[i]]]==={}, tmp, tmp=Union[tmp,x[[i]]];
> pos=Join[pos, {{i}}]], {i, 2, Length[x]}];
> x=Delete[x, pos];
> y=Join[y, {tmp}] ];
> y]
>
>
> Can you tell me if you have or know of a realization of this classic
> operation that works better/faster? Are there alternative paradigms for
> solving this kind of problem.
>
>
> Thanks, Mariusz
>
>
>
As this time I could have a go at my own solution before seeing all the
others and as it seemed pretty hopeless to compete with Carl and
Hartmut on speed, I decided to attempt to a method that would be
entirely different form all the other contributions, just for fun of
course. I call this approach "algebraic programming". It is a somewhat
vague concept, which I try to describe in my forthcoming Mathematica
Journal article, but in one sense it refers to solving such problems
buy finding a built-in Mathematica symbolic algebra function (or
functions) that uses the algorithm we are trying to implement, setting
up suitable input for it to work on, and then using pattern matching to
convert the output into what we need. The method often leads to
unexpected and elegant solutions but it's chief drawback is that it is
usually quite slow (actually this applies to what I call "naive
algebraic programming", of which this will be an example).
We start with Mariusz's data:
ls = {{1,
2}, {1, 5}, {2, 3}, {3, 4}, {5, 6}, {7, 8}, {11, 12}, {12, 13}, {
10, 14}} ;
Since we are going to use algebra it is inconvenient to have to deal
with numerical quantities. We shall therefore map HoldForm on all the
elements of the lists, which will enable us to treat them as symbolic
variables.
vars=HoldForm/@(Union@@ls);
Next, we convert our input data into a list of equalities between these
symbolic variables. Since HoldForm is invisible we get curious looking
output:
equals=Apply[Equal,Map[HoldForm,ls,{2}],{1}]
{1==2,1==5,2==3,3==4,5==6,
7==8,11==12,12==13,10==14}
Now we apply Reduce (in Mathematica 5.0 in earlier versions
Experimental`CylindricalAlgebraicDecomposition would also work):
sol = List @@ Reduce[equals, vars]
{2 == 1, 3 == 1, 4 == 1, 5 == 1, 6 == 1, 8 == 7,
12 == 11, 13 == 11, 14 == 10}
This actually contains all the information we need. The trick is now to
convert it into the required form.
Map[Union,Map[Flatten[#,1,Equal]&,Split[sol,#1[[2]]===#2[[2]]&]]]
{{1,2,3,4,5,6},{7,8},{11,12,13},{10,14}}
The "numbers" in the output still have HoldForm wrapped round them so
if we needed actual numbers we should also ReleaseHold to the output.
Andrzej Kozlowski
Chiba, Japan
http://www.mimuw.edu.pl/~akoz/