       # 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*)
remains=Range@Length@li;
While[Length@remains=!=0,
resultA={resultA,
Union@((If[sameTestQ[Part[li,First@remains],Part[li,#]],#,
Null]&)/@(Rest@remains))]};

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:=
li=Table[Random[Integer,{1,6}],{200},{3}];
First@Timing@EquivalenceIndex@li
First@Timing@EquivalenceIndex2@li

Out=
2.8 Second

Out=
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"

```

• Prev by Date: RE: Conic Sections and Quadric Surfaces
• Next by Date: Visual Basic
• Prev by thread: Re: Iterative Type Programming
• Next by thread: Visual Basic