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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 21.06.2010, 15:32   #1
Zimba
 
Регистрация: 21.06.2010
Сообщений: 4
По умолчанию Процедуры и функции(Pascal)

Помогите пожалуйста сделать проверку , за ранее спасибо!


Код:
Uses CRT;

Const
     maxn = 10;

Type
    Data = Real;
    Matrix = Array[1..maxn, 1..maxn] of Data;
    Vector = Array[1..maxn] of Data;

Procedure ReadSystem(n: Integer; var a: Matrix; var b: Vector);
Var
   i, j, r: Integer;
Begin
     r := WhereY;
     GotoXY(2, r);
     Write('A');
     For i := 1 to n do begin
         GotoXY(i*6+2, r);
         Write(i);
         GotoXY(1, r+i+1);
         Write(i:2);
     end;
     GotoXY((n+1)*6+2, r);
     Write('b');
     For i := 1 to n do begin
         For j := 1 to n do begin
             GotoXY(j * 6 + 2, r + i + 1);
             Read(a[i, j]);
         end;
         GotoXY((n + 1) * 6 + 2, r + i + 1);
         Read(b[i]);
     end;

End;


Procedure WriteX(n :Integer; x: Vector);
Var
   i: Integer;
Begin
     For i := 1 to n do
         Writeln('x', i, ' = ', x[i]);
End;


Function Gauss(n: Integer; a: Matrix; b: Vector; var x:Vector): Boolean;
Var
   i, j, k, l: Integer;
   q, m, t: Data;
Begin

     For k := 1 to n - 1 do begin


         l := 0;
         m := 0;
         For i := k to n do
             If Abs(a[i, k]) > m then begin
                m := Abs(a[i, k]);
                l := i;
             end;


         If l = 0 then begin
            Gauss := false;
            Exit;
         end;


         If l <> k then begin
            For j := 1 to n do begin
                t := a[k, j];
                a[k, j] := a[l, j];
                a[l, j] := t;
            end;
            t := b[k];
            b[k] := b[l];
            b[l] := t;
         end;


         For i := k + 1 to n do begin
             q := a[i, k] / a[k, k];
             For j := 1 to n do
                 If j = k then
                    a[i, j] := 0
                 else
                      a[i, j] := a[i, j] - q * a[k, j];
                 b[i] := b[i] - q * b[k];
             end;

     end;


     x[n]:= b[i] / a[n, n];
     For i := n - 1 downto 1 do begin
         t := 0;
         For j := 1 to n-i do
             t := t + a[i, i + j] * x[i + j];
         x[i] := (1 / a[i, i]) * (b[i] - t);
     end;

     Gauss := true;
End;

Var
    n, i: Integer;
    a: Matrix ;
    b, x: Vector;
Begin
      ClrScr;
      Writeln('reshenie');
      Writeln;

      Writeln('razshirennaia matrica');
      Repeat
             Write('n');
             Read(n);
      Until (n > 0) and (n <= maxn);
      Writeln;

      Writeln('3:5');
      ReadSystem(n, a, b);
      Writeln;

      If Gauss(n, a, b, x) then begin
         Writeln('x=');
         WriteX(n, x);
      end
      else
          Writeln('reshenii net');
      Writeln;
End.

Последний раз редактировалось Zimba; 21.06.2010 в 20:25.
Zimba вне форума Ответить с цитированием
Старый 21.06.2010, 16:09   #2
Snejnaya
Форумчанин
 
Регистрация: 12.05.2010
Сообщений: 219
По умолчанию

как твое задание "перемножить строку на столбец" соотносится с приведенным в сообщении кодом? Результат перемножения строки на столбец - это просто число.
Snejnaya вне форума Ответить с цитированием
Старый 21.06.2010, 18:40   #3
Zimba
 
Регистрация: 21.06.2010
Сообщений: 4
По умолчанию

программа решает матрицу методом гаусса,дает 3 корня, надо сделать проверку чтобы выяснить правильно ли программа решает
Zimba вне форума Ответить с цитированием
Старый 21.06.2010, 18:53   #4
Zimba
 
Регистрация: 21.06.2010
Сообщений: 4
По умолчанию

Короч проверка заключается в том что полученные корни надо умножить на строки,и если они верны,то получится столбец вектора(b),помогите пожалуйста очень надо...

Последний раз редактировалось Zimba; 21.06.2010 в 20:05.
Zimba вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Процедуры и функции (Pascal) P1RoG Помощь студентам 2 29.04.2010 03:44
[Pascal] Процедуры и функции koshkarjov Помощь студентам 4 29.04.2010 03:31
[Pascal] Функции и процедуры(подпрограммы) Рамик Помощь студентам 2 23.03.2009 17:00
Pascal-процедуры и функции xxBOBAHxx Помощь студентам 3 18.11.2008 14:30