Карманная сортировка

procedure QSort(first,last:integer);
      var
         L,R,c,X:integer;
      begin
         if first < last then
         begin
            X:= b[i,(first + last) div 2];
            L:= first;
            R:= last;
            while L <= R do
            begin
                while b[i,L] < X do
                   L:= L + 1;
                while b[i,R] > X do
                   R:= R - 1;
                if L <= R then
                begin
                   c:=b[i,L];
                   b[i,L]:=b[i,R];
                   b[i,R]:=c;
                   L:=L+1;
                   R:=R-1;
                end;
             end;
     QSort(first, R);
     QSort(L, last);
     end;
   end;

Procedure BucketSort(var m:array[1..10]of word);
begin
for i:=1 to n do
      begin
         b[(a[i] div 10)+1,razmer[(a[i] div 10)+1]+1]:=a[i];
         razmer[(a[i] div 10)+1]:=razmer[(a[i] div 10)+1]+1;
      end;
      for i:=1 to 10 do
         if razmer[i]<>0 then Qsort(1,razmer[i]);
      k:=0;
      for i:=1 to 10 do
      for j:=1 to razmer[i] do
      begin
         k:=k+1;
         a[k]:=b[i,j];
      end;
end;
Procedure Swap(Var a, b: word);
Var p: word;
begin
  p := a;
  a := b;
  b := p;
end;

uses crt;
const n=10;
var mass : array [1..n] of word;
    i, j, x ,k: integer;
     a:array[1..10] of word;
     b:array[1..10,1..10] of word;
     razmer:array[1..1000] of word;
procedure QSort(first,last:integer);
      var
         L,R,c,X:integer;
      begin
         if first < last then
         begin
            X:= b[i,(first + last) div 2];
            L:= first;
            R:= last;
            while L <= R do
            begin
                while b[i,L] < X do
                   L:= L + 1;
                while b[i,R] > X do
                   R:= R - 1;
                if L <= R then
                begin
                   c:=b[i,L];
                   b[i,L]:=b[i,R];
                   b[i,R]:=c;
                   L:=L+1;
                   R:=R-1;
                end;
             end;
     QSort(first, R);
     QSort(L, last);
     end;
   end;
Procedure BucketSort(var m:array[1..10]of word);
begin
for i:=1 to n do
      begin
         b[(a[i] div 10)+1,razmer[(a[i] div 10)+1]+1]:=a[i];
         razmer[(a[i] div 10)+1]:=razmer[(a[i] div 10)+1]+1;
      end;
      for i:=1 to 10 do
         if razmer[i]<>0 then Qsort(1,razmer[i]);
      k:=0;
      for i:=1 to 10 do
      for j:=1 to razmer[i] do
      begin
         k:=k+1;
         a[k]:=b[i,j];
      end;
end;
Procedure Swap(Var a, b: word);
Var p: word;
begin
  p := a;
  a := b;
  b := p;
end;
 
procedure CreateArr;
const arr:array[1..10]of word = (1235,2345,3462,42415,4214,2425,12412,4200,1255,24456);
var a:byte;
 begin
  randomize;
  WriteLn('1. Створення');
  WriteLn('   - Випадкове заповнення');
  WriteLn('   - Масив -константа');
  readln(a);
  case a of
  1:begin
  for i:= 1 to n do
     mass[i] := random(65535);
  writeln('Масив створено');
    end;
  2: begin
  for i:= 1 to n do
     mass[i] := arr[i];
  writeln('Масив створено');
     end;
 end;
 end;
Procedure PrintArr(var m:array[1..n] of word );
Begin
 for i:= 1 to n do
      write (m[i],'   ');
writeln;
end;
procedure SelectionSort(var m:array[1..n] of word );
begin
for i:= 1 to n-1 do
    begin
     for j:= i+1 to n do
         if mass[i]>mass[j] then
             swap(m[i],m[j]);
     end;
end;
begin
 
  WriteLn('1. Створення');
  WriteLn('2. Виведення');
  WriteLn('3. Сортування вибором');
  WriteLn('4. Розпод1лбъьне сортування');
  WriteLn('0. Виход');
  Write(' Обер1ть д1ю: ');
repeat
readln (x);
case x of
1:CreateArr();
2:PrintArr(mass);
3:SelectionSort(mass);
4: BucketSort(mass);
0:exit;
end;
 until false;
end.

type mass=array[1..10] of word;

Procedure someproc (m:mass);

procedure BucketSort(var a : array of word);
var
  Largest : word;
  digits, divisor : integer;
  BucketCount : array[0 .. 9] of Integer;
  Bucket : array[0 .. 9, 0 .. 19] of Integer;
  i, j, k, Pass, r : Integer;
begin
  Largest := a[0];
  for i := 1 to High(a) do
    if a[i] > Largest then Largest := a[i];
 
  digits := 0;
  while Largest > 0 do
  begin
    inc(digits);
    Largest := Largest div 10;
  end;
 
  divisor := 1;
  for pass := 0 to Pred(digits) do
  begin
    for k := 0 to 9 do BucketCount[k] := 0;
    for i := 0 to High(a) do
    begin
      r := (a[i] div divisor) mod 10;
      Bucket[r, BucketCount[r]] := a[i]; Inc(BucketCount[r]);
    end;
 
    i := 0;
    for k := 0 to 9 do
    begin
      writeln(k, ' ', BucketCount[k]);
      for j := 0 to Pred(BucketCount[k]) do
      begin
        a[i]:= Bucket[k, j]; Inc(i);
      end;
    end;
 
    divisor := divisor * 10;
  end;
end;