Матрицы

[Aizen_Stas]

Матрицы

Помогите найти ошибку! При ручном счете результаты вычисления вектора не совпадают с машинным.Кратко привожу постановку задачи и свой алгоритм:
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 по заданной формуле:

Алгоритм:

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:=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<0 then p:=p*x;
if x>0 then s:=s+x;
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: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]

Помогите найти ошибку!

Эх, да если бы "ошибку"! Ошибок тут такое море, что утонуть можно! Вот лишь некоторые:
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.