Код:
program project1;
type
massive = array [1..100,1..100] of integer;
RealMassive = array [1..100,1..100] of real;
var i,j,n,Ex_Pr: integer;
det: real;
Mas: array[1..100,1..100] of integer;
File_Matrix: text;
procedure WriteInFile(mas: massive; Zagolovok: string); {Запись результата в файл}
var k,i: integer;
begin
append(File_Matrix);
writeln(File_Matrix);
writeln(File_Matrix, Zagolovok);
for i:= 1 to n do
begin
for k:= 1 to n do
begin
write(File_Matrix, mas[i,k]);
end;
writeln(File_Matrix);
end;
close(File_Matrix);
end;
procedure SumEL(j,f: integer);{Сумма элементов 2}
var m,i,Sum: integer;
begin
append(File_Matrix);
for m:= 1 to n do
begin
Sum:= mas[j,m] + mas[m,f];
writeln(mas[j,m],'+',mas[m,f],'=',Sum);
writeln(File_Matrix);
write(File_Matrix,'sum= ',mas[j,m],'+',mas[m,f],'=',Sum);
end;
writeln(File_Matrix);
close(file_matrix);
end;
Procedure SumElement; {сумма элементов}
var i,j,k,f : integer;
begin
for i:= 1 to n do
begin
for k:= 1 to n do
begin
write(mas[i,k],' ');
end;
writeln();
end;
writeln('Enter string number');
readln(j);
writeln('Enter coloumn number');
readln(f);
SumEl(j,f);
end;
Procedure SpinMatrix; {Вращение матрицы}
var i,k,f: integer;
New_Mas: array[1..100,1..100] of integer;
begin
f:= n;
for i:= 1 to n do {Цикл вращения матрицы}
begin
for k:= 1 to n do
begin
New_Mas[k,f]:= mas[i,k];
end;
dec(f);
end; {/Цикл вращения матрицы}
for i:= 1 to n do {Вывод матрицы (Перевернутой)}
begin
for k:= 1 to n do
begin
write(New_Mas[i,k],' ');
end;
writeln();
end;
WriteInFile(New_Mas,'Rotation');
end; {/Вывод матрицы (Перевернутой)}
Procedure Transpose; {Транспонирование}
var i,k: integer;
New_Mas: array[1..100,1..100] of integer;
begin
for i:= 1 to n do
begin
for k:= 1 to n do
begin
if i <> k then
New_Mas[i,k]:= mas[k,i]
else
New_Mas[i,k]:= Mas[i,k];
write(New_Mas[i,k],' ');
end;
writeln();
end;
WriteInFile(New_Mas, 'Transpose');
end;
procedure Per(k,n:integer;var a:RealMassive; var p:integer);
var i,j:integer;z:real;
begin
z:=a[k,k];
i:=k;
p:=0; //после каждого преобразования
for j:=k+1 to n do //ищем по оставшимся строкам
begin
if abs(a[j,k])>z then //максимальный по модулю элемент
begin
z:=abs(a[j,k]);
i:=j; //запоминаем номер строки
p:=p+1;//считаем количество перестановок, т.к. при каждой
//перестановке меняется знак определителя
end;
end;
if i>k then //если эта строка ниже данной
for j:=k to n do
begin
z:=a[i,j];
a[i,j]:=a[k,j];
a[k,j]:=z;//перестановка
end;
end;
function znak(p:integer):integer;//ф-я определения знака определителя
begin
if (p mod 2 <> 0) then //если четное количество перестановок, "+" , если нет "-"
znak:=1
else
znak:=-1;
end;
procedure determinante(n:integer;var a:RealMassive;var det:real);//собственно определитель
var k,i,j,p:integer;
r:real;
begin
det:=1;
for k:=1 to n do //считаем по алгоритму, который во всех учебниках
begin
if a[k,k]=0 then per(k,n,a,p);//если главный элемент=0, делаем перестановку
det:=znak(p)*det*a[k,k]; //меняем знак определителя
for j:=k+1 to n do //делаем преобразования
begin
r:=a[j,k]/a[k,k];
for i:=k to n do
begin
a[j,i]:=a[j,i]-r*a[k,i];
end;
end;
end;
end;
procedure _Real_Massive(mas: massive); {Преобразует массив в вещественный тип}
var Real_Massive: array [1..100,1..100] of real;
i,k: integer;
begin
for i:= 1 to n do
for k:= 1 to n do
Real_Massive[i,k]:= mas[i,k]/1;
determinante(n,real_Massive,det);
writeln('Determinante= ', det:0:2);
append(File_Matrix);
writeln(File_Matrix);
write(File_Matrix,'det= ',det:0:2);
close(file_matrix);
end; {/Преобразует массив в вещественный тип}
procedure MainMenu; {Главное меню}
var task: integer;
begin
writeln(' ** Main Menu ** ');
writeln;
writeln('Enter task number');
writeln('1. Sum Elements');
writeln('2. Matrix Rotation');
writeln('3. Matrix Transpose');
writeln('4. Determinant');
writeln('5. Exit from the
program');
readln(task);
case task of
1: SumElement;
2: SpinMatrix;
3: Transpose;
4: _Real_Massive(mas);
5: Ex_Pr:= 1;
end;
end;
begin {Основная программа}
randomize;