Поразрядная сортировка целых положительных чисел по возрастанию, вариант LSD (Least Significant Digit radix sort) — Pascal(Паскаль)

procedure SortRadix(var a: array of Longint; n: Integer);
type LongintArr = array [0..0] of Longint;
var
  b: ^LongintArr;
  e: Integer;
{$R-}
  procedure SortCount;
  var
    c: array [0..$F] of Integer;
    i, t: Integer;
  begin
    FillChar(c,SizeOf(c),#0);
    for i:=0 to n-1 do Inc(c[a[i] shr e and $F]);
    for i:=Low(c)+1 to High(c) do Inc(c[i],c[i-1]);
    for i:=n-1 downto 0 do begin
      t:=a[i] shr e and $F;
      Dec(c[t]); b^[c[t]]:=a[i];
    end;
    for i:=0 to n-1 do a[i]:=b^[i];
  end;
var
  i: Integer;
  m: Longint;
begin
  GetMem(b,n*SizeOf(Longint));
  m:=a[0]; for i:=1 to n-1 do if m<a[i] then m:=a[i];
  e:=0;
  while m>0 do begin
    SortCount; Inc(e,4); m:=m shr 4;
  end;
  FreeMem(b,n*SizeOf(Longint));
end;

const
  n=10;
  a: array [0..n-1] of Longint = (9,8,7,6,5,4,3,2,1,0);
var i: Integer;
begin
  Write('A ='); for i:=Low(a) to High(a) do Write(' ',a[i]); WriteLn;
  SortRadix(a,n);
  Write('A''='); for i:=Low(a) to High(a) do Write(' ',a[i]); WriteLn;
end.

Можно сократить число проходов с 2 до 1 на каждый байт значения

procedure SortRadix(var a: array of Longint; n: Integer);
type LongintArr = array [0..0] of Longint;
var
  b: ^LongintArr;
  e: Integer;
{$R-}
  procedure SortCount;
  var
    c: array [0..$FF] of Integer;
    i, t: Integer;
  begin
    FillChar(c,SizeOf(c),#0);
    for i:=0 to n-1 do Inc(c[a[i] shr e and $FF]);
    for i:=Low(c)+1 to High(c) do Inc(c[i],c[i-1]);
    for i:=n-1 downto 0 do begin
      t:=a[i] shr e and $FF;
      Dec(c[t]); b^[c[t]]:=a[i];
    end;
    for i:=0 to n-1 do a[i]:=b^[i];
  end;
var
  i: Integer;
  m: Longint;
begin
  GetMem(b,n*SizeOf(b[0]));
  m:=a[0]; for i:=1 to n-1 do if m<a[i] then m:=a[i];
  e:=0;
  while m>0 do begin
    SortCount; Inc(e,8); m:=m shr 8;
  end;
  FreeMem(b,n*SizeOf(b[0]));
end;

Также возможно увеличить производительность возврата содержимого b^ в a добавив функцию Move

Move(b^,a,n*SizeOf(a[0]));

Leave a Comment