Lab_2.4

Program Lab_2_4;

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

Uses
    System.SysUtils;

Type
    TMatrix = Array Of Array Of Integer;
    TArr = Array Of Integer;
    TBool = Array Of Array Of Boolean;

Procedure WriteTask();
Begin
    Writeln('Данная программа находит седловую точку квадратной матрицы');
End;

Function FileInputPath(IsFileForRead: Boolean): String;
Var
    Path: String;
    IsCorrect: Boolean;
    F: TextFile;
Begin
    If (IsFileForRead) Then
        Write ('Введите путь к файлу для чтения: ')
    Else
        Write ('Введите путь к файлу для записи: ');
    Repeat
        IsCorrect := True;
        Readln(Path);
        AssignFile(F, Path);
        If (IsCorrect) And (Not FileExists(Path)) Then
        Begin
            IsCorrect := False;
            Writeln ('Файл не найден. Повторите попытку...');
        End;
    Until (IsCorrect);
    FileInputPath := Path;
End;

Function FileInputMatrixOrder(Path: String): Integer;
Const
    MAX_ORDER = 10;
    MIN_ORDER = 2;
Var
    MatrixOrder: Integer;
    F: TextFile;
    IsCorrect: Boolean;
Begin
    Repeat
        AssignFile(F, Path);
        Reset(F);
        IsCorrect := True;
        Try
            Readln (F, MatrixOrder);
        Except
            Writeln ('Некорректно введённый порядок матрицы. Попробуйте снова');
            IsCorrect := False;
        End;
        If (IsCorrect) And ((MatrixOrder < MIN_ORDER) Or (MatrixOrder > MAX_ORDER)) Then
        Begin
            Writeln ('Порядок матрицы неверного диапазона!');
            IsCorrect := False;
        End;
    Until (IsCorrect);
    CloseFile(F);
    FileInputMatrixOrder := MatrixOrder;
End;

Procedure FileMatrixInput(Matrix: TMatrix; Path: String; Order: Integer);
Var
    I,J: Integer;
    F: TextFile;
    IsCorrect: Boolean;
Begin
    Repeat
        IsCorrect := True;
        AssignFile(F, Path);
        Reset(F);
        Readln(F);
        I := 0;
        While (IsCorrect) And (I < Order) Do
        Begin
            J := 0;
            While (IsCorrect) And (J < Order) Do
            Begin
                Try
                    Read(F, Matrix[I][J]);
                Except
                    Writeln('Некорректное значение элемента матрицы');
                    IsCorrect := False;
                    Dec(I);
                End;
                Inc(J);
            End;
            Inc(I);
        End;
    Until (IsCorrect);
End;

Function ConsoleInputMatrixOrder(): Integer;
Const
    MIN_ORDER = 2;
    MAX_ORDER = 10;
Var
    Order: Integer;
    IsCorrect: Boolean;
Begin
    Repeat
        Writeln ('Введите порядок квадратной матрицы');
        IsCorrect := True;
        Try
            Readln (Order);
        Except
            Writeln ('Ошибка ввода! Повторите попытку...');
            IsCorrect := False;
        End;
        If ((IsCorrect) And ((Order < MIN_ORDER) Or (Order > MAX_ORDER))) Then
        Begin
            Writeln ('Ошибка ввода! Проверьте, входит ли введённое значение в допустимый диапазон и повторите попытку...');
            IsCorrect := False;
        End;
    Until (IsCorrect);
    ConsoleInputMatrixOrder := Order;
End;

Function ConsoleMatrixCreation(Order: Integer): TMatrix;
Const
    MIN_ELEMENT = -2147483648;
    MAX_ELEMENT = 2147483648;
Var
    I, J: Integer;
    IsCorrect: Boolean;
    Matrix: TMatrix;
Begin
    SetLength (Matrix, Order, Order);
    For I := 0 To High(Matrix) Do
        For J := 0 To High(Matrix) Do
            Repeat
                Writeln ('Введите ', (J + 1), ' элемент ', (I + 1), ' строки');
                IsCorrect := True;
                Try
                    Readln (Matrix[I][J]);
                Except
                    Writeln ('Ошибка ввода! Повторите попытку...');
                    IsCorrect := False;
                End;
                If ((IsCorrect) And ((Matrix[I][J] < MIN_ELEMENT) Or (Matrix[I][J] > MAX_ELEMENT))) Then
                Begin
                    Writeln ('Ошибка ввода! Введено число неверного диапазона');
                    IsCorrect := False;
                End;
            Until (IsCorrect);
    ConsoleMatrixCreation := Matrix;
End;

Procedure ConsolMatrixOutput(Matrix: TMatrix; Order: Integer);
Var
    I, J: Integer;
Begin
    Writeln ('Исходная матрица:');
    For I := 0 To High(Matrix) Do
    Begin
        For J := 0 To High(Matrix) Do
            Write (Matrix[I][J], ' ');
        Writeln;
    End;
End;

Function SmallestElementsInLine(Matrix: TMatrix; Order: Integer): TArr;
Var
    I, J, Min: Integer;
    MinIndexes: TArr;
Begin
    SetLength (MinIndexes, Order);
    For I := 0 To High(Matrix) Do
    Begin
        Min := Matrix[I][0];
        MinIndexes[I] := 0;
        For J := 1 To High(Matrix) Do
            If (Matrix[I][J] <= Min) Then
            Begin
                Min := Matrix[I][J];
                MinIndexes[I] := J;
            End;
    End;
    SmallestElementsInLine := MinIndexes;
End;

