Re: Re: how can I do this functionally?
- To: mathgroup at christensen.cybernetics.net
- Subject: [mg1045] Re: [mg966] Re: how can I do this functionally?
- From: Allan Hayes <hay at haystack.demon.co.uk>
- Date: Wed, 10 May 1995 08:15:36 -0400
Roman Maeder <maeder at inf.ethz.ch> in [mg966] Re: how can I do this
functionally? Gave an efficiency analysis of some solutions of David
Cabana's <drc at gate.net> problem given in mg[913].
I give some faster coded and some general rules that the changes
made seem to suggest.
(*1*) Try various styles.
(*2*) Consider using Thread instead of Transpose for threading (also
look at MapThread).
In Dave Wagner's code
Classify2[s_, f_] :=
With[{fs = f /@ s},
Cases[Transpose[{s, fs}], {x_,#}->x]& /@ Union[fs]
]
Transpose is used once for every member of Union[fs]. The
following code avoids this and is faster on the given tests (timings
are given later). Of course the problem of repeated use of Cases
remains.
Classify2A[s_, f_] :=
Module[{fs,gr,c},
fs = f/@s;
gr = Thread[{s,fs}]; (*2*)
c[y_] := Cases[gr, {x_,y}:> x];
c/@Union[fs]
]
I have got so used to looking fror integrated funcional and list
processing code that this came as something of a surprise.
(*3*) Operate on whole structures.
Roman Maeder's final code is
Classify[s_, f_] :=
Module[{ran, dom, pairs, steps},
{ran, dom} = Transpose[Sort[ {f[#], #}& /@ s ]];
pairs = Partition[ran, 2, 1];
steps = Flatten[Position[pairs, {e1_, e2_}/; e1 =!= e2, 1]];
Take[dom, #]& /@
Transpose[
{Prepend[steps, 0] + 1, Append[steps,Length[s]]}
]
]
Some modifications using the rules (*2*) and (*3*) give slightly
faster code.
ClassifyA[s_,f_] :=
Module[{ran,dom,pairs,steps},
{ran,dom}= Thread[Sort[Thread[{f/@s, s}]]]; (*2*)
pairs = Partition[ran, 2, 1];
steps = Flatten[Position[Apply[SameQ,pairs,1],False,1]];(*3*)
Take[dom,#]&/@
Thread[{Prepend[steps+1,1],Append[steps,Length[s]]}] (*2*)
];
TIMINGS
Using Roman's test setup
testdata := Range[size];
makeK[k_] := Mod[#, k]&
test[method_] :=
Timing[method[testdata, #]][[1]]& /@ makeK /@nclasses /.
Second -> 1
allMethods = {Classify2,Classify2A, Classify,ClassifyA};
I get (on a NeXT Turbo)
size = 200;
nclasses = Round[{1, size/4, size/2, 3size/4, size}];
test /@ allMethods //
MatrixForm[#, TableHeadings -> {allMethods, nclasses}]&
1 50 100 150 200
Classify2 0.0833333 1.36667 2.7 4.03333 5.3
Classify2A 0.0833333 0.733333 1.31667 1.91667 2.56667
Classify 0.183333 0.216667 0.266667 0.283333 0.333333
ClassifyA 0.166667 0.2 0.166667 0.2 0.266667
And for lists of length 5000
size = 5000;
nclasses = Round[{1,size/1000, size/500,size/100, size/50, size}];
test /@ allMethods[[{3,4}]] //
MatrixForm[#, TableHeadings -> {allMethods[[{3,4}]], nclasses}]&
1 5 10 50 100 5000
Classify 3.58333 4.56667 4.63333 4.38333 4.56667 8.13333
ClassifyA 2.23333 3.13333 3.15 3.01667 3.16667 6.3
Allan Hayes
hay at haystack.demon.co.uk