求一个字符串排序的函数(30分)

to hfghfghfg:
不好意思,刚才的代码有误:
function QuickSortStr(S: string): string;
procedure QuickSort(L, H: Integer);
var I, J: Integer;
X: Char;
begin
if L >= H then Exit;
I := L
J := H
X := S;
while (I <> J) do
begin
while (I < J) and (S[J] > X) do Dec(J);
if I < J then begin S := S[J]
Inc(I)
end;
while (I < J) and (S <= X) do Inc(I);
if I < J then begin S[J] := S
Dec(J)
end;
end;//
S := X;
QuickSort(L, I - 1);
QuickSort(I + 1, H);
// end;此处end要上移,否则时间繁杂度增加
end;
begin
QuickSort(1, Length(S));
Result := S;
end;
 
樓上的巨汁..我的運行到假死了...
 
如果遇到 大数据 QuickSortStr 可以说 几乎 不能用。

测试程序
http://www.efile.com.cn/efile/dfw@97546/sort.rar
 
to TYZhang:
http://www.efile.com.cn/efile/dfw@97546/sort.rar
 
Memo1
ss 0 毫秒
QuickSortStr 60 毫秒
ss 0 毫秒
QuickSortStr 50 毫秒
ss 0 毫秒
QuickSortStr 60 毫秒
ss 0 毫秒
QuickSortStr 50 毫秒
ss 0 毫秒
QuickSortStr 60 毫秒
ss 0 毫秒
QuickSortStr 50 毫秒
ss 10 毫秒
QuickSortStr 51 毫秒
ss 0 毫秒
QuickSortStr 60 毫秒
ss 0 毫秒
QuickSortStr 60 毫秒
ss 0 毫秒
QuickSortStr 50 毫秒
ss 0 毫秒
QuickSortStr 50 毫秒
 
procedure TForm1.FormCreate(Sender: TObject);
var
c: CHAR;
begin
for C := 'A' to 'Z' do
Data := DATA + C;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;

Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;

// 如果遇到 大数据 QuickSortStr 可以说 几乎 不能用。

end;
 
最新测试
Memo1
ss 10 毫秒
QuickSortStr 3455 毫秒
ss 0 毫秒
QuickSortStr 3425 毫秒
ss 10 毫秒
QuickSortStr 3364 毫秒
ss 10 毫秒
QuickSortStr 3365 毫秒


procedure TForm1.FormCreate(Sender: TObject);
var
c: CHAR;
begin
for C := 'A' to 'Z' do
Data := DATA + C;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;

// 如果遇到 大数据 QuickSortStr 可以说 几乎 不能用。




end;

 
to hfghfghfg:
我考,你这那是排序啊,就是统计吗。
小弟佩服[:)]
 
to TYZhang:
我的结果是正确的。
这种排序 叫做 填充 排序
有点类似 填充索引
适用于 某一段范围的排序
 
已转到
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2563570
 
實測如下: hfghfghfg的方法實在快的無話可說!!

ss 0 毫秒
QuickSortStr 31 毫秒
OrderString 2407 毫秒

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Memo4: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private

{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
Data: string;
function ss(v: string): string;
function QuickSortStr(S: string): string;
function orderString( S:string):string;
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
c: CHAR;
i:integer;
begin
for C := 'A' to 'Z' do
Data := DATA + C;
for i:= 1 to 6 do
begin
Data := Data + Data;
end;

Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;

{ Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
Data := Data + Data;
}

end;

function QuickSortStr(S: string): string;
procedure QuickSort(L, H: Integer);
var I, J: Integer;
X: Char;
begin
if L >= H then Exit;
I := L
J := H
X := S;
while (I <> J) do
begin
while (I < J) and (S[J] > X) do Dec(J);
if I < J then begin S := S[J]
Inc(I)
end;
while (I < J) and (S <= X) do Inc(I);
if I < J then begin S[J] := S
Dec(J)
end;
end;//
S := X;
QuickSort(L, I - 1);
QuickSort(I + 1, H);
// end;此处end要上移,否??间繁?度增加
end;
begin
QuickSort(1, Length(S));
Result := S;
end;

function ss(v: string): string;
var
data: array['A'..'Z'] of integer;
i: Integer;
c: char;
str: string;
begin
FillChar(data, length(data) * 4, 0);

for i := 1 to length(V) do
inc(data[V]);
result := '';
for c := 'A' to 'Z' do
if data[C] > 0 then
begin
setLength(str, data[C]);
FillChar(str[1], data[C], C);
result := result + str;
end;

end;

function orderString( S:string):string;
var max: char;
i,j:integer;
begin
for i:= 1 to length(S) do
for j:= 1 to length(S) do
begin
if ord(s) < ord(s[j]) then
begin
max := s[j];
s[j] := s;
s:= max;
end;
end;
result := s;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
S: string;
b: integer;
begin
b := GetTickCount;
S := ss(Data);
memo1.Lines.Add(format('ss %D 毫秒', [GetTickCount - b]));
memo2.Text := S;

b := GetTickCount;
S := QuickSortStr(Data);
memo1.Lines.Add(format('QuickSortStr %D 毫秒', [GetTickCount - b]));
memo3.Text := S;

b := GetTickCount;
S := orderString(Data);
memo1.Lines.Add(format('OrderString %D 毫秒', [GetTickCount - b]));
memo4.Text := S;
end;

end.
 
一共就 26 个大写字母,用得着这么麻烦吗?
 
多人接受答案了。
 
顶部