laba_3_5_delphi

Program Lab_2_3;

Uses
    System.SysUtils;

Type
    TMatrix = Array of Array of Real;
    TArray = Array of Real;

Function InputData() : Integer;
Var
    IsCorrect : Boolean;
    N : Integer;
Begin
    N := 0;
    Repeat
        IsCorrect := True;
        Try
            Readln(N)
        Except
            Writeln('Please, enter a integer number:');
            IsCorrect := False;
        End;
    Until(IsCorrect);
    InputData := N;
End;

Function ReadCountRoots () : Integer;
Var
    Num : Integer;
    IsCorrect : Boolean;
Const
    MIN_SIZE = 2;
Begin
    Repeat
        IsCorrect := True;
        Num := InputData();
        If (Num < MIN_SIZE) Then
        Begin
            Writeln('Please, enter a number > 2:');
            IsCorrect := False
        End;
    Until IsCorrect;
    ReadCountRoots := Num;
End;

Function Choose() : Boolean;
Var
    InputNumber : Integer;
    IsCorrect : Boolean;
Const
    MIN_NUM = 0;
    MAX_NUM = 1;
Begin
    Repeat
        IsCorrect := True;
        InputNumber := InputData();
        If ((InputNumber < MIN_NUM) or (InputNumber > MAX_NUM)) then
        Begin
            Writeln('You are out of input range!');
            IsCorrect := False;
        End;

    Until IsCorrect;
    If (InputNumber = 0) then
        Choose := True
    Else
        Choose := False;
End;

Function InputTriangularMatrixConsole(Num : Integer) : TMatrix;
Var
    I, J : Integer;
    ArrOfMatrixElements : TMatrix;
Begin
      SetLength(ArrOfMatrixElements, Num, Num);
      Dec(Num);
    For I := 0 To Num Do
            For J := 0 To Num Do
            ArrOfMatrixElements[I,J] := 0;
      For I := 0 To Num Do
      Begin
            For J := 0 To Num Do
            Begin
                  If (J - I > - 1) Then
                  Begin
                        Write('a[',(i + 1), ',', (j + 1), '] = ');
                        ArrOfMatrixElements[I,J] := InputData();
                  End;
            End;
      End;
      InputTriangularMatrixConsole := ArrOfMatrixElements;
End;

Function InputFreeMembersConsole(Num : Integer) : TArray;
Var
      I : Integer;
      ArrOfFreeMembers : TArray;
Begin
      SetLength(ArrOfFreeMembers, Num);
      Dec(Num);
      For I := 0 To Num Do
      Begin
            Write ('b[',(i + 1), '] = ');
            ArrOfFreeMembers[I] := InputData();
      End;
      InputFreeMembersConsole := ArrOfFreeMembers;
End;

Function RandomizeOtherElements (Num : Integer; ArrOfMatrixElements : TMatrix) : TMatrix;
Var
    Diff, I, J, Q : Integer;
    Max, Min : Real;
    ArrOfMatrixElementsRandom : TMatrix;
Begin
    Setlength(ArrOfMatrixElementsRandom, Num, Num);
    Max := ArrOfMatrixElements[0][0];
    Min := ArrOfMatrixElements[0][0];
    Dec(Num);
    for I := 0 to Num do
        for J := 0 to Num do
        Begin
            if ArrOfMatrixElements[I,J] > Max then
                Max := ArrOfMatrixElements[I,J];
            if ArrOfMatrixElements[I,J] < Min then
                Min := ArrOfMatrixElements[I,J];
        End;
    Diff := Round(Max - Min);
    for I := 0 to Num do
        for J := 0 to Num do
           ArrOfMatrixElementsRandom[I,J] := 0;
    for I := 0 to Num do
        for J := 0 to Num do
            if J - I < 0 then
            Begin
                Q := Round(Min) + Random(Diff);
                ArrOfMatrixElementsRandom[I,J] := Q;
            End;
    RandomizeOtherElements := ArrOfMatrixElementsRandom;
End;

Function CreateMatrix ( ArrOfMatrixElements : TMatrix; Num : Integer; ArrOfMatrixElementsRandom: TMatrix; ArrOfFreeMembers : TArray) : TMatrix;
Var
    I, J : Integer;
    Matrix : TMatrix;
