Новичок
Профиль
Группа: Участник
Сообщений: 1
Регистрация: 17.1.2007
Репутация: нет
Всего: нет
|
Помню сам парился  с вычматом и уже тогда решил, если сам напишу обязательно прогу выложу на всеобщее, так сказать осмотрение Вся каша сварена в одном юните и одной форме Delphi7  Методы половинного деления, комбинированный, итераций: | Код |
unit PoloCombo;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, StdCtrls, ValEdit, ExtCtrls;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Memo1: TMemo;
Memo2: TMemo;
Memo3: TMemo;
Label3: TLabel;
Button1: TButton;
DateTable: TValueListEditor;
Panel1: TPanel;
Image1: TImage;
GroupBox2: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
GroupBox3: TGroupBox;
RadioButton3: TRadioButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);
procedure RadioButton3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Down,Top,Eps,Ks,Hd:real;
implementation
uses Math;
{$R *.dfm}
Procedure Clearing();
var
i:integer;
begin
With Form1 do
begin
For i:=0 to ComponentCount-1 do
If Components[i] is TMemo Then
(Components[i] as TMemo).Text:='';
end;
end;
Procedure DownTopEps();
var
i:integer;
begin
With Form1 do
For i:=0 to ComponentCount-1 do
If (Components[i] is TMemo) and ((Components[i] as TMemo).Tag=1) Then
try
StrToFloat((Components[i] as TMemo).Text);
except
on E:EConvertError do
begin
Raise EConvertError.Create('Введите числовое значение');
(Components[i] as TMemo).Text:='';
Exit;
end;
end;
Top:=StrToFloat(Form1.Memo1.Text);
Down:=StrToFloat(Form1.Memo2.Text);
Eps:=StrToFloat(Form1.Memo3.Text);
If Down>=Top Then
begin
Raise EReadError.Create('Нижняя граница должна быть меньше верхней');
Down:=0;
Top:=0;
Exit;
end;
If Eps<=0 Then
begin
Raise EReadError.Create('Точность должна быть больше 0');
Exit;
end;
end;
Procedure Apriore();
begin
Clearing();
end;
Function f(x:real):real;
begin
Result:=Tan(0.44*x+0.3)-IntPower(x,2);
end;
Function f2(x:real):real;
var
r:real;
begin
r:=0.1*IntPower(x,2)-0.4*x-1.2;
If r<0 Then
Result:=(-1)*Power(Abs(r),1/3)
Else
Result:=Power(r,1/3)
end;
//----------МЕТОД ПОЛОВИННОГО ДЕЛЕНИЯ---------------------------------//
Function flag(x:real):integer;
begin
Result:=0;
if x<0 then
Result:=-1;
if x>0 then
Result:=1;
end;
Procedure ProverkaIntervala(a,b:real);
begin
If flag(f(a))=flag(f(b)) Then
begin
Raise EReadError.Create('На заданном интервале корни не найдены');
Exit;
end;
end;
Function FiftiFifti():real;
var
a,b:real;
i:integer;
begin
a:=Down;
b:=Top;
i:=flag(f(a));
ProverkaIntervala(a,b);
while abs(b-a)>Eps do
begin
Result:=(a+b)/2;
if flag(f(Result))=i then
a:=Result
else
b:=Result;
end;
end;
//--------------------КОМБИНИРОВАННЫЙ МЕТОД---------------------------------//
Function dif1(x:real):real;
var
dx,dy,dy2:real;
begin
dx:=1;
repeat
dx:=dx/2;
dy:=f(x+dx/2)-f(x-dx/2);
dy2:=f(5*x/4+dx)-2*f(5*x/4);
dy2:=dy2 + f(5*x/4-dx)
until abs((dy2*dy2*f(x))/(2*dx))<Eps;
Result:=dy/dx
end;
Function dif2(x:real):real;
var
dx,dy,dy3:real;
begin
dx:=1;
repeat
dx:=dx/2;
dy:=f(x+dx)-2*f(x)+ f(x-dx);
dy3:=f(5*x/4+2*dx)-2*f(5*x/4+dx);
dy3:=dy3-f(5*x/4-2*dx)+2*f(5*x/4-dx)
until abs(dy3/(6*dx))<Eps;
Result:=dy/(dx*dx)
end;
Procedure ProverkaDif(a,b:real);
begin
If ( flag(dif1(a))<>flag(dif1(b)) ) or ( flag(dif2(a))<>flag(dif2(b)) ) Then
begin
Raise EReadError.Create('На заданном интервале корни не найдены');
Exit;
end;
end;
Function Chord(a,b:real):real;
begin
Result:=a-((b-a)*f(a))/(f(b)-f(a));
Hd:=Result;
end;
Function Kasatel(a,b:real):real;
begin
Result:=a-f(a)/dif1(a);
Ks:=Result;
end;
Function Combinir():real;
var
a,b:real;
begin
a:=Down;
b:=Top;
ProverkaDif(a,b);
repeat
If flag(dif2(b))=flag(b) Then
begin
b:=Kasatel(a,b);
a:=Chord(b,a);
end
else
begin
a:=Kasatel(b,a);
b:=Chord(a,b);
end
until abs(Ks - Hd)<Eps;
ProverkaIntervala(a,b);
Result:=Ks;
end;
//------------------МЕТОД ИТЕРАЦИЙ-------------------------------//
Procedure ProverkaIntervalaF2(a,b:real);
begin
If flag(Power(a,3)-0.1*Power(a,2)+0.4*a+1.2)=flag(Power(b,3)-0.1*Power(b,2)+0.4*b+1.2) Then
begin
Raise EReadError.Create('На заданном интервале корни не найдены');
Exit;
end;
end;
Procedure ProverkaDifF2(b:real);
var
dx,dy,dy2:real;
begin
dx:=1;
repeat
dx:=dx/2;
dy:=f2(b+dx/2)-f2(b-dx/2);
dy2:=f2(5*b/4+dx)-2*f2(5*b/4);
dy2:=dy2 + f2(5*b/4-dx)
until abs((dy2*dy2*f2(b))/(2*dx))<Eps;
If abs(dy/dx)>=1 Then
Raise EReadError.Create('Процесс итерации расходится на данном интервале');
end;
Function Schet0(x:real):integer;
var
i:integer;
begin
i:=0;
While frac(x)>0 do
begin
x:=x*10;
inc(i);
end;
Result:=i;
end;
Function Iteration():real;
var
x,a,b:real;
begin
a:=Down;
b:=Top;
ProverkaDifF2(b);
ProverkaIntervalaF2(a,b);
x:=(a+b)/2;
repeat
ProverkaIntervalaF2(a,b);
x:=f2(x);
until RoundTo(x,(-1)*Schet0(Eps))=RoundTo(f2(x),(-1)*Schet0(Eps));
Result:=x;
end;
Procedure Vivod(Koren:real);
begin
Form1.DateTable.InsertRow( '('+FloatToStr(Down)+';'+FloatToStr(Top)+')', FloatToStr(RoundTo(Koren,-4)), true);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Apriore();
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
DownTopEps();
If RadioButton1.Checked Then
Vivod(FiftiFifti());
If RadioButton2.Checked Then
Vivod(Combinir());
If RadioButton3.Checked Then
Vivod(Iteration());
//дописать для метода итераций
end;
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
Image1.Picture.LoadFromFile('f1.bmp');
end;
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
Image1.Picture.LoadFromFile('f1.bmp');
end;
procedure TForm1.RadioButton3Click(Sender: TObject);
begin
Image1.Picture.LoadFromFile('f2.bmp');
end;
end.
|
|
Программа решения нелинейных уравнений (Delphi), помощь по ВЫЧМАТУ 
Загрузка ...
