Форум: "Основная";
Текущий архив: 2004.11.07;
Скачать: [xml.tar.bz2];
Внизsortirovka massivov metodom Shella Найти похожие ветки
← →
Tank Abot (2004-10-19 23:35) [0]Nu, uvazhaemie OTCI,znakom li koto nibudj s metodom sortirovki massiva imeni dostochtimogo i mnogomudrogo Shella?
Vrode vse rabotaet no toljko slishkom mnogo sravnenij...
vot kod...
//Shell-------------------------------------------------------------------------
procedure ShellSorting(N:integer);
var Mas:array of integer;
i,j:integer;
Count,P,D,t:integer;
KolShag,XX,X,Y,Shag,K,H,TMP:integer;
MasD:array of integer;
flag:boolean;
begin
Count:=0;
SetLength(Mas,0);
SetLength(Mas,N-1);
for i:=0 to N-1 do
Mas[i]:=StrToInt(Form1.ListBox1.Items.Strings[i]);
//------------------------------------------------------------------------------
//vspomogateljnie proceduri-----------------------------------------------------
t:=(Logarifm(N,2))-1;
//Sozdaem massiv delta(promezhutkov)
SetLength(MasD,t);
MasD[0]:=1;
for i:=1 to t-1 do
begin
MasD[i]:=(2*MasD[i-1])+1
end;
//Sama sortirovka---------------------------------------------------------------
Y:=Length(MasD);
while Y>=1 do
begin
Shag:=MasD[Y-1];//shag
KolShag:=N div Shag;//nahodim kol-vo shagov
if KolShag<=XX then
XX:=N-(KolShag*Shag) else XX:=N;
Flag:=TRUE;i:=0;Inc(Count);
for i:=0 to XX-2 do
begin
H:=i;Shag:=MasD[Y-1];P:=0;
while (H+Shag)<=N do
begin
Inc(Count);
Inc(P);
flag:=FALSE;
if Mas[H]>Mas[H+Shag]then
begin
TMP:=Mas[H];
Mas[H]:=Mas[H+Shag];
Mas[H+Shag]:=TMP;
flag:=TRUE;
end;
H:=Shag;Inc(Shag,Shag div P);Dec(K);
end;
end;
Dec(Y);
end;
//vstavka --------------------------------------------------------------
SetLength(Mas,N);
for i:=0 to N-1 do
begin
X:=Mas[i];j:=i-1;
Mas[0]:=X;
while(X<Mas[j])do
begin
Mas[j+1]:=Mas[j];
j:=j-1;
end;
Mas[j+1]:=X;
end;
//Vivod otsortirovannogo massiva-.....
← →
Verg © (2004-10-20 00:02) [1]
procedure ShellSortProc( A : TArray; L, R : integer);
var
H, J, I : integer;
V : TArrayElement;
begin
H:= 1;
while H <= ((R - L) / 9) do H := 3 * H + 1;
while H > 0 do
begin
for I := L + H to R do
begin
J := I;
V := A[I];
while ( J >= L+H ) and ( V < A[J-H] ) do
begin
A[J] := A[J-H];
Dec( J, H );
end;
A[J] := V;
end;
H := H div 3;
end;
end;
← →
Tank Abot (2004-10-21 20:59) [2]poprobuju...spasibo...
← →
Verg © (2004-10-21 22:08) [3]Eto ne mne spasibo, eto Robertu Sedgviku za obucheyie i vpravku mozgov v svojo vremia :))
← →
Verg © (2004-10-21 22:11) [4]Robert Sedgewick - рсепект.
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.11.07;
Скачать: [xml.tar.bz2];
Память: 0.46 MB
Время: 0.039 c