laba_3_3_del

program laba_3_3_del;

uses
    System.SysUtils,
    System.RegularExpressions;

type
    TArr = Array of Integer;
    TBuckets = Array of Array of Integer;

const
    MES_TASK = 'Пошаговая сортировка. Разработать алгоритм c методом пошаговой детализации и программу, реализующую этот алгоритм.';
    ERROR_FILE_NOT_FOUND = 'Файл не найден. ';
    MES_INPUT_OF_PATH = 'Пожалуйста, введите путь к файлу';
    MES_ASK_INPUT_METHOD = 'Откуда брать данные?' + #10#13 + '1 - из файла' + #10#13 + '2 - ввести вручную';
    MES_ASK_AGAIN_INPUT_METHOD = '"1" - повторить попытку.' + #10#13 + '"2" - ввести данные из консоли.';
    ERROR_FILE_CANNOT_BE_READ_OR_IS_EMPTY = 'Файл не может быть прочитан или пуст. ';
    MES_ASK_OUTPUT_TO_FILE = 'Хотите вывести ответ в файл?' + #10#13 + '1 - да' + #10#13 + '2 - нет';
    ERROR_FILE_CANNOT_BE_CREATED_OT_OPENED = 'Файл не может быть создан или открыт. ';
    ERROR_CHOICE_IS_INCORRECT = 'Надо ввести "1" или "2". ';
    ERROR_STRING_WITHOUT_NUMBERS = 'Введённая строка не содержит целые числа. ';
    ERROR_NO_NUMBERS_IN_STRING_IN_FILE = 'Первая строка в файле не содержит целые числа. ';
    ERROR_NUMBER_OUT_OF_RANGE = 'Одно или несколько чисел в строке выходят за рамки допустимых значений. ';
    ERROR_TOO_MANY_NUMBERS_IN_STRING = 'В строке слишком много чисел. ';
    MES_INPUT_REQUEST = 'Введите строку с числами через пробел:';
    MES_TRY_AGAIN = 'Повторите попытку:';
    SYS_IP_METHOD_FILE = 'FromFile';
    SYS_IP_METHOD_CONS = 'FromConsole';
    SYS_OP_TO_FILE_YES = 'Output to file';
    SYS_OP_TO_FILE_NO = 'Don''t output to file';
    MIN_NUMBER = -1000000;
    MAX_NUMBER = 1000000;
    MAX_QUANTITY_OF_NUMBERS = 10000;
    SPACE = ' ';
    END_OF_ROW = #10;
    NEW_ROW = #13;

function Choose(SChoice1: String; SChoice2: String; SQuestion: String) : String;
    var
        NChoice: ShortInt;
        BIsCorrect: Boolean;
        SAnswer: String;

    begin
        NChoice := 2;

        writeln(SQuestion, END_OF_ROW + NEW_ROW + 'Ваш выбор: ');
        repeat
            BIsCorrect := true;
            try
                readln(NChoice);
            except
                BIsCorrect := false;
            end;
            if (BIsCorrect and (NChoice <> 1) and (NChoice <> 2)) then
                BIsCorrect := false;
            if (not BIsCorrect) then
                writeln(ERROR_CHOICE_IS_INCORRECT, MES_TRY_AGAIN);
        until (BIsCorrect);
        if (NChoice = 1) then
            SAnswer := SChoice1
        else
           SAnswer := SChoice2;

        Choose := SAnswer;
    end;

function InputPathToFile(BIsInput: Boolean) : String;
    var
        SPartOfText, SPath: String;
    begin
        if (BIsInput) then
            SPartOfText := 'ввода'
        else
            SPartOfText := 'вывода';

        writeln('Пожалуйста, введите путь к файлу ', SPartOfText, ': ');
        readln(SPath);
        InputPathToFile := SPath;
    end;

function FindNumbersInString(SInput: String) : TArr;
    var
        AArr: TArr;
        RegEx: TRegEx;
        MatchCollection: TMatchCollection;
        i: Integer;

    begin
        RegEx := TRegEx.Create('\b-?[0-9]+\b');
        MatchCollection := RegEx.Matches(SInput);

        SetLength(AArr, MatchCollection.Count);
        for i := 0 to MatchCollection.Count - 1 do
            AArr[i] := StrToInt(MatchCollection.Item[i].Value);
        FindNumbersInString := AArr;
    end;

