Zliczanie 10 milionów linii w kilka sekund. Ja pisze o zmiennych nie w Random(10) tylko w 13 tyś.
{--------------------------------------------------------------------------
A very fast stringlist Quicksorting routine - many many times faster than
Delhpi's built in TStringlist.sort - even in spite of the double casts.
The whole routine sorts 100.000 words in about 1 sec (on a 650MHz machine (sic!)).
It is also much faster than using the TStringlist.Sorted := true property
while filling the stringlist. Set the sorted property to false and sort it using
this routine afterwards.
Copyright Hans J. Klarskov Mortensen 2004 - ([email protected]) Sorting routine
based on M. C. Kerman's book "Programming and Problem Solving
with Delphi", Pearsons Education, 2002.
If anyone can use this unit they're welcome. But I ask you to let
this copyright notice stay and that you don't pretend that you wrote it.
No warranty imaginable accepted. Use at your own risk.
(Language note: My native language is Danish. In this language "ord" means
"word" not ordinal.)
Usage : FastSortStList(YourStringlist);
-------------------------------------------------------------------------}
unit Quicksorting;
interface
uses
ComCtrls, Classes, Windows, Sysutils;
type
{This explains part of the speed! I wish I (really) knew why!
If this declaration is placed in connection with the
procedure the whole procedure is more than ten times slower.
The reason may be that placing it here means that the array is
created when the program loads - if it is declared "locally"
it is not created until the procedure requests it.}
OrdArray = array of string;
procedure FastSortStList(Stlist: TStringlist);
implementation
{------------ Standard hand coded quicksort ------------------------------}
{ The sorting is - as you can see - based on ANSI-values, thus it is case sensitive.
If case insensitivity is needed use ANSIUPPERCASE.
If the string variables indicated are replaced by integer variables it'll
happily sort integers as well, but of course a StrToInt cast is needed.
--------------------------------------------------------------------------}
procedure Swap(var Value1, Value2: string);
var
temp: string; //Integer;
begin
temp := Value1;
Value1 := Value2;
Value2 := temp;
end;
function GetPIndex(lo, hi: Integer): Integer;
var
i : integer;
begin
i := (lo+hi) div 2;
GetPIndex := i;
end;
procedure Quicksort(low, high: Integer; var Ordliste: OrdArray);
var
pivotIndex: Integer;
pivotValue: string;
left, right: Integer;
begin
pivotIndex := GetPIndex(low, high);
pivotValue := Ordliste[pivotIndex];
left := low;
right := high;
repeat
while ((left <= high) and (Ordliste[left] < pivotValue)) do
begin
Inc(left);
end;
while ((right >= low) and (pivotValue < Ordliste[right])) do
begin
Dec(right);
end;
if (left <= right) then
begin
Swap(Ordliste[left], Ordliste[right]);
Inc(left);
Dec(right);
end;
until (left > right);
if (low < right) then
begin
Quicksort(low, right, Ordliste);
end;
if (left < high) then
begin
Quicksort(left, high, Ordliste);
end;
end;
{----------- End of Quicksort routines -----------------------------}
{----------- The Stringlist sorting routine with casts -------------}
procedure FastSortStList(Stlist: TStringlist);
var
SortArray: OrdArray;
i, j: Integer;
begin
//Cast Stringlist to an array
setlength(sortArray, Stlist.count);
for i := 0 to Stlist.count - 1 do
SortArray[i] := Trim(Stlist.strings[i]);
//Now sort
QuickSort(Low(SortArray), High(SortArray), SortArray);
//Recast
for j := low(SortArray) to High(SortArray) do
begin //Sometimes empty entries abound, get rid of them
if StList.strings[j] <> '' then
Stlist.Strings[j] := Sortarray[j];
end;
//Free the array
SetLength(SortArray,0);
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Quicksorting;
type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
ListBox1: TListBox;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ZaladujListe : TStringList;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
i, a : integer;
s1, s2 : string;
sl, sl1 : TStringList;
begin
FastSortStList(ZaladujListe);
sl := TStringList.Create;
sl1 := TStringList.Create;
ZaladujListe.Insert(0,'');
for i := ZaladujListe.Count -1 downto 1 do
begin
s1 := ZaladujListe[i];
s2 := ZaladujListe[i-1];
if s1 = s2 then inc(a);
if s1 = s2 then sl.Text := inttostr(a+1)+' razy wystąpiło powtórzenie wartości statystycznej '+ZaladujListe[i];
if s1 <> s2 then sl.Text := inttostr(a+1)+' razy wystąpiło powtórzenie wartości statystycznej '+ZaladujListe[i];
if s1 <> s2 then a := 0;
if s1 <> s2 then sl1.Add(sl[sl.Count-1]);
if i = 1 then break;
//application.ProcessMessages;
end;
ZaladujListe.Delete(0);
ListBox1.Items.Text := sl1.Text;
sl.free;
sl1.free;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ZaladujListe.Free;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
ZaladujListe := TStringList.Create;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i, int : integer;
begin
for I := 0 to 10000000 do
begin
int := 1 + Random(10);
ZaladujListe.Add(IntToStr(int));
end;
end;
end.