Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Работа для программиста > Фриланс
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 23.06.2019, 17:14   #1
Skeezmo
Новичок
Джуниор
 
Регистрация: 23.06.2019
Сообщений: 0
По умолчанию [Pascal] Исправьте ошибки , Плачу 100 рублей.

Код:
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;
Skeezmo вне форума
Старый 23.06.2019, 18:04   #2
Вадим Мошев

Старожил
 
Аватар для Вадим Мошев
 
Регистрация: 12.11.2010
Сообщений: 8,568
По умолчанию

https://www.programmersforum.ru/showthread.php?t=329708
Вадим Мошев вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите написать 5 программ за каждую плачу 200 рублей С++ NORTVEIT Фриланс 7 27.12.2013 00:10
MDI исправьте ошибки x_Alex_x Win Api 6 20.02.2013 17:04
исправьте ошибки Devil669 Microsoft Office Excel 4 15.12.2012 23:30
исправьте ошибки rwrwrw Паскаль, Turbo Pascal, PascalABC.NET 1 26.10.2011 08:59
исправьте ошибки CHOSEN1 Помощь студентам 7 08.10.2010 15:48