Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

 
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 22.05.2010, 11:24
Flashton Flashton вне форума
Прохожий
 
Регистрация: 11.05.2010
Сообщения: 8
Репутация: 10
Вопрос Исправление готовой программы

Здравствуйте. Есть программа, реализующая метод Зейделя, делалась на основе программы написанной на Pascal. Помогите найти ошибку! Сам искал, не нашёл.
Почему-то при вводе данных обнуляется массив B, исправьте, пожалуйста, или подскажите как это исправить.
Программа Delphi (которую надо помочь исправить):
http://narod.ru/disk/21014231000/Seidel.rar.html

Текст этой проги:
Код:
unit Unit2A;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;

Const
maxn = 8;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    StringGrid3: TStringGrid;
    Button1: TButton;
    logMemo: TMemo;
    Button2: TButton;
    procedure ComboBox1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit1Exit(Sender: TObject);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure StringGrid2KeyPress(Sender: TObject; var Key: Char);
    procedure StringGrid1Exit(Sender: TObject);
    procedure StringGrid2Exit(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

{ объявления типов. "Псевдоним" для типа с плавающей запятой(т.е. дробного числа),
матрица - двумерный массив размером maxn на maxn, и вектор - одномерный массив из maxn элементов}
	Matrix = Array[1..maxn, 1..maxn] of Real;
	Vector = Array[1..maxn] of Real;

var
  Form1: TForm1;

implementation
uses Unit2;
{$R *.dfm}

procedure TForm1.ComboBox1Change(Sender: TObject);
var
  n:integer;
begin
  n:=StrToInt(ComboBox1.Items[ComboBox1.ItemIndex]);
  StringGrid1.Colcount:=n+1;
  StringGrid1.Rowcount:=n+1;
  StringGrid2.Rowcount:=n+1;
  StringGrid3.Rowcount:=n+1;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i,j:integer;
begin
  StringGrid1.Cells[0,0]:='Матрица A';
  StringGrid2.Cells[0,0]:='Массив B';
  StringGrid3.Cells[0,0]:='Массив X';
  for i:=1 to StringGrid1.RowCount do
    for j:=1 to StringGrid1.ColCount do
      StringGrid1.Cells[i,j]:='0';
  for i:=1 to StringGrid2.RowCount do
    StringGrid2.Cells[0,i]:='0';
end;

{ Функция, реализующая метод Зейделя }
function Seidel(n: Integer; a: Matrix; b: Vector; var x: Vector; e: Real) :Boolean;
var
  i, j: Integer;
  s1, s2, s, v, m: Real;
begin

{ Исследуем сходимость }
	{собственно да. Повторяем для каждой строки матрицы.
	 если сумма элементов строки матрицы, кроме диагонального больше,
	 чем этот самый диагональный, значит система методом Зейделя не решится }
	For i := 1 to n do begin
		{ это переменная, в которой будем хранить сумму, поэтому она сначала равна нулю }
		s := 0;
		{ проходим по всей строке... }
		For j := 1 to n do
			{ ..и если элемент не диагональный, прибавляем его модуль к нашей сумме }
			If j <> i then
				s := s + Abs(a[i, j]);

		{ а когда пройдем всю строку, в переменной эс окажется вся нужная сумма
		 ее-то мы и сравниваем с модулем соотв. диагонального элемента...}
		If s >= Abs(a[i, i]) then begin
			{ и если условие сходимости не выполняется,
			 возвращаем в основную программу ложь... }
			Result := false;
			{ и выходим из функции. }
			Exit;
		end;

	end;

	{ если мы достигли этого места, значит условие сходимости выполнено для всех строк матрицы
	 и мы можем продолжать решать систему методом Зейделя. Чему и ура. }

	{ вот этот блок будем повторять... }
	Repeat
		{ ибо метод итерационный - у нас есть предполагаемые значения иксов,
		  а мы будем рассчитывать на каждой итерации-шаге новый набор, и смотреть
		  на изменения - разницу между новым значением и старым. }

		{ тут будем хранить наибольшее из изменений переменной икс}
		m := 0;

		{ повторяем для каждой строки системы уравнений.
		 к слову сказать, к каноническому виду ее мы не привели, и поэтому будет
		 весело. }
		For i := 1 to n do begin

			{ Вычисляем суммы }
			{ они понадобятся для вычисления икса...
			состоят из элементов матрицы, умноженных на соотв. икс}
			s1 := 0;
			s2 := 0;
			{ первая - для элементов от первого до диагонального }
			For j := 1 to i - 1 do
				s1 := s1 + a[i, j] * x[j];
			{ вторая - от диагонального, включая его самого,
			 и до конца. Непонятно к чему такие фокусы, ибо
			 в конце их все равно складываем... }
			For j := i to n do
				s2 := s2 + a[i, j] * x[j];

			{ Вычисляем новое приближение и погрешность }
			{ сохраняем предыдущее значение }
			v := x[i];
			{ считаем новое.
			 до этой формулы шли долгой математикой, так что
			 в двух словах этого не объяснить... например, = x[i] - ( вот это нужно,
			 потому что в суммы мы включили диагональный элемент))) (1 / a[i, i]) - вот это
			 компенсация изначального неприведения системы к каноническому виду,
			 если бы мы сначала поделили бы все элементы на соотв. диагональные,
			 сего бы не было... а вообще не суть важно, ибо формула таки верная.}
			x[i] := x[i] - (1 / a[i, i]) * (s1 + s2 - b[i]);

			{ тут мы ищем максимальное изменение икса. если находим такое, сохраняем}
			If Abs(v - x[i]) > m then
				m := Abs(v - x[i]);

		end;

	{ вот этот блок будем повторять, пока не будет достигнута требуемая точность вычислений,
	 другими словами, пока самая большая разница между значением икса на предыдущем шаге и
	 значинием его же на этом шаге не будет меньше, чем нужная точность вычислений }
	Until m < e;

	{ собственно, если добрались до сюда, значит решили систему. Возвращаем правду. }
	Result := true;