Function LargestElementsInColumn(Matrix: TMatrix; Order: Integer): TArr;
Var
    I, J, Max: Integer;
    MaxIndexes: TArr;
Begin
    SetLength (MaxIndexes, Order);
    For J := 0 To High(Matrix) Do
    Begin
        Max := Matrix[0][J];
        MaxIndexes[J] := 0;
        For I := 1 To High(Matrix) Do
            If (Matrix[I][J] >= Max) Then
            Begin
                Max := Matrix[I][J];
                MaxIndexes[J] := I;
            End;
    End;
    LargestElementsInColumn := MaxIndexes;
End;

Function FindingMatrixSaddlePoints(Matrix: TMatrix; Order: Integer): TBool;
Var
    MaxElemIndexes, MinElemIndexes: TArr;
    SaddlePoints: TBool;
    I, J: Integer;
Begin
    SetLength (SaddlePoints, Order, Order);
    MinElemIndexes := SmallestElementsInLine(Matrix, Order);
    MaxElemIndexes := LargestElementsInColumn(Matrix, Order);
    For I := 0 To High(Matrix) Do
    Begin
        For J := 0 To High(Matrix) Do
        Begin
            If (MinElemIndexes[I] = J) And (MaxElemIndexes[J] = I) Then
                SaddlePoints[I][J] := True;
        End;
    End;
    FindingMatrixSaddlePoints := SaddlePoints;
End;

Procedure FileSaddlePointsOutput(Matrix: TMatrix; Order: Integer);
Var
    Path: String;
    IsFileForRead: Boolean;
    IsSaddlePoint: TBool;
    I, J, CountNotSaddle: Integer;
    F: TextFile;
Begin
    IsFileForRead := False;
    Path := FileInputPath(IsFileForRead);
    IsSaddlePoint := FindingMatrixSaddlePoints(Matrix, Order);
    AssignFile(F, Path);
    ReWrite(F);
    Write (F, 'Седловая точка матрицы: ');
    For I := 0 To High(Matrix) Do
        For J := 0 To High(Matrix) Do
            If (IsSaddlePoint[I][J]) Then
                Writeln (F, Matrix[I][J])
            Else
                Inc(CountNotSaddle);
    If  (CountNotSaddle = (Order + 1) * (Order + 1)) Then
        Writeln (F, 'Такой нет');
    CloseFile(F);
    Writeln ('Седловая точка матрицы записана в файл');
End;

Procedure ConsoleSaddlePointsOutput(Matrix: TMatrix; Order: Integer);
Var
    I, J, CountNotSaddle: Integer;
    SaddleElements: TBool;
Begin
    SaddleElements := FindingMatrixSaddlePoints(Matrix, Order);
    Writeln ('Седловая точка матрицы:');
    For I := 0 To High(Matrix) Do
        For J := 0 To High(Matrix) Do
            If (SaddleElements[I][J]) Then
                Writeln (Matrix[I][J])
            Else
                Inc(CountNotSaddle);
    If (CountNotSaddle = (Order) * (Order)) Then
        Writeln ('Такой нет');
End;

Procedure ConsoleChoice();
Var
    Order: Integer;
    Matrix: TMatrix;
    Saddles: TBool;
Begin
    Order := ConsoleInputMatrixOrder();
    Matrix := ConsoleMatrixCreation(Order);
    ConsolMatrixOutput(Matrix, Order);
    Saddles := FindingMatrixSaddlePoints(Matrix, Order);
    ConsoleSaddlePointsOutput(Matrix, Order);
End;

Procedure FileChoice();
Var
    Matrix: TMatrix;
    Path: String;
    Order, Choice: Integer;
    PathForRead, IsCorrect: Boolean;
    Saddles: TBool;
Begin
    PathForRead := True;
    Path := FileInputPath(PathForRead);
    Order := FileInputMatrixOrder(Path);
    SetLength(Matrix, Order, Order);
    FileMatrixInput(Matrix, Path, Order);
    Saddles := FindingMatrixSaddlePoints(Matrix, Order);
    Writeln ('Введите число, чтобы выбрать способ вывода решения задания: 1 - через консоль, 2 - через файл');
    Repeat
        IsCorrect := True;
        Try
            Readln(Choice);
        Except
            Writeln ('Число введено некорректно. Повторите попытку...');
            IsCorrect := False;
        End;
        If (IsCorrect) And (Choice <> 1) And (Choice <> 2) Then
        Begin
            Writeln ('Введите либо 1, либо 2. Ваш выбор: ');
            IsCorrect := False;
        End;
    Until (IsCorrect);
    If (Choice = 1) Then
        ConsoleSaddlePointsOutput(Matrix, Order)
    Else
        FileSaddlePointsOutput(Matrix, Order);
End;

Procedure Solution();
Var
    Choice: Integer;
    IsCorrect: Boolean;
Begin
    Writeln ('Введите число, чтобы выбрать способ решения задания: 1 - через консоль, 2 - через файл');
    Repeat
        IsCorrect := True;
        Try
            Readln(Choice);
        Except
            Writeln ('Число введено некорректно. Повторите попытку...');
            IsCorrect := False;
        End;
        If (IsCorrect) And (Choice <> 1) And (Choice <> 2) Then
        Begin
            Writeln ('Введите либо 1, либо 2. Ваш выбор: ');
            IsCorrect := False;
        End;
    Until (IsCorrect);
    If (Choice = 1) Then
        ConsoleChoice()
    Else
        FileChoice();
End;

Begin
    WriteTask();
    Solution();
    Readln;
End.