Recent

Author Topic: Sorting and Counting  (Read 36369 times)

avk

  • Hero Member
  • *****
  • Posts: 752
Re: Sorting and Counting
« Reply #105 on: August 01, 2019, 10:12:46 am »
And 32-bit results:
Code: Text  [Select][+][-]
  1.  
  2. RandomRange = 1
  3. Julkas1's time: 3.9780  #unique: 100000 #total: 10000000
  4. Julkas2's time: 3.9630  #unique: 100000 #total: 10000000
  5.   Akira's time: 3.4780  #unique: 100000 #total: 10000000
  6.  Howard's time: 5.1170  #unique: 100000 #total: 10000000
  7.    Avk1's time: 3.1360  #unique: 100000 #total: 10000000
  8.    Avk2's time: 0.4990  #unique: 100000 #total: 10000000
  9.   440bx's time: 2.2930  #unique: 100000 #total: 10000000
  10.  BrunoK's time: 2.2310  #unique: 100000 #total: 10000000
  11.  
  12. RandomRange = 2
  13. Julkas1's time: 3.9460  #unique: 200000 #total: 10000000
  14. Julkas2's time: 3.9630  #unique: 200000 #total: 10000000
  15.   Akira's time: 3.7440  #unique: 200000 #total: 10000000
  16.  Howard's time: 5.1630  #unique: 200000 #total: 10000000
  17.    Avk1's time: 3.3860  #unique: 200000 #total: 10000000
  18.    Avk2's time: 0.5140  #unique: 200000 #total: 10000000
  19.   440bx's time: 2.4340  #unique: 200000 #total: 10000000
  20.  BrunoK's time: 2.2930  #unique: 200000 #total: 10000000
  21.  
  22. RandomRange = 3
  23. Julkas1's time: 3.9780  #unique: 300000 #total: 10000000
  24. Julkas2's time: 3.9780  #unique: 300000 #total: 10000000
  25.   Akira's time: 3.9000  #unique: 300000 #total: 10000000
  26.  Howard's time: 5.2260  #unique: 300000 #total: 10000000
  27.    Avk1's time: 3.5560  #unique: 300000 #total: 10000000
  28.    Avk2's time: 0.5460  #unique: 300000 #total: 10000000
  29.   440bx's time: 2.5430  #unique: 300000 #total: 10000000
  30.  BrunoK's time: 2.3710  #unique: 300000 #total: 10000000
  31.  
  32. RandomRange = 4
  33. Julkas1's time: 4.0090  #unique: 400000 #total: 10000000
  34. Julkas2's time: 4.0250  #unique: 400000 #total: 10000000
  35.   Akira's time: 4.1030  #unique: 400000 #total: 10000000
  36.  Howard's time: 5.3190  #unique: 400000 #total: 10000000
  37.    Avk1's time: 3.6040  #unique: 400000 #total: 10000000
  38.    Avk2's time: 0.5770  #unique: 400000 #total: 10000000
  39.   440bx's time: 2.6050  #unique: 400000 #total: 10000000
  40.  BrunoK's time: 2.4490  #unique: 400000 #total: 10000000
  41.  
  42. RandomRange = 5
  43. Julkas1's time: 4.0560  #unique: 500000 #total: 10000000
  44. Julkas2's time: 4.0410  #unique: 500000 #total: 10000000
  45.   Akira's time: 4.3050  #unique: 500000 #total: 10000000
  46.  Howard's time: 5.4130  #unique: 500000 #total: 10000000
  47.    Avk1's time: 3.6820  #unique: 500000 #total: 10000000
  48.    Avk2's time: 0.6240  #unique: 500000 #total: 10000000
  49.   440bx's time: 2.6520  #unique: 500000 #total: 10000000
  50.  BrunoK's time: 2.4960  #unique: 500000 #total: 10000000
  51.  
  52. RandomRange = 6
  53. Julkas1's time: 4.0870  #unique: 600000 #total: 10000000
  54. Julkas2's time: 4.0560  #unique: 600000 #total: 10000000
  55.   Akira's time: 4.3680  #unique: 600000 #total: 10000000
  56.  Howard's time: 5.4910  #unique: 600000 #total: 10000000
  57.    Avk1's time: 3.7910  #unique: 600000 #total: 10000000
  58.    Avk2's time: 0.6710  #unique: 600000 #total: 10000000
  59.   440bx's time: 2.7300  #unique: 600000 #total: 10000000
  60.  BrunoK's time: 2.5290  #unique: 600000 #total: 10000000
  61.  
  62. RandomRange = 7
  63. Julkas1's time: 4.1340  #unique: 700000 #total: 10000000
  64. Julkas2's time: 4.1030  #unique: 700000 #total: 10000000
  65.   Akira's time: 4.4930  #unique: 700000 #total: 10000000
  66.  Howard's time: 5.5850  #unique: 700000 #total: 10000000
  67.    Avk1's time: 3.8840  #unique: 700000 #total: 10000000
  68.    Avk2's time: 0.7020  #unique: 700000 #total: 10000000
  69.   440bx's time: 2.7770  #unique: 700000 #total: 10000000
  70.  BrunoK's time: 2.5740  #unique: 700000 #total: 10000000
  71.  
  72. RandomRange = 8
  73. Julkas1's time: 4.1340  #unique: 799992 #total: 10000000
  74. Julkas2's time: 4.1500  #unique: 799992 #total: 10000000
  75.   Akira's time: 4.6020  #unique: 799992 #total: 10000000
  76.  Howard's time: 5.6630  #unique: 799992 #total: 10000000
  77.    Avk1's time: 3.9160  #unique: 799992 #total: 10000000
  78.    Avk2's time: 0.7640  #unique: 799992 #total: 10000000
  79.   440bx's time: 2.8240  #unique: 799992 #total: 10000000
  80.  BrunoK's time: 2.6200  #unique: 799992 #total: 10000000
  81.  
  82. RandomRange = 9
  83. Julkas1's time: 4.2430  #unique: 899989 #total: 10000000
  84. Julkas2's time: 4.1970  #unique: 899989 #total: 10000000
  85.   Akira's time: 4.6950  #unique: 899989 #total: 10000000
  86.  Howard's time: 5.6940  #unique: 899989 #total: 10000000
  87.    Avk1's time: 3.9940  #unique: 899989 #total: 10000000
  88.    Avk2's time: 0.7960  #unique: 899989 #total: 10000000
  89.   440bx's time: 2.8860  #unique: 899989 #total: 10000000
  90.  BrunoK's time: 2.6360  #unique: 899989 #total: 10000000
  91.  
  92. RandomRange = 10
  93. Julkas1's time: 4.1970  #unique: 999951 #total: 10000000
  94. Julkas2's time: 4.1960  #unique: 999951 #total: 10000000
  95.   Akira's time: 4.7740  #unique: 999951 #total: 10000000
  96.  Howard's time: 5.7720  #unique: 999951 #total: 10000000
  97.    Avk1's time: 4.0560  #unique: 999951 #total: 10000000
  98.    Avk2's time: 0.8420  #unique: 999951 #total: 10000000
  99.   440bx's time: 2.9490  #unique: 999951 #total: 10000000
  100.  BrunoK's time: 2.6980  #unique: 999951 #total: 10000000
  101.  
  102. repeatMillionsCount = 2
  103. Julkas1's time: 1.0140  #unique: 734214 #total: 2000000
  104. Julkas2's time: 0.9990  #unique: 734214 #total: 2000000
  105.   Akira's time: 1.4660  #unique: 734214 #total: 2000000
  106.  Howard's time: 1.3260  #unique: 734214 #total: 2000000
  107.    Avk1's time: 1.1230  #unique: 734214 #total: 2000000
  108.    Avk2's time: 0.3590  #unique: 734214 #total: 2000000
  109.   440bx's time: 0.6860  #unique: 734214 #total: 2000000
  110.  BrunoK's time: 0.6870  #unique: 734214 #total: 2000000
  111.  
  112. repeatMillionsCount = 4
  113. Julkas1's time: 1.8100  #unique: 794501 #total: 4000000
  114. Julkas2's time: 1.7940  #unique: 794501 #total: 4000000
  115.   Akira's time: 2.3240  #unique: 794501 #total: 4000000
  116.  Howard's time: 2.4180  #unique: 794501 #total: 4000000
  117.    Avk1's time: 1.8410  #unique: 794501 #total: 4000000
  118.    Avk2's time: 0.4680  #unique: 794501 #total: 4000000
  119.   440bx's time: 1.2630  #unique: 794501 #total: 4000000
  120.  BrunoK's time: 1.1550  #unique: 794501 #total: 4000000
  121.  
  122. repeatMillionsCount = 6
  123. Julkas1's time: 2.5900  #unique: 799570 #total: 6000000
  124. Julkas2's time: 2.5580  #unique: 799570 #total: 6000000
  125.   Akira's time: 3.0890  #unique: 799570 #total: 6000000
  126.  Howard's time: 3.4940  #unique: 799570 #total: 6000000
  127.    Avk1's time: 2.5270  #unique: 799570 #total: 6000000
  128.    Avk2's time: 0.5620  #unique: 799570 #total: 6000000
  129.   440bx's time: 1.8100  #unique: 799570 #total: 6000000
  130.  BrunoK's time: 1.6380  #unique: 799570 #total: 6000000
  131.  
  132. repeatMillionsCount = 8
  133. Julkas1's time: 3.3860  #unique: 799965 #total: 8000000
  134. Julkas2's time: 3.3540  #unique: 799965 #total: 8000000
  135.   Akira's time: 3.8530  #unique: 799965 #total: 8000000
  136.  Howard's time: 4.6170  #unique: 799965 #total: 8000000
  137.    Avk1's time: 3.2450  #unique: 799965 #total: 8000000
  138.    Avk2's time: 0.6870  #unique: 799965 #total: 8000000
  139.   440bx's time: 2.3080  #unique: 799965 #total: 8000000
  140.  BrunoK's time: 2.1380  #unique: 799965 #total: 8000000
  141.  
  142. repeatMillionsCount = 10
  143. Julkas1's time: 4.1340  #unique: 799998 #total: 10000000
  144. Julkas2's time: 4.1650  #unique: 799998 #total: 10000000
  145.   Akira's time: 4.6020  #unique: 799998 #total: 10000000
  146.  Howard's time: 5.6630  #unique: 799998 #total: 10000000
  147.    Avk1's time: 3.9150  #unique: 799998 #total: 10000000
  148.    Avk2's time: 0.7650  #unique: 799998 #total: 10000000
  149.   440bx's time: 2.8390  #unique: 799998 #total: 10000000
  150.  BrunoK's time: 2.6050  #unique: 799998 #total: 10000000
  151.  
  152. repeatMillionsCount = 12
  153. Julkas1's time: 4.9290  #unique: 800000 #total: 12000000
  154. Julkas2's time: 4.8990  #unique: 800000 #total: 12000000
  155.   Akira's time: 5.3660  #unique: 800000 #total: 12000000
  156.  Howard's time: 6.7240  #unique: 800000 #total: 12000000
  157.    Avk1's time: 4.8860  #unique: 800000 #total: 12000000
  158.    Avk2's time: 0.9230  #unique: 800000 #total: 12000000
  159.   440bx's time: 3.5090  #unique: 800000 #total: 12000000
  160.  BrunoK's time: 3.1780  #unique: 800000 #total: 12000000
  161.  
  162. repeatMillionsCount = 14
  163. Julkas1's time: 6.0210  #unique: 800000 #total: 14000000
  164. Julkas2's time: 5.7530  #unique: 800000 #total: 14000000
  165.   Akira's time: 6.1250  #unique: 800000 #total: 14000000
  166.  Howard's time: 7.8410  #unique: 800000 #total: 14000000
  167.    Avk1's time: 5.3080  #unique: 800000 #total: 14000000
  168.    Avk2's time: 0.9670  #unique: 800000 #total: 14000000
  169.   440bx's time: 3.8690  #unique: 800000 #total: 14000000
  170.  BrunoK's time: 3.5880  #unique: 800000 #total: 14000000
  171.  
  172. repeatMillionsCount = 16
  173. Julkas1's time: 6.4900  #unique: 800000 #total: 16000000
  174. Julkas2's time: 6.4720  #unique: 800000 #total: 16000000
  175.   Akira's time: 6.9760  #unique: 800000 #total: 16000000
  176.  Howard's time: 8.9740  #unique: 800000 #total: 16000000
  177.    Avk1's time: 6.0190  #unique: 800000 #total: 16000000
  178.    Avk2's time: 1.0460  #unique: 800000 #total: 16000000
  179.   440bx's time: 4.3830  #unique: 800000 #total: 16000000
  180.  BrunoK's time: 4.0730  #unique: 800000 #total: 16000000
  181.  
  182. repeatMillionsCount = 18
  183. Julkas1's time: 8.0010  #unique: 800000 #total: 18000000
  184. Julkas2's time: 7.7100  #unique: 800000 #total: 18000000
  185.   Akira's time: 8.4710  #unique: 800000 #total: 18000000
  186.  Howard's time: 10.9400 #unique: 800000 #total: 18000000
  187.    Avk1's time: 7.3030  #unique: 800000 #total: 18000000
  188.    Avk2's time: 1.1800  #unique: 800000 #total: 18000000
  189.   440bx's time: 4.9460  #unique: 800000 #total: 18000000
  190.  BrunoK's time: 4.7270  #unique: 800000 #total: 18000000
  191.  
  192. repeatMillionsCount = 20
  193. Julkas1's time: 8.2490  #unique: 800000 #total: 20000000
  194. Julkas2's time: 8.3960  #unique: 800000 #total: 20000000
  195.   Akira's time: 8.8410  #unique: 800000 #total: 20000000
  196.  Howard's time: 11.6740 #unique: 800000 #total: 20000000
  197.    Avk1's time: 7.5300  #unique: 800000 #total: 20000000
  198.    Avk2's time: 1.2660  #unique: 800000 #total: 20000000
  199.   440bx's time: 5.5000  #unique: 800000 #total: 20000000
  200.  BrunoK's time: 5.1120  #unique: 800000 #total: 20000000
  201.  

