Lab2_3

Program Lab2_3;

Uses
    System.SysUtils;

Type
    TMass = Array Of Array Of Double;
    TVector = Array Of Double;
    TErrorCode = (CORRECT, UNCORRECT_CHOISE, NON_NUMERIC, OUT_OF_RANGE, FILE_NOT_TXT, FILE_NOT_EXIST, FILE_NOT_READBLE, FILE_NOT_WRITEBLE,
        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. Uncorrect choise. 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 readeble. Please try again.', 'Error. File not writeble. 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 solves a system of linear equations using Gaussian elimination with back substitution.');
End;

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

Function IsFileTxt(PathToFile: String): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := CORRECT;
    If (Length(PathToFile) < 5) Or (GetLastPartStr(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 IsFileWriteble(Var FileName: TextFile): TErrorCode;
Var
    Error: TErrorCode;
Begin
    Error := CORRECT;
    Try
        Try
            Append(FileName);
        Except
            Error := FILE_NOT_READBLE;
        End;
    Finally
        Close(FileName);
    End;
    IsFileWriteble := Error;
End;

Procedure GetFileNormalReading(Var FileName: TextFile);
Var
    Error: TErrorCode;
    PathToFile: String;
Begin
    Repeat
        Readln(PathToFile);
        Error := IsFileTxt(PathToFile);
        If Error = CORRECT Then
            Error := IsFileExist(PathToFile);
        If Error = CORRECT Then
            AssignFile(FileName, PathToFile);
        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
            Error := IsFileExist(PathToFile);
        If Error = CORRECT Then
            AssignFile(FileName, PathToFile);
        If Error = CORRECT Then
            Error := IsFileWriteble(FileName);
        If Error <> CORRECT Then
            Writeln(ERR[Error]);
    Until Error = CORRECT;
End;

Function MatrixSetingFile(Var FileName: TextFile; Var Matrix: TMass; Var FreeVector: TVector): TErrorCode;
Var
    Error: TErrorCode;
    Rows, Cols: Integer;
Begin
    Error := CORRECT;
    Rows := 0;
    Cols := 0;
    Writeln('Чтение настроек матрицы...');
    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
    Begin
        SetLength(Matrix, Rows, Cols);
        SetLength(FreeVector, Rows);
    End;

    MatrixSetingFile := Error;
End;

Procedure MatrixSetingConsole(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 ReadMatrix(Var FileName: TextFile; Var Matrix: TMass);
Var
    I, J: Integer;
    Error: TErrorCode;
Begin
    Error := CORRECT;
    For I := 0 To High(Matrix) Do
    Begin
        For J := 0 To High(Matrix[I]) Do
        Begin
            If Not EOF(FileName) Then
            Begin
                Try
                    Read(FileName, Matrix[I][J]);
                Except
                    Error := READING_GO_WRONG;
                End;
            End
            Else
                Error := FILE_NOT_FULL;
        End;
    End;
    If Error <> CORRECT Then
        WriteLn(ERR[Error]);
End;

Procedure ReadFreeVector(Var FileName: TextFile; Var FreeVector: TVector);
Var
    I: Integer;
    Error: TErrorCode;
Begin
    Error := CORRECT;
    For I := 0 To High(FreeVector) Do
    Begin
        If Not EOF(FileName) Then
        Begin
            Try
                Read(FileName, FreeVector[I]);
            Except
                Error := READING_GO_WRONG;
            End;
        End
        Else
        Begin
            Error := FILE_NOT_FULL;
        End;
    End;

    If Error <> CORRECT Then
        WriteLn(ERR[Error]);
End;

Procedure ReadMatrixFromFile(Var Matrix: TMass; Var FreeVector: TVector);
Var
    FileName: TextFile;
    Error: TErrorCode;
Begin
    WriteLn('Enter the path to the file with extension ".txt" with matrix dimensions and free terms from ', MIN_ARR, ' .. ', MAX_ARR);
    GetFileNormalReading(FileName);
    Error := MatrixSetingFile(FileName, Matrix, FreeVector);

    If Error = CORRECT Then
    Begin
        ReadMatrix(FileName, Matrix);
        ReadFreeVector(FileName, FreeVector);
    End;

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


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

    For J := 0 To High(Matrix[I]) Do
    Begin
        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;
End;

Procedure ReadMatrixFromConsole(Var Matrix: TMass);
Var
    I, J, Rows, Cols: Integer;
    Error: TErrorCode;
Begin
    Rows := 0;
    Cols := 0;
    MatrixSetingConsole(Matrix, Rows, Cols);
    Writeln('Matrix size [', Rows, ',', Cols, ']');

    For I := 0 To High(Matrix) Do
    Begin
        WriteLn('Please enter the elements for row ', I, ' (diagonal and above) through the space in the range ', MIN_COUNT:7:2, ' .. ',
            MAX_COUNT:7:2);
        For J := 0 To High(Matrix[I]) Do
        Begin
            If J < I Then
            Begin
                Matrix[I][J] := 0;
            End
            Else
            Begin
                Repeat
                    Error := CORRECT;
                    Try
                        Read(Matrix[I][J]);
                    Except
                        Error := NON_NUMERIC;
                    End;
                    If (Error = CORRECT) And ((Matrix[I][J] < MIN_COUNT) Or (Matrix[I][J] > MAX_COUNT)) Then
                        Error := OUT_OF_RANGE;
                    If Error <> CORRECT Then
                        WriteLn(ERR[Error]);
                Until Error = CORRECT;
            End;
        End;
        ReadLn;
    End;
End;

Procedure ReadFreeVectorFromConsole(Var FreeVector: TVector; Var Matrix: TMass);
Var
    I: Integer;
    Error: TErrorCode;
Begin
    SetLength(FreeVector, Length(Matrix));
    Writeln('Enter the free terms:');
    For I := 0 To High(FreeVector) Do
    Begin
        Repeat
            Error := CORRECT;
            Try
                Read(FreeVector[I]);
            Except
                Error := NON_NUMERIC;
            End;
            If (Error = CORRECT) And ((FreeVector[I] < MIN_COUNT) Or (FreeVector[I] > MAX_COUNT)) Then
                Error := OUT_OF_RANGE;
            If Error <> CORRECT Then
                WriteLn(ERR[Error]);
        Until Error = CORRECT;
    End;
End;


Function OptionRead(Const MAX_OPTION: Integer): 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 := UNCORRECT_CHOISE;
        If Error <> CORRECT Then
            Write(ERR[Error]);
    Until Error = CORRECT;
    OptionRead := Option;
End;

Procedure OptionHowToRead(Var Matrix: TMass; Var FreeVector: TVector);
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(MAX_OPTION);
    If Option = 2 Then
        ReadMatrixFromFile(Matrix, FreeVector)
    Else
    Begin
        ReadMatrixFromConsole(Matrix);
        ReadFreeVectorFromConsole(FreeVector, Matrix);
    End;
End;

Procedure BackSubstitution(Var Matrix: TMass; Var FreeVector: TVector; Var Solutions: TVector);
Var
    I, J: Integer;
    Sum: Double;
    DivisionByZero: Boolean;
Begin
    SetLength(Solutions, Length(FreeVector));
    DivisionByZero := False;
    I := High(Matrix);
    While I >= 0 Do
    Begin
        Sum := FreeVector[I];
        For J := I + 1 To High(Matrix) Do
            Sum := Sum - Matrix[I][J] * Solutions[J];
        If Matrix[I][I] = 0 Then
        Begin
            Writeln('Error: Division by zero for row ', I);
            DivisionByZero := True;
        End
        Else
        Begin
            Solutions[I] := Sum / Matrix[I][I];
        End;
        Dec(I);
    End;
    If DivisionByZero Then
        Writeln('Back substitution terminated due to division by zero.');
End;

Procedure PrintConsole(Solutions: TVector);
Var
    I: Integer;
Begin
    WriteLn('The solutions are:');
    For I := 0 To High(Solutions) Do
        WriteLn('x[', I, '] = ', Solutions[I]:0:4);
End;

Procedure PrintFile(Solutions: TVector);
Var
    FileName: TextFile;
    Path: String;
    I: Integer;
    ErrorCode: TErrorCode;
Begin
    WriteLn('Enter the path to the file with the extension ".txt" to get the answer: ');
    GetFileNormalWriting(FileName);
    ErrorCode := IsFileWriteble(FileName);

    If ErrorCode = CORRECT Then
    Begin
        Rewrite(FileName);
        WriteLn(FileName, 'Solutions:');
        For I := 0 To High(Solutions) Do
            WriteLn(FileName, 'x[', I, '] = ', Solutions[I]:0:4);
        CloseFile(FileName);
    End
    Else
        WriteLn(ERR[ErrorCode]);
End;

Procedure PrintAnswer(Solutions: TVector);
Var
    Option, I: 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(MAX_OPTION);
    If Option = 2 Then
        PrintFile(Solutions)
    Else
        PrintConsole(Solutions);
End;

Var
    Matrix: TMass;
    FreeVector: TVector;
    Solutions: TVector;

Begin
    ProgramTask();
    OptionHowToRead(Matrix, FreeVector);
    BackSubstitution(Matrix, FreeVector, Solutions);
    PrintAnswer(Solutions);
    Writeln('Press Enter to exit');
    Readln;
End.