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;

Function FileMatrixInput(Matrix: TMatrix; Path: String; Order: Integer): TMatrix;
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;

Procedure FindingMatrixSaddlePoints(Matrix: TMatrix; Order, SaddlePoint: Integer; IsSaddlePoint: Boolean);
Var
    MaxElemIndexes, MinElemIndexes: TArr;
    I, J: Integer;
Begin
    IsSaddlePoint := False;
    MinElemIndexes := SmallestElementsInLine(Matrix, Order);
    MaxElemIndexes := LargestElementsInColumn(Matrix, Order);
    For I := 0 To High(Matrix) Do
        For J := 0 To High(Matrix) Do
            If (MinElemIndexes[I] = J) And (MaxElemIndexes[J] = I) Then
            Begin
                SaddlePoint := Matrix[I][J];
                IsSaddlePoint := True;
            End;
End;

Function FileChoice(): TMatrix;
Var
    Path: String;
    Matrix: TMatrix;
    Order: Integer;
    PathForRead: Boolean;
Begin
    PathForRead := True;
    Path := FileInputPath(PathForRead);
    Order := FileInputMatrixOrder(Path);
    SetLength(Matrix, Order, Order);
    FileMatrixInput(Matrix, Path, Order);
    FileChoice := Matrix;
End;

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

Function ConsoleChoice(): TMatrix;
Var
    Order, SaddlePoint: Integer;
    Matrix: TMatrix;
Begin
    Order := ConsoleInputMatrixOrder();
    Matrix := ConsoleMatrixCreation(Order);
    ConsolMatrixOutput(Matrix, Order);
    ConsoleChoice := Matrix;
End;

Procedure ConsoleSaddlePointsOutput(IsConsoleWay: Boolean; Matrix: TMatrix);
Var
    I, J, SaddlePoint, Order: Integer;
    IsSaddlePoint, IsFileForRead: Boolean;
    Path: String;
Begin
    Order := High(Matrix) + 1;
    If (IsConsoleWay) Then
    Begin
        FindingMatrixSaddlePoints(Matrix, Order, SaddlePoint, IsSaddlePoint);
        If (IsSaddlePoint) Then
        Write ('Седловая точка матрицы: ', SaddlePoint)
    Else
        Write ('Седловой точки нет');
    End
    Else
    Begin
        FindingMatrixSaddlePoints(Matrix, Order, SaddlePoint, IsSaddlePoint);
        If (IsSaddlePoint) Then
        Write ('Седловая точка матрицы: ', SaddlePoint)
        Else
        Write ('Седловой точки нет');
    End;
End;

Function ChooseOutputMethod(): Integer;
Var
    IsCorrect: Boolean;
    Choice: Integer;
Begin
    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);
    ChooseOutputMethod := Choice;
End;

Procedure Solution();
Var
    Path: String;
    Matrix: TMatrix;
    Choice: Integer;
    IsCorrect, IsConsoleWay, PathForRead: Boolean;
Begin
    Writeln ('Введите число, чтобы выбрать способ решения задания: 1 - через консоль, 2 - через файл');
    Choice := ChooseOutputMethod();
    If (Choice = 1) Then
    Begin
        IsConsoleWay := True;
        Matrix := ConsoleChoice();
        ConsoleSaddlePointsOutput(IsConsoleWay, Matrix);
    End
    Else
    Begin
        Matrix := FileChoice();
        Writeln ('Введите число, чтобы выбрать способ вывода решения задания: 1 - через консоль, 2 - через файл');
        Choice := ChooseOutputMethod();
        If (Choice = 1) Then
        Begin
            IsConsoleWay := False;
            ConsoleSaddlePointsOutput(IsConsoleWay, Matrix);
        End
        Else
            FileSaddlePointsOutput(Matrix);
    End;
End;

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