Форум: "Потрепаться";
Текущий архив: 2006.01.01;
Скачать: [xml.tar.bz2];
ВнизРеализация алгоритма решения сист. лин. уравнений методом Гаусса Найти похожие ветки
← →
saNat © (2005-12-10 10:28) [0]Доброго времени, Мастера :о)
Ни у кого не завалялась реализация алгоритма решения системы линейных уравнений методом Гаусса на Delphi? Мне сестренка подкинула задачу. Типа сессия, обещали автоматом экзамен поставить, а у меня проект на работе. Хотелось бы сэкономить время ;о) В принципе, нашел исходник на С, но идеально было бы просто готовое ей отдать, пусчай разбирается ;о)
С уважением, ЕВА
← →
Хинт © (2005-12-10 11:09) [1]Метод Гаусса-Зейделя на Pascal"е
program lab4;
uses
crt;
label
l1,l2,l3,l4,l5;
var
A:array [1..3,1..3] of real;
B:array [1..3] of real;
X:array [1..3] of real;
S,E,Q,D,tx:real;
loop,i,j,k:integer;
const
n=3; M=1000;
begin
clrscr;
WriteLn("Example:");
WriteLn("a11*x1+a12*x2+a13*x3=b1");
WriteLn("a21*x1+a22*x2+a23*x3=b1");
WriteLn("a31*x1+a32*x2+a33*x3=b1");
WriteLn(#13#10"Enter Data:");
for i:=1 to 3 do for j:=1 to 3 do
begin
Write("a",i,j,"=");
ReadLn(a[i,j]);
end;
for i:=1 to 3 do
begin
Write("b",i,"=");
ReadLn(b[i]);
end;
clrscr;
WriteLn("Please wait...");
E:=0.01;
for Loop:=1 to 4 do
begin
k:=1; E:=E/10;
l1:
Q:=0; i:=1;
l2:
S:=0;
if i<>1 then
begin
j:=1;
l3:
s:=s+a[i,j]*x[j];
if j<i-1 then
begin
j:=j+1; goto l3;
end;
if j=n-1 then goto l5;
end;
j:=i+1;
l4:
s:=s+a[i,j]*x[j];
if j<n then
begin
j:=j+1; goto l4;
end;
l5:
tx:=(b[i]-s)/a[i,i];
d:=abs(tx-x[i]);
if q<d then q:=d;
x[i]:=tx;
if i<n then
begin
i:=i+1; goto l2;
end;
if q>e then
begin
if k<M then goto l1 else WriteLn("Error");
end
else
begin
WriteLn(#13#10"E=",E:6:6);
for i:=1 to n do WriteLn("X[",i,"]=",x[i]:9:9);
end;
end;
WriteLn(#13#10"Press <enter> to exit");
readln;
end.
← →
Хинт © (2005-12-10 11:10) [2]Совсем забыл =) Надо исходную матрицу преобразовать в матрицу с диагональным преобладанием.
← →
uw © (2005-12-10 11:12) [3]http://alglib.sources.ru/translator/view.php?location=/linequations/obsolete/gaussm&target=delphi
Страницы: 1 вся ветка
Форум: "Потрепаться";
Текущий архив: 2006.01.01;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.01 c