Advertisement
Alyks

Untitled

Nov 17th, 2019
290
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 5.06 KB | None | 0 0
  1. program task3;
  2.  
  3. {$APPTYPE CONSOLE}
  4. {$R *.res}
  5.  
  6. uses
  7.     System.SysUtils, Math, Classes;
  8.  
  9. type
  10.     Arr = Array of Double;
  11.     TwoDimArr = Array of Arr;
  12.  
  13. var
  14.     MatrixRows, MatrixCols, VectorLength: Integer;
  15.     VectorType, FilePath: String;
  16.     Vector: Arr;
  17.     Matrix, Product: TwoDimArr;
  18.     InputFile: TextFile;
  19.     NotCorrect: Boolean;
  20.  
  21. procedure Split(Delimiter: Char; Str: string; ListOfStrings: TStrings);
  22. begin
  23.     ListOfStrings.Clear();
  24.     ListOfStrings.Delimiter := Delimiter;
  25.     ListOfStrings.DelimitedText := Str;
  26. end;
  27.  
  28. function ReadNextLine(const FileToRead: TextFile): String;
  29. var
  30.     Line: String;
  31. begin
  32.     Line := '';
  33.     try
  34.         Readln(FileToRead, Line);
  35.     except
  36.         Writeln('Возникла ошибка при чтении файла.');
  37.     end;
  38.     ReadNextLine := Line;
  39. end;
  40.  
  41. procedure ShowMatrix(const Matrix: TwoDimArr);
  42. var
  43.     i, j: Integer;
  44. begin
  45.     for i := 0 to High(Matrix) do
  46.     begin
  47.         for j := 0 to High(Matrix[i]) do
  48.             Write(Matrix[i, j]:5:2, ' ');
  49.         Writeln;
  50.     end;
  51. end;
  52.  
  53. procedure ShowVector(const Vector: Arr);
  54. var
  55.     i: Integer;
  56. begin
  57.     for i := 0 to High(Vector) do
  58.         Write(Vector[i]:5:2, ' ');
  59.     Writeln;
  60. end;
  61.  
  62. function TakeRow(Str: String; Size: Integer): Arr;
  63. var
  64.     i, Len, El: Integer;
  65.     Row: Arr;
  66.     NumsStr: String;
  67.     OutputList: TStringList;
  68. begin
  69.     SetLength(Row, Size);
  70.     OutputList := TStringList.Create();
  71.     Split(' ', Str, OutputList);
  72.     Len := Size - 1;
  73.     if (Len = OutputList.Count - 1) then
  74.         for i := 0 to Len do
  75.         begin
  76.             El := StrToInt(OutputList[i]);
  77.             if (El in [0 .. 9]) then
  78.                 Row[i] := El;
  79.         end
  80.     else
  81.         Writeln('Количество столбцов, введенных в файле, должно совпадать с количеством столбцов в матрице');
  82.  
  83.     TakeRow := Row;
  84. end;
  85.  
  86. function TakeVector(const InputFile: TextFile; var VectorType: String): Arr;
  87. var
  88.     Vector: Arr;
  89.     VectorLength: Integer;
  90.     CurrentString: String;
  91.     NotCorrect, Stop: Boolean;
  92. begin
  93.     NotCorrect := true;
  94.     Stop := false;
  95.     Reset(InputFile);
  96.     while (NotCorrect and (Not Stop)) do
  97.     begin
  98.         if (EOF(InputFile)) then
  99.         begin
  100.             Writeln('Вы не указали тип вектора');
  101.             Stop := true;
  102.         end
  103.  
  104.         else
  105.         begin
  106.             VectorType := ReadNextLine(InputFile);
  107.             if ((VectorType = 'вектор-столбец') or
  108.                 (VectorType = 'вектор-строка')) then
  109.                 NotCorrect := false;
  110.         end;
  111.     end;
  112.  
  113.     if (Not NotCorrect) then
  114.     begin
  115.         VectorLength := StrToInt(ReadNextLine(InputFile));
  116.         SetLength(Vector, VectorLength);
  117.         CurrentString := ReadNextLine(InputFile);
  118.         Vector := TakeRow(CurrentString, VectorLength);
  119.     end;
  120.     TakeVector := Vector;
  121. end;
  122.  
  123. function TakeMatrixFromFile(const InputFile: TextFile): TwoDimArr;
  124. var
  125.     CurrentString: String;
  126.     MatrixRows, MatrixCols, i: Integer;
  127.     Matrix: TwoDimArr;
  128.     MatrixRow: Arr;
  129. begin
  130.     i := 0;
  131.     Reset(InputFile);
  132.  
  133.     MatrixRows := StrToInt(ReadNextLine(InputFile));
  134.     MatrixCols := StrToInt(ReadNextLine(InputFile));
  135.  
  136.     SetLength(Matrix, MatrixRows, MatrixCols);
  137.  
  138.     while (i < MatrixRows) do
  139.     begin
  140.         CurrentString := ReadNextLine(InputFile);
  141.         MatrixRow := TakeRow(CurrentString, MatrixCols);
  142.         Matrix[i] := MatrixRow;
  143.         i := i + 1;
  144.     end;
  145.  
  146.     CloseFile(InputFile);
  147.     TakeMatrixFromFile := Matrix;
  148. end;
  149.  
  150. function TakeProduct(const Matrix: TwoDimArr; const Vector: Arr;
  151.     VectorLength: Integer): TwoDimArr;
  152. var
  153.     i, j, k: Integer;
  154.     Product: TwoDimArr;
  155. begin
  156.     SetLength(Product, VectorLength, Length(Matrix[0]));
  157.     for i := 0 to High(Product) do
  158.         for j := 0 to High(Matrix) do
  159.             for k := 0 to High(Matrix[j]) do
  160.                 Product[i, k] := Product[i, k] +
  161.                     Vector[IfThen(VectorLength = 1, j, i)] * Matrix[j, k];
  162.  
  163.     TakeProduct := Product;
  164. end;
  165.  
  166. begin
  167.     NotCorrect := true;
  168.     Writeln('Данная программа находит произведение вектора на матрицу');
  169.     Writeln;
  170.     Writeln('Введите путь до файла');
  171.     Readln(FilePath);
  172.     if (FileExists(FilePath)) then
  173.     begin
  174.         AssignFile(InputFile, FilePath);
  175.         Matrix := TakeMatrixFromFile(InputFile);
  176.         Writeln('Матрица:');
  177.         ShowMatrix(Matrix);
  178.         Vector := TakeVector(InputFile, VectorType);
  179.         Writeln('Тип вектора: ', VectorType);
  180.         Writeln('Вектор:');
  181.         ShowVector(Vector);
  182.  
  183.         MatrixRows := Length(Matrix);
  184.         MatrixCols := Length(Matrix[0]);
  185.         VectorLength := Length(Vector);
  186.         NotCorrect := false;
  187.     end
  188.     else
  189.         Writeln('Указанный вами файл не существует');
  190.  
  191.     if (Not NotCorrect) then
  192.     begin
  193.         if (((VectorType = 'вектор-столбец') and (MatrixRows <> 1)) or
  194.             ((VectorType = 'вектор-строка') and (MatrixRows <> VectorLength)))
  195.         then
  196.         begin
  197.             Writeln('Число строк в матрице должно быть равно числу столбцов в векторе');
  198.         end
  199.         else
  200.         begin
  201.             if (VectorType = 'вектор-строка') then
  202.                 VectorLength := 1;
  203.  
  204.             SetLength(Product, VectorLength, MatrixCols);
  205.             Product := TakeProduct(Matrix, Vector, VectorLength);
  206.  
  207.             Writeln('Результат :');
  208.             ShowMatrix(Product);
  209.         end;
  210.     end;
  211.  
  212.     Readln;
  213. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement