Текущий архив: 2004.11.07;
Скачать: CL | DM;

Вниз

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;
Скачать: CL | DM;

Наверх

Память: 0.45 MB
Время: 0.036 c