Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 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.011 c
1-1133530644
volod
2005-12-02 16:37
2006.01.01
Как с помощью функции OnDrawColumnCell выделить цветом всю строку


14-1134112577
begin...end
2005-12-09 10:16
2006.01.01
С Днём рождения! 9 декабря


1-1133863473
general
2005-12-06 13:04
2006.01.01
Вопрос по мышиному колесу


1-1133614064
Толян
2005-12-03 15:47
2006.01.01
Система счисления


1-1133515793
VID
2005-12-02 12:29
2006.01.01
Проблема отрисовки ProgressBar в XP !





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский