Решение системы линейных уравнений методом Гаусса.

[maliyusha]

Здравствуйте,не могу решить следующую задачу (на языке Паскаль):
При выполнении задания рекомендуется ввести в программу элементарную проверку правильности полученного решения путем подстановки полученных значений xi в наиболее полное уравнение исходной системы.
" x1 + x2 − x3 + x4 = 4,
2x1 − x2 + 3x3 − 2x4 = 1,
x1 − x3 + 2x4 = 6,
3x1 − x2 + x3 − x4 = 0"
Пожалуйста,помогите
Заранее благодарна

[maliyusha]

Очень нужно к пятнице(26 декабря),если не трудно.

[maliyusha]

Ну пожалуйста,откликнетесь! Неужели никто из программистов не может решить такую задачу? Для меня это сложно,потому что Паскаль изучаю всего 3 месяца а решить очень при очень нужно!!!

[lexus_ilia]

а там писанины много, а на самом деле советую поискать в инете...
Или лу4ше нет, я попробую у себя поискать, может что и найду

[lexus_ilia]

Я нашёл вам программу, которая решает систему уравнения методом Гауса, сначало используется Прямой ход для приведдения матрицы к треугольному виду, а потом обратный для нахождения x[1] x[2] ... x[n] ну а подстановку и проверку найденных елементов доделаете сами, это самая мелочь...

Program xa;
Const
 Nmax=20;
type
 VectorType = ARRAY[1..Nmax] OF Real;
 MatrixType = ARRAY[1..Nmax] OF VectorType;
function Gauss(n:Byte;A:MatrixType;B:VectorType;var x:VectorType):boolean;
var
 i,j,k,iMax:Byte;
 tmp,Max,d:Real;
 v:VectorType;
begin
 for k:=1 to n-1 do
 begin
  Max:=Abs(A[k,k]);
  iMax:=k;
  for i:=k+1 to n do
   if Abs(A[i,k])>Max then
   begin
    Max:=Abs(A[i,k]);
    iMax:=i;
   end;
  IF Max=0 THEN
  begin
   Gauss:=false;
   Exit
  end;
 IF iMax<>k then
 begin
  Tmp:=B[k];
  B[k]:=B[iMax];
  B[iMax]:=Tmp;
  v:=A[k];
  A[k]:=A[iMax];
  A[iMax]:=v
 end;
 for i:=k+1 to n do
  begin
   d:=A[i,k]/A[k,k];
   for j:=k to n do
    A[i,j]:=A[i,j]-d*A[k,j];
    B[i]:=B[i]-d*B[k];
  end;
 end;
 if A[n,n]=0 then
 begin
  Gauss:=false;
  Exit
 end;
 { ObPATHblu XoD }
 X[n]:=B[n]/A[n,n];
 for i:=n-1 downto 1 do
 begin
  tmp:=B[i];
  for j:=i+1 to n do
   tmp:=tmp-A[i,j]*X[j];
  X[i]:=tmp/A[i,i]
 end;
 Gauss:=true
end;
var
 n,i,j:Byte;
 a:MatrixType;
 b,x:VectorType;
begin
 Write('BBedute pa3mePbl matpuL/bl  ');
 READ(n);
 Writeln('PacLLIuPeHHa9 matpuL/a');
 for i:=1 to n do
 begin
  for j:=1 to n do
  begin
   write('A[' ,i, ',' ,j, ']=');
   readln(a[i,j]);
  end;
  Write('b[' ,i, ']=');
  readln(b[i]);
 end;
 if not Gauss(n,a,b,x) then
 begin
  Writeln('MatpiL/a Bblpo}l{DeHa');
  Halt;
 end;
 Writeln('PeLLIeHUe cuCTeMbl');
 for i:=1 to n do
 begin
  for j:=1 to n do
   b[i]:=b[i]-a[i,j]*x[j];
 Writeln(x[i]:12,' ',b[i]:12)
 end;
 readln
end.

[puporev]

Код программы с небольшими пояснениями я прилагаю, но если Вы не умеете или не понимаете как это решается на бумаге, Вы ничего не поймете, а пересказывать учебник я не буду.

uses crt;
const e=0.000001;//поскольку числа вещественные, при проверке точно не сойдется, поэтому вводим погрешность расчетов
var a:array[1..4,1..5] of real;//масив коэфф. и св. членов
    b:array[1..4] of real;//массив свободных членов
    x:array[1..4] of real;  //массив корней уравнения
    n,i,j,k:integer;z,r,g:real;
begin
clrscr;
n:=4;
writeln('Введите коэффициенты системы и свободные члены');
for i:=1 to n do
for j:=1 to n+1 do
read(A[i,j]);
readln;
clrscr;
writeln('Матрица коэффициентов и свободных членов');
for i:=1 to n do
  begin
    for j:=1 to n+1 do
    write(A[i,j]:6:2);
    writeln;
  end;
readln;
for i:=1 to n do  // запоминаем свободные члены 
b[i]:=a[i,n+1];
for k:=1 to n do //прямой ход Гаусса, приведение матрицы коэффициентов к треугольному виду
     begin
       for j:=k+1 to n do
          begin
            r:=a[j,k]/a[k,k];
            for i:=k to n do
               begin
                 a[j,i]:=a[j,i]-r*a[k,i];
               end;
            b[j]:=b[j]-r*b[k];
          end;
     end;
for k:=n downto 1 do //обратный ход Гаусса, вычисление корней
     begin
       r:=0;
       for j:=k+1 to n do
         begin
           g:=a[k,j]*x[j];
           r:=r+g;
         end;
      x[k]:=(b[k]-r)/a[k,k];
     end;
writeln('Корни системы:');
for i:=1 to n do
write('x[',i,']=',x[i]:0:2,'   ');
writeln;
writeln('Proverka:');
if 2*x[1]-x[2]+3*x[3]-2*x[4]-1<e then writeln('Reshenie vernoe!')//здесь применяем погрешность, или всегда будет неверный результат
else  writeln('Reshenie nevernoe!');
readln;
end.

[maliyusha]

Ребята,огромное спасибо за отклик! Все работает!
Дело за малым защитить! Еще раз спасибо!!!!

[puporev]

Реши этот пример на бумаге, много поймешь, да и зачтется.

[maliyusha]

Спасибо за совет Обязательно решу.

[RamzesVRA]

Функция заданая таблично. Постройте интерполяционный многочлен Лагранжа.
х
2 7 10

y
3 4 10

Заранее благодарен.