Lab2_3

Program Lab2_3;

Uses
    System.SysUtils;

Type
    TBool = Array Of Array Of Boolean;
    TMass = Array Of Array Of Double;
    TErrorCode = (CORRECT,
        INCORRECT_CHOICE,
        NON_NUMERIC,
        OUT_OF_RANGE,
        FILE_NOT_TXT,
        FILE_NOT_EXIST,
        FILE_NOT_READABLE,
        FILE_NOT_WRITABLE,
        FILE_IS_EMPTY,
        READING_GO_WRONG,
        FILE_NOT_FULL);

Const
    MIN_ARR = 2;
    MAX_ARR = 20;
    MAX_OPTION = 2;
    MIN_COUNT = -999.999;
    MAX_COUNT = 999.999;
    Err: Array [TErrorCode] Of String = ('',
        'Error. Incorrect choice. Please try again. ',
        'Error. Non-numeric value. Please try again. ',
        'Error. Out of Range. Please try again. ',
        'Error. File not .txt. Please try again',
        'Error. File not Exist. Please try again.',
        'Error. File not readable. Please try again.',
        'Error. File not writable. Please try again.',
        'Error. File is empty. Please try again.',
        'Error. Reading go wrong. Please try again.',
        'Error. The file lacks sufficient information . Please try again. ');

Procedure ProgramTask();
Begin
    Writeln('This program find �saddle point� of the given matrix');
End;

Function GetExtention(Var Str: String; PosStart, PosEnd: Integer): String;
Var
    I: Integer;
    PartStr: String;
Begin
    PartStr := '';
    For I := PosStart To PosEnd Do
        PartStr := PartStr + Str[I];
    GetExtention := PartStr;
End;

Function IsFileTxt(PathToFile: String): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := CORRECT;
    If (Length(PathToFile) < 5) Or (GetExtention(PathToFile, Length(PathToFile) - 3, Length(PathToFile)) <> '.txt') Then
        Error := FILE_NOT_TXT;
    IsFileTxt := Error;
End;

Function IsFileExist(PathToFile: String): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := CORRECT;
    If Not FileExists(PathToFile) Then
        Error := FILE_NOT_EXIST;
    IsFileExist := Error;
End;

Function IsFileReadble(Var FileName: TextFile): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := CORRECT;
    Try
        Reset(FileName);
    Except
        Error := FILE_NOT_EXIST
    End;
    IsFileReadble := Error;
End;

Function IsFileWritable(Var FileName: TextFile): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := CORRECT;
    Try
        Append(FileName);
    Except
        Error := FILE_NOT_WRITABLE;
    End;
    IsFileWritable := Error;
End;

Procedure GetFileNormalReading(Var FileName: TextFile);
Var
    Error: TErrorCode;
    PathToFile: String;
Begin
    Repeat
        Readln(PathToFile);
        Error := IsFileTxt(PathToFile);
        If Error = CORRECT Then
        Begin
            Error := IsFileExist(PathToFile);
            AssignFile(FileName, PathToFile);
        End;
        If Error = CORRECT Then
            Error := IsFileReadble(FileName);
        If (Error = CORRECT) And (EOF(FileName)) Then
            Error := FILE_IS_EMPTY;
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Procedure GetFileNormalWriting(Var FileName: TextFile);
Var
    Error: TErrorCode;
    PathToFile: String;
Begin
    Repeat
        Readln(PathToFile);
        Error := IsFileTxt(PathToFile);
        If Error = CORRECT Then
        Begin
            Error := IsFileExist(PathToFile);
            AssignFile(FileName, PathToFile);
        End;
        If Error = CORRECT Then
            Error := IsFileWritable(FileName);
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Function MatrixSetingFile(Var FileName: TextFile; Var Matrix: TMass): TErrorCode;
Var
    Error: TErrorCode;
    Rows, Cols: Integer;
