lab24

Program Lab24;

Uses
    SysUtils;

Const
    MIN_C = 1;
    MAX_C = 2;
    MIN_SIZE = 1;
    MAX_SIZE = 50;
    MIN_A = -1000;
    MAX_A = 1000;

Type
    TArray = Array Of Integer;

Function InputInteger(Const MIN, MAX: Integer): Integer;
Var
    N: Integer;
    IsCorrect: Boolean;
Begin
    N := 0;
    Repeat
        IsCorrect := True;
        WriteLn('Введите значение: ');
        Try
            ReadLn(N);
        Except
            IsCorrect := False;
            WriteLn('Некорректный ввод.');
        End;

        If IsCorrect And ((N < MIN) Or (N > MAX)) Then
        Begin
            WriteLn('Введите корректное значение.');
            IsCorrect := False;
        End;
    Until IsCorrect;
    InputInteger := N;
End;

Function IsFileExists(Const FileName: String): Boolean;
Begin
    IsFileExists := FileExists(FileName);
    If Not FileExists(FileName) Then
        WriteLn('Файл не существует.');
End;

Function IsFileTxt(Const FileName: String): Boolean;
Var
    FileType: String;
Begin
    If (Length(FileName) > 4) Then
    Begin
        FileType := FileName.SubString(FileName.Length - 4);
        If (FileType = '.txt') Then
            IsFileTxt := True
        Else
        Begin
            WriteLn('Файл не является текстовым. ');
            IsFileTxt := False;
        End;
    End
    Else
    Begin
        WriteLn('Введите корректное имя файла. ');
        IsFileTxt := False;
    End;
End;

Function IsFileNotEmpty(Var MyFile: TextFile): Boolean;
Var
    IsNotEmpty: Boolean;
Begin
    Try
        Try
            Reset(MyFile);
            IsNotEmpty := Not Eof(MyFile);
            If (Not IsNotEmpty) Then
                WriteLn('Этот файл пустой. ');
        Except
            WriteLn('Непредвиденная ошибка.');
            IsNotEmpty := False;
        End;
    Finally
        CloseFile(MyFile);
    End;
    IsFileNotEmpty := IsNotEmpty;
End;

Function IsFileWritable(Var MyFile: TextFile): Boolean;
Begin
    IsFileWritable := True;
    Try
        Rewrite(MyFile);
    Except
        IsFileWritable := False;
        WriteLn('Этот файл невозможно открыть для записи.');
    End;
End;

Function IsFileReadable(Var MyFile: TextFile): Boolean;
Begin
    IsFileReadable := True;
    Try
        Reset(MyFile);
    Except
        IsFileReadable := False;
        WriteLn('Этот файл невозможно открыть для чтения.');
    End;

End;

Function RequestFileNameForReading(Var MyFile: TextFile): String;
Var
    FileName: String;
    IsCorrect: Boolean;
Begin
    Repeat
        WriteLn('Введите имя файла с путём:');
        ReadLn(FileName);
        AssignFile(MyFile, FileName);
        IsCorrect := IsFileExists(FileName) And IsFileTxt(FileName) And IsFileReadable(MyFile) And IsFileNotEmpty(MyFile);
    Until IsCorrect;
    RequestFileNameForReading := FileName;
End;

Function RequestFileNameForWriting(Var MyFile: TextFile): String;
Var
    FileName: String;
    IsCorrect: Boolean;
Begin
    Repeat
        WriteLn('Введите имя файла с путём: ');
        ReadLn(FileName);
        AssignFile(MyFile, FileName);
        IsCorrect := IsFileExists(FileName) And IsFileTxt(FileName) And IsFileWritable(MyFile);
    Until IsCorrect;
    RequestFileNameForWriting := FileName;
End;

Procedure CreateArray(N: Integer; Var Arr: TArray);
Var
    I: Integer;
    IsCorrect: Boolean;
Begin
    SetLength(Arr, N);
    For I := 0 To High(Arr) Do
    Begin
        Repeat
            IsCorrect := True;
            Write('Введите ', I + 1, ' элемент массива: ');
            Try
                ReadLn(Arr[I]);
            Except
                IsCorrect := False;
                WriteLn('Некорректный ввод. Введите число.');
            End;

            If IsCorrect And (((Arr[I] < MIN_A) Or (Arr[I] > MAX_A)) Or ((I > 0) And (Arr[I] < Arr[I - 1]))) Then
            Begin
                WriteLn('Некорректный ввод данных. Массив должен быть упорядочен по возрастанию.', #13#10, 'Диапазон значений от ', MIN_A,
                    ' до ', MAX_A, '. ');
                IsCorrect := False;
            End;

        Until IsCorrect;
    End;
