Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: prograMing: EquivalenceIndex

• To: mathgroup@smc.vnet.net
• Subject: [mg11190] Re: prograMing: EquivalenceIndex
• From: Clemens Frey <Clemens.Frey@uni-bayreuth.de>
• Date: Mon, 2 Mar 1998 23:10:47 -0500
• Organization: uni-bayreuth.de
• References: <6ctbf1$l5a@smc.vnet.net>

Xah wrote:
> 
> 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.
> 

Hi Xah, so this is my answer...

I didnt have enough spare time to recreate on your previous  prograMing
problems, but now I tried to recode your EquivalenceIndex function. 
First I made up the following short and fully functional version:

Remove[theSameAs,EquivalenceIndexCF1];           theSameAs[y_,li_] :=
Position[SameQ[#,z/.z->y]& /@ li,True]//Flatten;   (*1*)
EquivalenceIndexCF1[li_] := theSameAs[#,li]& /@ li //Union;            
(*2*)   

The definition on line 1 programs a function that gives you the indexes
of all the elements of li_ which are equivalent to y_. You may wonder
about
the "z/.z->y" thing, but writing just "y" instead doesnt work (why?).
Line 2 automatically applies the function of line 1 to all the members
of li_.
Equal element of the resulting list are deleted ("//Union"). The main
drawback of this is that elements of li_ which are already  known to
be in a equivalent class are tested again. (They are  a l l  tested !).

So I coded a mixture of functional and loop programming:

Remove[EquivalenceIndexCF2];
EquivalenceIndexCF2[li_, sameTestQ_:SameQ]:= Module[
    {
        idx={}, 
        l = Transpose@{li,Range@Length@li},                            
(*3*)
        elem, theSameAsElemIndexes
    },
    While[
        l != {},
        elem = First@First@l;                                          
(*4*)
        theSameAsElemIndexes = 
            Flatten @ Position[sameTestQ[elem,First@#]& /@ l, True];   
(*5*)
        AppendTo[
            idx,
            Part[l, theSameAsElemIndexes] /. {__,x_Integer}->x         
(*6*)
        ];
        l = Part[l, Complement[Range@Length@l, theSameAsElemIndexes] ];
(*7*)
    ];
    idx
];

Here li_ is eventually cut down. 
First the elements of li_ are supplied with their positions in li_ (see
line 3), e.g. f[x] in position 1 ist getting {f[x],1}.  
Then in each step of the "While"-loop the equivalence class of the first
element
of the first elem/pos-group (in our example: f[x]) is computed: First
you get their elements' positions in the (after previous steps, like in
line 1) 
remaining l-List (line 5), then the indexes of these elements in respect
to
the original li_ are extracted (line 6).  The equivalence class is
subtracted from l (line 7). 

We compare the four versions:
(on a Pentium 150 running OS/2, Mathematica 2.2.1 under Warp-Windows
3.11)

li=Table[Random[Integer,{1,6}],{200},{3}]; timeList = {
 Timing@EquivalenceIndexXah1[li],
 Timing@EquivalenceIndexXah2[li],
 Timing@EquivalenceIndexCF1[li],
 Timing@EquivalenceIndexCF2[li]
};

We get times that show that the CF2-Version is fastest:

First/@timeList
{2. Second, 4.12 Second, 3.72 Second, 1.38 Second}

where the results (after Mathematica-ordering via Union) are equal:

Equal@@Union/@(Part[#,2]& /@ timeList) True


regards
Clemens