Advertisement
deced

Untitled

Oct 21st, 2020
123
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 7.33 KB | None | 0 0
  1. program Lab2_4;
  2.  
  3. uses
  4.     System.SysUtils;
  5.  
  6. type
  7.     Matrix = array of array of Integer;
  8.  
  9. var
  10.     MainMatrix: Matrix;
  11.  
  12. function GetOutputDirectory(): String;
  13. var
  14.     Ret: String;
  15.     IsCorrect: Boolean;
  16. begin
  17.     IsCorrect := false;
  18.     repeat
  19.         Writeln('Введите директорию, в которую хотите сохранить матрицу');
  20.         Readln(Ret);
  21.         if DirectoryExists(Ret) then
  22.             IsCorrect := true
  23.         else
  24.             Writeln('Такой директории не существует.Попробуйте ещё раз');
  25.     until IsCorrect;
  26.     GetOutputDirectory := Ret;
  27. end;
  28.  
  29. procedure PrintMatrix(MatrixToPrint: Matrix);
  30. var
  31.     I, J: Integer;
  32. begin
  33.     for I := 0 to High(MatrixToPrint) do
  34.     begin
  35.         for J := 0 to High(MatrixToPrint) do
  36.             Write(MatrixToPrint[I, J]:6);
  37.         Writeln;
  38.     end;
  39. end;
  40.  
  41. procedure PrintMatrixToFile(MatrixToPrint: Matrix);
  42. var
  43.     I, J: Integer;
  44.     OutputFile: TextFile;
  45.     Directory: String;
  46. begin
  47.     Directory := GetOutputDirectory();
  48.     AssignFile(OutputFile, Directory + '\output.txt');
  49.     Rewrite(OutputFile);
  50.     for I := 0 to High(MatrixToPrint) do
  51.     begin
  52.         for J := 0 to High(MatrixToPrint) do
  53.             Write(OutputFile, MatrixToPrint[I, J]:6);
  54.         Writeln(OutputFile);
  55.     end;
  56.     Writeln('Матрица сохранена по указанному пути');
  57.     CloseFile(OutputFile);
  58. end;
  59.  
  60. function GetInputType(): String;
  61.  
  62. var
  63.     Ret: string;
  64.     IsCorrect: Boolean;
  65. begin
  66.     IsCorrect := false;
  67.     repeat
  68.         Writeln('Выберите способ задания матрицы файл/консоль (ф/к)');
  69.         Read(Ret);
  70.         if (Ret = 'ф') or (Ret = 'Ф') then
  71.         begin
  72.             Ret := 'File';
  73.             IsCorrect := true;
  74.         end
  75.         else if (Ret = 'к') or (Ret = 'К') then
  76.         begin
  77.             Ret := 'Console';
  78.             IsCorrect := true;
  79.         end;
  80.         Readln;
  81.     until IsCorrect;
  82.     GetInputType := Ret;
  83. end;
  84.  
  85. function IsFileCorrect(Path: String; Size: Integer): Boolean;
  86. var
  87.     ISize, JSize, Num: Integer;
  88.     IsCorrect: Boolean;
  89.     MatrixFile: TextFile;
  90. begin
  91.     ISize := 0;
  92.     JSize := 0;
  93.     IsCorrect := true;
  94.     AssignFile(MatrixFile, Path);
  95.     Reset(MatrixFile);
  96.     while not(SeekEof(MatrixFile)) and IsCorrect do
  97.     begin
  98.         inc(ISize);
  99.         while not(SeekEoln(MatrixFile)) and IsCorrect do
  100.         begin
  101.             try
  102.                 Read(MatrixFile, Num);
  103.             except
  104.                 IsCorrect := false;
  105.             end;
  106.             inc(JSize);
  107.         end;
  108.         Readln(MatrixFile);
  109.         if (JSize <> Size) then
  110.             IsCorrect := false;
  111.         JSize := 0;
  112.     end;
  113.     if ISize <> Size then
  114.         IsCorrect := false;
  115.     CloseFile(MatrixFile);
  116.     IsFileCorrect := IsCorrect;
  117. end;
  118.  
  119. function GetMatrixItem(I, J: Integer): Integer;
  120. var
  121.     Ret: Integer;
  122.     IsCorrect: Boolean;
  123. begin
  124.     repeat
  125.         Writeln('Введите значение элемента матрицы [', I, ',', J, ']');
  126.         IsCorrect := true;
  127.         try
  128.             Readln(Ret)
  129.         except
  130.             IsCorrect := false;
  131.             Writeln('Значение матрицы должно быть числом')
  132.         end;
  133.     until IsCorrect;
  134.     GetMatrixItem := Ret;
  135. end;
  136.  
  137. function GetMatrixSize(): Integer;
  138. var
  139.     Ret: Integer;
  140.     IsCorrect: Boolean;
  141. begin
  142.     Ret := 0;
  143.     repeat
  144.         Writeln('Введите размер матрицы ');
  145.         IsCorrect := true;
  146.         try
  147.             Readln(Ret)
  148.         except
  149.             IsCorrect := false;
  150.             Writeln('Размер матрицы должен быть числом')
  151.         end;
  152.         if ((((Ret < 2) or (Ret > 10000)) or (Ret mod 2 = 1)) and IsCorrect)
  153.         then
  154.         begin
  155.             Writeln('Размер матрицы должен быть кратен двум и принадлежать промежутку от 2 до 10000');
  156.             IsCorrect := false
  157.         end;
  158.     until IsCorrect;
  159.     GetMatrixSize := Ret;
  160. end;
  161.  
  162. function GetMatrixFromConsole(Size: Integer): Matrix;
  163. var
  164.     Ret: Matrix;
  165.     I, J: Integer;
  166. begin
  167.     SetLength(Ret, Size, Size);
  168.     for I := 0 to High(Ret) do
  169.         for J := 0 to High(Ret) do
  170.             Ret[I, J] := GetMatrixItem(I, J);
  171.     GetMatrixFromConsole := Ret;
  172. end;
  173.  
  174. function GetMatrixFilePath(MatrixSize: Integer): String;
  175. var
  176.     Path: String;
  177.     IsCorrect: Boolean;
  178. begin
  179.     repeat
  180.         Writeln('Введите абсолютный путь к файлу ');
  181.         Readln(Path);
  182.         IsCorrect := false;
  183.         if not(FileExists(Path)) then
  184.             Writeln('Файл не найден')
  185.         else
  186.         begin
  187.             if IsFileCorrect(Path, MatrixSize) then
  188.                 IsCorrect := true
  189.             else
  190.                 Writeln('Данные в файле некорректны');
  191.         end;
  192.     until IsCorrect;
  193.     GetMatrixFilePath := Path;
  194. end;
  195.  
  196. function GetMatrixFromFile(Size: Integer): Matrix;
  197. var
  198.     Ret: Matrix;
  199.     I, J: Integer;
  200.     FilePath: string;
  201.     MatrixFile: TextFile;
  202. begin
  203.     SetLength(Ret, Size, Size);
  204.     FilePath := GetMatrixFilePath(Size);
  205.     AssignFile(MatrixFile, FilePath);
  206.     Reset(MatrixFile);
  207.     for I := 0 to High(Ret) do
  208.     begin
  209.         for J := 0 to High(Ret) do
  210.             Read(MatrixFile, Ret[I, J]);
  211.         Readln(MatrixFile);
  212.     end;
  213.     CloseFile(MatrixFile);
  214.     GetMatrixFromFile := Ret;
  215. end;
  216.  
  217. function GetMatrix(): Matrix;
  218. var
  219.     RetMatrix: Matrix;
  220.     Size: Integer;
  221.     InputType: string;
  222. begin
  223.     Size := GetMatrixSize();
  224.     InputType := GetInputType();
  225.     if (InputType = 'Console') then
  226.         RetMatrix := GetMatrixFromConsole(Size)
  227.     else if (InputType = 'File') then
  228.         RetMatrix := GetMatrixFromFile(Size);
  229.     GetMatrix := RetMatrix;
  230. end;
  231.  
  232. function GetMatrixPart(Matr: Matrix; I, J, Size: Integer): Matrix;
  233. var
  234.     Ret: Matrix;
  235.     indexI, indexJ: Integer;
  236. begin
  237.     SetLength(Ret, Size, Size);
  238.     for indexI := 0 to High(Ret) do
  239.         for indexJ := 0 to High(Ret) do
  240.             Ret[indexI, indexJ] := Matr[indexI + I, indexJ + J];
  241.     GetMatrixPart := Ret;
  242. end;
  243.  
  244. procedure InsertMatrix(MainMatriix, ToInsert: Matrix; I, J: Integer);
  245. var
  246.     indexI, indexJ: Integer;
  247. begin
  248.     for indexI := 0 to High(ToInsert) do
  249.         for indexJ := 0 to High(ToInsert) do
  250.             MainMatriix[indexI + I, indexJ + J] := ToInsert[indexI, indexJ];
  251. end;
  252.  
  253. procedure Swap(ToSwap: Matrix);
  254. var
  255.     Matrix1, Matrix2, Matrix3, Matrix4: Matrix;
  256.     HalfSize: Integer;
  257. begin
  258.     HalfSize := Length(ToSwap) div 2;
  259.     Matrix1 := GetMatrixPart(ToSwap, 0, 0, HalfSize);
  260.     Matrix2 := GetMatrixPart(ToSwap, 0, HalfSize, HalfSize);
  261.     Matrix3 := GetMatrixPart(ToSwap, HalfSize, 0, HalfSize);
  262.     Matrix4 := GetMatrixPart(ToSwap, HalfSize, HalfSize, HalfSize);
  263.     InsertMatrix(ToSwap, Matrix1, HalfSize, HalfSize);
  264.     InsertMatrix(ToSwap, Matrix2, HalfSize, 0);
  265.     InsertMatrix(ToSwap, Matrix3, 0, 0);
  266.     InsertMatrix(ToSwap, Matrix4, 0, HalfSize);
  267. end;
  268.  
  269. begin
  270.     MainMatrix := GetMatrix();
  271.     PrintMatrix(MainMatrix);
  272.     Swap(MainMatrix);
  273.     Writeln;
  274.     PrintMatrix(MainMatrix);
  275.     PrintMatrixToFile(MainMatrix);
  276.     Readln;
  277.  
  278. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement