LSD 2.1

{$mode objfpc}

program RadixLSD;

uses
    Math, SysUtils;

type
    TDigit = -9..9;
    TResultPos = -1..high(word);
    TArray = pLongint;
    TInputMode = (Keyboard, Textfile);
    TOutputMode = (ToScreen, ToTextfile, ToBoth);
    TReadElement = function (var f: text; var number: longint; index: longword): boolean;

function ReadFromFile(var f: text; var number: longint; index: longword = 0): boolean;
begin
    if eof(f) then
        result:= false
    else
    begin
        result:=true;
        try
            read(f,number);
        except
            result:= false;
        end;
    end;
end;

function ReadFromKeyboard(var f: text; var number: longint; index: longword): boolean;
var
    isCorrect: boolean;
begin
    write('Введите ', index + 1, ' элемент массива: ');
    repeat
        isCorrect:= true;

        try
            readln(number);
        except
            isCorrect:= false;
            write('Ошибка ввода! Повторите ввод: ');
        end;
    until isCorrect;

    result:= true;
end;

procedure PrintError(var f: text; outputMode: TOutputMode);
begin
    writeln('Возникла ошибка во время обработки входного файла!');
    if (outputMode <> ToScreen) then
    begin
        append(f);
        writeln(f,'Возникла ошибка во время обработки входного файла!');
        close(f);
    end;
end;

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


procedure PrintArray (const arrToPrint: TArray; size: longword; var f: text);
var
    i: word;

begin
    append(f);
    for i:= 0 to size-2 do
            write(f, arrToPrint[i],' ');
    writeln(f, arrToPrint[size-1]);
    writeln(f);
    close(f);
end;

function GetDigit(number: longint; 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; size: longword; var f: text; outputMode: TOutputMode);
var
    numberOfDigit: byte;
    currentDigit: TDigit;
    i: word;
    digits: array [-9..9] of word;
    temp, tempArray: pLongint;

begin
    GetMem(tempArray, sizeof(longint) * size);

    for numberOfDigit:= 1 to maxNumberOfDigit do
    begin
        fillchar(digits,sizeof(digits),0);
        for i:=0 to size - 1 do
            inc(digits[GetDigit(arrToSort[i], numberOfDigit)]);

        digits[9]:= size - digits[9];

        for currentDigit:= 8 downto -9 do
            digits[currentDigit]:= digits[currentDigit+1] - digits[currentDigit];

        for i:=0 to size-1 do
        begin
            tempArray[digits[GetDigit(arrToSort[i], numberOfDigit)]] := arrToSort[i];
            inc(digits[GetDigit(arrToSort[i], numberOfDigit)]);
        end;

        temp:=tempArray;
        tempArray:=arrToSort;
        arrToSort:=temp;

        rewrite(f);
        writeln(f, 'Сортировка по ', numberOfDigit, ' разряду:');
        close(f);

        PrintArray(arrToSort,size,f);

        if (outputMode = ToBoth) then
        begin
            append(output);
            writeln('Сортировка по ', numberOfDigit, ' разряду:');
            PrintArray(arrToSort,size,output);
        end;
    end;

    FreeMem(tempArray);
end;

function ProcArray (var arrToProc: TArray; size: longword; var maxNumberOfDigits: byte; var f: text; readElement: TReadElement; inputMode: TInputMode): boolean;
var
    numberOfDigits: byte;
    i: word;
    isCorrect: boolean;
begin
    reset(f);
    if (inputMode = Textfile) then
        readln(f);

    result:= true;
    maxNumberOfDigits:= 0;
    isCorrect:= true;

    i:= 0;
    while (i < size) and (isCorrect) do
    begin
        isCorrect:= readElement(f, arrToProc[i], i);

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

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

        inc(i);
    end;

    close(f);
    result:= isCorrect;
end;

function ReadSize(var size: longword; var f: text): boolean;
begin
    reset(f);

    result:=true;
    try
        readln(f,size);
        if (size < 2) then
            raise Exception.Create('<2');
    except
        result:= false;
    end;

    close(f);
end;

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

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

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

    writeln;
    inputFileName:= fileName;
end;

procedure ChooseOutputFile (var f: text; const inputFileName: ansistring);
var
    fileName: ansistring;
    isValid: boolean;

begin
    repeat
        isValid:=true;

        write('Введите имя файла для вывода результата: ');
        readln(fileName);
        assign(f, fileName);

        try
            if (fileName = inputFileName) then
                raise Exception.Create('input = output');
            rewrite(f);
            close(f);
        except
            isValid:=false;
            writeln('Невозможно использовать файл с таким именем!');
        end;
    until isValid;
    writeln;
end;

procedure PressEnter;
begin
    rewrite(output);
    writeln('Нажмите Enter.');
    readln;
end;

function ChooseInput: TInputMode;
var
    source: char;
begin
    repeat
        write('Выберите способ ввода входных данных (K - клавиатура, F - файл):  ');
        readln(source);

        if (UpperCase(source) = 'K') then
            result:= Keyboard
        else
            result:= Textfile;
    until ( (UpCase(source) = 'K') or (UpCase(source) = 'F') );
    writeln;
end;

function ChooseOutput: TOutputMode;
var
    output: char;
begin
    repeat
        write('Выберите способ вывода данных (S - экран, F - файл, A - экран и файл): ');
        reset(input);
        readln(output);

        if (UpperCase(output) = 'S') then
            result:= ToScreen
        else
            if (UpperCase(output) = 'F') then
                result:= ToTextfile
            else
                result:= ToBoth;
    until ( (UpCase(output) = 'S') or (UpCase(output) = 'F') or (UpCase(output) = 'A') );
    writeln;
end;

var
    fIn, fOut : text;
    size: longword;
    arrToSort: TArray;
    maxDigit: byte;
    isCorrect: boolean;
    inputFileName: ansistring;
    outputMode: TOutputMode;

begin
    if (ChooseInput = Textfile) then
    begin
        ChooseInputFile(fIn, inputFileName);
        isCorrect:= ReadSize(size, fIn);

        if (isCorrect) then
        begin
            GetMem(arrToSort, sizeof(longint)*size);
            isCorrect:= (ProcArray(arrToSort, size, maxDigit, fIn, @ReadFromFile, Textfile));
        end;
    end
    else
    begin
        repeat
            write('Введите количество элементов массива (минимум - 2): ');
            isCorrect:= ReadSize(size, input);
        until isCorrect;
        writeln;

        fIn:= input;

        GetMem(arrToSort, sizeof(longint)*size);
        ProcArray(arrToSort, size, maxDigit, input, @ReadFromKeyboard, Keyboard);
        writeln;
    end;

    outputMode:= ChooseOutput;
    if (outputMode = ToScreen) then
        fOut:= output
    else
        if ( (outputMode = ToTextfile) or (outputMode = ToBoth)) then
            ChooseOutputFile(fOut, inputFileName);

    if (isCorrect) then
    begin
        if (outputMode <> ToTextfile) then
        begin
            writeln('Исходный массив:');
            PrintArray(arrToSort, size, output);
        end;

        RadixSort(arrToSort, maxDigit, size, fOut, outputMode);

        append(fOut);
        writeln(fOut, 'Отсортированный массив:');
        close(fOut);
        PrintArray(arrToSort, size, fOut);

        if (outputMode = ToBoth) then
        begin
            rewrite(output);
            writeln('Отсортированный массив:');
            PrintArray(arrToSort, size, output);
        end;

        FreeMem(arrToSort);
    end
    else
    begin
        PrintError(fOut, outputMode);
        PrintHelp;
    end;

    PressEnter;
end.