Begin
    Rows := 0;
    Cols := 0;
    Writeln('Reading setings of matrix...');
    Error := CORRECT;
    Try
        Read(FileName, Rows);
        Read(FileName, Cols);
    Except
        Error := READING_GO_WRONG;
    End;
    If EOF(FileName) Then
        Error := FILE_NOT_FULL;
    If (Error = CORRECT) And ((Rows < MIN_ARR) Or (Rows > MAX_ARR) Or (Cols < MIN_ARR) Or (Cols > MAX_ARR)) Then
        Error := OUT_OF_RANGE;
    If Error = CORRECT Then
        SetLength(Matrix, Rows, Cols);

    MatrixSetingFile := Error;
End;

Procedure MatrixSettingConsole(Var Matrix: TMass; Var Rows, Cols: Integer);
Var
    Error: TErrorCode;
Begin
    Repeat
        Error := CORRECT;
        Writeln('Please write size of matrix through the space in the range ', MIN_ARR, ' .. ', MAX_ARR);
        Try
            Readln(Rows, Cols);
        Except
            Error := NON_NUMERIC;
        End;
        If (Error = CORRECT) And ((Rows < MIN_ARR) Or (Rows > MAX_ARR) Or (Cols < MIN_ARR) Or (Cols > MAX_ARR)) Then
            Error := OUT_OF_RANGE;
        If Error <> CORRECT Then
            Write(ERR[Error]);
    Until Error = CORRECT;
    SetLength(Matrix, Rows, Cols);
End;

Procedure ReadMatrixFromFile(Var Matrix: TMass);

Var
    FileName: TextFile;
    Error: TErrorCode;
    I, J: Integer;
Begin
    Repeat
        WriteLn('Enter the path to the file with extension ".txt" with matrix length and High from ', MIN_ARR, ' .. ', MAX_ARR);
        GetFileNormalReading(FileName);
        Error := MatrixSetingFile(FileName, Matrix);
        If Error = CORRECT Then
            For I := 0 To High(Matrix) Do
                For J := 0 To High(Matrix[I]) Do
                    If Not EOF(FileName) Then
                    Begin
                        Try
                            Read(FileName, Matrix[I][J]);
                        Except
                            Error := READING_GO_WRONG;
                        End;
                    End
                    Else
                        Error := FILE_NOT_FULL;

        If Error <> CORRECT Then
            WriteLn(ERR[Error]);
            CloseFile(FileName);
    Until Error = CORRECT;
End;

Procedure ReadColsFromConsole(Var Matrix: TMass; Const I: Integer);
Var
    Error: TErrorCode;
    J: Integer;
    Num: Double;
Begin
    WriteLn('Please enter the col ', I, ' through the space in the range ', MIN_COUNT:7:2, ' .. ', MAX_COUNT:7:2);
    Num := 0;

    For J := 0 To High(Matrix[I]) Do
        Repeat
            Error := CORRECT;
            Try
                Read(Num);
            Except
                Error := NON_NUMERIC;
            End;
            If (Error = CORRECT) And ((Num < MIN_COUNT) Or (Num > MAX_COUNT)) Then
                Error := OUT_OF_RANGE;
            If Error = CORRECT Then
                Matrix[I][J] := Num
            Else
                WriteLn(ERR[Error]);
        Until Error = CORRECT;
End;

Procedure ReadMatrixFromConsole(Var Matrix: TMass);
Var
    I, Rows, Cols: Integer;
Begin
    Rows := 0;
    Cols := 0;
    MatrixSettingConsole(Matrix, Rows, Cols);
    Writeln('Matrix size [', Rows, ',', Cols, ']');
    For I := 0 To High(Matrix) Do
        ReadColsFromConsole(Matrix, I);
End;

Function OptionRead(): Integer;
Var
    Error: TErrorCode;
    Option: Integer;
Begin
    Option := 0;
    Repeat
        Error := CORRECT;
        Try
            Readln(Option);
        Except
            Error := NON_NUMERIC;
        End;
        If (Error = CORRECT) And ((Option < 1) Or (Option > MAX_OPTION)) Then
            Error := INCORRECT_CHOICE;
        If Error <> CORRECT Then
            Write(ERR[Error]);
    Until Error = CORRECT;
    OptionRead := Option;
End;

Procedure OptionHowToRead(Var Matrix: TMass);
Var
    Option: Integer;