function ChechForErrorsInArrFromFile(AArr: TArr) : ShortInt;
    var
        i: Integer;
        MyError: ShortInt;

    begin
        MyError := 0;
        if (Length(AArr) < 1) then
                MyError := 3
            else
                if (Length(AArr) > MAX_QUANTITY_OF_NUMBERS) then
                    MyError := 4;
            if (MyError = 0) then
            begin
                i := 0;
                while ((i < Length(AArr)) and (MyError = 0)) do
                begin
                    if ((AArr[i] < MIN_NUMBER) or (AArr[i] > MAX_NUMBER)) then
                        MyError := 5;
                end;
            end;
    end;

function ReadArrFromFile(SPathToFile: String; var MyError: ShortInt) : TArr;
    var
        FInput: TextFile;
        SInput: String;
        AInput: TArr;

    begin
        SInput := '';
        if (FileExists(SPathToFile)) then
            try
                AssignFile(FInput, SPathToFile);
                Reset(FInput);
            except
                MyError := 1;
            end
        else
            MyError := 1;
        if (MyError = 0) then
        begin
            if (Eof(FInput)) then
                MyError := 2
            else
                readln(FInput, SInput);
            CloseFile(FInput);
        end;

        AInput := FindNumbersInString(SInput);


        ReadArrFromFile := AInput;
    end;

procedure ChechForErrorsInArrFromConsole(AInput: TArr; var BIsCorrect: Boolean);
    var
        i: Integer;

    begin
        if (Length(AInput) < 1) then
            begin
                writeln(ERROR_STRING_WITHOUT_NUMBERS, MES_TRY_AGAIN);
                BIsCorrect := false;
            end
            else
                if (Length(AInput) > MAX_QUANTITY_OF_NUMBERS) then
                begin
                    writeln(ERROR_TOO_MANY_NUMBERS_IN_STRING, MES_TRY_AGAIN);
                    BIsCorrect := false;
                end;
            if (BIsCorrect) then
            begin
                i := 0;
                while ((i < Length(AInput)) and BIsCorrect) do
                begin
                    if ((AInput[i] < MIN_NUMBER) or (AInput[i] > MAX_NUMBER)) then
                    begin
                        writeln(ERROR_NUMBER_OUT_OF_RANGE, MES_TRY_AGAIN);
                        BIsCorrect := false;
                    end;
                    Inc(i);
                end;
            end;
    end;

function ReadArrFromConsole() : TArr;
    var
        AInput: TArr;
        SInput: String;
        BIsCorrect: Boolean;
        i: Integer;

    begin
        writeln(MES_INPUT_REQUEST);
        repeat
            readln(SInput);
            AInput := FindNumbersInString(SInput);
            BIsCorrect := true;
            ChechForErrorsInArrFromConsole(AInput, BIsCorrect);
        until (BIsCorrect);

        readArrFromConsole := AInput;
    end;

function GetInput() : TArr;
    var
        SInputMethod, SPathToFile: String;
        BInputIsDone: Boolean;
        MyError: ShortInt;
        AInput: TArr;
        Num: Integer;

    begin
        BInputIsDone := false;

        SInputMethod := Choose(SYS_IP_METHOD_FILE, SYS_IP_METHOD_CONS, MES_ASK_INPUT_METHOD);

        repeat
            if (SInputMethod = SYS_IP_METHOD_FILE) then
            begin
                MyError := 0;
                SPathToFile := InputPathToFile(true);

                AInput := ReadArrFromFile(SPathToFile, MyError);
                if (MyError > 0) then
                begin
                    case MyError of
                        1: writeln(ERROR_FILE_NOT_FOUND, MES_TRY_AGAIN);
                        2: writeln(ERROR_FILE_CANNOT_BE_READ_OR_IS_EMPTY, MES_TRY_AGAIN);
                        3: writeln(ERROR_NO_NUMBERS_IN_STRING_IN_FILE, MES_TRY_AGAIN);
                        4: writeln(ERROR_TOO_MANY_NUMBERS_IN_STRING, MES_TRY_AGAIN);
                        5: writeln(ERROR_NUMBER_OUT_OF_RANGE, MES_TRY_AGAIN);
                    end;
                    SInputMethod := choose(SYS_IP_METHOD_FILE, SYS_IP_METHOD_CONS, MES_ASK_AGAIN_INPUT_METHOD);
                end
                else
                    BInputIsDone := true;
            end
            else
            begin
                AInput := ReadArrFromConsole();
                BInputIsDone := true;
            end
        until (BInputIsDone);

        writeln('На входе:');
        for Num in AInput do
            write(Num, Space);
        writeln;
        writeln;

        GetInput := AInput;
    end;

