[comp.lang.pascal] Combsort problem

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