Advertisement
ksyshshot

:(

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