Begin
    Setlength(Matrix, Num, Num + 1);
    Dec(Num);
    for I := 0 to Num do
        for J := 0 to Num do
        Begin
            if J - I < 0 then
                Matrix[I,J] := ArrOfMatrixElementsRandom[I,J];
            if J - I > -1 then
                Matrix[I,J] := ArrOfMatrixElements[I,J];
        End;
    for I := 0 to Num do
        Matrix[I][Num + 1]:= ArrOfFreeMembers[I];
    CreateMatrix := Matrix;
End;

Procedure MoveStrings(Matrix : TMatrix; FirstRow : Integer; SecondRow : Integer; Num : Integer);
Var
    LastNum, J : Integer;
    R : Real;
Begin
    LastNum := Num + 1;
    If (FirstRow < Lastnum) and (SecondRow < LastNum) then
    Begin
        For J := 0 To Num Do
        Begin
            R := Matrix[SecondRow][J];
            Matrix[SecondRow][J] := Matrix[FirstRow][J];
            Matrix[FirstRow][J] := R;
        End;
    End;
End;

Function NewMatrix (Matrix : TMatrix; Num : Integer): TMatrix;
Var
    TmpI, LastNum1, LastNum2, J, I, M: Integer;
    K : Real;
Begin
    LastNum1 := Num - 1;
    LastNum2 := Num + 1;
    For J := 0 to Num - 1 do
    Begin
        If (Matrix[J,J] = 0) and (J < LastNum1) then
        Begin
            TmpI := J + 1;
            Repeat
                If Matrix[TmpI,J] <> 0 then
                    MoveStrings(Matrix, J, TmpI, Num);
            Until (Matrix[J,J] = 0);
        End;
        for I := J + 1 to Num - 1 do
        Begin
            K := Matrix[i][j] / Matrix[j][j];
            For M := J to LastNum2 - 1 do
               matrix[i][m] := matrix[i][m] - k * matrix[j][m];
        End;
    End;
    NewMatrix := Matrix;
End;

Function FindRoots (Matrix : TMatrix; Num : Integer) : TArray;
Var
    Sum : Real;
    TmpRoots : TArray;
    I, j : Integer;
Begin
    Setlength(TmpRoots, Num);
    For I := Num - 1 downto 0 do
    Begin
        Sum := 0;
        for J := I + 1 to Num - 1 do
            Sum := Sum + TmpRoots[j] * Matrix[i][j];
        if (Matrix[i][i] = 0) then
            TmpRoots[i] := 0
        else
            tmpRoots[i] := (matrix[i][num] - sum) / matrix[i][i];
    End;
    FindRoots := TmpRoots
End;


Procedure WriteMatrixInC(Matrix : TMatrix; Num : Integer);
Var
    I, J : Integer;
Begin
    Writeln('Your virgin matrix:');
    for I := 0 to Num - 1 do
    Begin
        for J := 0 to Num do
            Write(Matrix[I,J], ' ');
        Writeln;
    End;
End;

Function GaussM(Matrix : TMatrix; Num : Integer) : TArray;
Begin
    WriteMatrixInC(matrix, Num);
    NewMatrix(matrix, Num);
    GaussM := FindRoots(Matrix, Num);
End;

Procedure OutputSystemRoots(ArrOfSystemRoots : TArray; Num : Integer);
Var
    I : Integer;
Begin
    Dec(Num);
    For I := 0 To Num Do
        Writeln('x[', I + 1, '] = ', arrOfSystemRoots[I], ' ');
End;

Function InputFilePath() : String;
Var
    IsCorrect : Boolean;
    Path : String;
Begin
    Writeln('Input path to file: ');
    Repeat
        IsCorrect := True;
        Readln(Path);
        If(Not FileExists(Path)) Then
        Begin
            IsCorrect := False;
            Writeln('Wrong way to file. Input correct path.');
        End
        Else If (ExtractFileExt(Path) <> '.txt') Then
        Begin
            Writeln('Must have .txt');
            IsCorrect := False;
        End;
    Until IsCorrect;
    InputFilePath := Path;
End;

Function InputSizeOfMatrixFromFile(Path : String) : Integer;
Var
    Num : Integer;
    IsCorrect : Boolean;
    InputFile : TextFile;
Const
    MIN = 2;
Begin
    Num := 0;
    AssignFile(InputFile, Path);
    Reset(InputFile);
    IsCorrect := True;
    Try
        Readln(InputFile, Num);
    Except
        IsCorrect := False;
        Writeln('Mistake of reading size of array from file.');
    End;
    If (IsCorrect And (Num < MIN)) Then
        Writeln('Mistake of array elements.');
    CloseFile(InputFile);
    InputSizeOfMatrixFromFile := Num;