End;

Function InputSizeFromFile(Var Size: Integer; Var MyFile: TextFile): Boolean;
Var
    IsCorrect: Boolean;
Begin
    IsCorrect := True;
    Size := 0;
    Try
        ReadLn(MyFile, Size);
    Except
        Writeln('Ошибка в строке с размером. Некорректный размер массива.');
        IsCorrect := False;
    End;

    If IsCorrect And ((Size < MIN_SIZE) Or (Size > MAX_SIZE)) Then
    Begin
        Writeln('Размер не входит в диапазон от ', MIN_SIZE, ' до ', MAX_SIZE, '.');
        IsCorrect := False;
    End;
    InputSizeFromFile := IsCorrect;
End;

Function ReadArray(Var MyFile: TextFile; Var Arr: TArray; Const Size: Integer): Boolean;
Var
    I: Integer;
    IsCorrect: Boolean;
Begin
    SetLength(Arr, Size);
    IsCorrect := True;
    Try
        For I := 0 To High(Arr) Do
        Begin
            Read(MyFile, Arr[I]);
            If (Arr[I] < MIN_A) Or (Arr[I] > MAX_A) Then
                IsCorrect := False;
        End;
        If Not IsCorrect Then
            WriteLn('Элементы массива выходят за диапазон допустимых значений.');
    Except
        Writeln('Непредвиденная ошибка. Проверьте корректность данных.');
        IsCorrect := False;
    End;
    ReadArray := IsCorrect;
End;

Function IsArrayIncreasing(Arr: TArray): Boolean;
Var
    I: Integer;
    IsIncreasing: Boolean;
Begin
    IsIncreasing := True;
    For I := 1 To High(Arr) Do
    Begin
        If Arr[I] < Arr[I - 1] Then
        Begin
            IsIncreasing := False;
        End;
    End;
    If Not IsIncreasing Then
        WriteLn('Массивы должны быть упорядочены по возрастанию.');
    IsArrayIncreasing := IsIncreasing;
End;

Function InputArgumentsFromFileForArrA(Var MyFile: TextFile; Const Path: String; Var N: Integer; Var Arr: TArray): Boolean;
Var
    IsCorrect: Boolean;
Begin
    IsCorrect := True;
    Try
        Try
            Reset(MyFile);
        Except
            WriteLn('Непредвиденная ошибка');
            IsCorrect := False;
        End;
        If IsCorrect Then
        Begin
            IsCorrect := InputSizeFromFile(N, MyFile);
            If IsCorrect Then
            Begin
                ReadLn(MyFile);
                IsCorrect := ReadArray(MyFile, Arr, N);
                If IsCorrect Then
                    IsCorrect := IsArrayIncreasing(Arr);
            End;
        End;
    Finally
        CloseFile(MyFile);
    End;
    InputArgumentsFromFileForArrA := IsCorrect;
End;

Function InputArgumentsFromFileForArrB(Var MyFile: TextFile; Const Path: String; Var N: Integer; Var Arr: TArray): Boolean;
Var
    IsCorrect: Boolean;
Begin
    IsCorrect := True;
    Try
        Try
            Reset(MyFile);
        Except
            WriteLn('Непредвиденная ошибка');
            IsCorrect := False;
        End;
        If IsCorrect Then
        Begin
            ReadLn(MyFile);
            IsCorrect := InputSizeFromFile(N, MyFile);
            If IsCorrect Then
            Begin
                ReadLn(MyFile);
                IsCorrect := ReadArray(MyFile, Arr, N);
                If IsCorrect Then
                    IsCorrect := IsArrayIncreasing(Arr);
            End;
        End;
    Finally
        CloseFile(MyFile);
    End;
    InputArgumentsFromFileForArrB := IsCorrect;
End;

Function CountSizeOfArrC(ArrA: TArray; ArrB: TArray): Integer;
Var
    I, J, Count: Integer;
Begin
    Count := 0;
    J := 0;
    For I := 0 To High(ArrA) Do
    Begin
        If (I = 0) Or (ArrA[I] <> ArrA[I - 1]) Then
        Begin
            While (J <= High(ArrB)) And (ArrB[J] < ArrA[I]) Do
            Begin
                If (J = 0) Or (ArrB[J] <> ArrB[J - 1]) Then
                    Inc(Count);
                Inc(J);
            End;
            If (J > High(ArrB)) Or (ArrA[I] <> ArrB[J]) Then
                Inc(Count);
        End;
    End;
    For J := J To High(ArrB) Do
    Begin

        If (J = 0) Or (ArrB[J] <> ArrB[J - 1]) Then
            Inc(Count);
    End;
    CountSizeOfArrC := Count;
End;

