Лаба 3.3

{$mode objfpc}
program RadixLSD;

uses
    Math, SysUtils;

type
    TDigit = 0..9;
    TResultPos = -1..high(word);
    TArray = array of longword;

var
    inputFile: text;
    size: word;
    arrToSort: TArray;

procedure Swap (var a, b : longword);
var
    temp: integer;
begin
    temp:=a;
    a:=b;
    b:=temp;
end;

procedure PrintError;
begin
    writeln;
    writeln('Возникла ошибка во время обработки входного файла!');
    writeln;
end;

procedure PrintHelp;
begin
    writeln;
    writeln('      Справка по формату входного файла      ');
    writeln;
    writeln('В первой строке входного файла должно содержаться количество элементов массива для сортировки');
    writeln('Будет прочитано лишь указанное количество элементов.');
    writeln('В следующей строке должны содержаться элементы данного массива, разделенные одним пробелом.');
    writeln('Поддерживаются только целые положительные числа, посторонние символы в файле не допускаются.');
    writeln;
    writeln;
end;


procedure PrintArray (const arrToPrint: TArray; currentNumberOfDigit: byte = 0);
var
    i: word;
begin
    if (currentNumberOfDigit <> 0) then
        writeln('Сортировка по ',currentNumberOfDigit,' разряду:')
    else
        writeln('Исходный массив:');

    for i:= low(arrToPrint) to high(arrToPrint)-1 do
            write(arrToPrint[i],' ');
        writeln(arrToPrint[high(arrToPrint)]);
        writeln;
end;

function GetDigit(number: longword; numberOfDigit: byte): TDigit;
var
    i: byte;
begin
    for i:= 1 to numberOfDigit - 1 do
        number:= number div 10;

    result:=number mod 10;
end;

procedure RadixSort (var arrToSort: TArray; maxNumberOfDigit: byte);
var
    numberOfDigit: byte;
    currentDigit: TDigit;
    resultPos: TResultPos;
    i: word;

begin
        for numberOfDigit:= 1 to maxNumberOfDigit do
        begin
            resultPos:= -1;

            for currentDigit:= 0 to 9 do
                    for i:= low(arrToSort) to high(arrToSort) do
                            if ( GetDigit(arrToSort[i],numberOfDigit) = currentDigit) then
                            begin
                                inc(resultPos);
                                swap(arrToSort[resultPos], arrToSort[i]);
                            end;
            PrintArray(arrToSort,numberOfDigit);
        end;

end;

function ProcArray (var arrToProc: TArray): byte;
var
    maxNumberOfDigits, numberOfDigits: byte;
    i: word;
begin
    reset(inputFile);
    readln(inputFile);

    maxNumberOfDigits:= 0;

    for i:= low(arrToProc) to high(arrToProc) do
    begin
            read(inputFile,arrToProc[i]);

            try
                numberOfDigits:= trunc(ln(arrToProc[i])/ln(10))+1;
            except
                numberOfDigits:=0;
            end;

            if (numberOfDigits > maxNumberOfDigits) then
                    maxNumberOfDigits:= numberOfDigits;
    end;

    PrintArray(arrToProc);

    result:= maxNumberOfDigits;

    close(inputFile);
end;

function GetSize(var f: text): word;
begin
    reset(f);

    try
        readln(inputFile,result);
    except
        PrintError;
        PrintHelp;
        result:=0;
    end;

    close(f);
end;

procedure ChooseFile(var f: text);
var
    fileName: ansistring;
    isExisting: boolean;
begin
    repeat
        write('Введите имя файла с исходными данными: ');
        readln(fileName);

        isExisting := FileExists(fileName);
        assign(f,fileName);

        if not isExisting then
            writeln('Такого файла не существует!')
    until isExisting;
end;

begin
    ChooseFile(inputFile);
    size:= GetSize(inputFile);
    setlength(arrToSort, size);
    RadixSort(arrToSort, ProcArray(arrToSort));
end.