End;

{ Процедура вывода результатов }
Procedure WriteX(n :Integer; x: Vector);
Var
i: Integer;
Begin
	{ все элементы вектора-решения, от первого до последнего, пишем на экране }
	For i := 1 to n do
    Form1.StringGrid3.Cells[0,i]:='x'+IntToStr(i)+' = '+FloatToStr(x[i]);
End;

procedure TForm1.Button1Click(Sender: TObject);
var
  n,i,j: integer;
  a: matrix;
  b,x: vector;
  e,s: real;
  str:string;
begin
  logMemo.Clear;
  n:=StrToInt(ComboBox1.Items[ComboBox1.ItemIndex]);
  e:=StrToFloat(Edit1.Text);
  for i:=1 to maxn do begin
    b[i]:=0;
    for j:=1 to maxn do
      a[i,j]:=0;
  end;

  for i:=1 to n do begin
    b[i]:=StrToFloat(StringGrid2.Cells[0,i]);
    for j:=1 to n do
      a[i,j]:=StrToFloat(StringGrid1.Cells[i,j]);
  end;
  if (e<=0) or (e>1) then begin
    MessageDlg('Некорректная точность вычислений!',mtError,[mbOk],0);
    exit;
  end;
	If Seidel(n, a, b, x, e) then begin
		{ ... и если он вычислится, пишем на экран... }
		logMemo.Lines.Add('Результат вычислений:');
		WriteX(n, x);

		{ Проверяем правильность решения подстановкой }
		{ Повторяем для каждой строки системы уравнений }
		for i:= 1 to n do
		begin
			{ подставляем иксы в уравнение, и считаем.
			  если полученное значение будет равно соотв. свободному члену
			  или отличаться от него на значение точности, значит все норм. }
			s:= 0;
			for j:= 1 to n do
				s:= s + a[i, j]*x[j];

			{ выводим на экран уравнение и подсчитанное значение
			  уравнение, естественно, с подставленными иксами
			 пишем все слагаемые...}
      str:='';
			for j:= 1 to n do
			begin
				str:=str+(FloatToStr(a[i, j])+'*['+FloatToStr(x[j])+']');
				{ ... и если слагаемое не последнее, ставим плюс }
				if (j<>n) and (a[i, j+1] >= 0) then
					str:=str+'+';
			end;

			{ а в конце ставим равно и выводим найденное значение }
			logMemo.Lines.Add(str+' = '+FloatToStr(s));
		end;
	end
	else begin
		logMemo.Lines.Add('Метод Зейделя не сходится для введённой системы');
    MessageBeep(0);
  end;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key='.' then Key:=',';
  if ((Key<'0') or (Key>'9')) and (Key<>',') and (Key<>#8) then begin
    Key:=#0;
    MessageBeep(0);
  end;
end;

procedure TForm1.Edit1Exit(Sender: TObject);
begin
  if Edit1.Text='' then Edit1.Text:='0';
end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key='.' then Key:=',';
  if ((Key<'0') or (Key>'9')) and (Key<>'-') and (Key<>',') and (Key<>#8) then begin
    Key:=#0;
    MessageBeep(0);
  end;
end;

procedure TForm1.StringGrid2KeyPress(Sender: TObject; var Key: Char);
begin
  if Key='.' then Key:=',';
  if ((Key<'0') or (Key>'9')) and (Key<>'-')  and (Key<>',') and (Key<>#8) then begin
    Key:=#0;
    MessageBeep(0);
  end;
end;

procedure TForm1.StringGrid1Exit(Sender: TObject);
var
  i,j:integer;
begin
  for i:=1 to StringGrid1.RowCount do
    for j:=1 to StringGrid1.ColCount do
      if StringGrid1.Cells[i,j]='' then StringGrid1.Cells[i,j]:='0';
end;

procedure TForm1.StringGrid2Exit(Sender: TObject);
var
  i:integer;
begin
  for i:=1 to StringGrid2.RowCount do
    if StringGrid1.Cells[0,i]='' then StringGrid2.Cells[0,i]:='0';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Form2.Show;
end;

end.
Ответить с цитированием
 


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 15:09.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025