Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

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"