program lab33;

{$APPTYPE CONSOLE}
{$R *.res}

uses
    System.SysUtils;

type
    TArray = array of Integer;

Function CheckExtension(Path: String): Boolean; forward;

Function InputIntegerNumber(MinNumber, MaxNumber: Integer): Integer;

var
    IsCorrect: Boolean;
    Number: Integer;

begin
    repeat
        IsCorrect := true;
        try
            Readln(Number);
        except
            Writeln('Нужно ввести целое число, которое не меньше ', MinNumber,
                    ' и не больше ', MaxNumber);
            IsCorrect := false;
        end;
        if IsCorrect and ((Number < MinNumber) or (Number > MaxNumber)) then
        begin
            Writeln('Нужно ввести целое число, которое не меньше ', MinNumber,
                    ' и не больше ', MaxNumber);
            IsCorrect := false;
        end;
    until IsCorrect;
    InputIntegerNumber := Number;
end;

Function ChooseWayOfInput(): Integer;

const
    CONSOLE_WAY = 1;
    FILE_WAY = 2;
    RANDOM_GENERATION_INPUT = 3;

var
    UserWay: Integer;

begin
    Repeat
        UserWay := InputIntegerNumber(1, 3);
    Until (UserWay = CONSOLE_WAY) or (UserWay = FILE_WAY) or (UserWay = RANDOM_GENERATION_INPUT);
    ChooseWayOfInput := UserWay;
end;

Function ChooseWayOfOutput(): Integer;

const
    CONSOLE_WAY = 1;
    FILE_WAY = 2;

var
    UserWay: Integer;

begin
    Repeat
        UserWay := InputIntegerNumber(1, 2);
    Until (UserWay = CONSOLE_WAY) or (UserWay = FILE_WAY);
    ChooseWayOfOutput := UserWay;
end;

Function InputPathToFile(): String;

var
    Path: String;
    IsCorrect: Boolean;
    NewFile: TextFile;
begin
    Writeln('Input path to file:');
    repeat
        Readln(Path);
        IsCorrect := CheckExtension(Path);
    until IsCorrect;
    InputPathToFile := Path;
end;

Function CheckPermissionForReading(Path: String): Boolean;

var
    OutputFile: TextFile;
    RightPermission: Boolean;

begin
    Assign(OutputFile, Path);
    RightPermission := true;
    try
        Reset(OutputFile);
        Close(OutputFile);
    except
        Writeln('File is not available for reading.');
        RightPermission := false;
    end;
    CheckPermissionForReading := RightPermission;
end;

Function ReceiveNumberOfElementsFromConsole(): Integer;

var
    NumberOfElements: Integer;
    Text: String;

begin
    Writeln('Input number of elements: ');
    NumberOfElements := InputIntegerNumber(2, 200);
    ReceiveNumberOfElementsFromConsole := NumberOfElements;
end;

Function CheckFile(PathToFile: string): Boolean;

var
    IsCorrect, Flag: Boolean;
    EndNumber, i: Integer;
    InputFile: TextFile;
    Text: String;

begin
    Assign(InputFile, PathToFile);
    Reset(InputFile);
    Read(InputFile, Text);
    Flag:= true;
    IsCorrect:= false;
    EndNumber:= Length(Text) + 1;
    i:= 1;
    while (i < EndNumber) and Flag do
    begin;
        if (Text[i] <> ' ') and (Text[i] <> '-') then
            try
                StrToInt(copy(Text, i, 1));
            except
                Writeln('Received data includes non-integer chars.');
                Flag := false;
            end;
        Inc(i);
    end;
    Close(InputFile);
    if flag and (Text = '') then
    begin
        Flag := false;
        Writeln('File is empty');
    end;
    CheckFile := flag;
end;

Function ReceiveNumberOfElementsFromFile(PathToFile: String): Integer;

var
    InputFile: TextFile;
    ELement, NumberOfElements: Integer;