End;

Function InputTriangularMatrixFile(Path : String; Num : Integer) : TMatrix;
Var
    I, J : Integer;
    ArrOfMatrixElements : TMatrix;
    IsCorrect : Boolean;
    InputFile : TextFile;
Begin
    SetLength(ArrOfMatrixElements, Num, Num);
    Dec(Num);
    AssignFile(InputFile, Path);
    Reset(InputFile);
    Readln(InputFile);
    Repeat
        IsCorrect := True;
        For I := 0 To Num Do
        Begin
            For J := 0 To Num Do
            Begin
                If (J - I > - 1) Then
                Begin
                    Try
                        Read(InputFile, ArrOfMatrixElements[I, J]);
                    Except
                        IsCorrect := False;
                        Writeln('Mistake of reading from file.')
                    End;
                    If (IsCorrect And (ArrOfMatrixElements[I, J] < -100) Or (ArrOfMatrixElements[I, J] > 100)) Then
                    Begin
                        IsCorrect := False;
                        Writeln('Wrong number in file.');
                    End;
                End;
            End;
        End;

    Until IsCorrect;

    InputTriangularMatrixFile := ArrOfMatrixElements;
End;

Function InputFreeMembersFile(Path : String; Num : Integer) : TArray;
Var
    I: Integer;
    ArrOfFreeMembers : TArray;
    IsCorrect : Boolean;
    InputFile : TextFile;
Begin
    SetLength(ArrOfFreeMembers, Num);
    Dec(Num);

    Repeat
        IsCorrect := True;
        For I := 0 To Num Do
        Begin
            Try
                Read(InputFile, ArrOfFreeMembers[I]);
            Except
                IsCorrect := False;
                Writeln('Mistake of reading from file.')
            End;
            If (IsCorrect And (ArrOfFreeMembers[I] < -100) Or (ArrOfFreeMembers[I] > 100)) Then
            Begin
                IsCorrect := False;
                Writeln('Wrong number in file.');
            End;

        End;

    Until IsCorrect;

    InputFreeMembersFile := ArrOfFreeMembers;
End;

Procedure FileOutput(Path : String; Arr : TArray);
Var
    IsCorrect : Boolean;
    OutputFile : TextFile;
    I: Integer;
Begin
    AssignFile(OutputFile, Path);
    Repeat
        IsCorrect := True;
        Try
            Rewrite(OutputFile);
        Except
            IsCorrect := False;
            Writeln('Mistake with writing in file. Input another path.');
            Path := InputFilePath();
        End;
    Until IsCorrect;
    Writeln(OutputFile, 'Sorted array:');
    For I := 0 To High(Arr) Do
        Write(OutputFile, Arr[I], ' ');
    CloseFile(OutputFile);
    Write('Success!');
End;

Var
    Path : String;
  Num : Integer;
    ArrOfMatrixElements, ArrOfMatrixElementsRandom, Matrix: TMatrix;
    ArrOfFreeMembers, Roots : TArray;
  Choice : Boolean;
Begin
    Writeln('Gauss method. Input elements above main diagonal and free members.');
    Writeln('Type 0 - console input, type 1 - file input.');
    Choice := Choose();
    If (Choice) Then
    Begin
        Writeln('Input number of unknown equations: ');
        Num := readCountRoots();
        Writeln('Input matrix elements: ');
        ArrOfMatrixElements := InputTriangularMatrixConsole(Num);
        Writeln('Input free members: ');
        ArrOfFreeMembers := InputFreeMembersConsole(Num);
    End
    Else
    Begin
        Path := InputFilePath();
        Num := InputSizeOfMatrixFromFile(Path);
        ArrOfMatrixElements := InputTriangularMatrixFile(Path, Num);
        ArrOfFreeMembers := InputFreeMembersFile(Path, Num);
    End;

  ArrOfMatrixElementsRandom := RandomizeOtherElements(num, arrOfMatrixElements);
  Matrix := CreateMatrix(arrOfMatrixElements, num, arrOfMatrixElementsRandom, arrOfFreeMembers);
  Roots := GaussM(matrix, num);

    Writeln('Type 0 - console output, type 1 - file output.');
    Choice := Choose();
    If (Choice) Then
      OutputSystemRoots(Roots, Num)
    Else
          FileOutput (Path, Roots);
    Readln;
End.