Advertisement
ksyshshot

Lab_2.4

Nov 2nd, 2022 (edited)
102
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 10.25 KB | Source Code | 0 0
  1. Program Lab_2_4;
  2.  
  3. {$APPTYPE CONSOLE}
  4. {$R *.res}
  5.  
  6. Uses
  7.     System.SysUtils;
  8.  
  9. Type
  10.     TMatrix = Array Of Array Of Integer;
  11.     TArr = Array Of Integer;
  12.     TBool = Array Of Array Of Boolean;
  13.  
  14. Procedure WriteTask();
  15. Begin
  16.     Writeln('Данная программа находит седловую точку квадратной матрицы');
  17. End;
  18.  
  19. Function FileInputPath(IsFileForRead: Boolean): String;
  20. Var
  21.     Path: String;
  22.     IsCorrect: Boolean;
  23.     F: TextFile;
  24. Begin
  25.     If (IsFileForRead) Then
  26.         Write ('Введите путь к файлу для чтения: ')
  27.     Else
  28.         Write ('Введите путь к файлу для записи: ');
  29.     Repeat
  30.         IsCorrect := True;
  31.         Readln(Path);
  32.         AssignFile(F, Path);
  33.         If (IsCorrect) And (Not FileExists(Path)) Then
  34.         Begin
  35.             IsCorrect := False;
  36.             Writeln ('Файл не найден. Повторите попытку...');
  37.         End;
  38.     Until (IsCorrect);
  39.     FileInputPath := Path;
  40. End;
  41.  
  42. Function FileInputMatrixOrder(): Integer;
  43. Const
  44.     MAX_ORDER = 10;
  45.     MIN_ORDER = 2;
  46. Var
  47.     Path: String;
  48.     MatrixOrder: Integer;
  49.     F: TextFile;
  50.     IsCorrect, IsFileForRead: Boolean;
  51. Begin
  52.     IsFileForRead := True;
  53.     Repeat
  54.         Path := FileInputPath(IsFileForRead);
  55.         AssignFile(F, Path);
  56.         IsCorrect := True;
  57.         Try
  58.             Reset(F);
  59.         Except
  60.             Writeln ('Не удалось открыть файл. Повторите попытку...');
  61.             IsCorrect := False;
  62.         End;
  63.         If (IsCorrect) Then
  64.             Try
  65.                 Readln (F, MatrixOrder);
  66.             Except
  67.                 Writeln ('Некорректно введённый порядок матрицы. Попробуйте снова');
  68.                 IsCorrect := False;
  69.             End;
  70.         If (IsCorrect) And ((MatrixOrder < MIN_ORDER) Or (MatrixOrder > MAX_ORDER)) Then
  71.         Begin
  72.             Writeln ('Порядок матрицы неверного диапазона!');
  73.             IsCorrect := False;
  74.         End;
  75.     Until (IsCorrect);
  76.     CloseFile(F);
  77.     FileInputMatrixOrder := MatrixOrder;
  78. End;
  79.  
  80. Function FileMatrixInput(Matrix: TMatrix; Path: String; Order: Integer): TMatrix;
  81. Var
  82.     I,J: Integer;
  83.     F: TextFile;
  84.     IsCorrect: Boolean;
  85. Begin
  86.     Repeat
  87.         IsCorrect := True;
  88.         AssignFile(F, Path);
  89.         Reset(F);
  90.         Readln(F);
  91.         I := 0;
  92.         While (IsCorrect) And (I < Order) Do
  93.         Begin
  94.             J := 0;
  95.             While (IsCorrect) And (J < Order) Do
  96.             Begin
  97.                 Try
  98.                     Read(F, Matrix[I][J]);
  99.                 Except
  100.                     Writeln('Некорректное значение элемента матрицы');
  101.                     IsCorrect := False;
  102.                     Dec(I);
  103.                 End;
  104.                 Inc(J);
  105.             End;
  106.             Inc(I);
  107.         End;
  108.     Until (IsCorrect);
  109. End;
  110.  
  111. Function ConsoleInputMatrixOrder(): Integer;
  112. Const
  113.     MIN_ORDER = 2;
  114.     MAX_ORDER = 10;
  115. Var
  116.     Order: Integer;
  117.     IsCorrect: Boolean;
  118. Begin
  119.     Repeat
  120.         Writeln ('Введите порядок квадратной матрицы');
  121.         IsCorrect := True;
  122.         Try
  123.             Readln (Order);
  124.         Except
  125.             Writeln ('Ошибка ввода! Повторите попытку...');
  126.             IsCorrect := False;
  127.         End;
  128.         If ((IsCorrect) And ((Order < MIN_ORDER) Or (Order > MAX_ORDER))) Then
  129.         Begin
  130.             Writeln ('Ошибка ввода! Проверьте, входит ли введённое значение в допустимый диапазон и повторите попытку...');
  131.             IsCorrect := False;
  132.         End;
  133.     Until (IsCorrect);
  134.     ConsoleInputMatrixOrder := Order;
  135. End;
  136.  
  137. Function ConsoleMatrixCreation(Order: Integer): TMatrix;
  138. Const
  139.     MIN_ELEMENT = -2147483648;
  140.     MAX_ELEMENT = 2147483648;
  141. Var
  142.     I, J: Integer;
  143.     IsCorrect: Boolean;
  144.     Matrix: TMatrix;
  145. Begin
  146.     SetLength (Matrix, Order, Order);
  147.     For I := 0 To High(Matrix) Do
  148.         For J := 0 To High(Matrix) Do
  149.             Repeat
  150.                 Writeln ('Введите ', (J + 1), ' элемент ', (I + 1), ' строки');
  151.                 IsCorrect := True;
  152.                 Try
  153.                     Readln (Matrix[I][J]);
  154.                 Except
  155.                     Writeln ('Ошибка ввода! Повторите попытку...');
  156.                     IsCorrect := False;
  157.                 End;
  158.                 If ((IsCorrect) And ((Matrix[I][J] < MIN_ELEMENT) Or (Matrix[I][J] > MAX_ELEMENT))) Then
  159.                 Begin
  160.                     Writeln ('Ошибка ввода! Введено число неверного диапазона');
  161.                     IsCorrect := False;
  162.                 End;
  163.             Until (IsCorrect);
  164.     ConsoleMatrixCreation := Matrix;
  165. End;
  166.  
  167. Procedure ConsolMatrixOutput(Matrix: TMatrix; Order: Integer);
  168. Var
  169.     I, J: Integer;
  170. Begin
  171.     Writeln ('Исходная матрица:');
  172.     For I := 0 To High(Matrix) Do
  173.     Begin
  174.         For J := 0 To High(Matrix) Do
  175.             Write (Matrix[I][J], ' ');
  176.         Writeln;
  177.     End;
  178. End;
  179.  
  180. Function SmallestElementsInLine(Matrix: TMatrix; Order: Integer): TArr;
  181. Var
  182.     I, J, Min: Integer;
  183.     MinIndexes: TArr;
  184. Begin
  185.     SetLength (MinIndexes, Order);
  186.     For I := 0 To High(Matrix) Do
  187.     Begin
  188.         Min := Matrix[I][0];
  189.         MinIndexes[I] := 0;
  190.         For J := 1 To High(Matrix) Do
  191.             If (Matrix[I][J] <= Min) Then
  192.             Begin
  193.                 Min := Matrix[I][J];
  194.                 MinIndexes[I] := J;
  195.             End;
  196.     End;
  197.     SmallestElementsInLine := MinIndexes;
  198. End;
  199.  
  200. Function LargestElementsInColumn(Matrix: TMatrix; Order: Integer): TArr;
  201. Var
  202.     I, J, Max: Integer;
  203.     MaxIndexes: TArr;
  204. Begin
  205.     SetLength (MaxIndexes, Order);
  206.     For J := 0 To High(Matrix) Do
  207.     Begin
  208.         Max := Matrix[0][J];
  209.         MaxIndexes[J] := 0;
  210.         For I := 1 To High(Matrix) Do
  211.             If (Matrix[I][J] >= Max) Then
  212.             Begin
  213.                 Max := Matrix[I][J];
  214.                 MaxIndexes[J] := I;
  215.             End;
  216.     End;
  217.     LargestElementsInColumn := MaxIndexes;
  218. End;
  219.  
  220. Procedure FindingMatrixSaddlePoints(Matrix: TMatrix; IsConsoleAnswer: Boolean);
  221. Var
  222.     MaxElemIndexes, MinElemIndexes: TArr;
  223.     I, J, Order, SaddlePoint: Integer;
  224.     IsSaddlePoint, PathForRead, IsCorrect: Boolean;
  225.     Path: String;
  226.     F: TextFile;
  227. Begin
  228.     Order := High(Matrix) + 1;
  229.     MinElemIndexes := SmallestElementsInLine(Matrix, Order);
  230.     MaxElemIndexes := LargestElementsInColumn(Matrix, Order);
  231.     For I := 0 To High(Matrix) Do
  232.         For J := 0 To High(Matrix) Do
  233.             If (MinElemIndexes[I] = J) And (MaxElemIndexes[J] = I) Then
  234.             Begin
  235.                 SaddlePoint := Matrix[I][J];
  236.                 IsSaddlePoint := True;
  237.             End;
  238.     If (IsConsoleAnswer) Then
  239.     Begin
  240.         If (IsSaddlePoint) Then
  241.             Write ('Седловая точка матрицы: ', SaddlePoint)
  242.         Else
  243.             Write ('Седловой точки нет');
  244.     End
  245.     Else
  246.     Begin
  247.         PathForRead := False;
  248.         Repeat
  249.             Path := FileInputPath(PathForRead);
  250.             AssignFile(F, Path);
  251.             Try
  252.                 ReWrite(F);
  253.             Except
  254.                 Writeln ('Не удалось открыть файл. Повторите попытку...');
  255.                 IsCorrect := False;
  256.             End;
  257.         Until (IsCorrect);
  258.         If (IsSaddlePoint) Then
  259.             Write (F, 'Седловая точка матрицы: ', SaddlePoint)
  260.         Else
  261.             Write (F, 'Седловой точки нет');
  262.         CloseFile(F);
  263.         Writeln ('Седловая точка матрицы записана в файл');
  264.     End;
  265. End;
  266.  
  267. Function FileChoice(): TMatrix;
  268. Var
  269.     Path: String;
  270.     Matrix: TMatrix;
  271.     Order: Integer;
  272.     PathForRead: Boolean;
  273. Begin
  274.     Order := FileInputMatrixOrder();
  275.     SetLength(Matrix, Order, Order);
  276.     FileMatrixInput(Matrix, Path, Order);
  277.     FileChoice := Matrix;
  278. End;
  279.  
  280. Function ConsoleChoice(): TMatrix;
  281. Var
  282.     Order, SaddlePoint: Integer;
  283.     Matrix: TMatrix;
  284. Begin
  285.     Order := ConsoleInputMatrixOrder();
  286.     Matrix := ConsoleMatrixCreation(Order);
  287.     ConsolMatrixOutput(Matrix, Order);
  288.     ConsoleChoice := Matrix;
  289. End;
  290.  
  291. Function ChooseOutputMethod(): Integer;
  292. Var
  293.     IsCorrect: Boolean;
  294.     Choice: Integer;
  295. Begin
  296.     Repeat
  297.         IsCorrect := True;
  298.         Try
  299.             Readln(Choice);
  300.         Except
  301.             Writeln ('Число введено некорректно. Повторите попытку...');
  302.             IsCorrect := False;
  303.         End;
  304.         If (IsCorrect) And (Choice <> 1) And (Choice <> 2) Then
  305.         Begin
  306.             Writeln ('Введите либо 1, либо 2. Ваш выбор: ');
  307.             IsCorrect := False;
  308.         End;
  309.     Until (IsCorrect);
  310.     ChooseOutputMethod := Choice;
  311. End;
  312.  
  313. Procedure Solution();
  314. Var
  315.     Path: String;
  316.     Matrix: TMatrix;
  317.     Choice: Integer;
  318.     IsCorrect, IsConsoleAnswer, PathForRead: Boolean;
  319. Begin
  320.     IsConsoleAnswer := False;
  321.     Writeln ('Введите число, чтобы выбрать способ решения задания: 1 - через консоль, 2 - через файл');
  322.     Choice := ChooseOutputMethod();
  323.     If (Choice = 1) Then
  324.     Begin
  325.         IsConsoleAnswer := True;
  326.         Matrix := ConsoleChoice();
  327.         FindingMatrixSaddlePoints(Matrix, IsConsoleAnswer);
  328.     End
  329.     Else
  330.     Begin
  331.         Matrix := FileChoice();
  332.         Writeln ('Введите число, чтобы выбрать способ вывода решения задания: 1 - через консоль, 2 - через файл');
  333.         Choice := ChooseOutputMethod();
  334.         If (Choice = 1) Then
  335.         Begin
  336.             IsConsoleAnswer := True;
  337.             FindingMatrixSaddlePoints(Matrix, IsConsoleAnswer);
  338.         End
  339.         Else
  340.             FindingMatrixSaddlePoints(Matrix, IsConsoleAnswer);
  341.     End;
  342. End;
  343.  
  344. Begin
  345.     WriteTask();
  346.     Solution();
  347.     Readln;
  348. End.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement