Программирование / 1234(что нашла катик) / L234 / Main

unit Main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls, StdCtrls, Spin, Math, ExtDlgs, Rep;

type
TMainForm = class(TForm)
MainMenu: TMainMenu;
miFile: TMenuItem;
miClose: TMenuItem;
miMethod: TMenuItem;
miHook_Jeeves: TMenuItem;
Graph: TImage;
WindowCoords: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
MinX1: TSpinEdit;
MinX2: TSpinEdit;
MaxX1: TSpinEdit;
MaxX2: TSpinEdit;
Interleave: TGroupBox;
Label5: TLabel;
ilX1: TEdit;
Label6: TLabel;
ilX2: TEdit;
bData: TGroupBox;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
bgX1: TEdit;
bgX2: TEdit;
bgEps: TEdit;
N5: TMenuItem;
LLinesSetup: TButton;
miSave: TMenuItem;
miSettings: TMenuItem;
miRepaint: TMenuItem;
miExtr: TMenuItem;
miMin: TMenuItem;
miMax: TMenuItem;
miDebug: TMenuItem;
SaveBMP: TSavePictureDialog;
miReport: TMenuItem;
miQuickDescent: TMenuItem;
miNewton: TMenuItem;
miFFunction: TMenuItem;
miInstantRepaint: TMenuItem;
procedure Check4Real(Sender: TObject; var Key: Char);
procedure Check4NReal(Sender: TObject; var Key: Char);
procedure miRepaintClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure ilX1Change(Sender: TObject);
procedure ilX2Change(Sender: TObject);
procedure bgX1Change(Sender: TObject);
procedure bgX2Change(Sender: TObject);
procedure bgEpsChange(Sender: TObject);
procedure GraphMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Bounds1Change(Sender: TObject);
procedure Bounds2Change(Sender: TObject);
procedure LLinesSetupClick(Sender: TObject);
procedure miSaveClick(Sender: TObject);
{procedure miHook_JeevesClick(Sender: TObject);}
procedure miMinMaxClick(Sender: TObject);
procedure miDebugClick(Sender: TObject);
procedure miReportClick(Sender: TObject);
procedure miQuickDescentClick(Sender: TObject);
{procedure miNewtonClick(Sender: TObject);
procedure miFFunctionClick(Sender: TObject);}
procedure miInstantRepaintClick(Sender: TObject);
{procedure WindowCoordsClick(Sender: TObject);}
{procedure miCloseClick(Sender: TObject);}
private
nX1,nX2,iX1,iX2,bX1,bX2,Eps:real;
x10,x20:integer;
Min:boolean;
InstantRepaint:boolean;
procedure DrawGrid;
procedure RecreateGraph;
procedure DrawLevelLines;
{procedure DrawConstraint;}
procedure GetScreenParams;
function MinOnX1(X1,X2:real):real;
function MinOnX2(X1,X2:real):real;
function dFdX1(X1,X2:real):extended;
function dFdX2(X1,X2:real):extended;
{function d2FdX1(X1,X2:real):extended;
function d2FdX2(X1,X2:real):extended;
function d2FdX1dX2(X1,X2:real):extended;
function d2FdX2dX1(X1,X2:real):extended;}
function MinF(var X1,X2:real;x,y:real):boolean;
function Real2X(N:real):integer;
function Real2Y(N:real):integer;
{function dAuxFdX1(X1,X2:real):extended;
function dAuxFdX2(X1,X2:real):extended;
function MinAuxF(var X1,X2:real;x,y:real):boolean; }
function X2Real(X:integer):real;
function Y2Real(Y:integer):real;
public
procedure GenerateLLines;
end;

var
MainForm: TMainForm;
Alpha,Beta:real;

implementation

uses LLines;

{$R *.DFM}

function F(X1,X2:real;RealValue:boolean=False):real;
//Основная функция
begin
Result:=Sqr(Sqr(X1)-X2)+3*Sqr(X1-2); //Just
//Result:=Sqr(x1)+Sqr(x2)+x1*x2-2*x1-6*x2; //Kunside
// Result:=8*Sqr(X1)+4*X1*X2+5*Sqr(X2); //Lone Wolf
//Result:=Sqr(X1-4)+Sqr(X2-2)+5*Sqr(X1+X2-4); //Usher
if not(MainForm.Min or RealValue) then Result:=-Result;
end;

