Re: Need a nice way to do the "left count"
- To: mathgroup at smc.vnet.net
- Subject: [mg40302] Re: Need a nice way to do the "left count"
- From: Selwyn Hollis <selwynh at earthlink.net>
- Date: Sun, 30 Mar 2003 20:14:26 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
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: [mg40302] 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>