Поразрядная сортировка целых положительных чисел

{$R-}
Program xa;
uses
  crt;
type
  itype=longint; {Тип сортируемых данных}
  TTImas=array [1..1] of itype;
  TImas=^TTImas;
  ltype=byte; {Тип для массива "карманов"}
  TTBmas=array [1..1] of ltype;
  TBmas=^TTBmas;
 
{процедура вывода массива}
procedure printmas(mas:TImas; n:longint);
var
  i:longint;
begin
  for i:=1 to n do
    Write(mas^[i], ' ');
end;
 
{Процедура определения длинны числа}
function lengthi(ch:longint):integer;
var
 s:string;
begin
  str(ch,s);
  lengthi:=length(s);
end;
 
{Процедура определяющая в какой "карман" пойдёт число}
function numberpos(ch,posi:longint):integer;
var
 s:string;
 code,tmpi:integer;
begin
  str(ch,s);
  if length(s)<posi then
    numberpos:=0
  else
  begin
    delete(s,1,length(s)-posi);
    if length(s)>1 then
      delete(s,2,length(s)-1);
    val(s,tmpi,code);
    numberpos:=tmpi
   end;
end;
 
{Процедура сортировки}
procedure sortmas(var mas:TImas; n:longint);
var
  i,k,koliter,posf,l,posi,tmp:longint;
  mastmp:TImas;
  pos:TBmas;
begin
  koliter:=0;
  GetMem(MasTmp,sizeof(itype)*n);
  GetMem(pos,sizeof(ltype)*n);
  for i:=1 to n do
  begin
    if lengthi(mas^[i])>koliter then
      koliter:=lengthi(mas^[i]);
    pos^[i]:=0;
  end;
  for i:=1 to koliter do
  begin
    for k:=1 to n do
    begin
      pos^[k]:=numberpos(mas^[k],i);
      mastmp^[k]:=mas^[k];
    end;
    posi:=1;
    for posf:=0 to 9 do
      for k:=1 to n do
        if (pos^[k]=posf) then
        begin
          mas^[posi]:=mastmp^[k];
          inc (posi);
        end;
  end;
end;
 
{Процедура проверки правильности сортировки}
function yes(mas:TImas; n:longint):boolean;
var
  flag:boolean;
  i:longint;
begin
  flag:=true;
  i:=n;
  while (i>1) and flag do
  begin
    if mas^[i]<mas^[i-1] then
      flag:=False;
    dec(i);
  end;
  yes:=flag;
end;
 
var
  massiv:TImas;
  i,n:longint;
begin
  repeat
    clrscr;
    Write('Vvedute pa3mepHoCt'' massiva, n= ');
    readln(n);
  until (n>0);
  clrscr;
  Writeln('VVedute elemenTbl massiva');
  GetMem(massiv,sizeof(itype)*n);
  for i:=1 to n do
  begin
    Write('Massiv[',i,']= ');
    readln(massiv^[i]);
  end;
  clrscr;
  writeln('massiv do coptupovki:');
  printmas(massiv,n);
  sortmas(massiv,n);
  writeln;
  writeln;
  writeln('massiv posle sortupovku');
  printmas(massiv,n);
  writeln;
  Write('Macciv otcoptipovan ');
  if yes(massiv,n) then
    writeln('pravul''no')
  else
    writeln('nepravil''no');
  readln;
  FreeMem(massiv,sizeof(itype)*n);
end.
{$R+}
Теги:
сортировка, массив
Добавлено: 15 Сентября 2013 02:49:57 Добавил: Андрей Ковальчук Нравится 0
Добавить
Комментарии:
Нету комментариев для вывода...