{function Constraint(X1:real):real;
//Ограничение; зависимость X2 от X1
begin
Result:=-X1-2;
end;

function AuxF(X1,X2:real):real;
begin
if MainForm.Min then Result:=F(X1,X2)+Alpha*Sqr(Constraint(X1)-X2)
else Result:=F(X1,X2)-Alpha*Sqr(Constraint(X1)-X2);
end;
}
procedure TMainForm.Check4Real(Sender: TObject; var Key: Char);
begin
if not(Key in ['0'..'9','.',#8]) then Key:=#0;
end;

procedure TMainForm.Check4NReal(Sender: TObject; var Key: Char);
begin
if not(Key in ['0'..'9','.','-',#8]) then Key:=#0;
end;

procedure TMainForm.DrawGrid;
var i,x1,x2,t:integer;
begin
Screen.Cursor:=crHourGlass;
try
t:=Graph.Width-8;
x2:=Graph.Height-8;
graph.canvas.Pen.Color:=clmedgray;
//Graph.Canvas.Pen.Style:=psDot;
for i:=Round(MinX1.Value/iX1) to Round(MaxX1.Value/iX1) do
begin
x1:=x10+Round(nX1*i*iX1);
if (x1<5) or (x1>t) then Continue;
with Graph.Canvas do
begin
if i=0 then Pen.Width:=2;
MoveTo(x1,5);
LineTo(x1,x2);
if i=0 then
begin
Pen.Width:=1;
//Pen.Style:=psDot;
end;
end;
end;
t:=Graph.Height-8;
x1:=Graph.Width-8;
for i:=Round(MinX2.Value/iX2) to Round(MaxX2.Value/iX2) do
begin
x2:=x20-Round(nX2*i*iX2);
if (x2<5) or (x2>t) then Continue;
with Graph.Canvas do
begin
if i=0 then Pen.Width:=2;
MoveTo(5,x2);
LineTo(x1,x2);
if i=0 then
begin
Pen.Width:=1;
//Pen.Style:=psDot;
end;
end;
end;
finally
Screen.Cursor:=crDefault;
end;
end;

procedure TMainForm.DrawLevelLines;
var LArr,DevArr:array of real;
n,i,j,c:integer;
r:real;
begin
Screen.Cursor:=crHourGlass;
n:=LLinesForm.ListLength;
SetLength(LArr,n);
SetLength(DevArr,n);
try
for i:=0 to n-1 do
begin
LArr[i]:=0;
DevArr[i]:=0;
Val(LLinesForm.LevelList.Items[i],r,c);
if c<>0 then Continue;
LArr[i]:=r;
Val(LLinesForm.DevList.Items[i],r,c);
if c<>0 then Continue;
DevArr[i]:=r;
end;
for i:=0 to Graph.Width-1 do
for j:=0 to Graph.Height-1 do
begin
r:=F(X2Real(i),Y2Real(j));
for c:=0 to n-1 do
if Abs(r-LArr[c])<=DevArr[c] then
Graph.Canvas.Pixels[i,j]:=clBlack;
end;
finally
DevArr:=nil;
LArr:=nil;
Screen.Cursor:=crDefault;
end;
end;
//перерисовать
procedure TMainForm.miRepaintClick(Sender: TObject);
begin
GetScreenParams;
with Graph.Canvas do FillRect(ClipRect);
with Graph.Canvas.Pen do
begin
Width:=1;
Color:=clBlack;
end;
DrawGrid;
DrawLevelLines;
end;

procedure TMainForm.GenerateLLines;
var i,x,c:integer;
y,r:real;
s:string;
begin
with LLinesForm do
begin
LevelList.Clear;
DevList.Clear;
y:=X2Real(Round(Graph.Width/2));
for i:=2 to 9 do
begin
x:=Round(Graph.Height*i/20);
r:=F(y,Y2Real(x));
Str(r:0:5,s);
c:=LevelList.Items.Add(s);
r:=Abs(r-F(y,Y2Real(x+1)))/1.2;
Str(r:0:5,s);
DevList.Items.Insert(c,s);
end;
ListLength:=Math.Min(LevelList.Items.Count,DevList.Items.Count);
end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var i:integer;
begin
Val(ilX1.Text,iX1,i);
Val(ilX2.Text,iX2,i);
with bData do
for i:=0 to ControlCount-1 do
if Controls[i] is TEdit then
(Controls[i] as TEdit).OnChange(Controls[i]);
InstantRepaint:=miInstantRepaint.Checked;
miMin.Click;
GetScreenParams;
LLinesForm:=TLLinesForm.Create(Self);
GenerateLLines;
end;

procedure TMainForm.RecreateGraph;
var h,w:integer;
begin
with Graph do
begin
h:=Height;
w:=Width;
Free;
end;
Graph:=TImage.Create(Self);
with Graph do
begin
Parent:=Self;
Top:=0;
Left:=0;
Height:=h;
Width:=w;
Align:=alTop;
Anchors:=[akLeft,akTop,akRight,akBottom];
Cursor:=crCross;
OnMouseDown:=GraphMouseDown;
end;
miRepaint.Click;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
RecreateGraph;
end;

//{---процедуры обработки ввода интервала сетки
procedure TMainForm.ilX1Change(Sender: TObject);
var c:integer;
t:real;
begin
ilX1.Font.Color:=clWindowText;
Val(ilX1.Text,t,c);
if (t>0) and (c=0)
then begin
iX1:=t;
if InstantRepaint then miRepaint.Click;
end
else ilX1.Font.Color:=clRed;
end;

procedure TMainForm.ilX2Change(Sender: TObject);
var c:integer;
t:real;
begin
ilX2.Font.Color:=clWindowText;
Val(ilX2.Text,t,c);
if (t>0) and (c=0)
then begin
iX2:=t;
if InstantRepaint then miRepaint.Click;
end
else ilX2.Font.Color:=clRed;
end;
//процедуры обработки ввода интервала сетки---}


//{---процедуры обработки ввода начальных данных
procedure TMainForm.bgX1Change(Sender: TObject);
var c:integer;
begin
Val(bgX1.Text,bX1,c);
if c=0 then bgX1.Font.Color:=clWindowText
else bgX1.Font.Color:=clRed;
end;

procedure TMainForm.bgX2Change(Sender: TObject);
var c:integer;
begin
Val(bgX2.Text,bX2,c);
if c=0 then bgX2.Font.Color:=clWindowText
else bgX2.Font.Color:=clRed;
end;

procedure TMainForm.bgEpsChange(Sender: TObject);
var c:integer;
t:real;
begin
bgEps.Font.Color:=clWindowText;
Val(bgEps.Text,t,c);
if (t>0) and (c=0) then Eps:=t
else bgEps.Font.Color:=clRed;
end;
//процедуры обработки ввода начальных данных---}


procedure TMainForm.GraphMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var s:string;
begin
bX1:=X2Real(X);
bX2:=Y2Real(Y);
Str(bX1:0:5,s);
bgX1.Text:=s;
Str(bX2:0:5,s);
bgX2.Text:=s;
end;


//{---процедуры обработки ввода координат окна
procedure TMainForm.Bounds1Change(Sender: TObject);
begin
WindowCoords.Font.Color:=clWindowText;
if MaxX1.Value>MinX1.Value
then begin
if InstantRepaint then miRepaint.Click;
end
else WindowCoords.Font.Color:=clRed;
end;

procedure TMainForm.Bounds2Change(Sender: TObject);
begin
WindowCoords.Font.Color:=clWindowText;
if MaxX2.Value>MinX2.Value
then begin
if InstantRepaint then miRepaint.Click;
end
else WindowCoords.Font.Color:=clRed;
end;
//процедуры обработки ввода координат окна---}

//{---процедуры обработки нажатия кнопки Линии уровня
procedure TMainForm.LLinesSetupClick(Sender: TObject);
begin
LLinesForm.ShowModal;
end;
//процедуры обработки нажатия кнопки Линии уровня---}


procedure TMainForm.GetScreenParams;
begin
nX1:=Graph.Width/(MaxX1.Value-MinX1.Value);
x10:=-Round(nX1*MinX1.Value);
nX2:=Graph.Height/(MaxX2.Value-MinX2.Value);
x20:=Round(nX2*MaxX2.Value);
end;

procedure TMainForm.miSaveClick(Sender: TObject);
begin
SaveBMP.FileName:='';
if SaveBMP.Execute then
Graph.Picture.SaveToFile(SaveBMP.FileName);
end;

{
//{---решение методом Хука-Дживса
procedure TMainForm.miHook_JeevesClick(Sender: TObject);
var x11,x12,x21,x22,t1,t2:real;
t,i:longword;
begin
Screen.Cursor:=crHourGlass;
t:=GetTickCount;
RepForm.Show;
with RepForm.RepMemo.Lines do
begin
Append('Решение задачи методом Хука-Дживса');
Append('Начальные данные:');
Append('X1= '+FloatToStr(bX1));
Append('X2= '+FloatToStr(bX2));
Append('Eps= '+FloatToStr(Eps)+#13#10);
end;
i:=0;
x21:=bX1;
t1:=bX1;
x22:=bX2;
t2:=bX2;
try
miRepaint.Click;
with Graph.Canvas do
begin
Pen.Style:=psSolid;
Pen.Width:=2;
MoveTo(Real2X(t1),Real2Y(t2)); //устанавливаем курсор в начальную точку
end;
repeat
Inc(i); //счетчик шагов
x11:=x21; //запоминаем текущую координату
x12:=x22; //запоминаем текущую координату
x21:=MinOnX1(t1,t2); //одномерная минимизация методом деления
x22:=MinOnX2(x21,t2);//шага пополам
with Graph.Canvas do
begin
Pen.Color:=clGreen;
LineTo(Real2X(x21),Real2Y(t2));//рисум шаг из точки первой в следующую
LineTo(Real2X(x21),Real2Y(x22));//найденную одним цикломисследующего поиска
//цикл == циклу покоординатного спуска
t1:=x11; //запоминаем снова текущую координату
t2:=x12; //запоминаем снова текущую координату
//отправляем текущую точку и только что полученную
//в функцию, котораяпо ходу возвращает точку движения по образцу
if not MinF(t1,t2,x21,x22) then Exit;
Pen.Color:=clRed;
LineTo(Real2X(x11),Real2Y(x12)); //рисуем движение метода
LineTo(Real2X(t1),Real2Y(t2));
end;
if miDebug.Checked then
with RepForm.RepMemo.Lines do
begin
Append('Шаг '+IntToStr(i)+'; '+FloatToStr((GetTickCount-t)/1000)+' сек');
Append('X1= '+FloatToStr(x21));
Append('X2= '+FloatToStr(x22));
Append('F(X1,X2)= '+FloatToStr(F(x21,x22,True)));
Append('tX1= '+FloatToStr(t1));
Append('tX2= '+FloatToStr(t2));
Append('delta= '+FloatToStr(Hypot(x21-x11,x22-x12)));
Append('----------------------------------------');
end;
until Hypot(x21-x11,x22-x12)<Eps;
with RepForm.RepMemo.Lines do
begin
Append('Задача решена за '+IntToStr(i)+' шаг(а,ов); '+FloatToStr((GetTickCount-t)/1000)+' сек');
Append('Решение:');
Append('X1= '+FloatToStr(x21));
Append('X2= '+FloatToStr(x22));
Append('F(X1,X2)= '+FloatToStr(F(x21,x22,True)));
Append('delta= '+FloatToStr(Hypot(x21-x11,x22-x12)));
Append('========================================'#13#10);
end;
finally
Screen.Cursor:=crDefault;
end;
end;
}
//решение методом Хука-Дживса---}


//{---выбор вида экстремума
procedure TMainForm.miMinMaxClick(Sender: TObject);
begin
if Sender=miMin then
begin
miMin.Checked:=True;
miMax.Checked:=False;
Min:=True;
end
else begin
miMin.Checked:=False;
miMax.Checked:=True;
Min:=False;
end;
end;
//выбор вида экстремума---}

function TMainForm.MinOnX1(X1, X2: real): real;
var x,dx:real;
begin
x:=X1;
dx:=Eps*50;
while Abs(dx)>=Eps/10 do
begin
dx:=-dx/2;
while F(x+dx,X2)<F(x,X2) do x:=x+dx;
end;
Result:=x;
end;

function TMainForm.MinOnX2(X1, X2: real): real;
var x,dx:real;
begin
x:=X2;
dx:=Eps*50;
while Abs(dx)>=Eps/10 do
begin
dx:=-dx/2;
while F(X1,x+dx)<F(X1,x) do x:=x+dx;
end;
Result:=x;
end;

function TMainForm.MinF(var X1, X2: real; x, y: real):boolean;
var t,dx,k,b:real;
i:integer;
begin
Result:=True;
if x=X1 then
begin
X1:=MinOnX1(X1,X2);
Exit;
end;
if y=X2 then
begin
X2:=MinOnX2(X1,X2);
Exit;
end;
k:=(y-X2)/(x-X1);
b:=X2-k*X1;
dx:=Eps*200;
t:=X1;
while Hypot(dx,dx*k)>=Eps do
begin
dx:=-dx/2;
i:=0;
while F(t+dx,(t+dx)*k+b)<F(t,t*k+b) do
begin
Inc(i);
t:=t+dx;
if (i mod 1000000)=0 then
begin
if MessageDlg('Внимание! Экстремум не найден за '+IntToStr(i)+' итераций!'#13#10+
'Остановить выполнение программы?',mtWarning,[mbYes,mbNo],0)=mrYes then
begin
Result:=False;
Exit;
end;
end;
end;
end;
X1:=t;
X2:=t*k+b;
end;

function TMainForm.X2Real(X: integer): real;
begin
Result:=(X-x10)/nX1;
end;

function TMainForm.Y2Real(Y: integer): real;
begin
Result:=(x20-Y)/nX2;
end;

function TMainForm.Real2X(N: real): integer;
begin
Result:=Round(N*nX1+x10);
end;

function TMainForm.Real2Y(N: real): integer;
begin
Result:=Round(x20-N*nX2);
end;

procedure TMainForm.miDebugClick(Sender: TObject);
begin
miDebug.Checked:=not miDebug.Checked;
end;

procedure TMainForm.miReportClick(Sender: TObject);
begin
with RepForm do
begin
Show;
if WindowState=wsMinimized then WindowState:=wsNormal;
end;
end;

//{---решение методом наискорейшего спуска
procedure TMainForm.miQuickDescentClick(Sender: TObject);
var x11,x12,x21,x22,d1,d2,g1,g2:real;
i,t:longword;
begin
Screen.Cursor:=crHourGlass;
t:=GetTickCount;
RepForm.Show;
with RepForm.RepMemo.Lines do
begin
Append('Решение задачи методом наискорейшего спуска');
Append('Начальные данные:');
Append('X1= '+FloatToStr(bX1));
Append('X2= '+FloatToStr(bX2));
Append('Eps= '+FloatToStr(Eps)+#13#10);
end;
i:=0;
x21:=bX1;
x22:=bX2;
try
miRepaint.Click;
with Graph.Canvas do
begin
with Pen do
begin
Color:=clRed;
Style:=psSolid;
Width:=2;
end;
MoveTo(Real2X(x21),Real2Y(x22));
end;
repeat
Inc(i);
x11:=x21;
x12:=x22;
g1:=dFdX1(x11,x12);
g2:=dFdX2(x11,x12);
d1:=-g1/Hypot(x11-g1,x12-g2);
d2:=-g2/Hypot(x11-g1,x12-g2);
MinF(x21,x22,x21+d1*10,x22+d2*10);
Graph.Canvas.LineTo(Real2X(x21),Real2Y(x22));
if miDebug.Checked then
with RepForm.RepMemo.Lines do
begin
Append('Шаг '+IntToStr(i)+'; '+FloatToStr((GetTickCount-t)/1000)+' сек');
Append('X1= '+FloatToStr(x21));
Append('X2= '+FloatToStr(x22));
Append('H= '+FloatToStr(Hypot(x21-x11,x22-x12)));
Append('F(X1,X2)= '+FloatToStr(F(x21,x22,True)));
Append('----------------------------------------');
end;
until Hypot(x21-x11,x22-x12)<Eps;
with RepForm.RepMemo.Lines do
begin
Append('Задача решена за '+IntToStr(i)+' шаг(а,ов); '+FloatToStr((GetTickCount-t)/1000)+' сек');
Append('Решение:');
Append('X1= '+FloatToStr(x21));
Append('X2= '+FloatToStr(x22));
Append('F(X1,X2)= '+FloatToStr(F(x21,x22,True)));
Append('========================================'#13#10);
end;
finally
Screen.Cursor:=crDefault;
end;
end;
//решение методом наискорейшего спуска---}

function TMainForm.dFdX1(X1, X2: real): extended;
const d=1e-6;
begin
Result:=F(X1+d,X2)/d-F(X1,X2)/d;
end;

function TMainForm.dFdX2(X1, X2: real): extended;
const d=1e-6;
begin
Result:=F(X1,X2+d)/d-F(X1,X2)/d;
end;

{function TMainForm.d2FdX1(X1, X2: real): extended;
const d=1e-3;
begin
Result:=dFdX1(X1+d,X2)/d-dFdX1(X1,X2)/d;
end;

function TMainForm.d2FdX1dX2(X1, X2: real): extended;
const d=1e-3;
begin
Result:=dFdX1(X1,X2+d)/d-dFdX1(X1,X2)/d;
end;

function TMainForm.d2FdX2(X1, X2: real): extended;
const d=1e-3;
begin
Result:=dFdX2(X1,X2+d)/d-dFdX2(X1,X2)/d;
end;

function TMainForm.d2FdX2dX1(X1, X2: real): extended;
const d=1e-3;
begin
Result:=dFdX2(X1+d,X2)/d-dFdX2(X1,X2)/d;
end;

{procedure TMainForm.miNewtonClick(Sender: TObject);
var x11,x12,x21,x22,det,r:real;
i,t:longword;
Gess:array[1..2,1..2] of real;
begin
Screen.Cursor:=crHourGlass;
t:=GetTickCount;
RepForm.Show;
with RepForm.RepMemo.Lines do
begin
Append('Решение задачи методом Ньютона');
Append('Начальные данные:');
Append('X1= '+FloatToStr(bX1));
Append('X2= '+FloatToStr(bX2));
Append('Eps= '+FloatToStr(Eps)+#13#10);
end;
i:=0;
x21:=bX1;
x22:=bX2;
try
miRepaint.Click;
with Graph.Canvas do
begin
with Pen do
begin
Color:=clRed;
Style:=psSolid;
Width:=2;
end;
MoveTo(Real2X(x21),Real2Y(x22));
end;
repeat
Inc(i);
x11:=x21;
x12:=x22;
Gess[1,1]:=d2FdX1(x21,x22);
Gess[1,2]:=d2FdX1dX2(x21,x22);
Gess[2,1]:=d2FdX2dX1(x21,x22);
Gess[2,2]:=d2FdX2(x21,x22);
det:=Gess[1,1]*Gess[2,2]-Gess[2,1]*Gess[1,2];
r:=Gess[1,1]/det;
Gess[1,1]:=Gess[2,2]/det;
Gess[2,2]:=r;
Gess[1,2]:=-Gess[1,2]/det;
Gess[2,1]:=-Gess[2,1]/det;
x21:=x11-Gess[1,1]*dFdX1(x11,x12)-Gess[1,2]*dFdX2(x11,x12);
x22:=x12-Gess[2,1]*dFdX1(x11,x12)-Gess[2,2]*dFdX2(x11,x12);
Graph.Canvas.LineTo(Real2X(x21),Real2Y(x22));
if miDebug.Checked then
with RepForm.RepMemo.Lines do
begin
Append('Шаг '+IntToStr(i)+'; '+FloatToStr((GetTickCount-t)/1000)+' сек');
Append('X1= '+FloatToStr(x21));
Append('X2= '+FloatToStr(x22));
Append('F(X1,X2)= '+FloatToStr(F(x21,x22,True)));
Append('----------------------------------------');
end;
until Hypot(x21-x11,x22-x12)<Eps;
with RepForm.RepMemo.Lines do
begin
Append('Задача решена за '+IntToStr(i)+' шаг(а,ов); '+FloatToStr((GetTickCount-t)/1000)+' сек');
Append('Решение:');
Append('X1= '+FloatToStr(x21));
Append('X2= '+FloatToStr(x22));
Append('F(X1,X2)= '+FloatToStr(F(x21,x22,True)));
Append('========================================'#13#10);
end;
finally
Screen.Cursor:=crDefault;
end;
end;

procedure TMainForm.miFFunctionClick(Sender: TObject);
var x11,x12,x21,x22,d1,d2,g1,g2:real;
i,t:longword;
begin
Screen.Cursor:=crHourGlass;
t:=GetTickCount;
RepForm.Show;
with RepForm.RepMemo.Lines do
begin
Append('Решение задачи методом штрафных функций');
Append('Начальные данные:');
Append('X1= '+FloatToStr(bX1));
Append('X2= '+FloatToStr(bX2));
Append('Eps= '+FloatToStr(Eps)+#13#10);
end;
i:=0;
x21:=bX1;
x22:=bX2;
Alpha:=0.9;
Beta:=1.01;
try
miRepaint.Click;
DrawConstraint;
Application.ProcessMessages;
with Graph.Canvas do
begin
with Pen do
begin
Color:=clRed;
Style:=psSolid;
Width:=2;
end;
MoveTo(Real2X(x21),Real2Y(x22));
end;
repeat
Alpha:=Alpha*Beta;
Inc(i);
x11:=x21;
x12:=x22;
g1:=dAuxFdX1(x11,x12);
g2:=dAuxFdX2(x11,x12);
d1:=-g1/Hypot(x11-g1,x12-g2);
d2:=-g2/Hypot(x11-g1,x12-g2);
MinAuxF(x21,x22,x21+d1*10,x22+d2*10);
Graph.Canvas.LineTo(Real2X(x21),Real2Y(x22));
if miDebug.Checked then
with RepForm.RepMemo.Lines do
begin
Append('Шаг '+IntToStr(i)+'; '+FloatToStr((GetTickCount-t)/1000)+' сек');
Append('X1= '+FloatToStr(x21));
Append('X2= '+FloatToStr(x22));
Append('F(X1,X2)= '+FloatToStr(F(x21,x22,True)));
Append('----------------------------------------');
end;
until Sqr(Constraint(X21)-X22)<Eps;
with RepForm.RepMemo.Lines do
begin
Append('Задача решена за '+IntToStr(i)+' шаг(а,ов); '+FloatToStr((GetTickCount-t)/1000)+' сек');
Append('Решение:');
Append('X1= '+FloatToStr(x21));
Append('X2= '+FloatToStr(x22));
Append('F(X1,X2)= '+FloatToStr(F(x21,x22,True)));
Append('========================================'#13#10);
end;
finally
Screen.Cursor:=crDefault;
end;
end; }

procedure TMainForm.miInstantRepaintClick(Sender: TObject);
var b:boolean;
begin
b:=not miInstantRepaint.Checked;
miInstantRepaint.Checked:=b;
InstantRepaint:=b;
end;

{function TMainForm.dAuxFdX1(X1, X2: real): extended;
const d=1e-6;
begin
Result:=AuxF(X1+d,X2)/d-AuxF(X1,X2)/d;
end;

function TMainForm.dAuxFdX2(X1, X2: real): extended;
const d=1e-6;
begin
Result:=AuxF(X1,X2+d)/d-AuxF(X1,X2)/d;
end;

function TMainForm.MinAuxF(var X1, X2: real; x, y: real): boolean;
var t,dx,k,b:real;
i:integer;
begin
Result:=True;
k:=(y-X2)/(x-X1);
b:=X2-k*X1;
dx:=Eps*200;
t:=X1;
while Hypot(dx,dx*k)>=Eps do
begin
dx:=-dx/2;
i:=0;
while AuxF(t+dx,(t+dx)*k+b)<AuxF(t,t*k+b) do
begin
Inc(i);
t:=t+dx;
if (i mod 1000000)=0 then
begin
if MessageDlg('Внимание! Экстремум не найден за '+IntToStr(i)+' итераций!'#13#10+
'Остановить выполнение программы?',mtWarning,[mbYes,mbNo],0)=mrYes then
begin
Result:=False;
Exit;
end;
end;
end;
end;
X1:=t;
X2:=t*k+b;
end;

procedure TMainForm.DrawConstraint;
var i:integer;
begin
with Graph.Canvas do
begin
Pen.Color:=clGreen;
Pen.Style:=psSolid;
MoveTo(0,Real2X(Constraint(X2Real(0))));
for i:=1 to Graph.Width-1 do
LineTo(i,Real2Y(Constraint(X2Real(i))));
end;
end;
}

end.