function SplitInputBetweenLists(AInput: TArr; NDivisor: Integer; var ArrBuckets: TBuckets; NBITNESS: ShortInt) : Boolean;
    var
        Temp, Num, Index: Integer;
        FlStillWorking: Boolean;

    begin
        FlStillWorking := false;

        for Num in AInput do
        begin
            Temp := Num div NDivisor;
            Index := Temp mod NBitness;
            SetLength(ArrBuckets[Index], Length(ArrBuckets[Index]) + 1);
            ArrBuckets[Index][High(ArrBuckets[Index])] := Num;
            if ((not FlStillWorking) and (Temp > 0)) then
                FlStillWorking := true;
        end;

        SplitInputBetweenLists := FlStillWorking;
    end;

function LsdSort(AInput: TArr) : TArr;
    const
        NBITNESS = 10; // разрядность

    var
        i, j, NDivisor, Num: Integer;
        FlStillWorking: Boolean;
        ArrBuckets: TBuckets;

    Begin
        FlStillWorking := true;
        NDivisor := 1;
        SetLength(ArrBuckets, NBITNESS);

        for i := 0 to High(ArrBuckets) do
            Setlength(ArrBuckets[i], 0);

        while (FlStillWorking) do
        begin
            FlStillWorking := SplitInputBetweenLists(AInput, NDivisor, ArrBuckets, NBITNESS);

            // moving lists back into input array
            i := 0;
            for j := 0 to NBITNESS - 1 do
            begin
                for Num in ArrBuckets[j] do
                begin
                    aInput[i] := Num;
                    write(Num, Space);
                    Inc(i);
                end;

                Setlength(ArrBuckets[j], 0); //clear ArrBuckets
            end;
            writeln;

            NDivisor := NDivisor * NBITNESS;
        end;
    end;

procedure OutputToFile(AArr: TArr; SPathToFIle: String);
    var
        BOutputReady: Boolean;
        FOutput: TextFile;
        i: Integer;

    begin
        BOutputReady := false;
        repeat
            try
                AssignFile(FOutput, SPathToFIle);
                Rewrite(FOutput);
                for i := 0 to High(AArr) do
                    write(FOutput, AArr[i], SPACE);
                CloseFile(FOutput);
                BOutputReady := true;
            except
                writeln(ERROR_FILE_CANNOT_BE_CREATED_OT_OPENED);
            end;
        until (bOutputReady);
    end;

procedure OutputAnswer(AArr: TArr);
    var
        SShouldOutputInfoToFile, SPathToFile: String;
        BOutputIsReady: Boolean;
        i: Integer;

    begin
        writeln;
        writeln('Ответ:');
        for i := 0 to High(AArr) do
            write(AArr[i], SPACE);
        writeln;

        repeat
            BOutputIsReady := true;
            SShouldOutputInfoToFile := Choose(SYS_OP_TO_FILE_YES, SYS_OP_TO_FILE_NO, MES_ASK_OUTPUT_TO_FILE);

            if (SShouldOutputInfoToFile = SYS_OP_TO_FILE_YES) then
            begin
                SPathToFile := InputPathToFile(false);
                if (FileExists(SPathToFile)) then
                    OutputToFile(AArr, SPathToFile)
                else
                begin
                    BOutputIsReady := false;
                    writeln(ERROR_FILE_NOT_FOUND);
                end;
            end;
        until (BOutputIsReady);
    end;

var
    SInput: String;
    AArr: TArr;
    Num: Integer;

begin
    writeln(MES_TASK);
    // Путь к моему файлу ввода: C:\Users\Aleksandr\Desktop\input.txt
    // Путь к моему файлу вывода: C:\Users\Aleksandr\Desktop\output.txt

    AArr := GetInput();
    LsdSort(AArr);
    OutputAnswer(AArr);

    readln;
end.