alex@aureus.sublink.org (Sandro Doro) (04/20/91)
Last week i have read "A fast, easy sort" by Stephen Lacey and Richard Box BYTE McGraw-Hill April 1991, p.315-320. With a few simple modification to a bubble sort speed up the routine. I have coded so (TP): ------------------------ cut--------------------------------------------------- program test; uses crt,dos; const numelts = 1000; shrinkFactor = 1.3; type tdata = integer; arraytype = array [1..numelts] of tdata; aptr = 1..numelts; var x,y: arraytype; i,n: aptr; h,m,s,hund: word; procedure bsort(var x: arraytype; n: aptr); var pass,j: aptr; intchange: boolean; hold: tdata; begin intchange:=true; pass:=1; while (pass<=n-1) and (intchange) do begin intchange:=false; for j:=1 to n-pass do if x[j]>x[j+1] then begin intchange:=true; hold:=x[j]; x[j]:=x[j+1]; x[j+1]:=hold end; pass:=pass+1 end end; procedure comb(var x: arraytype; n: aptr); var i,j,gap: aptr; intchange: boolean; hold: tdata; begin intchange:=true; gap:=n; repeat gap:=trunc(gap*1.0/shrinkFactor); if gap<1 then gap:=1; intchange:=false; for j:=1 to n-gap do begin i:=j+gap; if x[j]>x[i] then begin intchange:=true; hold:=x[j]; x[j]:=x[i]; x[i]:=hold end end until (gap=1) and (intchange) end; function LeadingZero(w : Word) : String; var s : String; begin Str(w:0,s); if Length(s) = 1 then s := '0' + s; LeadingZero := s; end; begin n:=numelts; for i:=1 to numelts do begin x[i]:=random(10000); y[i]:=x[i] end; clrscr; gettime(h,m,s,hund); Write('Start bubble sort at ',LeadingZero(h), ':',LeadingZero(m),':',LeadingZero(s), '.',LeadingZero(hund),' ... '); bsort(x,n); gettime(h,m,s,hund); WriteLn(' stop at ',LeadingZero(h),':',LeadingZero(m), ':',LeadingZero(s),'.',LeadingZero(hund)); gettime(h,m,s,hund); Write('Start comb sort at ',LeadingZero(h), ':',LeadingZero(m),':',LeadingZero(s), '.',LeadingZero(hund),' ... '); comb(y,n); gettime(h,m,s,hund); WriteLn(' stop at ',LeadingZero(h),':',LeadingZero(m), ':',LeadingZero(s),'.',LeadingZero(hund)); end. ------------------------ cut--------------------------------------------------- The result is no good: the first ten element of y are 0,11,14,21,33,39,40,55,71,65 [...] Why ? where is the error(s) ? Ciao -- Sandro Doro e-mail: alex@aureus.sublink.org
Kai_Henningsen@ms.maus.de (Kai Henningsen) (04/27/91)
Sandro Doro alex @ aureus.sublink.org schrieb am 20.04.1991, 12:44 SD> procedure comb(var x: arraytype; SD> n: aptr); SD> var SD> i,j,gap: aptr; SD> intchange: boolean; SD> hold: tdata; SD> begin SD> intchange:=true; What for? SD> gap:=n; SD> repeat SD> gap:=trunc(gap*1.0/shrinkFactor); SD> if gap<1 then gap:=1; SD> intchange:=false; SD> for j:=1 to n-gap do SD> begin SD> i:=j+gap; SD> if x[j]>x[i] then SD> begin SD> intchange:=true; SD> hold:=x[j]; SD> x[j]:=x[i]; SD> x[i]:=hold SD> end SD> end SD> until (gap=1) and (intchange) ... and NOT intchange! SD> end; SD>Why ? where is the error(s) ? MfG Kai