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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 24.05.2015, 06:08   #1
Джесс1
 
Регистрация: 23.03.2015
Сообщений: 3
По умолчанию Помогите дорешать

Здравствуйте)) Помогите пожалуйста дорешать задачу про метод Гаусса.
Мне осталось найти обратную матрицу, но я не могу сообразить как..

Вот задача..
Код:
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

Const nmax=10;
Type mas=array[1..nmax] of real;
     matr=array[1..nmax] of mas;
Var A,C,T:matr;
    b,x:mas;
    i,j,n,count,err:integer;
    det,s:real;
Procedure Gaus(Var A:matr;B:mas;Var X:mas;Var count:integer;Var err:integer);
Var i,j,k,imax:integer;
    temp,pr,sum:real;
Begin
    count:=0;err:=0;
    For k:=1 to n-1 do
    Begin
     //ищем в столбце k max элемент
     imax:=k;
     For i:=k+1 to n do
      if abs(A[i,k])>abs(A[imax,k]) then imax:=i;
     if imax<>k then
     Begin
       For j:=1 to n do
       Begin
         temp:=A[k,j];
         A[k,j]:=A[imax,j];
         A[imax,j]:=temp;
       End;
       temp:=B[k];
       B[k]:=B[imax];
       B[imax]:=temp;
       //увеличиваем кол-во перестановок
       inc(count);
     End;
     //прямой метод Гаусса
     For i:=k+1 to n do
     Begin
        pr:=a[i,k]/a[k,k];
        For j:=1 to n do
         a[i,j]:=a[i,j]-a[k,j]*pr;  
        b[i]:=b[i]-b[k]*pr;
        if A[i,i]=0 then

        Begin
          err:=1;
          //âûõîäèì
          Exit;
        End;
     End;
     End;

     //обратный ход Метода Гаусса
     x[n]:=b[n]/a[n,n];
     For k:=n-1 downto 1 do
     Begin
        sum:=0;
        For i:=k+1 to n do
         sum:=sum+x[i]*a[k,i];
        x[k]:=(b[k]-sum)/a[k,k];
     End;
End;
Begin
    //размер и сама СЛАУ
    n:=4;
    A[1,1]:=-3;A[1,2]:=2;A[1,3]:=-4;A[1,4]:=5;B[1]:=12.29;
    A[2,1]:=2;A[2,2]:=-1;A[2,3]:=1;A[2,4]:=-11.5;B[2]:=-12.69;
    A[3,1]:=1;A[3,2]:=-3;A[3,3]:=-2;A[3,4]:=2.7;B[3]:=13.10;
    A[4,1]:=5;A[4,2]:=-1;A[4,3]:=3;A[4,4]:=7.8;B[4]:=56.93;
    C:=A;
  
    Gaus(A,B,X,count,err);
    if err=1 then
    Begin
      writeln('Matrica virozhdennaya');
      Exit;
    End;
    
    write('X = (',X[1]:7:3);
    For i:=2 to n do
     write(';',X[i]:7:3);
    writeln('  )');
    write('Nevyazka: ');
    For i:=1 to n do
    Begin
      s:=0;
      For j:=1 to n do
       s:=s+C[i,j]*X[j];
      //выводим невязку
      write(s-B[i]:0:2,' ');
    End;
    writeln;
    if odd(count) then det:=-1
     else det:=1;
    For i:=1 to n do
     det:=det*A[i,i];//вычисляем определитель
    writeln('det(A) = ',det:0:2);
    For i:=1 to n do
     B[i]:=0;
    readln;

End.

Последний раз редактировалось Stilet; 24.05.2015 в 06:52.
Джесс1 вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
помогите дорешать задачу pavelstraut Общие вопросы C/C++ 4 23.07.2009 16:53
Помогите дорешать программу darika Паскаль, Turbo Pascal, PascalABC.NET 4 14.05.2009 15:08
Помогите дорешать задачу на While Andrux Помощь студентам 12 29.12.2008 21:24