prograMing: EquivalenceIndex
- To: mathgroup@smc.vnet.net
- Subject: [mg11121] prograMing: EquivalenceIndex
- From: "Xah" <xah@best.com>
- Date: Mon, 23 Feb 1998 21:40:42 -0500
- Organization: Venus & Xah Love Factory
Another fun programing problem. In this problem, I'd be very interested if someone can come up with a solution that is either purely functional, or faster. Problem: Write the function EquivalenceIndex. It's usage message is given below. EquivalenceIndex::usage= "EquivalenceIndex[listA,sameTestQ] returns a partition of indexes, e.g. \ {{1,4,7},{2},{3,10},{5,8},{6,9}}, of listA. Index of elements that are \ considered equivalent under sameTestQ are grouped together. sameTestQ must \ accept two arguments and return either True or False. It defaults to SameQ. \ ListA can have head other than List. To guarantee that \ sameTestQ[listA[[e]],listA[[f]]]==False for any e,f in distinct index \ grouping, sameTestQ must be orderless and transitive: (1) \ sameTestQ[a,b]==sameTestQ[b,a], (2) if sameTestQ[a,b], sameTestQ[b,c], then \ sameTestQ[a,c]. Usage Exapmle: \ EquivalenceIndex[Permutations[Range@3],Function[#1===Reverse@#2]]"; Here are two solutions. -- (*First solution*) EquivalenceIndex[li_,sameTestQ_:SameQ]:=Module[{remains,resultA,tempHead}, remains=Range@Length@li; resultA=tempHead[]; While[Length@remains=!=0, resultA={resultA, tempHead[First@remains, Union@((If[sameTestQ[Part[li,First@remains],Part[li,#]],#, Null]&)/@(Rest@remains))]}; remains=Complement[remains,Flatten@(Last@resultA/.tempHead->List)]]; DeleteCases[{resultA/.List->Sequence}/.tempHead->List,{}|Null,{0, Infinity}]]; (*essentially the same algorithm but coded in a more readible style*) EquivalenceIndex2[li_,sameTestQ_:SameQ]:= Module[{remains,remains2,result1,result2}, remains=Range@Length@li; result1={}; While[Length@remains=!=0, result2={First@remains}; remains2={}; {((If[sameTestQ[Part[li,First@remains],Part[li,#]],AppendTo[result2,#], AppendTo[remains2,#]]&)/@(remains/.{_,rest___}->{rest}))}; AppendTo[result1,result2]; remains=remains2; ]; result1]; -- Here are some tests. Clear[li]; Do[li=Table[Random[Integer,{1,5}],{10},{3}]; If[SameQ@@((#[li]&)/@{EquivalenceIndex,EquivalenceIndex2, EquivalenceIndex3})//Not,Print["fucked: ",li]],{100}] Here are some speed tests: In[121]:= li=Table[Random[Integer,{1,6}],{200},{3}]; First@Timing@EquivalenceIndex@li First@Timing@EquivalenceIndex2@li Out[121]= 2.8 Second Out[122]= 6.03333 Second Again, I'd be very interested to see a solution that is either purely functional, or faster. Xah xah@best.com http://www.best.com/~xah/SpecialPlaneCurves_dir/specialPlaneCurves.html "morality abets evil"