帮我看一眼,为什么这么快速排序算法这么慢?(100分)

  • 主题发起人 主题发起人
  • 开始时间 开始时间

Unregistered / Unconfirmed
GUEST, unregistred user!
排序2000个数据,1分钟都没跑完。
代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
function partition(p,r:integer;var L:TStringList):Integer;
procedure Quick_Sort(p,r:Integer;var L:TStringList);
{ Public declarations }
end;


var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Quick_Sort(p,r:Integer;var L:TStringList);
const
e=12;
var
q:Integer;
begin
if p>=r then
Exit
else
begin
q:=partition(p,r,L);//将L[p..r]分解为L[p..q]和L[q+1..r]两部分
memo2.Lines:=l;
Quick_Sort(p,q,L);
//递归排序L[p..q]
Quick_Sort(q+1,r,L);//递归排序L[q+1..r]
end;
end;

function TForm1.partition(p,r:integer;var L:TStringList):Integer;
var
i,j,
pivot:Integer;
tmp:string ;
begin
pivot:=(r + p) shr 1;
//在L[p..r]中选择一个支点元素pivot
i:=p-1;
j:=r+1;
while Truedo
begin
Application.ProcessMessages;
repeat Dec(j) until CompareText(L.Strings[j],L.Strings[pivot])<=0;
//移动左指针
repeat inc(i) until CompareText(L.Strings,L.Strings[pivot])>=0;
//移动右指针
if i< j then
//交换L和L[j]
begin
tmp:=L.Strings;
L.Strings:=L.Strings[j] ;
L.Strings[j]:=tmp;
end
else
if j<>r then
begin
Result:=j;
break;
//返回j的值作为分割点
end
else
begin
Result:=j-1;
//返回j前一个位置作为分割点
break;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
Tmp:TStringList;
begin
Tmp:=TStringList(memo1.Lines);
Quick_Sort(0,Tmp.Count-1,Tmp);
memo2.Lines:=Tmp;
end;

procedure TForm1.Button2Click(Sender: TObject);
//随机产生2000个数据
var
i,j:Integer;
begin
Randomize;
for i:=0 to 2000do
begin
j:=Random(100000);
if memo1.Lines.IndexOf(IntToStr(j))=-1 then
memo1.Lines.Add(IntToStr(j));
end;
end;

end.
 
逻辑没有仔细地看,头晕,呵呵,但是我觉得不是你算法上的问题,而是VCL方面的问题,你试着改一下看看。
首先,你把partition中的Application.ProcessMessages支掉,绝对可以快很多。
其次,TStringList的交换字符串肯定会占去了不少时间,我建议改成TList,存储指针,速度应该会快很多。
先说这点,算是交差,呵呵
 
沒功夫幫你看,就是教父的意見。有大量數據時不要用字符串直接賦值。
給你看看DELPHI的Tlist.sort的源碼。它也用快速排序的。
它用指針。
procedure TList.Sort(Compare: TListSortCompare);
begin
if (FList <> nil) and (Count > 0) then
QuickSort(FList, 0, Count - 1, Compare);
end;

procedure QuickSort(SortList: PPointerList;
L, R: Integer;
SCompare: TListSortCompare);
var
I, J: Integer;
P, T: Pointer;
begin
repeat
I := L;
J := R;
P := SortList^[(L + R) shr 1];
repeat
while SCompare(SortList^, P) < 0do
Inc(I);
while SCompare(SortList^[J], P) > 0do
Dec(J);
if I <= J then
begin
T := SortList^;
SortList^ := SortList^[J];
SortList^[J] := T;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
QuickSort(SortList, L, J, SCompare);
L := I;
until I >= R;
end;
 
是啊,说的对。
 
是啊,时间都花在界面更新上了
 
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
function partition(const p,r:Integer;var L:array of string):Integer;
procedure Quick_Sort(const p,r:Integer;var L:array of string);
{ Public declarations }
end;


