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

*To*: mathgroup at smc.vnet.net*Subject*: [mg40311] Re: [mg40303] Re: Need a nice way to do the "left count"*From*: Dr Bob <majort at cox-internet.com>*Date*: Mon, 31 Mar 2003 04:01:12 -0500 (EST)*References*: <C3A16B6A-6334-11D7-B455-00039311C1CC@mimuw.edu.pl>*Reply-to*: majort at cox-internet.com*Sender*: owner-wri-mathgroup at wolfram.com

Andrzej is quite right, Map is more natural here. He forgot to remove 'Rest', however. It should be: drbob3[s_List] := Block[{count, n = 0}, count[any_] := 0; Map[++n - (++count[#]) &, s]] or drbob4[s_List] := Block[{count}, count[any_] := 0; Range@Length@s - Map[++count[#] &, s]] Much to my surprise, drbob and drbob4 have almost identical timings for 100 values in a list: n = 100000; test = Array[Round[99Random[]] &, n]; Timing[drbob[test];] Timing[drbob2[test];] Timing[drbob3[test];] Timing[drbob4[test];] {1.093999999999994*Second, Null} {1.718999999999994*Second, Null} {1.7659999999999911*Second, Null} {1.0930000000000177*Second, Null} But drbob4 beats drbob (slightly) for 21 values: n = 100000; test = Array[Round[20Random[]] &, n]; Timing[drbob[test];] Timing[drbob2[test];] Timing[drbob3[test];] Timing[drbob4[test];] {0.7970000000000255*Second, Null} {1.4530000000000314*Second, Null} {1.3900000000000432*Second, Null} {0.7810000000000059*Second, Null} and for binary lists: n = 100000; test = Array[Random[Integer] &, n]; Timing[drbob[test];] Timing[drbob2[test];] Timing[drbob3[test];] Timing[drbob4[test];] Timing[andrzej2[test];] {0.8440000000000225*Second, Null} {1.421999999999997*Second, Null} {1.421999999999997*Second, Null} {0.7649999999999864*Second, Null} {0.5310000000000059*Second, Null} Bobby On Mon, 31 Mar 2003 13:53:50 +0900, Andrzej Kozlowski <akoz at mimuw.edu.pl> wrote: > I agree that Bob's algorithm is the simplest and most natural of all > except that his use of FoldList seems to me to be intended to mystify > and confuse ;-) > > In fact > > drbob3[s_List] := Block[{count, n = 0}, > count[any_] := 0; > Rest@Map[++n - (++count[#]) &, s] > ] > > does the same thing as drbob2 and is, at least on my machine, slightly > faster. > > As for the algorithm, it is essentially exactly what you would do if you > had to solve this problem by hand. You simply count how many times an > element in the n-th place has occurred and subtract it from n. The only > weakness of this algorithm is that when you get a repetition like > {b,a,a...} we know that the number of non a's before the second a is the > same as the number of non a's before the first a, so there is no need to > count but the algorithm wastes a tiny amount of time on recounting this > number again. > > My algorithm for two distinct values avoids this problem. It exploits the > fact that to solve the problem for just two distinct values you only need > to know: > > In[23]:= > Length/@Split[{a,b,b,a,a,a,b,a,b,a,a}] > > Out[23]= > {1,2,3,1,1,1,2} > > The numbers you see give you the number of repeats of the same value you > are going to see in the final list. You can also (here is the point where > the difference between two value case and the general case becomes > significant) work out what these values are going to be. The number you > are going to get in the k-th position, where k is even will be the sum of > the numbers in all the odd positions preceding k, and the value you get > in the k-t place when k is odd the sum of all the values in the even > positions preceding k. > Since my code depends on this fact it obviously can't be expected to work > with more than 2 values. > > Andrzej Kozlowski > Yokohama, Japan > http://www.mimuw.edu.pl/~akoz/ > http://platon.c.u-tokyo.ac.jp/andrzej/ > > > On Monday, March 31, 2003, at 10:14 am, Dr Bob wrote: > >> 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: mathgroup at smc.vnet.net >>>>>> To: stevebg at adelphia.net >>>>>> Sent: Saturday, March 29, 2003 4:53 AM >>>>>> Subject: [mg40311] [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> >>> >>> >> >> >> > > -- majort at cox-internet.com Bobby R. Treat

**Re: Need a nice way to do this**

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

**Help-directional fields**