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/