IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Программа на файлы, Программа на файлы
Demon666
сообщение 25.04.2007 17:04
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской
Реальное имя: Lbvf

Репутация: -  0  +


Люди помогите пожалуйста, написал программу, но видимо где то ошибки, помогите пожалуйста найти. Программа должна читать из файла матрицу, в один файл должна забивать нижнетреугольную матрицу (нули под главной диагональю), в другой - верхнедиагональную. а в третий ответ на вопрос - является ли матрица симметричной (т.е матрица равна своей транспонированной)


program matr;
const nmax=10;
n=10;
type
tc=real;
tmas=array[1..nmax, 1..nmax] of tc;
tmatrix=record n:1..n;
c:tmas;
end;

function somn(a,b:real):real;
var c:real;
begin
if (a=0) or (b=0) then c:=0;
if (a>=b) and (b<>0) then c:=a/b
else
if (a<b) and (a<>0) then c:=b/a;

somn:=c;

end;

procedure readf(var f:text; var a:tmatrix);
var i,j:integer;
begin
readln(f, a.n);
for j:=1 to a.n do
for i:=1 to a.n do
read(f, a.c[i][j]);
end;

procedure neal(var a:tmatrix);
var i,j,k:integer; p:real;
begin
i:=1; j:=1;
for i:=1 to a.n do
for j:=i+1 to a.n do begin
p:=somn(a.c[i][1], a.c[i][j]);
for k:=1 to a.n do
a.c[k][j]:=a.c[k][j]-p*a.c[k][1];
end;
end;

procedure trans(var a:tmatrix);
var i,j,k:integer;
p:real;
begin
i:=1;
for k:=0 to a.n-1 do begin
for j:=2 to a.n do begin
p:=a.c[i+k][j+k];
a.c[i+k][j+k]:=a.c[j+k][i+k];
a.c[j+k][i+k]:=p;

end;
end;
end;
function prov(a:tmatrix):boolean;
var i,j:integer;
begin
prov:=true;
for i:=1 to a.n do
for j:=1 to a.n do
if a.c[i][j]<>a.c[j][i] then prov:=false;
end;

var f,f1,f2,f3:text;
a,m,p:tmatrix;
i,j:integer;

begin
assign(f, 'm:\ish.txt');
reset(f);
assign(f1, 'c:\out1.txt');
rewrite(f1);
assign(f2, 'c:\out2.txt');
rewrite(f2);
assign(f3, 'c:\out3.txt');
rewrite(f3);
write(f2, prov(a));
readf(f, a);
m:=a;
neal(a);
for j:=1 to a.n do begin
for i:=1 to a.n do
write(f1, a.c[i][j]);
writeln(f1);
end;

trans(m);
neal(m);
trans(m);
for j:=1 to a.n do begin
for i:=1 to a.n do
write(f3, m.c[i][j]);
writeln(f3);
end;

close(f);
close(f1);
close(f2);
close(f3);
end.



заранее спасибо!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 19.07.2025 19:05
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"