Re: Need a nice way to do the "left count"

*To*: mathgroup at smc.vnet.net*Subject*: [mg40303] Re: Need a nice way to do the "left count"*From*: Dr Bob <majort at cox-internet.com>*Date*: Sun, 30 Mar 2003 20:14:30 -0500 (EST)*References*: <09AA87AE-62CE-11D7-B50C-000393671006@earthlink.net>*Reply-to*: majort at cox-internet.com*Sender*: owner-wri-mathgroup at wolfram.com

I actually think my code is the easiest to understand of them all, but I suppose every programmer thinks that! I had forgotten to time my other code, so here it is: drbob2[s_List] := Block[{count, n = 0}, count[any_] := 0; Rest@FoldList[++n - (++count[#2]) &, Null, s] ] (Note that the second argument of FoldList, in both my solutions, is not used.) I timed Selwyn's new solution, and the four best (for more than 2 values) are now: n = 10000; test = Array[Round[99Random[]] &, n]; Timing[fisher[test];] Timing[selwyn2[test];] Timing[drbob[test];] Timing[drbob2[test];] {2.171999999999997*Second, Null} {0.7180000000000035*Second, Null} {0.10999999999999943*Second, Null} {0.17199999999999704*Second, Null} Bobby On Sun, 30 Mar 2003 11:38:29 -0500, Selwyn Hollis <selwynh at earthlink.net> wrote: > For what it's worth, I get a 4X speed-up by not using PrependTo, and a > minor improvement by using Block instead of Module within Scan: > > countdiffs[s_List] := Module[{members, totals, g, j}, > members = Union[s]; > totals = Count[s, #] & /@ members; > j = Length[s]; > Scan[Block[{i = First@First@Position[members, #]}, > g[j] = j - totals[[i]]; > totals[[i]]--; j--] &, Reverse[s]]; > Table[g[i], {i, Length[s]}]] > > But it's still much slower than drBob's brilliantly incomprehensible code > :^) > > --- > Selwyn > > > On Saturday, March 29, 2003, at 08:13 PM, Dr Bob wrote: > >> Here are timings with a binary-valued list: >> >> n = 10000; >> test = Array[Random[Integer] &, n]; >> Timing[gray[test];] >> Timing[hanlon[test];] >> Timing[andrzej1[test];] >> Timing[fisher[test];] >> Timing[selwyn[test];] >> Timing[drbob[test];] >> Timing[andrzej2[test];] >> >> {36.547*Second, Null} >> {12.406000000000006*Second, Null} >> {19.437000000000012*Second, Null} >> {0.29700000000002547*Second, Null} >> {3.7819999999999823*Second, Null} >> {0.07800000000003138*Second, Null} >> {0.06200000000001182*Second, Null} >> >> Neither 'gray' nor 'andrzej2' can handle more than two values in a list, >> and they give different answers in that case, while the others agree. >> (They all agree on binary lists.) >> >> n = 1000; >> test = Array[Round[3*Random[]] &, n]; >> andrzej1[test] == fisher[test] == selwyn[test] == hanlon[test] == >> drbob[test] >> gray[test] == drbob[test] >> andrzej2[test] == drbob[test] >> gray[test] == andrzej2[test] >> >> True >> False >> False >> False >> >> Here are timings on a list with 21 different values: >> >> n = 10000; >> test = Array[Round[20Random[]] &, n]; >> Union[test] >> Timing[hanlon[test];] >> Timing[andrzej1[test];] >> Timing[fisher[test];] >> Timing[selwyn[test];] >> Timing[drbob[test];] >> >> {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, >> 20} >> {13.078000000000001*Second, Null} >> {15.563000000000002*Second, Null} >> {0.5779999999999959*Second, Null} >> {2.9849999999999994*Second, Null} >> {0.07800000000000296*Second, Null} >> >> and here are timings with 100 different values: >> >> n = 10000; >> test = Array[Round[99Random[]] &, n]; >> Timing[hanlon[test];] >> Timing[andrzej1[test];] >> Timing[fisher[test];] >> Timing[selwyn[test];] >> Timing[drbob[test];] >> >> {12.969000000000001*Second, Null} >> {15.765*Second, Null} >> {2.2039999999999935*Second, Null} >> {3.6400000000000006*Second, Null} >> {0.09399999999999409*Second, Null} >> >> 'fisher' seems badly affected by increasing the number of values. >> >> Bobby >> >> On Sun, 30 Mar 2003 08:00:57 +0900, Andrzej Kozlowski >> <akoz at mimuw.edu.pl> wrote: >> >>> If any one is interested in doing performance tests I suggest using my >>> other function, which I also posted to the Mathgroup. The two functions >>> were meant to demonstrate the difference between elegance (which I >>> identify with shortness of code) and efficiency. Here is the efficient >>> one (the algorithm works only for lists containing just two distinct >>> symbols): >>> >>> f2[l_List] := Module[{mult = >>> Length /@ Split[l], list1, >>> list2, values}, list1 = Rest[FoldList[Plus, 0, Table[mult[[i]], {i, 1, >>> Length[mult], >>> 2}]]]; list2 = >>> FoldList[Plus, >>> 0, Table[mult[[i]], {i, 2, 2( >>> Floor[(Length[mult] + 1)/2]) - 1, 2}]]; >>> values = Take[Flatten[Transpose[{list2, >>> list1}]], Length[mult]]; Flatten[Table[Table[values[[i]], { >>> mult[[i]]}], {i, 1, Length[mult]}]]] >>> >>> >>> >>> On Sunday, March 30, 2003, at 07:12 am, Steve Gray wrote: >>> >>>> Hello all, >>>> I am again gratified for all the prompt, more-than-competent >>>> solutions to my problem. I'm enclosing a .nb file with all replies >>>> received so far so you can compare them. I did not do timing because >>>> the lists I have are relatively short and I don't need to call this >>>> function very often. >>>> Thanks again. >>>> >>>> Steve Gray >>>> >>>> ----- Original Message ----- >>>> From: BobHanlon at aol.com To: mathgroup at smc.vnet.net >>>> To: stevebg at adelphia.net >>>> Sent: Saturday, March 29, 2003 4:53 AM >>>> Subject: [mg40303] Re: [mg40279] Need a nice way to do this >>>> >>>> In a message dated 3/29/03 6:11:39 AM, stevebg at adelphia.net writes: >>>> >>>> Given a list consisting of only two distinct values, such as >>>> s={a,b,b,a,a,a,b,a,b,a,a}, I want to derive a list of equal length >>>> g={0,1,1,2,2,2,4,3,5,4,4}. The rule is: for each position >>>> 1<=p<=Length[s], look at list s and set g[[p]] to the number of >>>> elements in s to the left of p which are not equal to s[[p]]. >>>> In a more general version, which I do not need now, s would >>>> not be restricted to only two distinct values. >>>> >>>> Thank you for any ideas, including other applications where >>>> this particular calculation is used. The current application is an >>>> unusual conjecture in geometry. >>>> >>>> >>>> <Left-Count.nb> >>> Andrzej Kozlowski >>> Yokohama, Japan >>> http://www.mimuw.edu.pl/~akoz/ >>> http://platon.c.u-tokyo.ac.jp/andrzej/ >>> >>> >> >> >> >> -- majort at cox-internet.com >> Bobby R. Treat<Left-Count.nb> > >