Технический форум

Технический форум (http://www.tehnari.ru/)
-   Помощь студентам (http://www.tehnari.ru/f41/)
-   -   Матрицы (http://www.tehnari.ru/f41/t60260/)

Aizen_Stas 24.11.2011 21:29

Матрицы
 
Вложений: 1
Помогите найти ошибку! При ручном счете результаты вычисления вектора не совпадают с машинным.Кратко привожу постановку задачи и свой алгоритм:
1)расчёт элементов квадратной матрицы A=a(i,j), i,j=1,2,…n по заданной формуле:a=sin(i*j)*ln(j!);
2)вычисление элементов вектора X=x(i) i=1,2,…n
по заданному правилу:xi-скалярное произведение i-го столбца на (n+1-i)-ю строку;
3)упорядочить элементы четных строк матрицы А по убыванию абсолютных значений;
4)вычисление значения функции y по заданной формуле:Вложение 57043

Алгоритм:

Program Lab5;
Const n=3;
Title='Pabota 5';
Type vect=array[1..n] of real;
matr=array[1..n,1..n] of real;
Var x:vect; a:matr;
i,j:integer;
y:real;
Procedure Matrica(n:integer; Var A:matr);
Var f,i,j:integer;
Begin
for i:=1 to n do
for j:=1 to n do
begin
f:=1;
f:=f*j;
a[j,i]:=sin(i*j)*ln(f);
end;
End;
Procedure Vector(n:integer; A:matr; Var X:vect);
Var l,k,h,i:integer;
Begin
for i:=1 to n do
begin
l:=n+1-i;
h:=0;
for k:=1 to n do
x[i]:=h+a[k,i]*a[l,k];
end;
End;
Procedure Porjadok(n:integer; Var A:matr);
Var k,i,j:integer;
q:real;
Begin
for j:=1 to n do
begin
if j mod 2=0 then
begin
for i:=1 to n-1 do
for k:=i+1 to n do
if abs(a[j,i])<abs(a[j,k]) then
begin
q:=a[j,i]; a[j,i]:=a[j,k]; a[j,k]:=q;
end;
end;
end;
End;
Function Fyn(n:integer; X:vect):real;
Var i:integer;
P,S,y:real;
Begin
p:=1;
s:=0;
for i:=1 to n do
begin
if x[i]<0 then p:=p*x[i];
if x[i]>0 then s:=s+x[i];
y:=p/s;
end;
Fyn:=y;
End;

Begin
Matrica(n,a);
Writeln('MATPICA A');
for i:=1 to n do
Begin
for j:=1 to n do Write(a[i,j]:8:3);
writeln;
End;
Vector(n,a,x);
Writeln('BEKTOP X');
for i:=1 to n do write(x[i]:8:3);
writeln;
Porjadok(n,a);
Writeln('UPOR CHETNYE STROKI MATPICY A');
for i:=1 to n do
Begin
for j:=1 to n do Write(a[i,j]:8:3);
writeln;
End;
y:=Fyn(n,x);
Writeln('Rez y= ',y:10:3);
Writeln(Title);
End.

Vladimir_S 24.11.2011 23:41

Цитата:

Сообщение от Aizen_Stas (Сообщение 623001)
Помогите найти ошибку!

Эх, да если бы "ошибку"! Ошибок тут такое море, что утонуть можно! Вот лишь некоторые:
1. В процедуре Matrica неверно считается факториал.
2. Там же перепутаны индексы массива (a[j,i] вместо a[i,j]).
3. В процедуре Porjadok неверно записан алгоритм "пузырька".
4. В функции Fyn вычисление y:=p/s; загнано в тело цикла (а надо после), что приводит к ошибке и "вылету" программы.
В общем, до крайности неряшливая работа. Извините, но в программировании так нельзя: компьютер "общих соображений" не понимает, в программе всё должно быть выверено до последней точки.
Вот исправленный вариант:
Код:

Const
 n=3;
 Title='Pabota 5';
Type
 vect=array[1..n] of real;
 matr=array[1..n,1..n] of real;
Var
 x:vect;
 a:matr;
 i,j:integer;
 y:real;

Procedure Matrica(n:integer; Var A:matr);
Var
  i,j,k:integer;
  f:Longint;
Begin
 for i:=1 to n do
  for j:=1 to n do
  begin
    f:=1;
    for k:=1 to j do
    f:=f*k;
    a[i,j]:=sin(i*j)*ln(f);
  end;
End;

Procedure Vector(n:integer; A:matr; Var X:vect);
Var
 l,k,i:integer;
Begin
 for i:=1 to n do
  begin
  l:=n+1-i;
  x[i]:=0;
  for k:=1 to n do
  x[i]:=x[i]+a[k,i]*a[l,k];
  end;
End;

Procedure Porjadok(n:integer; Var A:matr);
Var
 k,i,j:integer;
 q:real;
Begin
 for j:=1 to n do
  begin
  if j mod 2=0 then
    begin
    for i:=1 to n do
      for k:=1 to n-i do
      if abs(a[j,k])<abs(a[j,k+1]) then
        begin
        q:=a[j,k];
        a[j,k]:=a[j,k+1];
        a[j,k+1]:=q;
        end;
    end;
  end;
End;

Function Fyn(n:integer; X:vect):real;
Var
 i:integer;
 P,S:real;
Begin
 p:=1;
 s:=0;
 for i:=1 to n do
  begin
  if x[i]<0 then p:=p*x[i];
  if x[i]>0 then s:=s+x[i];
  end;
 Fyn:=p/s;
End;

Begin
 Matrica(n,a);
 Writeln('MATPICA A');
 for i:=1 to n do
  Begin
  for j:=1 to n do
    Write(a[i,j]:8:3);
  writeln;
  End;
 Vector(n,a,x);
 Writeln;
 Writeln('BEKTOP X');
 for i:=1 to n do write(x[i]:8:3);
 writeln;
 writeln;
 Porjadok(n,a);
 Writeln('UPOR CHETNYE STROKI MATPICY A');
 for i:=1 to n do
  Begin
  for j:=1 to n do
    Write(a[i,j]:8:3);
  writeln;
  End;
 writeln;
 y:=Fyn(n,x);
 Writeln('Rez y= ',y:10:3);
 Writeln(Title);
 Readln
End.



Часовой пояс GMT +4, время: 00:28.

Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.