Procedure MergeArrays(Var ArrA: TArray; Var ArrB: TArray; Var ArrC: TArray; Const K: Integer);
Var
    I, J, Index: Integer;
Begin
    Index := 0;
    J := 0;
    I := 0;
    SetLength(ArrC, K);
    While (I <= High(ArrA)) And (J <= High(ArrB)) Do
    Begin
        If ArrA[I] < ArrB[J] Then
        Begin
            If (Index = 0) Or (ArrC[Index - 1] <> ArrA[I]) Then
            Begin
                ArrC[Index] := ArrA[I];
                Inc(Index);
            End;
            Inc(I);
        End
        Else
            If ArrA[I] > ArrB[J] Then
            Begin
                If (Index = 0) Or (ArrC[Index - 1] <> ArrB[J]) Then
                Begin
                    ArrC[Index] := ArrB[J];
                    Inc(Index);
                End;
                Inc(J);
            End
            Else
            Begin
                If (Index = 0) Or (ArrC[Index - 1] <> ArrA[I]) Then
                Begin
                    ArrC[Index] := ArrA[I];
                    Inc(Index);
                End;
                Inc(I);
                Inc(J);
            End;
    End;
    While I <= High(ArrA) Do
    Begin
        If (Index = 0) Or (ArrC[Index - 1] <> ArrA[I]) Then
        Begin
            ArrC[Index] := ArrA[I];
            Inc(Index);
        End;
        Inc(I);
    End;
    While J <= High(ArrB) Do
    Begin
        If (Index = 0) Or (ArrC[Index - 1] <> ArrB[J]) Then
        Begin
            ArrC[Index] := ArrB[J];
            Inc(Index);
        End;
        Inc(J);
    End;
End;

Procedure PrintToConsole(Const Arr: TArray);
Var
    I: Integer;
Begin
    For I := 0 To High(Arr) Do
        Write(Arr[I], ' ');
End;

Function PrintToFile(Var MyFile: TextFile; Const Arr: TArray): Boolean;
Var
    I: Integer;
    IsCorrect: Boolean;
Begin
    IsCorrect := True;
    Try
        Try
            Rewrite(MyFile);
            For I := 0 To High(Arr) Do
                Write(MyFile, Arr[I], ' ');
            WriteLn('Результат выведен в файле.');
        Except
            WriteLn('Непредвиденная ошибка.');
            IsCorrect := False;
        End;
    Finally
        CloseFile(MyFile);
    End;
    PrintToFile := IsCorrect;
End;

Var
    N, M, K, Choice: Integer;
    IsCorrect: Boolean;
    ArrA, ArrB, ArrC: TArray;
    MyFile: TextFile;
    MyFileName: String;

Begin
    N := 0;
    WriteLn('Данная программа выполняет слияние двух упорядоченных по возрастанию массивов целых чисел в один упорядоченный массив (без повторений).',
        #13#10, 'Диапазон размеров массивов: ', MIN_SIZE, '...', MAX_SIZE, #13#10, 'Диапазон для значений элементов массива: ', MIN_A,
        '...', MAX_A, #13#10, 'При работе с файлом в нём сначала должны быть прописаны размеры массивов, а затем сами массивы.', #13#10,
        'Откуда Вы хотите вводить данные?', #13#10, '1 - консоль, 2 - файл.');
    Choice := InputInteger(MIN_C, MAX_C);
    If (Choice = 1) Then
    Begin
        WriteLn('Введите размер массива A.');
        N := InputInteger(MIN_SIZE, MAX_SIZE);
        CreateArray(N, ArrA);
        WriteLn('Введите размер массива B.');
        M := InputInteger(MIN_SIZE, MAX_SIZE);
        CreateArray(M, ArrB);
    End
    Else
    Begin
        Repeat
            MyFileName := RequestFileNameForReading(MyFile);
            IsCorrect := InputArgumentsFromFileForArrA(MyFile, MyFileName, N, ArrA) And
                InputArgumentsFromFileForArrB(MyFile, MyFileName, M, ArrB);
        Until IsCorrect;
    End;
    K := CountSizeOfArrC(ArrA, ArrB);
    MergeArrays(ArrA, ArrB, ArrC, K);
    WriteLn('Куда Вы хотите выводить результат?', #13#10, '1 - консоль, 2 - файл.');
    Choice := InputInteger(MIN_C, MAX_C);
    If (Choice = 1) Then
    Begin
        PrintToConsole(ArrC);
    End
    Else
    Begin
        Repeat
            MyFileName := RequestFileNameForWriting(MyFile);
            IsCorrect := PrintToFile(MyFile, ArrC);
        Until IsCorrect;
    End;
    ReadLn;

End.