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

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

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

> Метод Гаусса
moto
сообщение 7.02.2004 4:48
Сообщение #1


Гость






Помогите плиз реализовать метод Гаусса  в Turbo pascal как можно более простым способом. Алгоритм решения ясен, вот только возникла проблема в приведении расширенной матрицы к диагональному виду, голову сломала  ??? помогите плиз!!!
 К началу страницы 
+ Ответить 
 
Closed Topic Открыть новую тему 
Ответов(1 - 2)
poison
сообщение 25.02.2004 13:55
Сообщение #2


Гость






Программа выглядит так:

Код
Program Gaus;
       const n=4;
       var  A: array [1..n,1..n] of Real;
            B: array [1..n] of Real;
            x: array [1..n] of Real;
            i, j, k:           Integer;
            L, G:              Real;
        Begin
             Writeln;
             for i:=1 to n do
                      x[i]:=0;
             for i:=1 to n do
                 begin
                      Write ('B[',i,']=');
                      Read  (B[i]);
                 end;
             for i:=1 to n do
                 for j:=1 to n do
                     read (A[i,j]);
             for k:=1 to (n-1) do
                 for i:=(k+1) to n do
                     begin
                          L:=A[i,k]/A[k,k];
                          B[i]:=B[i]-L*B[k];
                          for j:=k to n do
                              A[i,j]:=A[i,j]-L*A[k,j];
                     end;
             for i:=1 to n do
                 begin
                      writeln;
                      for j:=1 to n do
                          write (A[i,j]);
                 end;
             x[n]:=B[n]/A[n,n];
             for i:=(n-1) downto 1 do
                 begin
                      for k:=(i+1) to n do
                          G:=G+A[i,k]*x[k];
                      x[i]:=1/A[i,i]*(B[i]-G);
                      G:=0;
                 end;
             writeln;
             writeln;
             for i:=1 to n do
                 begin
                      writeln;
                      write ('X[',i,']=',x[i]);
                 end;
             end.


При выводе трехугольной матрицы случаются ошибки, но ответ всегда правильный.
 К началу страницы 
+ Ответить 
Zole
сообщение 21.05.2004 20:20
Сообщение #3





Группа: Пользователи
Сообщений: 3

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


Текст программы:
Код
Program Gauss;
Uses crt;
Const
     n=3;
Var i,j,k:integer;
    c,s:real;
    A:array[1..n,1..n] of real;
    B:array[1..n] of real;
    X:array[1..n] of real;
Begin   clrscr;
  Writeln(' Введите коэфициенты систем уравнений');
        For i:=1 to n do
        For j:=1 to n do read(a[i,j]);
   Writeln(' Введите коэфициенты свободных членов уравнений');
        For i:=1 to n do Read(b[i]);
               k:=1;
Repeat
       i:=k;
    Repeat
         c:=a[i+1,k]/a[k,k];
          j:=1;
       Repeat
             a[i+1,j]:=a[i+1,j]-c*a[k,j];
             j:=j+1
      Until    j>=n;
                  b[i+1]:=b[i+1]-c*b[k];
                  i:=i+1
    Until   i>n-1;
               k:=k+1
Until    k>=(n-1);
           x[n]:=b[n]/a[n,n];
           i:=n-1;
  Repeat
        s:=0;
        j:=i+1;
     Repeat
           s:=s+x[j]*a[i,j];
           j:=j+1
        Until    j>n;
                   x[i]:=(b[i]-s)/a[i,i];
                    i:=i-1
 Until i<0;
   For i:=1 to n do Writeln('x[',i,']=',x[i]:9:7)
End.

;) :p9: :p9:

Сообщение отредактировано: volvo - 5.01.2005 1:00
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 



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