begin;
    NumberOfElements := 0;
    Assign(InputFile, PathToFile);
    Reset(InputFile);
    while (not EOF(InputFile)) do
    begin
        Read(InputFile, Element);
        Inc(NumberOfElements);
    end;
    Close(InputFile);
    ReceiveNumberOfElementsFromFile := NumberOfElements;
end;

Function ReceiveNumberOfElements(var UserWay: Integer; var PathToFile: string): Integer;

const
    CONSOLE_WAY = 1;
    FILE_WAY = 2;
    RANDOM_GENERATION_WAY = 3;

var
    NumberOfElements: Integer;
    IsTextCorrect: Boolean;
    IsCorrect: Boolean;

begin;
    IsTextCorrect := true;
    Writeln('Choose way of input:'#13#10'Type "1" if you want to receive sequence from console;'#13#10'Type "2" if you want to receieve sequence from file;'#13#10'Type "3" if you want to fill sequence with random numbers:');
    UserWay := ChooseWayOfInput();
    case UserWay of
        CONSOLE_WAY:
            begin
                NumberOfElements := ReceiveNumberOfElementsFromConsole();
            end;
        FILE_WAY:
            begin
                repeat
                    PathToFile := InputPathToFile();
                until CheckPermissionForReading(PathToFile) and CheckFile(PathToFile);
                NumberOfElements := ReceiveNumberOfElementsFromFile(PathToFile);
            end;
        RANDOM_GENERATION_WAY:
            begin
                NumberOfElements := ReceiveNumberOfElementsFromConsole();
            end;
    end;
    if not IsTextCorrect then
        Writeln('There are no reqired elements.');
    ReceiveNumberOfElements := NumberOfElements;
end;

Procedure FillingSourceArrayFromConsole(var SourceArray: array of Integer);

var
    i, EndNumber: Integer;

begin;
    EndNumber:= length(SourceArray) - 1;
    for i := 0 to EndNumber do
    begin
        Writeln('Input element: ');
        SourceArray[i] := InputIntegerNumber(-50, 50);
    end;
end;

Procedure FillSourceArrayWithRandomNumbers(var SourceArray: array of Integer);

var
    i, EndNumber: Integer;

begin
    Randomize;
    EndNumber := Length(SourceArray) - 1;
    for i:= 0 to EndNumber do
        SourceArray[i] := Random(101) - 50;
end;

Procedure ReceieveSourceArrayFromFile(var SourceArray: array of Integer; PathToFile: string);

var
    i, EndNumber: Integer;
    InputFile: TextFile;

begin
    Assign(InputFile, PathToFile);
    Reset(InputFile);
    i:= 0;
    EndNumber := Length(SourceArray);
    while (not EOF(InputFile)) and (i < EndNumber) do
    begin
        Read(InputFile, SourceArray[i]);
        Inc(i);
    end;
end;

Procedure ReceiveSourceArray(var SourceArray: array of Integer; NumberOfElements: Integer; UserWay: Integer; PathToFile: string);

const
    CONSOLE_WAY = 1;
    FILE_WAY = 2;
    RANDOM_GENERATION_FAY = 3;

var
    i, EndNumber: Integer;


begin
    case UserWay of
        CONSOLE_WAY:
            begin
                FillingSourceArrayFromConsole(SourceArray);
            end;
        FILE_WAY:
            begin
                ReceieveSourceArrayFromFile(SourceArray, PathToFile);
            end;
        RANDOM_GENERATION_FAY:
            begin
                FillSourceArrayWithRandomNumbers(SourceArray);
            end;
    end;
    EndNumber:= Length(SourceArray) - 1;
    Writeln('Source array:');
    for i := 0 to EndNumber do
        Write(SourceArray[i]:3,' ');
    Writeln('');
end;

Function CheckExtension(Path: String): Boolean;

var
    RigthExtension: Boolean;

begin
    if (ExtractFileExt(Path) = '.txt') then
        RigthExtension := true
    else
    begin
        Writeln('Wrong file extension.');
        RigthExtension := false;
    end;
    CheckExtension := RigthExtension;
end;

Function CheckPermissionForWriting(Path: String): Boolean;

var
    OutputFile: TextFile;
    RightPermission: Boolean;

begin
    Assign(OutputFile, Path);
    RightPermission := true;
    try
        Rewrite(OutputFile);
        Close(OutputFile);
    except
        Writeln('File is not available for writing.');
        RightPermission := false;
    end;
    CheckPermissionForWriting := RightPermission;
end;

Procedure PrintResultToFile(Path: String; SortedArray: array of Integer);

var
    OutputFile: TextFile;
    i, EndNumber: Integer;

begin
    Assign(OutputFile, Path);
    Append(OutputFile);
    Write(OutputFile, 'Sorted array: ');
    EndNumber := Length(SortedArray) - 1;
    for i := 0 to EndNumber do
            Write(OutputFile, SortedArray[i]:3, ' ');
    Close(OutputFile);
    Writeln('Result is writen in file.');
end;

Procedure PrintResultInConsole(SortedArray: array of Integer);

var
    i, EndNumber: Integer;

begin;
    Writeln('Sorted array: ');
    EndNumber := Length(SortedArray) - 1;
    for i := 0 to EndNumber do
       Write(SortedArray[i]:3, ' ');
end;

Procedure PrintResult(SortedArray: array of Integer; var UserWay: Integer; var PathToFile: string);

const
    CONSOLE_WAY = 1;
    FILE_WAY = 2;

begin;
    case UserWay of
        CONSOLE_WAY:
            begin
                PrintResultInConsole(SortedArray);
            end;
        FILE_WAY:
            begin
                PrintResultToFile(PathToFile, SortedArray);
            end;
    end;
    Writeln('Program is completed.');
end;

Procedure FillingArrayWithZeros(var SizesOfIntermediateArray: array of Integer);

var
    Counter, i, NumberOfElements, EndNumber: Integer;

begin
    NumberofElements:= length(SizesOfIntermediateArray);
    Counter := NumberOfElements mod 2;
    for i := 0 to Counter do
        SizesOfIntermediateArray[i] := 0;
end;

Function FindPositionToWriteSizesOfFirstSortingArray(var SizesOfFirstSortingArray: array of Integer; NumberOfElements: Integer): Integer;

var
    i, Index: Integer;
    IsCorrect: Boolean;

begin
    i:= 0;
    Index:= 0;
    IsCorrect:= true;
    while (i <  NumberOfElements) and IsCorrect do
    begin
        if (SizesOfFirstSortingArray[i] = 0) then
        begin
           IsCorrect:= false;
           Index:= i;
        end;
        Inc(i);
    end;
    FindPositionToWriteSizesOfFirstSortingArray := Index;
end;

Function FindPositionToWriteSizesOfSecondSortingArray(var SizesOfSecondSortingArray: array of Integer; NumberOfElements: Integer): Integer;

var
    i, Index: Integer;
    IsCorrect: Boolean;

begin
    i:= 0;
    Index:= 0;
    IsCorrect:= true;
    while (i <  NumberOfElements) and IsCorrect do
    begin
        if (SizesOfSecondSortingArray[i] = 0) then
        begin
           IsCorrect:= false;
           Index:= i;
        end;
        Inc(i);
    end;
    FindPositionToWriteSizesOfSecondSortingArray := Index;
end;

Function FindConditionOfSorted(var IntermediateArray: array of Integer) : Boolean;

var
    Counter, i, EndNumber: Integer;
    Flag: Boolean;

begin
    Counter:= 0;
    EndNumber:= Length(IntermediateArray) - 1;
    for i := 1 to EndNumber do
    begin;
        if (IntermediateArray[i - 1] <= IntermediateArray[i]) then
        begin
            Inc(Counter);
        end;
    end;
    if (Counter = EndNumber) then
        Flag:= true
    else
        Flag:= false;
    FindConditionOfSorted :=  Flag;
end;

Procedure CreatingFirstF(var IntermediateArray, SourceArray: array of Integer);

var
    EndNumber, i: Integer;

begin
    EndNumber:= Length(SourceArray) - 1;
    for i:= 0 to EndNumber do
       IntermediateArray[i]:= SourceArray[i];
end;

Procedure CreatingSortedArray(var SortedArray: array of Integer; var IntermediateArray: array of Integer);

var
    EndNumber, i: Integer;

begin
    EndNumber:= Length(IntermediateArray) - 1;
    for i:= 0 to EndNumber do
       SortedArray[i]:= IntermediateArray[i];
end;

Function FindNumberOfPairs(var SizesOfFirstSortingArray: array of Integer; NumberOfElements: Integer): Integer;

var
    Counter, i, NullPosition: Integer;

begin
    i:= 0;
    Counter:= NumberOfElements div 2 + 1;
    NullPosition := Counter;
    while i < Counter do
    begin
        if (SizesOfFirstSortingArray[i] = 0) then
        begin
            NullPosition := i;
            i := Counter;
        end;
        Inc(i);
    end;
    FindNumberOfPairs := NullPosition;
end;

Procedure FindSortedPart(var IntermediateArray: array of Integer; var Sort: array of Integer; NumberOfElements: Integer; var Index: Integer; var Length: Integer);

var
    k, i, j: Integer;

begin
    k := 0;
    i := Index;
    while (i < NumberOfElements) do
     begin
        if (i + 1 < NumberOfElements) then
        begin
            if (IntermediateArray[i] <= IntermediateArray[i + 1]) then
                Inc(k)
            else
                i := NumberOfElements;
        end;
        Inc(i);
     end;
    if (k > 0) then
    begin
        j := 0;
        for i := Index to Index + k do
        begin
            sort[j] := IntermediateArray[i];
            Inc(j);
        end;
    end
    else
        sort[0] := IntermediateArray[Index];
    Length := k + 1;
    Index := Index + Length;
end;

Procedure FillFirstSortingArray(var FirstSortingArray: array of Integer; var sort: array of Integer; var SizesOfFirstSortingArray: array of Integer; NumberOfElements: Integer; Length: Integer; var IndexOfIntermediateArray: Integer);

var
    i, NumberOfPosition: Integer;

begin
    for i := IndexOfIntermediateArray to IndexOfIntermediateArray + Length - 1 do
        FirstSortingArray[i] := sort[i - IndexOfIntermediateArray];
    NumberOfPosition := findPositionToWriteSizesOfFirstSortingArray(SizesOfFirstSortingArray, NumberOfElements);
    SizesOfFirstSortingArray[NumberOfPosition] := Length;
    IndexOfIntermediateArray := IndexOfIntermediateArray + Length;
end;

Procedure FillSecondSortingArray(var SecondSortingArray: array of Integer; var sort: array of Integer; var SizesOfSecondSortingArray: array of Integer; NumberOfElements: Integer; Length: Integer; var IndexOfIntermediateArray: Integer);

var
    i, NumberOfPosition: Integer;

begin

    for i := IndexOfIntermediateArray to IndexOfIntermediateArray + Length - 1 do
        SecondSortingArray[i] := sort[i - IndexOfIntermediateArray];
    NumberOfPosition := findPositionToWriteSizesOfSecondSortingArray(SizesOfSecondSortingArray, NumberOfElements);
    SizesOfSecondSortingArray[NumberOfPosition] := Length;
    IndexOfIntermediateArray := IndexOfIntermediateArray + Length;
end;

Procedure FillingSortingArrays(var IntermediateArray: array of Integer; var FirstSortingArray: array of Integer; var SecondSortingArray: array of Integer; var SizesOfFirstSortingArray: array of Integer; var SizesOfFSecondSortingArray: array of Integer; NumberOfElements: Integer);

var
    Index, IndexOfIntermediateArray, Length, Condition, i: Integer;
    Sort: array of Integer;

begin
    Index := 0;
    IndexOfIntermediateArray := 0;
    Length := 0;
    Condition := 0;
    i:= 0;
    SetLength(Sort, NumberOfElements);
    FillingArrayWithZeros(SizesOfFirstSortingArray);
    FillingArrayWithZeros(SizesOfFSecondSortingArray);
    while (i < NumberOfElements) do
    begin
        findSortedPart(IntermediateArray, sort, NumberOfElements, Index, Length);
        if (Condition mod 2 = 0) then
            FillFirstSortingArray(FirstSortingArray, sort, SizesOfFirstSortingArray, NumberOfElements, Length, IndexOfIntermediateArray)
        else
            FillSecondSortingArray(SecondSortingArray, sort, SizesOfFSecondSortingArray, NumberOfElements, Length, IndexOfIntermediateArray);
        Inc(Condition);
        i := i + Length;
    end;
end;

Procedure PrintArray(var SourceArray: array of Integer; UserWay: Integer; PathToFile: string);

const
    CONSOLE_WAY = 1;
    FILE_WAY = 2;

var
    i, EndNumber: Integer;
    FileOut: TextFile;

begin
    EndNumber:= Length(SourceArray) - 1;
    case UserWay of
        CONSOLE_WAY:
            begin
                for i := 0 to  EndNumber do
                    Write(SourceArray[i]:3, ' ');
                Writeln('');
            end;
        FILE_WAY:
            begin
                Assign(FileOut, PathToFile);
                Append(FileOut);
                for i := 0 to  EndNumber do
                    Write(FileOut ,SourceArray[i]:3, ' ');
                Writeln(FileOut, '');
                Close(FileOut);
            end;
    end;
end;

Procedure ReceiveNewSourceArray(var IntermediateArray: array of Integer; var FirstSortingArray: array of Integer; SecondSortingArray: array of Integer; SizesOfFirstSortingArray: array of Integer; SizesOfFSecondSortingArray: array of Integer; NumberOfElements: Integer; var UserWay: Integer; var PathToFile: string);

var
    Counter, Index, i, j1, j2, z, EndNumber, SizeOfFirstSortingArray, SizeOfSecondSortingArray: Integer;

begin
    fillingSortingArrays(IntermediateArray, FirstSortingArray, SecondSortingArray, SizesOfFirstSortingArray, SizesOfFSecondSortingArray, NumberOfElements);
    Counter := FindNumberOfPairs(SizesOfFirstSortingArray, NumberOfElements);
    Index := 0;
    EndNumber := Counter - 1;
    for i := 0 to EndNumber do
    begin
        SizeOfFirstSortingArray := SizesOfFirstSortingArray[i];
        SizeOfSecondSortingArray := SizesOfFSecondSortingArray[i];
        j1 := Index;
        j2 := Index + SizeOfFirstSortingArray;
        z := Index;
        while (z < Index + SizeOfFirstSortingArray + SizeOfSecondSortingArray) do
        begin
            if ((j1 = Index + SizeOfFirstSortingArray) and (j2 <> Index + SizeOfFirstSortingArray + SizeOfSecondSortingArray)) then
            begin
                while (j2 < SizeOfFirstSortingArray + SizeOfSecondSortingArray + Index) do
                begin
                    IntermediateArray[z] := SecondSortingArray[j2];
                    Inc(z);
                    Inc(j2);
                end;
            end;
            if ((j2 = Index + SizeOfFirstSortingArray + SizeOfSecondSortingArray) and (j1 <> Index + SizeOfFirstSortingArray)) then
            begin
                while (j1 < SizeOfFirstSortingArray + Index) do
                begin
                    IntermediateArray[z] := FirstSortingArray[j1];
                    Inc(z);
                    Inc(j1)
                end
            end;
            if ((FirstSortingArray[j1] < SecondSortingArray[j2]) and (j2 < NumberOfElements) and (j1 < NumberOfElements) and (z < Index + SizeOfFirstSortingArray + SizeOfSecondSortingArray)) then
            begin
                IntermediateArray[z] := FirstSortingArray[j1];
                Inc(z);
                Inc(j1);
            end
            else
            begin
                if ((SecondSortingArray[j2] < FirstSortingArray[j1]) and (j2 < NumberOfElements) and (j1 < NumberOfElements) and (z < Index + SizeOfFirstSortingArray + SizeOfSecondSortingArray)) then
                begin
                    IntermediateArray[z] := SecondSortingArray[j2];
                    Inc(z);
                    Inc(j2)
                end
                else
                    if ((SecondSortingArray[j2] = FirstSortingArray[j1]) and (j2 < NumberOfElements) and (j1 < NumberOfElements) and (z < Index + SizeOfFirstSortingArray + SizeOfSecondSortingArray)) then
                    begin
                        IntermediateArray[z] := FirstSortingArray[j1];
                        Inc(z);
                        Inc(j1);
                        IntermediateArray[z] := SecondSortingArray[j2];
                        Inc(z);
                        Inc(j2);
                    end;
            end;
        end;
        Index := Index + SizeOfFirstSortingArray + SizeOfSecondSortingArray;
    end;
    PrintArray(IntermediateArray, UserWay, PathToFile);
end;

Procedure ReceieveWayOfOutput(var UserWay: Integer; var PathToFile: string);

const
    CONSOLE_WAY = 1;
    FILE_WAY = 2;

var
    FileOut: TextFile;

begin
    Writeln('Choose way of output:'#13#10'Type ''1'' if you want to print sorting and result in console.'#13#10'Type ''2'' if you want to print sorting and result in file.');
    UserWay := ChooseWayOfOutput();
    case UserWay of
        CONSOLE_WAY:
            begin
                Writeln('Sorting:');
            end;
        FILE_WAY:
            begin
                repeat
                    PathToFile := inputPathToFile();
                until (checkExtension(PathToFile) and checkPermissionForWriting(PathToFile));
                Assign(FileOut, PathToFile);
                Rewrite(FileOut);
                Writeln(FileOut, 'Sorting:');
                Close(FileOut);
            end;
    end;
end;

Procedure Sorting(var SourceArray: array of Integer; var SortedArray: array of Integer; NumberOfElements: Integer; var UserWay: Integer; var PathToFile: string);

var
   IntermediateArray, FirstSortingArray, SecondSortingArray, SizesOfFirstSortingArray, SizesOfFSecondSortingArray: array of Integer;
   HalfNumberOfElements: Integer;

begin;
    Setlength(IntermediateArray, NumberOfElements);
    Setlength(FirstSortingArray, NumberOfElements);
    Setlength(SecondSortingArray, NumberOfElements);
    HalfNumberOfElements := NumberOfELements div 2 + 1;
    Setlength(SizesOfFirstSortingArray, HalfNumberOfElements);
    Setlength(SizesOfFSecondSortingArray, HalfNumberOfElements);
    CreatingFirstF(IntermediateArray, SourceArray);
    while (not findConditionOfSorted(IntermediateArray)) do
    begin
        ReceiveNewSourceArray(IntermediateArray, FirstSortingArray, SecondSortingArray, SizesOfFirstSortingArray, SizesOfFSecondSortingArray, NumberOfElements, UserWay, PathToFile);
    end;
    CreatingSortedArray(SortedArray, IntermediateArray);
end;

Procedure main();

var
    NumberOfElements, i, UserWay: Integer;
    SourceArray, SortedArray: array of Integer;
    PathToFile: string;

begin
    Writeln('This program implements natural merge sorting.');
    NumberOfElements := ReceiveNumberOfElements(UserWay, PathToFile);
    Setlength(SourceArray, NumberOfElements);
    ReceiveSourceArray(SourceArray, NumberOfElements, UserWay, PathToFile);
    Setlength(SortedArray, NumberOfElements);
    ReceieveWayOfOutput(UserWay, PathToFile);
    Sorting(SourceArray, SortedArray, NumberOfElements, UserWay, PathToFile);
    PrintResult(SortedArray, UserWay, PathToFile);
    Readln;
end;

begin
    Main();
end.