440bx

  • Hero Member
  • *****
  • Posts: 3944
Re: Sorting and Counting
« Reply #106 on: August 01, 2019, 10:28:27 am »
And this can not be fixed?
It sure can and, Bruno and yourself are using the "fix" I'd have to use, which is, doing string to integer conversion without readln do it for you (which is slow).

I have mixed feelings about using that optimization for this problem.  To keep the code simple and easy to understand, I'd use ntdll's atoi function but, there is no way for calls to atoi to beat an inline implementation that does not even check for overflows.

Both of your algorithms can be made even faster by not using writeln.  I suppose there must be an object (I'm guessing, a TMemoryStream), that would allow writing an entire block of memory (properly formatted beforehand) in one shot instead of a gazillion writeln(s).

IMO, your avk2 algorithm has the best balance between being clean, easy to understand and fast.  That's what a good program is.  To me, that's the winner.



(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

hnb

  • Sr. Member
  • ****
  • Posts: 270
Re: Sorting and Counting
« Reply #107 on: August 01, 2019, 10:34:33 am »
small update : my assumption and new propositions for rtl-generics was wrong. After tests I can say one : the Akira proposition for rtl-generics is better than my ideas, not much difference but Akira wins. The positive aspect: thanks to this topic I have ideas to update library (not directly related to sorting and counting), but in general with positive influence on performance and new functionalities.
Checkout NewPascal initiative and donate beer - ready to use tuned FPC compiler + Lazarus for mORMot project

best regards,
Maciej Izak

avk

  • Hero Member
  • *****
  • Posts: 752
Re: Sorting and Counting
« Reply #108 on: August 01, 2019, 12:19:07 pm »
...Both of your algorithms can be made even faster by not using writeln.  I suppose there must be an object (I'm guessing, a TMemoryStream), that would allow writing an entire block of memory (properly formatted beforehand) in one shot instead of a gazillion writeln(s)...
IMO what is already there is already too much, all this things move the code farther and farther from correctness, simplicity and portability. But curious.

...
Code: [Select]
  Result := 1 - integer( a=b ) - 2*integer( a<b );
...
But why not
Code: Pascal  [Select][+][-]
  1.   Result := Integer(a > b) - Integer(a < b);
  2.  
?

440bx

  • Hero Member
  • *****
  • Posts: 3944
Re: Sorting and Counting
« Reply #109 on: August 01, 2019, 12:29:48 pm »
IMO what is already there is already too much, all this things move the code farther and farther from correctness, simplicity and portability. But curious.
I completely agree with that.  I admit to being curious too and, there are a number of optimizations that come to mind but, it really feels they are completely out of place for what should be (and can be) a very simple program.
(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

avk

  • Hero Member
  • *****
  • Posts: 752
Re: Sorting and Counting
« Reply #110 on: August 01, 2019, 01:36:53 pm »
I almost forgot,
@hnb, I don’t know if you are aware of such a problem:
Code: Pascal  [Select][+][-]
  1. function GenTestArray: specialize TArray<Integer>;
  2. const
  3.   TestSize = 200000;
  4. var
  5.   I, J: Integer;
  6. begin
  7.   SetLength(Result, TestSize);
  8.   for I := 0 to Pred(TestSize div 2) do
  9.     Result[I] := I;
  10.   J := 0;
  11.   for I := TestSize div 2 to High(Result) do
  12.     begin
  13.       Result[I] := J;
  14.       Inc(J);
  15.     end;
  16. end;
  17.  
try sorting this array using TArrayHelper.

MathMan

  • Sr. Member
  • ****
  • Posts: 325
Re: Sorting and Counting
« Reply #111 on: August 01, 2019, 02:28:20 pm »
...
...
Code: Pascal  [Select][+][-]
  1.   Result := 1 - integer( a=b ) - 2*integer( a<b );
  2.  
...
But why not
Code: Pascal  [Select][+][-]
  1.   Result := Integer(a > b) - Integer(a < b);
  2.  
?

Mainly because I didn't thought of it ;-)

wp

  • Hero Member
  • *****
  • Posts: 11853
Re: Sorting and Counting
« Reply #112 on: August 01, 2019, 02:52:11 pm »
Code: [Select]
  Result := 1 - integer( a=b ) - 2*integer( a<b );
Why not add logarithms to increase the effect of obfuscation.  ;D

In earnest: If only the sign of the result of the compare function is evaluated by the sort, wouldn't it be sufficient to just subtract the values?
Code: Pascal  [Select][+][-]
  1. function ComparePairs(constref L, R: TIntPair): LongInt;
  2. begin
  3.   Result := L.Key - R.Key;
  4. end;
  5.  


440bx

  • Hero Member
  • *****
  • Posts: 3944
Re: Sorting and Counting
« Reply #113 on: August 01, 2019, 03:27:23 pm »
@wp

In earnest: If only the sign of the result of the compare function is evaluated by the sort, wouldn't it be sufficient to just subtract the values?
Code: Pascal  [Select][+][-]
  1. function ComparePairs(constref L, R: TIntPair): LongInt;
  2. begin
  3.   Result := L.Key - R.Key;
  4. end;
  5.  
You've just shown a bit of code that, once seen, seems totally obvious and makes one wonder why that isn't the way everyone does it.

Makes me wonder if there is a reason, other than simply not thinking about it, why it isn't normally done that way.  I cannot think of one.
« Last Edit: August 01, 2019, 03:29:19 pm by 440bx »
(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

howardpc

  • Hero Member
  • *****
  • Posts: 4144
Re: Sorting and Counting
« Reply #114 on: August 01, 2019, 04:03:14 pm »
Makes me wonder if there is a reason, other than simply not thinking about it, why it isn't normally done that way.  I cannot think of one.
I think it is normally done that way.
I've seen that very code (or something almost identical) both in this forum (I believe it was in code from Marco) and in the FPC sources.

MathMan

  • Sr. Member
  • ****
  • Posts: 325
Re: Sorting and Counting
« Reply #115 on: August 01, 2019, 04:13:24 pm »
You've just shown a bit of code that, once seen, seems totally obvious and makes one wonder why that isn't the way everyone does it.

Makes me wonder if there is a reason, other than simply not thinking about it, why it isn't normally done that way.  I cannot think of one.

Hm - in this case, what about range check errors? The comparison is save, but the subtraction is not, or is it?

But yes, if only the sign is required then simple subtraction should be sufficient. However the compare & cast hands back a ternary state, as did the initial comparison function.

440bx

  • Hero Member
  • *****
  • Posts: 3944
Re: Sorting and Counting
« Reply #116 on: August 01, 2019, 04:15:08 pm »
I think it is normally done that way.
I've seen that very code (or something almost identical) both in this forum (I believe it was in code from Marco) and in the FPC sources.
I've read a lot of code in various languages and, I think it's the first time I see it done that way, because I'd remember it.  Now that I've seen it, I'm not about to forget it.
(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

avk

  • Hero Member
  • *****
  • Posts: 752
Re: Sorting and Counting
« Reply #117 on: August 01, 2019, 04:18:20 pm »
For this particular benchmark, this will work.
But what happens if, for example, L.Key = 1500000000 and R.Key = -1500000005?
« Last Edit: August 04, 2019, 06:51:58 am by avk »

440bx

  • Hero Member
  • *****
  • Posts: 3944
Re: Sorting and Counting
« Reply #118 on: August 01, 2019, 05:06:20 pm »
@MathMan

But yes, if only the sign is required then simple subtraction should be sufficient.
For a sort compare function only the sign should matter (provided the sort function doesn't compare against hard coded values, -1, 0, 1, which it definitely shouldn't.)

@avk

But what happens if, for example, L.Key = 1500000000 and R.Key = -1500000005?
Yes, you are right.  Those values would cause an overflow which would incorrectly indicate that L is less than R.

Both you, and MathMan are correct, doing comparisons avoids that problem.


Thank you both, for pointing out that problem (which now seems obvious too.)
« Last Edit: August 01, 2019, 05:10:41 pm by 440bx »
(FPC v3.0.4 and Lazarus 1.8.2) or (FPC v3.2.2 and Lazarus v3.2) on Windows 7 SP1 64bit.

BrunoK

  • Sr. Member
  • ****
  • Posts: 452
  • Retired programmer
Re: Sorting and Counting
« Reply #119 on: August 01, 2019, 05:31:50 pm »
My last word supporting Signed SizeInt values.

Code: Pascal  [Select][+][-]
  1.  
  2.   { TSortCountList }
  3. type
  4.   TSortCountList = class(TFPList)
  5.   public
  6.     procedure QuickSort;
  7.   end;
  8.  
  9. procedure SortCountBrunoK1;  { Note : requires Classes }
  10. const
  11.   cCR = $0D;
  12.   cETX = $03;
  13.   c0 = Ord('0');
  14.   function LoadStreamToList(aMemStream: TMemoryStream; aList: TFPList): integer;
  15.   var
  16.     { Parse lines }
  17.     lPByte, lPEndByte: PByte;
  18.  
  19.     { Values extraction }
  20.     lValueStarted: boolean = False;
  21.     lSizeInt: SizeInt = 0;
  22.     lMulSign: integer = 1;
  23.     lCntRec: integer;
  24.   begin
  25.     { Prepare aList }
  26.     lCntRec := aMemStream.Size;
  27.     if lCntRec <= 0 then // Stream empty ?
  28.       exit(0);
  29.     aList.Count := lCntRec div 10; // Setup approximative size
  30.     aList.Count := 0;
  31.  
  32.     lPByte := PByte(aMemStream.memory);
  33.     lPEndByte := lPByte + aMemStream.Size;
  34.     (lPEndByte -1)^ := cETX;
  35.     while lPByte <= lPEndByte do begin
  36.       if (lPByte^ <= cCR) then begin
  37.         if lValueStarted then begin
  38.           aList.Add(Pointer(lMulSign * lSizeInt));
  39.           lSizeInt := 0;
  40.           lMulSign := 1;
  41.           lValueStarted := False;
  42.         end;
  43.       end
  44.       else begin
  45.         if lPByte^ in [Ord('+'),Ord('-')] then begin
  46.           if lPByte^ = Ord('-') then
  47.             lMulSign := lMulSign * -1;
  48.         end
  49.         else begin
  50.           lValueStarted := True;
  51.           lSizeInt := lSizeInt * 10 + (lPByte^ - c0);
  52.         end;
  53.       end;
  54.       Inc(lPByte);
  55.     end;
  56.     Result := aList.Count;
  57.   end;
  58. var
  59.   lFile: TextFile;
  60.   lMemStream: TMemoryStream;
  61.   lNbRecs: integer = 0;
  62.   lSortCountList: TSortCountList;
  63.   lIx: integer;
  64.   lLastValue: pointer;
  65.   lListCount: integer;
  66.   lLastValueCount: integer;
  67.   lWriteTextLn : shortstring;
  68. begin
  69.   routineName := 'SortCountBrunoK1'; // {$I %currentroutine%};
  70.   lMemStream := TMemoryStream.Create;
  71.   lMemStream.LoadFromFile(inFileName);
  72.   lSortCountList := TSortCountList.Create;
  73.   lNbRecs := LoadStreamToList(lMemStream, lSortCountList);
  74.   lMemStream.Free; // Not needed anymore
  75.   if lNbRecs > 0 then begin
  76.     AssignFile(lFile, outFilename);
  77.     Rewrite(lFile);
  78.     lSortCountList.QuickSort;
  79.     lIx := 0;
  80.     lLastValue := lSortCountList[lIx];
  81.     lLastValueCount := 1;
  82.     lListCount := lSortCountList.Count;
  83.     lSortCountList.Add(nil);
  84.     repeat
  85.       Inc(lIx);
  86.       if (lSortCountList[lIx] <> lLastValue) then begin
  87.         Inc(unique);
  88.         WriteLn(lFile, UINTPTR(lLastValue), ' - ', lLastValueCount);
  89.         if (lIx >= lListCount) then
  90.           Break;
  91.         lLastValue := lSortCountList[lIx];
  92.         lLastValueCount := 1;
  93.       end
  94.       else
  95.         Inc(lLastValueCount);
  96.     until False;
  97.     CloseFile(lFile);
  98.     Total := lIx;
  99.   end;
  100.   lSortCountList.Free;
  101. end;
  102.  
  103. { TSortCountList }
  104.  
  105. type
  106.   PSizeIntList = ^TSizeIntList;
  107.   TSizeIntList = array[0..MaxListSize - 1] of SizeInt;
  108.  
  109. procedure TSortCountList.QuickSort;
  110. var
  111.   _list: PSizeIntList;
  112.   procedure _QSort(L, R: integer);
  113.   var
  114.     I, J: integer;
  115.     P, Q: SizeInt;
  116.   begin
  117.     repeat
  118.       I := L;
  119.       J := R;
  120.       P := SizeInt(_list^[(L + R) div 2]);
  121.       repeat
  122.         while SizeInt(_list^[i]) < P do
  123.           I := I + 1;
  124.         while P < SizeInt(_list^[J]) do
  125.           J := J - 1;
  126.         if I <= J then begin
  127.           Q := _list^[I];
  128.           _list^[I] := _list^[J];
  129.           _list^[J] := Q;
  130.           I := I + 1;
  131.           J := J - 1;
  132.         end;
  133.       until I > J;
  134.       // sort the smaller range recursively
  135.       // sort the bigger range via the loop
  136.       // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
  137.       if J - L < R - I then begin
  138.         if L < J then
  139.           _QSort(L, J);
  140.         L := I;
  141.       end
  142.       else begin
  143.         if I < R then
  144.           _QSort(I, R);
  145.         R := J;
  146.       end;
  147.     until L >= R;
  148.   end;
  149. begin
  150.   if not Assigned(List) or (Count < 2) then exit;
  151.   _List := PSizeIntList(List);
  152.   _QSort(0, Count - 1);
  153. end;
  154.  

 

TinyPortal © 2005-2018