var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Quick_Sort(const p,r:Integer;var L:array of string);
const
e=12;
var
q:Integer;
begin
if p>=r then
Exit
else
begin
q:=partition(p,r,L);//&amp;frac12;&amp;laquo;L[p..r]·&amp;Ouml;&amp;frac12;&amp;acirc;&amp;Icirc;&amp;ordf;L[p..q]&amp;ordm;&amp;Iacute;L[q+1..r]&amp;Aacute;&amp;frac12;&amp;sup2;&amp;iquest;·&amp;Ouml;
Quick_Sort(p,q,L);
//&amp;micro;&amp;Yacute;&amp;sup1;é&amp;Aring;&amp;Aring;&amp;ETH;òL[p..q]
Quick_Sort(q+1,r,L);//&amp;micro;&amp;Yacute;&amp;sup1;é&amp;Aring;&amp;Aring;&amp;ETH;òL[q+1..r]
end;
end;

function TForm1.partition(const p,r:Integer;var L:array of string):Integer;
var
i,j,
pivot:Integer;
tmp:string ;
begin
pivot:=(r + p) shr 1;
//&amp;Ocirc;&amp;Uacute;L[p..r]&amp;Ouml;&amp;ETH;&amp;Ntilde;&amp;iexcl;&amp;Ocirc;&amp;ntilde;&amp;Ograve;&amp;raquo;&amp;cedil;&amp;ouml;&amp;Ouml;§&amp;micro;&amp;atilde;&amp;Ocirc;&amp;ordf;&amp;Euml;&amp;Oslash;pivot
i:=p-1;
j:=r+1;
while Truedo
begin
// Application.ProcessMessages;
repeat Dec(j) until L[j]<=L[pivot];
//&amp;Ograve;&amp;AElig;&amp;para;&amp;macr;×ó&amp;Ouml;&amp;cedil;&amp;Otilde;&amp;euml;
repeat inc(i) until L>=L[pivot];
//&amp;Ograve;&amp;AElig;&amp;para;&amp;macr;&amp;Oacute;&amp;Ograve;&amp;Ouml;&amp;cedil;&amp;Otilde;&amp;euml;
if i< j then
//&amp;frac12;&amp;raquo;&amp;raquo;&amp;raquo;L&amp;ordm;&amp;Iacute;L[j]
begin
tmp:=L;
L:=L[j] ;
L[j]:=tmp;
end
else
if j<>r then
begin
Result:=j;
break;
//·&amp;micro;&amp;raquo;&amp;Oslash;j&amp;micro;&amp;Auml;&amp;Ouml;&amp;micro;×÷&amp;Icirc;&amp;ordf;·&amp;Ouml;&amp;cedil;&amp;icirc;&amp;micro;&amp;atilde;
end
else
begin
Result:=j-1;
//·&amp;micro;&amp;raquo;&amp;Oslash;j&amp;Ccedil;°&amp;Ograve;&amp;raquo;&amp;cedil;&amp;ouml;&amp;Icirc;&amp;raquo;&amp;Ouml;&amp;Atilde;×÷&amp;Icirc;&amp;ordf;·&amp;Ouml;&amp;cedil;&amp;icirc;&amp;micro;&amp;atilde;
break;
end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i:Integer;
Tmp:TStringList;
begin
time,endtime:Longint;
mlist:array[0..2000-1] of string;
begin
for i:=Low(mlist) to High(mlist)do
mlist:=memo1.Lines.Strings;

begin
time:=GetTickCount;
Quick_Sort(Low(mlist),High(mlist),mlist);
endtime:=GetTickCount;
for i:=Low(mlist) to High(mlist)do
memo2.Lines.Add(mlist);
MessageDlg(IntToStr(endtime-begin
time), mtWarning, [mbOK], 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i,j:Integer;
begin
Randomize;
for i:=0 to 2000do
begin
j:=Random(100000);
if memo1.Lines.IndexOf(IntToStr(j))=-1 then
begin
memo1.Lines.Add(IntToStr(j));
end;
end;
end;

看来还是教父说的对,,就是VCL的问题,我改成数组后,不到10MS就搞定了。
 
多人接受答案了。
 
>>就是VCL的问题,我改成数组后,不到10MS就搞定了
我怎么没看明白,2000个数据而已,主要是
Application.ProcessMessages;耗费时间
当然,大量的复制字符串也是极为耗时的,不过这好像不属于VCL问题,和和
 
实际上字符串赋值的速度是非常快的,
关键是,你操作的是控件的字符串列表,
更新他的某一项会引起界面的更新,这比较耗时间,
如果你事先调用 begin
Update 完毕后调用 EndUpdate
速度就会快多了,
Application.ProcessMessages也耗费不了多少时间的
 
后退
顶部