Begin
    Writeln('If you want to read from console enter: 1');
    Writeln('If you want to read from File enter:    2');
    Option := OptionRead();
    If Option = 2 Then
        ReadMatrixFromFile(Matrix)
    Else
        ReadMatrixFromConsole(Matrix);
End;

Function FindMinRowCoord(Const Matrix: TMass): Tbool;
Var
    I, J, Count, Col: Integer;
    Min: Double;
    Rmins: TBool;
Begin
    SetLength(Rmins, Length(Matrix), Length(Matrix[0]));
    For I := 0 To High(Matrix) Do
    Begin
        Col := 0;
        Min := Matrix[I][0];
        Count := 0;
        For J := 0 To High(Matrix[I]) Do
            If Matrix[I][J] < Min Then
            Begin
                Min := Matrix[I][J];
                Count := 1;
                Col := J;
            End
            Else
                If Matrix[I][J] = Min Then
                Begin
                    Inc(Count);
                End;
        Rmins[I][Col] := Count = 1;
    End;
    FindMinRowCoord := Rmins;
End;

Function FindMaxColCoord(Const Matrix: TMass): TBool;
Var
    I, J, Count, Row: Integer;
    Max: Double;
    Cmaxs: TBool;
Begin
    SetLength(Cmaxs, Length(Matrix), Length(Matrix[0]));
    For J := 0 To High(Matrix[0]) Do
    Begin
        Row := 0;
        Max := Matrix[0][J];
        Count := 0;
        For I := 0 To High(Matrix) Do
            If Matrix[I][J] > Max Then
            Begin
                Max := Matrix[I][J];
                Count := 1;
                Row := I;
            End
            Else
                If Matrix[I][J] = Max Then
                    Inc(Count);
        Cmaxs[Row][J] := Count = 1
    End;
    FindMaxColCoord := Cmaxs;
End;

Function FindSaddlePoint(Var Matrix: TMass; Var Row, Col: Integer): Double;
Var
    I, J: Integer;
    Saddle: Double;
    Rmins, Cmaxs: TBool;

Begin
    Rmins := FindMinRowCoord(Matrix);
    Cmaxs := FindMaxColCoord(Matrix);
    Saddle := 0;
    For I := 0 To High(Matrix) Do
        For J := 0 To High(Matrix[I]) Do
            If Rmins[I][J] And Cmaxs[I][J] Then
            Begin
                Saddle := Matrix[I][J];
                Row := I;
                Col := J;
            End;
    FindSaddlePoint := Saddle;
End;

Procedure PrintConsole(Const Row, Col: Integer; Const Answer: Double);
Begin
    If (Row <> -1) And (Col <> -1) Then
        WriteLn('Saddle point found at (', Row, ',', Col, ') with value: ', Answer:7:5)
    Else
        WriteLn('No saddle point found');
End;

Procedure PrintFile(Const Row, Col: Integer; Const Answer: Double);
Var

    FileName: TextFile;
Begin
    WriteLn('Enter the path to the file with extension ".txt" to get answer: ');
    GetFileNormalWriting(FileName);
    Writeln(FileName);
    If (Row <> -1) And (Col <> -1) Then
        Write(FileName, 'Saddle point found at (', Row, ',', Col, ') with value: ', Answer:7:5)
    Else
        Write(FileName, 'No saddle point found');
    CloseFile(FileName);
End;

Procedure PrintAnswer(Const Row, Col: Integer; Const Answer: Double);
Var
    Option: Integer;
Begin
    Writeln('If you want to print answer in console enter: 1');
    Writeln('If you want to print answer in File enter:    2');
    Option := OptionRead();
    If Option = 2 Then
        PrintFile(Row, Col, Answer)
    Else
        PrintConsole(Row, Col, Answer);
End;

Var
    Row, Col: Integer;
    Matrix: TMass;
    Answer: Double;

Begin
    Row := -1;
    Col := -1;
    ProgramTask();
    OptionHowToRead(Matrix);
    Answer := FindSaddlePoint(Matrix, Row, Col);
    PrintAnswer(Row, Col, Answer);
    Writeln('Press Enter to exit');
    Readln;

End.