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

L

lingm

Unregistered / Unconfirmed
GUEST, unregistred user!
'ekhzba'>>>>>>>>'abehkz'
[:D]
 
var s0,s1,s2:byte
sc:char;
for s1:=1 to Length(ss)-1 do begin
s0:=s1;
for s2:=s1+1 to Length(ss) do begin
if ss[s0]>ss[s2] then s0:=s2;
end;
if s1<>s0 then begin
sc:=ss[s0];
ss[s0]:=ss[s1];
ss[s1]:=sc;
end;
end;
 
delphi中没有这样的函数吗?(顺序排列字符串)
 
var sb:boolean
s1:byte
sc:char;
repeat
sb:=true;
for s1:=1 to Length(ss) do begin
if ss[s1]>ss[s1+1] then begin
sc:=ss[s1];
ss[s1]:=ss[s1+1];
ss[s1+1]:=sc;
sb:=False;
break;
end;
end;
until sb;
 
var
i,j:integer;
abc:String;
temp:char;
begin
abc:='ekhzba';
for i:=1 to length(abc) do
BEGIN
Application.ProcessMessages;
for j:=i to length(abc) do
begin
if CompareStr(abc,abc[j])>0 then
begin
temp:=abc;
abc:=abc[j];
abc[j]:=temp;
end;
end;
END;
showMessage(abc);
end;
 
连替换都有AnsiReplaceStr,
排序应该也有吧
 
都用了两层循环,有没有更好的方法
 
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
function ss(v: string): string;
var
sl: TstringList;
ws: wideString;
i: integer;
str, str2: string;
begin
ws := v;
sl := TstringList.Create;
for i := 1 to length(ws) do
begin
str := ws;
str2 := inttostr(i);
sl.Add(format('%s%-16s', [str, str2]));
end;
sl.Sort;
Result := '';
for i := 1 to sl.Count - 1 do
Result := Result + copy(sl, 1, length(sl) - 16);
freeandnil(sl);

end;
begin
showmessage(ss('asfasf哈哈asa'));
end;

end.

 
如果保证只是26个小写字母且没有重复的,也可以这样:
var
sb:array ['a'..'z'] of byte;
s1:byte;
sc:char;

fillchar(sb,26,#0);
for s:=1 to length(ss) do sb[ss]:=1;
ss:='';
for sc:='a' to 'z' do if sb[sc]=1 then ss:=ss+sc;
 
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;
end;

剛才測驗了...絕對ok...
 
只有大写字母
 
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;
 
我的应该是非常快的。
 
一样的两层循环,能快的哪里去哦
 
[8D][8D][:D]
 
为啥全是“冒泡”,来个快速的:
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;
begin
QuickSort(1,Length(S));
Result:=S;
end;

procedure TForm1.Button1Click(Sender: TObject);
var S:String;
begin
//S:=Uppercase('procedureTFormButton1ClickSenderTObject');
S:='qwertyuiopasdfghjklzxcvbnm';
S:=QuickSortStr(S);
ShowMessage(S);
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;
end;

剛才測試了...絕對ok...
 
Memo1
ss 0 毫秒
QuickSortStr 951 毫秒
ss 0 毫秒
QuickSortStr 941 毫秒
ss 0 毫秒
QuickSortStr 951 毫秒
ss 0 毫秒
QuickSortStr 951 毫秒
ss 0 毫秒
QuickSortStr 952 毫秒
ss 0 毫秒
QuickSortStr 961 毫秒
ss 0 毫秒
QuickSortStr 961 毫秒
ss 0 毫秒
QuickSortStr 952 毫秒
ss 0 毫秒
QuickSortStr 951 毫秒


测试程序

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
data: string;
implementation

{$R *.dfm}

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;
S := X;
QuickSort(L, I - 1);
QuickSort(I + 1, H);
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;




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;
}

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]));

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

end;



end.


 
顶部 底部