Математические основы анализа и синтеза дискретных систем

Дата публикации PostDateIcon 08.02.2014 |

Написать программу, производящую оптимизацию (поиск минимуму) двух заданных целевых функций (см. ниже) с использованием совмещения метода Кифера-Вольфовица и метода последовательных приближений. Программа должна уметь построить линии уровня (10 – 15 линий) которые должны заполнять все поле экрана. Также программа должна отображать траекторию движения точки поиска. Найти значения и точки всех минимумов.

Заданы целевые функции:

f1(x) = [2.5(5x1+3x2 — 8)2 — 10]2 + (5x1 — 8)2 + (3x2 — 2)2
исходный вектор x0 = (1.2; 1)T

f2(x) = 0.1x13 + 612 + 1.2x1x22 + 12x1x2 + 24 x22 — 2800
исходный вектор x0 = (-60; -25)T или x0 = (2; 2)T

Метод Кифера-Вольфовица

Метод Кифера-Вольфовица является модифицированным методом градиента. Суть метода градиента заключается в вычислении на каждом шаге (в каждой текущей точке) значение градиента (вектор) и движение в противоположную сторону на рабочий шаг a:

xk+1 = xk — a grad[f(xk)]

При этом

grad[f(xk)] = Δf/Δx = [f(xk + ρ) — f(xk — ρ)]/2ρ

где ρ — значение пробного шага по каждой из осей. Чем меньше, тем точнее будет вычислено направление градиента.

Отличительная черта метода Кифера-Вольфовица – зависимость пробного шага ρ и рабочего шага a от номера итерации k:

a = a0/k; ρ = ρ0/kγ

где a0, ρ0 — постоянные; 0 < γ <0.5 - значение степени номера k-й итерации. Сам алгоритм поиска остается прежним. Обычно выбирают γ = 0.25. При этом всегда должно быть ρ < |a grad[f(xk)].

Достоинства метода:
• повышается скорость нахождения минимума;
• высока эффективность при крутых склонах поверхности f(x);

Недостатки метода:
• мала эффективность метода на пологих участках;
• шаг быстро уменьшается и может стать сравнимым с ошибкой измерения;

Метод поразрядного приближения

Суть метода: в начале происходит сканирование отрезка одномерной функции с постоянным шагов в дном и том же направлении. Как только будет обнаружено возрастание функции, происходит изменение направления сканирования на противоположной и уменьшение размера сканирующего шага в k раз. Как только размер шага станет меньше наперед заданной величины (ошибки измерения) необходимо прекратить оптимизацию.

Блок-схема алгоритма поразрядного приближения
Рис. Блок-схема алгоритма поразрядного приближения

Где:
VLen(x1,x2) – длинна вектора (x1,x2)
(Ax1,Ax2) и (Bx1,Bx2) – начальная и конечная (условно) точки отрезка.
k – коэффициент деления шага
a – начальная длинна шага в долях от длинны отрезка
e – ошибка оптимизации
Nmax – максимально допустимое число шагов
(Lx1,Lx2) – текущее положение точки на отрезке
(dx1,dx2) – шаг оптимизации по осям x1 и x2

Блок-схема алгоритма реализации метода Кифера-Вольфовица с использованием метода поразрядного приближения
Рис. Блок-схема алгоритма реализации метода Кифера-Вольфовица с использованием метода поразрядного приближения

Где:
VLen(x1,x2) – длинна вектора (x1,x2)
(Lx1,Lx2) – текущая оптимальная точка.
(nLx1,nLx2) – новая оптимальная точка
k – номер шага
a0 – начальный рабочий шаг
p0 – начальный пробный шаг
Nmax – максимально допустимое число шагов
a и p – текущее значение рабочего шага и пробного шага

Основное окно программы и органы управления
Рис. Основное окно программы и органы управления

1. Рабочая область. Здесь отображается сама функция и результаты оптимизации.
2. Координатная сетка. Точность чисел можно настраивать на соответствующей закладке.
3. Маркер начальной точки оптимизации.
5. На этой закладке можно выбрать одну из двух целевых функций, установить начальную точку и настроить координатную сетку.
6. Здесь можно выбрать, как будет визуализироваться график целевой функции – градиенты/линии, и настроить параметры.
7. Настройка параметров оптимизации и точности отображения чисел.
8. Управление программой.
9. Текущее положение курсора в рабочей области по оси x1.
10. Текущее положение курсора в рабочей области по оси x2.
11. Значение функции в точке на которую указывает курсор.
12. Результат оптимизации: время, точка минимум и значение функции в этой точке, количество итераций одномерного и двумерного метода.

Примечание по работе с программой:
После начала работы с программой доступными являются только визуализировать и об авторе. Для того чтобы остальные кнопки так же стали доступны, необходимо визуализировать функцию.

1. Выбор функции и исходного вектора для оптимизации. Настройка осей координат:

Настройка осей координат
Рис. Настройка осей координат

2. Выбор одной из двух целевых функций (см. техзадание)

Выбор одной из двух целевых функций
Рис. Выбор одной из двух целевых функций

3. Для установки начальной точки нужно нажать на установить и непосредственно в рабочей области указать на исходную точку левым кликом. Либо вписать координаты непосредственно. Checkbox “Маркер” позволяет показать или спрятать курсор. Для изменения цвета рамки, фона и текста нужно кликнуть на соответствующий прямоугольник и выбрать из палитры нужный цвет.

4. Checkbox “Показывать” включает/выключает отображение сетки координат. Для настройки частоты сетки по вертикали и горизонтали используйте соответствующие поля. При указании в поле “Всего цифр” значения 0, длинна числа будет минимально возможной. Поле “После запятой” устанавливает точность чисел на осях, на остальную программу это не влияет.

5. Настройка визуализатора целевой функции

Настройка визуализатора целевой функции

6. При включении режима “Сохранять пропорции” любое изменение масштаба будет устанавливать поле “W” (ширина), а поле “Н” будет вычисляться исходя из реальных пропорций рабочего поля на экране.

7. “Высота градиента” — какой интервал значений функции занимает один градиент.

8. Eps – при попадании в этот интервал (начиная от линии) точка считается принадлежащей линии. Другими словами этот параметр определяет толщину линий.

9. Параметры оптимизации

10. “Максимальное число шагов” определяется для метода Кифера-Вольфовица. Расчеты ведутся с максимально доступной точностью, а поля “Всего цифр” и “После запятой” позволяют настроить точность вывода результатов в статус баре.

11. A0 в процентах от длинны всего отрезка одномерной оптимизации определяет длину начального шага сканирования.
K определяет во сколько раз будет уменьшаться шаг сканирования при нахождении минимума.
E — необходимая точность.

12. A0 начальная длинна рабочего шага. P0 начальное значение пробного шага. gamma , см. описание метода Кифера-Вольфовица

Результаты решения задачи оптимизации для заданных в техническом задании начальных точек.

1. f1(x)

x0 = (1.2; 1)
1D: A0 = 10% K = 4.0 E = 0.001
2D: A0 = 0.07 P0 = 0.000001 gamma = 0.25
Результат:
x1 = (1.2018; 0.0036) F(x) = 7.9598; 445 мс, 3940 шагов

x0 = (1.2; 1)
1D: A0 = 10%; K = 4.0; E = 0.0001
2D: A0 = 0.07; P0 = 0.000001; gamma = 0.25
Результат:
x2 = (1.5998; 0.6669) F(x) = 0.0000; 391мс, 4271 шагов

2. f2(x)

x0 = (-60; -25) оптимизация не удалась ни при каких параметрах — функция бесконечно уменьшается в направлении антиградиента

x0 = (2; 2)
1D: A0=50%; K=4.0; E=0.0001
2D: A0=0.03; P0=0.01; gamma=0.25
x=(0.3833; -0.1206) F(x)=-2799.3117; 24 шага 1D и 73 шага 2D; 50.395 мс

Зависимость числа итераций (одномерного и двумерного
методов в сумме) от значения параметров.

Анализируем оптимизацию функции f2(x). Начальные параметры:
x0=(2,2)
1D: A0=10%; K=4.0; E=0.00001;
2D: A0=0.1; P0=0.001; gamma=0.25;

Зависимость от A0 (1D):

Зависимость от K (1D)

Зависимость от Е (1D):

Зависимость от A0 (2D):

Зависимость от P0 (2D):

Зависимость от gamma (2D):

Листинг программы

program Opt;
uses
Forms,
main in ‘main.pas’ {Form1},
takeFunction in ‘takeFunction.pas’,
drawFunction in ‘drawFunction.pas’,
takeSysParam in ‘takeSysParam.pas’,
about in ‘about.pas’ {Form3};

{$R *.RES}

begin
Application.Initialize;
Application.Title := ‘Оптимизатор’;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm3, Form3);
Application.Run;
end.

unit takeFunction;
interface
uses Math;
type
FL = extended;
FunctionType = function(x1,x2:extended):FL;
dPoint = record x,y:FL; end;
iPoint = record x,y:integer; end;
var
optFunc : FunctionType;
StartMarker: dPoint;

function optFunc1(x1,x2:FL):FL;
function optFunc2(x1,x2:FL):FL;
function optFuncUser(x1,x2:FL):FL;

function dPoint_(ax,ay:FL):dPoint;
function iPoint_(ax,ay:longint):iPoint;

implementation
uses main;
//================= Функции для оптимизации ===================
function optFunc1(x1,x2:FL):FL;
begin
// фуекция 43
result := sqr(2.5*sqr(5*x1+3*x2-8) — 10) +
sqr(5*x1-8) +
sqr(3*x2-2);
end;

function optFunc2(x1,x2:FL):FL;
begin
//функция 44
result := 0.1*x1*x1*x1 +
6*x1*x1 +
1.2*x1*x2*x2 +
12*x1*x2 +
24*x2*x2 —
2800;
end;
function optFuncUser(x1,x2:FL):FL;
begin
end;
//================= Приведение к типам =====================
function dPoint_(ax,ay:FL):dPoint;
begin
result.x:=ax;
result.y:=ay;
end;

function iPoint_(ax,ay:longint):iPoint;
begin
result.x:=ax;
result.y:=ay;
end;

begin
optFunc:=optFunc1;
end.

unit takeSysParam;
interface
uses Graphics,sysutils,windows;

var
nWidt :integer;
nDec :integer;

function Str2Real(s:string):extended;
function Real2Str(r:real):string;
function iRed(C:TColor):byte;
function iGreen(C:TColor):byte;
function iBlue(C:TColor):byte;

implementation

function Str2Real(s:string):extended;
var code:integer;
begin
val(s,result,code);
end;

function Real2Str(r:real):string;
begin
str(r:nWidt:nDec,result);
end;

function iRed(C:TColor):byte;
begin
result:=C and $FF;
end;

function iGreen(C:TColor):byte;
begin
result:=(C and $FF00) shr 8;
end;

function iBlue(C:TColor):byte;
begin
result:=(C and $FF0000) shr 16;
end;

begin
nWidt := 0;
nDec := 8;
end.

unit about;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
jpeg, RzBckgnd, StdCtrls, RzLabel, ExtCtrls;
type
TForm3 = class(TForm)
Panel1: TPanel;
RzBackground1: TRzBackground;
Panel2: TPanel;
RzLabel1: TRzLabel;
RzLabel2: TRzLabel;
RzLabel3: TRzLabel;
RzLabel4: TRzLabel;
RzLabel5: TRzLabel;
procedure RzBackground1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form3: TForm3;

implementation

{$R *.DFM}

procedure TForm3.RzBackground1Click(Sender: TObject);
begin
self.Visible:=false;
end;
end.

unit drawFunction;
interface
uses windows,messages,Graphics,takeFunction,takeSysParam,main,sysutils,
extctrls,Classes,Math,syncobjs;
type
drawThread = function(data:pointer):integer;//stdcall;
var
hRender, // хэндл потока
hBitmap, //
hOldBitmap, //
hdc :THandle;
drawThreadCur :drawThread;
pDrTh :pointer absolute drawThreadCur;
// armed :boolean;
//////////////////////////
// Для Dig2Real и Real2Dig
scrW :integer;
scrH :integer;
realW,realH :FL;
realL,realT :FL;
////////////////////
// Для GradientLines
gradHeight :FL; // Высота одного градиента
Col1, Col2 :TColor; // Начальный и конечный цвет
////////////////////
// Для MonoLinea
monoHeight :FL; // Высота одного градиента
eps :FL; // Ширина границы
LineCol,BackCol:TColor; // Цвет линий и фона

function Dig2Real(a:iPoint):dPoint;
function Real2Dig(a:dPoint):iPoint;

function GradientLines(data:pointer):integer;//stdcall;
function MonoLines(data:pointer):integer;

//procedure dr(y:integer);

implementation

function GradientLines(data:pointer):integer;//stdcall;
var
armed:boolean; // должен ли выполняться процесс
x,y:integer;
rp:dPoint;
fu:double;
begin
armed:=true;

if hdc<>0 then begin
SelectObject(hdc,hOldBitmap);
DeleteObject(hBitmap);
DeleteDC(hdc);
end;

hdc := CreateCompatibleDC(Form1.MainLayerBitmap.Canvas.Handle);
hBitmap := CreateCompatibleBitmap(Form1.MainLayerBitmap.Canvas.Handle,scrW,scrH);
hOldBitmap := SelectObject(hdc,hBitmap);

//==========
for y:=0 to scrH-1 do
begin
for x:=0 to scrW-1 do
begin
rp:=Dig2Real(iPoint_(x,y));
fu:=optFunc(rp.x, rp.y);
fu:=fu / abs(gradHeight);
fu:=fu-floor(fu);

if fu>1 then fu:=1;
if fu<0 then fu:=0; SetPixel(hdc,x,y,rgb(byte(iRed(Col1)+floor((iRed(Col2)-iRed(Col1))*real(fu))), byte(iGreen(Col1)+floor((iGreen(Col2)-iGreen(Col1))*real(fu))), byte(iBlue(Col1)+floor(( iBlue(Col2)-iBlue(Col1) )*real(fu))) )); end; if (y mod 10 = 0) or (y = scrH-1) then PostMessage(main.Form1.Handle,WM_RENDER_UPDATE, (word(y-10+1) shl 16) or word(y+1),0); end; //========== if Form1.MainLayerBitmap.Canvas.LockCount=0 then StretchBlt(Form1.MainLayerBitmap.Canvas.Handle,0,0,Form1.MainLayerBitmap.Width,Form1.MainLayerBitmap.Height, hdc,0,0,scrW,scrH,SRCCOPY); result:=0; armed:=false; PostMessage(main.Form1.Handle,WM_RENDER_FINISH,0,0); CloseHandle(hRender); end; //============================================================// //============================================================// //============================================================// function MonoLines(data:pointer):integer; var armed:boolean; // должен ли выполняться процесс x,y:integer; rp:dPoint; fu:FL; begin armed:=true; if hdc<>0 then begin
SelectObject(hdc,hOldBitmap);
DeleteObject(hBitmap);
DeleteDC(hdc);
end;

hdc := CreateCompatibleDC(Form1.MainLayerBitmap.Canvas.Handle);
hBitmap := CreateCompatibleBitmap(Form1.MainLayerBitmap.Canvas.Handle,scrW,scrH);
hOldBitmap := SelectObject(hdc,hBitmap);

//==========
if eps>1 then eps:=1;
if eps<0 then eps:=0; for y:=0 to scrH-1 do begin for x:=0 to scrW-1 do begin rp:=Dig2Real(iPoint_(x,y)); fu:=optFunc(rp.x, rp.y); fu:=fu / abs(monoHeight); fu:=fu-floor(fu); if (fu>=1-eps) then
SetPixel(hdc,x,y,rgb(round($ff*(1-(1-fu)/eps)),
round($ff*(1-(1-fu)/eps)),
round($ff*(1-(1-fu)/eps))))
else
SetPixel(hdc,x,y,BackCol);
end;

if (y mod 10 = 0) or (y = scrH-1) then
PostMessage(main.Form1.Handle,WM_RENDER_UPDATE,
(word(y-10+1) shl 16) or word(y+1),0);
end;
//==========
if Form1.MainLayerBitmap.Canvas.LockCount=0 then
StretchBlt(Form1.MainLayerBitmap.Canvas.Handle,0,0,Form1.MainLayerBitmap.Width,Form1.MainLayerBitmap.Height,
hdc,0,0,scrW,scrH,SRCCOPY);
armed:=false;
PostMessage(main.Form1.Handle,WM_RENDER_FINISH,0,0);
CloseHandle(hRender);
result:=0;
end;

//==============================================================
//==============================================================
//==============================================================

function Dig2Real(a:iPoint):dPoint;
begin
result.x := realL + a.x*(realW/scrW);
result.y := realT — a.y*(realH/scrH);
end;
function Real2Dig(a:dPoint):iPoint;
begin
if a.x>2147483647 then a.x:=2147483646;
if a.x<(-2147483640) then a.x:=-2147483640; if a.y>2147483647 then a.y:=2147483646;
if a.y<(-2147483640) then a.y:=-2147483640; result.x := integer(round((a.x - realL)*(scrW / realW))); result.y := integer(round((realT - a.y)*(scrH / realH))); end; begin end. unit main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, takeFunction, SpeedBar, ExtCtrls, RxGrdCpt, StdCtrls, ComCtrls, RzEdit, RAButtons, RAI2, RAEditor, RzButton, RzRadChk, RAScrollMax, ImgList, RAHLEditor, RAHint, RzBHints, Mask, RzPanel, ToolWin, Buttons, RzStatus, FloatRzEdit,Math, RzBmpBtn, RzSpnEdt, ExtDlgs; const WM_RENDER_FINISH = WM_USER + 8; // render -> main
WM_RENDER_UPDATE = WM_USER + 9;
pe = 0.8; // удаленность указателя от начала стрелки
d1 = 10; // ширина в основании указателя
d2 = 15; // шинира стралки в начале
MC = ‘Оптимизатор 2D функций’;

type
TForm1 = class(TForm)
CaptionVert: TRACaptionButton;
CaptionHor: TRACaptionButton;
ImageList1: TImageList;
Panel1: TPanel;
Page: TPageControl;
TabSheet1: TTabSheet;
RAScrollMax1: TRAScrollMax;
RAScrollMaxBand1: TRAScrollMaxBand;
SetFunc1: TRzRadioButton;
SetFunc2: TRzRadioButton;
SetFuncUser: TRzRadioButton;
FuncEdit: TRzMemo;
RAScrollMaxBand2: TRAScrollMaxBand;
Label1: TLabel;
Label2: TLabel;
MarkerCh: TRzCheckBox;
RzPanel1: TRzPanel;
TabSheet2: TTabSheet;
RAScrollMax2: TRAScrollMax;
RAScrollMaxBand3: TRAScrollMaxBand;
RAScrollMaxBand4: TRAScrollMaxBand;
GradientRadio: TRzRadioButton;
PixelsRadio: TRzRadioButton;
RAScrollMaxBand5: TRAScrollMaxBand;
MainLayerBitmap: TPaintBox;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
TabSheet3: TTabSheet;
RAScrollMax3: TRAScrollMax;
RzToolbar1: TRzToolbar;
RzStatusBar1: TRzStatusBar;
X1Pane: TRzStatusPane;
RenderBut: TRzToolbarButton;
ZoomPlus: TRzToolbarButton;
ZoomMinus: TRzToolbarButton;
X2Pane: TRzStatusPane;
GradColor1: TShape;
GradColor2: TShape;
Label10: TLabel;
FloatRzEdit1: TFloatRzEdit;
Label11: TLabel;
RzButton1: TRzButton;
FloatX1: TFloatRzEdit;
FloatX2: TFloatRzEdit;
FloatW: TFloatRzEdit;
FloatH: TFloatRzEdit;
BackCol: TShape;
RzButton2: TRzButton;
LineCol: TShape;
Label9: TLabel;
Label12: TLabel;
Label13: TLabel;
FloatRzEdit2: TFloatRzEdit;
FloatRzEdit3: TFloatRzEdit;
RzToolbarButton1: TRzToolbarButton;
Move: TRzToolbarButton;
EdX1: TFloatRzEdit;
EdX2: TFloatRzEdit;
SetMarkBut: TRzToolbarButton;
MarkPen: TShape;
RzButton3: TRzButton;
MarkBrush: TShape;
MarkText: TShape;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
SProp: TRzCheckBox;
RAScrollMaxBand6: TRAScrollMaxBand;
SavePicture: TRzToolbarButton;
BtnBlankButton1: TRzToolbarButton;
RzSpinEdit1: TRzSpinEdit;
ShowGrid: TRzCheckBox;
RzSpacer: TRzSpacer;
Label17: TLabel;
Label18: TLabel;
RzSpinEdit2: TRzSpinEdit;
Label19: TLabel;
GridCol: TShape;
Label20: TLabel;
GridTextCol: TShape;
Label21: TLabel;
Label22: TLabel;
RzSpinEdit3: TRzSpinEdit;
RzSpinEdit4: TRzSpinEdit;
Label23: TLabel;
Label24: TLabel;
RAScrollMaxBand7: TRAScrollMaxBand;
RAScrollMaxBand8: TRAScrollMaxBand;
Label25: TLabel;
Label26: TLabel;
FloatRzEdit4: TFloatRzEdit;
Label27: TLabel;
Label28: TLabel;
Label29: TLabel;
FloatRzEdit5: TFloatRzEdit;
FloatRzEdit6: TFloatRzEdit;
Label30: TLabel;
FloatRzEdit7: TFloatRzEdit;
FloatRzEdit8: TFloatRzEdit;
FloatRzEdit9: TFloatRzEdit;
Label31: TLabel;
Label32: TLabel;
Label33: TLabel;
StartOptimize: TRzToolbarButton;
RAScrollMaxBand9: TRAScrollMaxBand;
FloatRzEdit11: TFloatRzEdit;
SavePictureDialog: TSavePictureDialog;
Label34: TLabel;
RzStatusPane: TRzStatusPane;
RzSpinEdit5: TRzSpinEdit;
RzSpinEdit6: TRzSpinEdit;
Label35: TLabel;
Label36: TLabel;
Col1D: TShape;
Col2D: TShape;
FPane: TRzStatusPane;
procedure CaptionVertClick(Sender: TObject);
procedure CaptionHorClick(Sender: TObject);
procedure SetFuncClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure StartRenderClick(Sender: TObject);
procedure MainLayerBitmapPaint(Sender: TObject);
procedure SetLineStyle(Sender: TObject);
procedure MainLayerBitmapMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure MainLayerBitmapMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure MainLayerBitmapMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ColorShapeClick(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure RzButton1Click(Sender: TObject);
procedure RzButton2Click(Sender: TObject);
procedure RzToolbarButton1Click(Sender: TObject);
procedure SetMarkButClick(Sender: TObject);
procedure MarkerChClick(Sender: TObject);
procedure RzButton3Click(Sender: TObject);
procedure EdX1Change(Sender: TObject);
procedure EdX2Change(Sender: TObject);
procedure ShowGridClick(Sender: TObject);
procedure RzSpinEdit1Changing(Sender: TObject;
var AllowChange: Boolean);
procedure RzSpinEdit1Change(Sender: TObject);
procedure SavePictureClick(Sender: TObject);
procedure BtnBlankButton1Click(Sender: TObject);
procedure StartOptimizeClick(Sender: TObject);
procedure FloatWChange(Sender: TObject);
procedure FloatHChange(Sender: TObject);
procedure RzSpinEdit5Change(Sender: TObject);
private
procedure WMRenderFinish(var Msg:TMessage);message WM_RENDER_FINISH;
procedure WMRenderUpdate(var Msg:TMessage);message WM_RENDER_UPDATE;
public
isZoomIn,isZoomOut,isMove,isSetMarker: boolean;
deltaX,deltaY : integer;
X1,Y1,oldX,oldY : integer;
hPen:THandle;
steps:integer; // число шагов оптимизации
time:real; // время в мкс
procedure dOuterAr(hdc:THandle;const r:TRect);
procedure dInnerAr(hdc:THandle;const r:TRect);
procedure dAr(hdc:THandle;const A,B:iPoint;p,d1,d2:real);
function Opt1D(Ax1,Ax2,Bx1,Bx2,k,a,e:real;Nmax:integer;var Rx1,Rx2:extended):integer;
function Opt2D(Ax1,Ax2,a0,p0,gamma,a0_1d,k_1d,e_1d:real;Nmax:integer;var Rx1,Rx2:extended):integer;
end;
var
Form1: TForm1;

implementation

uses drawFunction,takeSysParam, about;

{$R *.DFM}

// Разворачиваем окно по вертикали
procedure TForm1.CaptionVertClick(Sender: TObject);
begin
Height:=Screen.Height+8;
Top:=-4;
end;

// Разворачиваем окно по горизонтали
procedure TForm1.CaptionHorClick(Sender: TObject);
begin
Width:=Screen.Width+8;
Left:=-4;
end;

// Выбираем функцию
procedure TForm1.SetFuncClick(Sender: TObject);
begin
FuncEdit.Enabled:=false;
FuncEdit.Color:=$00C9C9C9;
if (Sender as TRzRadioButton).Name=’SetFunc1′
then takeFunction.optFunc:=takeFunction.optFunc1;
if (Sender as TRzRadioButton).Name=’SetFunc2′
then takeFunction.optFunc:=takeFunction.optFunc2;
if (Sender as TRzRadioButton).Name=’SetFuncUser’
then
begin
takeFunction.optFunc:=takeFunction.optFuncUser;
FuncEdit.Enabled:=true;
FuncEdit.Color:=clWhite;
end;
end;

// Создание формы
procedure TForm1.FormCreate(Sender: TObject);
begin
RzPanel1.Align := alClient;
MainLayerBitmap.Align := alClient;
SetFunc1.Checked:=true;
GradientRadio.Checked:=true;
drawFunction.drawThreadCur := drawFunction.GradientLines;
isZoomIn := false;
isZoomOut:=false;
isMove:=false;
isSetMarker:=false;
Caption := MC;
// Application.ActivateHint(

end;

// Рендерим функцию
procedure TForm1.StartRenderClick(Sender: TObject);
var tID:cardinal;
begin
if drawFunction.hRender<>0 then
TerminateThread(drawFunction.hRender,0);
CloseHandle(drawFunction.hRender);

MainLayerBitmap.Canvas.Pen.Width:=2;
MainLayerBitmap.Canvas.Pen.Color:=clRed;
MainLayerBitmap.Canvas.Brush.Style:=bsClear;
MainLayerBitmap.Canvas.Rectangle(Rect(0,0,
MainLayerBitmap.Width,MainLayerBitmap.Height));

drawFunction.scrW:=MainLayerBitmap.Width;
drawFunction.scrH:=MainLayerBitmap.Height;
drawFunction.realW:=Str2Real(FloatW.Text);
drawFunction.realH:=Str2Real(FloatH.Text);
drawFunction.realL:=Str2Real(FloatX1.Text);
drawFunction.realT:=Str2Real(FloatX2.Text);

drawFunction.gradHeight := Str2Real(FloatRzEdit1.Text);
drawFunction.Col1 := GradColor1.Brush.Color;
drawFunction.Col2 := GradColor2.Brush.Color;

drawFunction.monoHeight := Str2Real(FloatRzEdit2.Text);
drawFunction.eps := Str2Real(FloatRzEdit3.Text);
drawFunction.BackCol := BackCol.Brush.Color;
drawFunction.LineCol := LineCol.Brush.Color;

drawFunction.hRender:=BeginThread(nil,0,drawFunction.drawThreadCur ,nil,0,tID);

ZoomPlus.Enabled:=true;
ZoomMinus.Enabled:=true;
Move.Enabled:=true;
RzToolbarButton1.Enabled:=true;
SavePicture.Enabled:=true;
StartOptimize.Enabled:=true;
end;

// Перерисовка функции
procedure TForm1.MainLayerBitmapPaint(Sender: TObject);
var
w,h,c:integer;
pp:iPoint;
x,y:extended;
dp:dPoint;
s:string;
const
smX : integer=15;
smY : integer=-15;
begin
if (drawFunction.hdc<>0) then // если рисунок существует
StretchBlt(MainLayerBitmap.Canvas.Handle,
0,0,MainLayerBitmap.Width,MainLayerBitmap.Height,
drawFunction.hdc,
0,0,scrW,scrH,
SRCCOPY);

////////////////
// Рисуем сетку
if ShowGrid.Checked=true then
begin
MainLayerBitmap.Canvas.Pen.Color:=GridCol.Brush.Color;
MainLayerBitmap.Canvas.Pen.Width:=1;
if RzSpinEdit1.Value>=1 then // вертикальная
for c:=1 to round(RzSpinEdit1.Value) do
begin
x:=MainLayerBitmap.Width/(RzSpinEdit1.Value+1)*c;
MainLayerBitmap.Canvas.MoveTo(round(x),0);
MainLayerBitmap.Canvas.LineTo(round(x),MainLayerBitmap.Height-1);
dp:=Dig2Real(iPoint_(round(x),0));
MainLayerBitmap.Canvas.Font.Color:=GridTextCol.Brush.Color;
SetBkColor(MainLayerBitmap.Canvas.Handle,GridCol.Brush.Color);
SetBkMode(MainLayerBitmap.Canvas.Handle,OPAQUE);
str(dp.x:round(RzSpinEdit3.Value):round(RzSpinEdit4.Value),s);
MainLayerBitmap.Canvas.TextOut(round(x-MainLayerBitmap.Canvas.TextWidth(s)/2),0,s);
end;
if RzSpinEdit2.Value>=1 then // Горизонтальная
for c:=1 to round(RzSpinEdit2.Value) do
begin
y:=MainLayerBitmap.Height/(RzSpinEdit2.Value+1)*c;
MainLayerBitmap.Canvas.MoveTo(0,round(y));
MainLayerBitmap.Canvas.LineTo(MainLayerBitmap.Width-1,round(y));
dp:=Dig2Real(iPoint_(0,round(y)));
MainLayerBitmap.Canvas.Font.Color:=GridTextCol.Brush.Color;
SetBkColor(MainLayerBitmap.Canvas.Handle,GridCol.Brush.Color);
SetBkMode(MainLayerBitmap.Canvas.Handle,OPAQUE);
str(dp.y:round(RzSpinEdit3.Value):round(RzSpinEdit4.Value),s);
MainLayerBitmap.Canvas.TextOut(0,round(y-MainLayerBitmap.Canvas.TextHeight(s)/2),s);
end;
end;

////////////////
// Рисуем маркер
if MarkerCh.Checked=true then
begin
if (StartMarker.x>realL) and
(StartMarker.yrealT-realH) then
begin
//MainLayerBitmap.Canvas.Pen.Color:=MarkPen.Brush.Color;
//MainLayerBitmap.Canvas.Brush.Color:=MarkBrush.Brush.Color;
pp:=Real2Dig(dPoint_(StartMarker.x,StartMarker.y));

MainLayerBitmap.Canvas.Pen.Width:=2;
MainLayerBitmap.Canvas.Pen.Color:=MarkPen.Brush.Color;
MainLayerBitmap.Canvas.MoveTo(pp.x,pp.y);
MainLayerBitmap.Canvas.LineTo(pp.x+smX,pp.y+smY);

w:=max(MainLayerBitmap.Canvas.TextWidth(‘X1:’+EdX1.Text),
MainLayerBitmap.Canvas.TextWidth(‘X2:’+EdX2.Text));
h:=2*MainLayerBitmap.Canvas.TextHeight(EdX1.Text);

MainLayerBitmap.Canvas.Brush.Color:=MarkBrush.Brush.Color;
MainLayerBitmap.Canvas.Pen.Width:=1;
MainLayerBitmap.Canvas.Rectangle(pp.x+smX,pp.y+smY-h-1,
pp.x+smX+w+4,pp.y+smY+1);

MainLayerBitmap.Canvas.Font.Color:=MarkText.Brush.Color;
SetBkColor(MainLayerBitmap.Canvas.Handle,MarkText.Brush.Color);
SetBkMode(MainLayerBitmap.Canvas.Handle,TRANSPARENT);
MainLayerBitmap.Canvas.TextOut(pp.x+smX+2,pp.y+smY-h,’X1:’+EdX1.Text);
MainLayerBitmap.Canvas.TextOut(pp.x+smX+2,pp.y+smY-round(h/2),’X2:’+EdX2.Text);
end;
end;

end;

// Обрабатываем сообщение о завершении рендеринга
procedure TForm1.WMRenderFinish(var Msg:TMessage);
begin
MainLayerBitmapPaint(self);
end;

procedure TForm1.WMRenderUpdate(var Msg:TMessage);
var r:TRect;
Canv:TCanvas;
begin
r.Left:=0;
r.Top:=Msg.WParamHi;
r.Right:=MainLayerBitmap.Width-1;
r.Bottom:=Msg.WParamLo;

Canv:=TCanvas.Create;
Canv.Handle:=drawFunction.hdc;
MainLayerBitmap.Canvas.CopyRect(r,Canv,r);
Canv.Free;
end;

procedure TForm1.SetLineStyle(Sender: TObject);
begin
if (Sender as TRzRadioButton).Name = ‘GradientRadio’ then
begin
drawFunction.drawThreadCur := drawFunction.GradientLines;
end;

if (Sender as TRzRadioButton).Name = ‘PixelsRadio’ then
begin
drawFunction.drawThreadCur := drawFunction.MonoLines;
end;
end;

procedure TForm1.MainLayerBitmapMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var oldPen:THandle;
begin

{ if (Button = mbRight) and (isZoomIn or IsZoomOut) then
begin
SetRop2(MainLayerBitmap.Canvas.Handle,R2_XORPEN);
oldPen:=SelectObject(MainLayerBitmap.Canvas.Handle,hPen);
dOuterAr(MainLayerBitmap.Canvas.Handle,Rect(x1,y1,oldX,oldY));
SelectObject(MainLayerBitmap.Canvas.Handle,oldPen);
SetRop2(MainLayerBitmap.Canvas.Handle,R2_COPYPEN);

isZoomIn:=false;
isZoomOut:=false;
exit;
end;}
// Поднимаем все командные кнопки при левом нажатии
if (Button = mbRight) and (isMove=false) and
(isZoomIn=false) and (isZoomOut=false) and
(ZoomPlus.Down or ZoomMinus.Down or Move.Down) then
begin
ZoomPlus.Down:=false;
ZoomMinus.Down:=false;
Move.Down:=false;
SetMarkBut.Down:=false;
end;
// Начало сдвига
if (Button = mbLeft) and (Move.Down=true) then
begin
deltaX:=Mouse.CursorPos.x-MainLayerBitmap.Left;
deltaY:=Mouse.CursorPos.y-MainLayerBitmap.Top;
MainLayerBitmap.Align:=alNone;
isMove:=true;
end;

// Начало увеличения мастаба
if (ZoomPlus.Down=true) and (Button=mbLeft) then
begin
X1:=X;
Y1:=Y;

isZoomIn:=true;

oldX:=X;
oldY:=Y;
hPen:=CreatePen(PS_SOLID ,1,$FFFFFF);

SetRop2(MainLayerBitmap.Canvas.Handle,R2_XORPEN);
oldPen:=SelectObject(MainLayerBitmap.Canvas.Handle,hPen);
dOuterAr(MainLayerBitmap.Canvas.Handle,Rect(x1,y1,x,y));
SelectObject(MainLayerBitmap.Canvas.Handle,oldPen);
SetRop2(MainLayerBitmap.Canvas.Handle,R2_COPYPEN);
end;

// Начало уменьшения
if (ZoomMinus.Down=true) and (Button=mbLeft) then
begin
X1:=X;
Y1:=Y;
isZoomOut:=true;

oldX:=X;
oldY:=Y;
hPen:=CreatePen(ps_solid,1,$ffffff);

SetRop2(MainLayerBitmap.Canvas.Handle,R2_XORPEN);
oldPen:=SelectObject(MainLayerBitmap.Canvas.Handle,hPen);
dInnerAr(MainLayerBitmap.Canvas.Handle,Rect(x1,y1,x,y));
SelectObject(MainLayerBitmap.Canvas.Handle,oldPen);
SetRop2(MainLayerBitmap.Canvas.Handle,R2_COPYPEN);
end;
// Установка маркера
if SetMarkBut.Down=true then
begin
StartMarker:=Dig2Real(iPoint_(X,Y));
EdX1.Text:=Real2Str(takeFunction.StartMarker.x);
EdX2.Text:=Real2Str(takeFunction.StartMarker.y);
SetMarkBut.Down:=false;
MainLayerBitmap.Cursor:=crDefault;
//MainLayerBitmapPaint(self);
end;

end;

////////////////
// Движение мыши
procedure TForm1.MainLayerBitmapMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
var dp:dPoint;
oldPen:THandle;
sX1,sX2,sF:string;
begin

if (scrW<>0) and
(scrH<>0) and
(realW<>0) and
(realH<>0) then
begin
dp:=Dig2Real(iPoint_(X,Y));
sX1:=’X1:’+Real2Str(dp.x);
sX2:=’X2:’+Real2Str(dp.y);
sF:=’F:’+Real2Str(optFunc(dp.x,dp.y));
X1Pane.Caption:=sX1;
X2Pane.Caption:=sX2;
FPane.Caption:=sF;
if X1Pane.Canvas.TextWidth(sX1)>X1Pane.Width-12 then
X1Pane.Width:=X1Pane.Canvas.TextWidth(sX1)+12;
if X2Pane.Canvas.TextWidth(sX2)>X2Pane.Width-12 then
X2Pane.Width:=X2Pane.Canvas.TextWidth(sX2)+12;
if FPane.Canvas.TextWidth(sF)>FPane.Width-12 then
FPane.Width:=FPane.Canvas.TextWidth(sF)+12;
end;

// Сдвиг рисунка
if (Move.Down=true) and (isMove=true) then
begin
MainLayerBitmap.Left:=Mouse.CursorPos.x-deltaX;
MainLayerBitmap.Top:=Mouse.CursorPos.y-deltaY;
FloatX1.Text:=Real2Str(realL-MainLayerBitmap.Left*realW/scrW);
FloatX2.Text:=Real2Str(realT+MainLayerBitmap.Top*realH/scrH);
end;

// Увеличеие рисунка
if isZoomIn and (ZoomPlus.Down=true) then
begin
if (x<>oldX) or (y<>oldY) then
begin

SetRop2(MainLayerBitmap.Canvas.Handle,R2_XORPEN);
oldPen:=SelectObject(MainLayerBitmap.Canvas.Handle,hPen);
dOuterAr(MainLayerBitmap.Canvas.Handle,Rect(x1,y1,oldX,oldY));
dOuterAr(MainLayerBitmap.Canvas.Handle,Rect(x1,y1,x,y));
SelectObject(MainLayerBitmap.Canvas.Handle,oldPen);
SetRop2(MainLayerBitmap.Canvas.Handle,R2_COPYPEN);

oldX:=X;
oldY:=Y;
end;
end;

// Уменьшение рисунка
if isZoomOut and (ZoomMinus.Down=true) then
begin
if (x<>oldX) or (y<>oldY) then
begin
SetRop2(MainLayerBitmap.Canvas.Handle,R2_XORPEN);
oldPen:=SelectObject(MainLayerBitmap.Canvas.Handle,hPen);
dInnerAr(MainLayerBitmap.Canvas.Handle,Rect(x1,y1,oldX,oldY));
dInnerAr(MainLayerBitmap.Canvas.Handle,Rect(x1,y1,x,y));
SelectObject(MainLayerBitmap.Canvas.Handle,oldPen);
SetRop2(MainLayerBitmap.Canvas.Handle,R2_COPYPEN);

oldX:=X;
oldY:=Y;
end;
end;

end;

//////////////////
//Отпускаем кнопку
procedure TForm1.MainLayerBitmapMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var oldPen:THandle;
// p:TPoint;
dp1,dp2:dPoint;
ip1{,ip2}:iPoint;
begin

// Заканчиваем увеличение
if isZoomIn and ZoomPlus.Down and (Button = mbLeft) then
begin
SetRop2(MainLayerBitmap.Canvas.Handle,R2_XORPEN);
oldPen:=SelectObject(MainLayerBitmap.Canvas.Handle,hPen);

dOuterAr(MainLayerBitmap.Canvas.Handle,Rect(x1,y1,oldX,oldY));
SelectObject(MainLayerBitmap.Canvas.Handle,oldPen);
SetRop2(MainLayerBitmap.Canvas.Handle,R2_COPYPEN);

if not((abs(x1-oldX)<10) and (abs(y1-oldY)<10)) then begin StretchBlt(MainLayerBitmap.Canvas.Handle, 0,0,MainLayerBitmap.Width,MainLayerBitmap.Height, MainLayerBitmap.Canvas.Handle, x1,y1,X-x1,Y-y1,SRCCOPY); dp1:=Dig2Real(iPoint_(x1,y1)); dp2:=Dig2Real(iPoint_(X,Y)); FloatX1.Text:=Real2Str(dp1.x); FloatX2.Text:=Real2Str(dp1.y); FloatW.Text :=Real2Str(dp2.x-dp1.x); if SProp.Checked=true then begin // FloatW.SetFocus; FloatW.OnChange(self); end else FloatH.Text :=Real2Str(dp1.y-dp2.y); MainLayerBitmap.Canvas.Pen.Width:=2; MainLayerBitmap.Canvas.Pen.Color:=clRed; MainLayerBitmap.Canvas.Brush.Style:=bsClear; MainLayerBitmap.Canvas.Rectangle(Rect(0,0, MainLayerBitmap.Width,MainLayerBitmap.Height)); StartRenderClick(self); end; isZoomIn := false; end; // Заканчиваем уменьшение if isZoomOut and ZoomMinus.Down and (Button = mbLeft) then begin SetRop2(MainLayerBitmap.Canvas.Handle,R2_XORPEN); oldPen:=SelectObject(MainLayerBitmap.Canvas.Handle,hPen); dInnerAr(MainLayerBitmap.Canvas.Handle,Rect(x1,y1,oldX,oldY)); SelectObject(MainLayerBitmap.Canvas.Handle,oldPen); SetRop2(MainLayerBitmap.Canvas.Handle,R2_COPYPEN); if not((abs(x1-oldX)<10) and (abs(y1-oldY)<10)) then begin StretchBlt(MainLayerBitmap.Canvas.Handle, x1,y1,X-x1,Y-y1, MainLayerBitmap.Canvas.Handle, 0,0,MainLayerBitmap.Width,MainLayerBitmap.Height, SRCCOPY); FloatW.Text :=Real2Str(realW*scrW/abs(X-x1)); if SProp.Checked=true then begin //FloatW.SetFocus; FloatW.OnChange(self); end else FloatH.Text :=Real2Str(realH*scrH/abs(Y-y1)); FloatX1.Text:=Real2Str(realL - x1*(realW*scrW/abs(X-x1))/scrW); FloatX2.Text:=Real2Str(realT + y1*(realH*scrH/abs(Y-y1))/scrH); MainLayerBitmap.Canvas.Pen.Width:=2; MainLayerBitmap.Canvas.Pen.Color:=clRed; MainLayerBitmap.Canvas.Brush.Style:=bsClear; MainLayerBitmap.Canvas.Rectangle(Rect(0,0, MainLayerBitmap.Width,MainLayerBitmap.Height)); StartRenderClick(self); end; isZoomOut := false; end; // Заканчиваем перемещение if (Button = mbLeft) and (Move.Down=true) and (isMove=true) then begin dp1.x:=realL-MainLayerBitmap.Left*realW/scrW; dp1.y:=realT+MainLayerBitmap.Top*realH/scrH; FloatX1.Text:=Real2Str(dp1.x); FloatX2.Text:=Real2Str(dp1.y); MainLayerBitmap.Align:=alClient; ip1:=Real2Dig(dPoint_(dp1.x,dp1.y)); BitBlt(drawFunction.hdc,-ip1.x,-ip1.y, scrW,scrH, drawFunction.hdc, 0,0,SRCCOPY); MainLayerBitmap.Canvas.Pen.Width:=2; MainLayerBitmap.Canvas.Pen.Color:=clRed; MainLayerBitmap.Canvas.Brush.Style:=bsClear; MainLayerBitmap.Canvas.Rectangle(Rect(0,0, MainLayerBitmap.Width,MainLayerBitmap.Height)); StartRenderClick(self); isMove:=false; end; deleteObject(hPen); end; procedure TForm1.ColorShapeClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var ColorDlg:TColorDialog; begin if Sender is TShape then begin ColorDlg := TColorDialog.Create(self); ColorDlg.Options:= [cdFullOpen, cdPreventFullOpen, cdShowHelp, cdSolidColor, cdAnyColor]; ColorDlg.Color := (Sender as TShape).Brush.Color; if ColorDlg.Execute = true then (Sender as TShape).Brush.Color := ColorDlg.Color; ColorDlg.Free; MainLayerBitmapPaint(self); end; end; procedure TForm1.RzButton1Click(Sender: TObject); var t:TColor; begin t:=GradColor1.Brush.Color; GradColor1.Brush.Color := GradColor2.Brush.Color; GradColor2.Brush.Color := t; end; procedure TForm1.dOuterAr(hdc:THandle;const r:TRect); var p:TPoint; // LT,RT,LB,RB:real; const xdelt = 5; ydelt = 5; begin movetoex(hdc,r.Left,r.Top,@p); lineto(hdc,r.Right,r.Top); lineto(hdc,r.Right,r.Bottom); lineto(hdc,r.Left,r.Bottom); lineto(hdc,r.Left,r.Top); dAr(hdc,iPoint_(r.Left,r.Top),iPoint_(xdelt,ydelt),pe,d1,d2); dAr(hdc,iPoint_(r.Right,r.Top),iPoint_(MainLayerBitmap.Width-xdelt,ydelt),pe,d1,d2); dAr(hdc,iPoint_(r.Right,r.Bottom),iPoint_(MainLayerBitmap.Width-xdelt, MainLayerBitmap.Height-ydelt),pe,d1,d2); dAr(hdc,iPoint_(r.Left,r.Bottom),iPoint_(xdelt,MainLayerBitmap.Height-ydelt),pe,d1,d2); end; procedure TForm1.dInnerAr(hdc:THandle;const r:TRect); var p:TPoint; // LT,RT,LB,RB:real; const xdelt = 5; ydelt = 5; begin movetoex(hdc,r.Left,r.Top,@p); lineto(hdc,r.Right,r.Top); lineto(hdc,r.Right,r.Bottom); lineto(hdc,r.Left,r.Bottom); lineto(hdc,r.Left,r.Top); dAr(hdc,iPoint_(xdelt,ydelt),iPoint_(r.Left,r.Top),pe,d1,d2); dAr(hdc,iPoint_(MainLayerBitmap.Width-xdelt,ydelt),iPoint_(r.Right,r.Top),pe,d1,d2); dAr(hdc,iPoint_(MainLayerBitmap.Width-xdelt, MainLayerBitmap.Height-ydelt),iPoint_(r.Right,r.Bottom),pe,d1,d2); dAr(hdc,iPoint_(xdelt,MainLayerBitmap.Height-ydelt),iPoint_(r.Left,r.Bottom),pe,d1,d2); end; procedure TForm1.dAr(hdc:THandle;const A,B:iPoint;p,d1,d2:real); var px,py,perpX,perpY,l:real; op:TPoint; begin l:=sqrt(sqr(A.x-B.x)+sqr(A.y-B.y)); px:=A.x+(B.x-A.x)*p; py:=A.y+(B.y-A.y)*p; perpX:=-(B.y-A.y)/l; perpY:=(B.x-A.x)/l; MoveToEx(hdc,A.x,A.y,@op); LineTo(hdc,round(px+perpX*d1),round(py+perpy*d1)); LineTo(hdc,round(px+perpX*(d1+d2)),round(py+perpy*(d1+d2))); LineTo(hdc,B.x,B.y); LineTo(hdc,round(px-perpX*(d1+d2)),round(py-perpy*(d1+d2))); LineTo(hdc,round(px-perpX*d1),round(py-perpy*d1)); LineTo(hdc,A.x,A.y); end; procedure TForm1.RzButton2Click(Sender: TObject); var t:TColor; begin t:=LineCol.Brush.Color; LineCol.Brush.Color := BackCol.Brush.Color; BackCol.Brush.Color := t; end; procedure TForm1.RzToolbarButton1Click(Sender: TObject); //var rect:TRect; begin MainLayerBitmapPaint(Sender); end; procedure TForm1.SetMarkButClick(Sender: TObject); begin if SetMarkBut.Down=true then begin ZoomPlus.Down:=false; ZoomMinus.Down:=false; Move.Down:=false; MainLayerBitmap.Cursor:=crHandPoint; end else begin MainLayerBitmap.Cursor:=crDefault; end end; procedure TForm1.MarkerChClick(Sender: TObject); begin MainLayerBitmapPaint(self); end; procedure TForm1.RzButton3Click(Sender: TObject); var t:TColor; begin t:=MarkPen.Brush.Color; MarkPen.Brush.Color := MarkBrush.Brush.Color; MarkBrush.Brush.Color := t; MainLayerBitmapPaint(self); end; procedure TForm1.EdX1Change(Sender: TObject); begin try StartMarker.x:=Str2Real(EdX1.text); MainLayerBitmapPaint(self); except MessageBox(0,'Неправильно введено число','Ошибка',mb_ok or MB_ICONERROR); end; end; procedure TForm1.EdX2Change(Sender: TObject); begin try StartMarker.y:=Str2Real(EdX2.text); MainLayerBitmapPaint(self); except MessageBox(0,'Неправильно введено число','Ошибка',mb_ok or MB_ICONERROR); end; end; procedure TForm1.ShowGridClick(Sender: TObject); //var i:integer; begin Label17.Enabled:=ShowGrid.Checked; Label18.Enabled:=ShowGrid.Checked; Label19.Enabled:=ShowGrid.Checked; RzSpinEdit1.Enabled:=ShowGrid.Checked; RzSpinEdit2.Enabled:=ShowGrid.Checked; GridCol.Enabled:=ShowGrid.Checked; GridTextCol.Enabled:=ShowGrid.Checked; Label20.Enabled:=ShowGrid.Checked; Label21.Enabled:=ShowGrid.Checked; RzSpinEdit3.Enabled:=ShowGrid.Checked; RzSpinEdit4.Enabled:=ShowGrid.Checked; Label22.Enabled:=ShowGrid.Checked; Label23.Enabled:=ShowGrid.Checked; Label24.Enabled:=ShowGrid.Checked; MainLayerBitmapPaint(self); end; procedure TForm1.RzSpinEdit1Changing(Sender: TObject; var AllowChange: Boolean); begin MainLayerBitmapPaint(self); end; procedure TForm1.RzSpinEdit1Change(Sender: TObject); begin MainLayerBitmapPaint(self); end; {****************************************************************************} {********************* Оптимизация ****************************} {****************************************************************************} procedure TForm1.SavePictureClick(Sender: TObject); var bmp:TBitmap; begin bmp:=TBitmap.Create; bmp.Width:=MainLayerBitmap.Width; bmp.Height:=MainLayerBitmap.Height; bmp.Canvas.CopyRect(Rect(0,0,bmp.Width-1,bmp.Height-1), MainLayerBitmap.Canvas, Rect(0,0,bmp.Width-1,bmp.Height-1)); SavePictureDialog.Title:='Сохранение графика ('+IntToStr(bmp.Width)+'x'+IntToStr(bmp.Height)+')'; if SavePictureDialog.Execute=true then bmp.SaveToFile(SavePictureDialog.FileName); bmp.Free; end; procedure TForm1.BtnBlankButton1Click(Sender: TObject); begin Form3.Visible:=true; end; function TForm1.Opt1D;//(Ax1,Ax2,Bx1,Bx2,k,a,e:real;Nmax:integer;var Rx1,Rx2:extended):integer; function VLen(x1,x2:real):real; begin result:=sqrt(x1*x1+x2*x2); end; var f:boolean; Lx1,Lx2,dx1,dx2,a1:real; N:integer; ip:iPoint; begin N:=0; a1:=a; f:=false; if a>1 then
begin
result:=0;
Rx1:=Ax1;
Rx2:=Ax2;
exit;
end;
dx1:=(Bx1-Ax1)*a1;
dx2:=(Bx2-Ax2)*a1;
Lx1:=Ax1 + dx1;
Lx2:=Ax2 + dx2;
while (f=false) do
begin
N:=N+1;
if N>Nmax then
begin
f:=true;
Rx1:=Lx1;
Rx2:=Lx2;
result:=3;
break;
end;
if optFunc(Lx1,Lx2)>=optFunc(Lx1-dx1,Lx2-dx2) then
begin
dx1:=-dx1/k;
dx2:=-dx2/k;
Lx1:=Lx1 + dx1;
Lx2:=Lx2 + dx2;
end
else
begin
Lx1:=Lx1 + dx1;
Lx2:=Lx2 + dx2;
end;

//if abs(dx1)/abs(Bx1-Ax1)/sqr(k)<=e then if VLen(dx1,dx2)/VLen(Bx1-Ax1,Bx2-Ax2)/sqr(k)<=e then begin Rx1:=Lx1; Rx2:=Lx2; f:=true; result:=0; end; end; if (result<>0) and ((Lx1>Bx1) or (Lx2>Bx2)) then
begin
Rx1:=Bx1;
Rx2:=Bx2;
result:=1;
end;
if (result<>0) and ((Lx1Nmax then
begin
Rx1:=Lx1;
Rx2:=Lx2;
result:=3;
f:=true;
break;
end;

Bx1:=(optFunc(Lx1+p,Lx2)-optFunc(Lx1-p,Lx2))/(2*p);
Bx2:=(optFunc(Lx1,Lx2+p)-optFunc(Lx1,Lx2-p))/(2*p);

if p>abs(a*VLen(Bx1,Bx2)) then // шаг меньше ошибки изм.
begin
Rx1:=Lx1;
Rx2:=Lx2;
result:=0;
f:=true;
break;
end;

nLx1:=Lx1 — a*Bx1;
nLx2:=Lx2 — a*Bx2;
//
with MainLayerBitmap.Canvas do
begin
ip1:=Real2Dig(dPoint_(Lx1,Lx2));
ip2:=Real2Dig(dPoint_(nLx1,nLx2));
Pen.Color:=Col2D.Brush.Color;
Rectangle(ip1.x-1,ip1.y-1,ip1.x+1,ip1.y+1);
Rectangle(ip2.x-1,ip2.y-1,ip2.x+1,ip2.y+1);
MoveTo(ip1.x,ip1.y);
LineTo(ip2.x,ip2.y);
end;

if optFunc(nLx1,nLx2)>optFunc(Lx1,Lx2) then
begin
Opt1D(Lx1,Lx2,nLx1,nLx2,k_1d,a0_1d,e_1d,Nmax,nLx1,nLx2);
end;
//
k:=k+1;
a := a0 / k;
p := p0 / (exp(gamma*ln(k)));
Lx1:=nLx1;
Lx2:=nLx2;
end;
end;

{————————————————————}
{————————————————————}
{————————————————————}
{————————————————————}

procedure TForm1.StartOptimizeClick(Sender: TObject);
var
Nmax : integer; //1D 2D
a0_1d : extended; // 1D
K : extended; // 1D
e_1d : extended; // 1D
a0_2d : extended; // 2D
p0 : extended; // 2D
gamma : extended; // 2D
sp,rp : dPoint;
r:integer;
ip:iPoint;
freq,t1,t2:int64;
s:string;
begin
QueryPerformanceFrequency(freq);
QueryPerformanceCounter(t1);

steps:=0;
RzStatusPane.Caption:=»;
MainLayerBitmapPaint(self);

Nmax := StrToInt(FloatRzEdit11.Text);
a0_1d := Str2Real(FloatRzEdit4.Text)/100;
K := Str2Real(FloatRzEdit5.Text);
e_1d := Str2Real(FloatRzEdit6.Text);
a0_2d := Str2Real(FloatRzEdit7.Text);
p0 := Str2Real(FloatRzEdit8.Text);
gamma := Str2Real(FloatRzEdit9.Text);
sp.x := Str2Real(EdX1.Text);
sp.y := Str2Real(EdX2.Text);

r:=Opt2D(sp.x,sp.y,a0_2d,p0,gamma,a0_1d,k,e_1d,Nmax,rp.x,rp.y);
ip:=Real2Dig(rp);
MainLayerBitmap.Canvas.Pen.Color:=clYellow;
MainLayerBitmap.Canvas.Rectangle(ip.x-3,ip.y-3,ip.x+3,ip.y+3);

QueryPerformanceCounter(t2);
time := (t2-t1)/freq*1000;
str(time:0:3,s);
case r of
0:RzStatusPane.Caption:=’OK ‘ + s + ‘ мс | ‘+IntToStr(steps)+’ steps’ + ‘ | (‘+Real2Str(rp.x)+’,’+Real2Str(rp.y)+’) F=’+Real2Str(optFunc(rp.x,rp.y));
3:RzStatusPane.Caption:=’Шаги исчерпаны’;
end;

end;

procedure TForm1.FloatWChange(Sender: TObject);
begin
if (SProp.Checked=true) {and (FloatW.Focused=true)} then
try
FloatH.Text:=Real2Str(Str2Real(FloatW.Text)*
MainLayerBitmap.Height/MainLayerBitmap.Width);
except end;
end;

procedure TForm1.FloatHChange(Sender: TObject);
begin
{if (SProp.Checked=true) then
try
FloatW.Text:=Real2Str(Str2Real(FloatH.Text)*
MainLayerBitmap.Width/MainLayerBitmap.Height);
except end; }
end;

procedure TForm1.RzSpinEdit5Change(Sender: TObject);
begin
takeSysParam.nWidt:=round(RzSpinEdit5.value);
takeSysParam.nDec:= round(RzSpinEdit6.Value);
end;

end.

Примечание:
При разработке программы были использованы сторонние библиотеки: R&A Library 1.60, Raize Components Version 2.51c, RxLib 2.75. При попытке компиляции в отсутствии этих библиотек, исходники программы могут быть повреждены.

Похожие записи
  1. Открытый В-сплайн 3-ей степени на Builder C++
  2. Программа эмуляции работы КЭШ-памяти
  3. Задачи, решаемые применением языка VHDL для анализа и синтеза дискретных систем
  4. Составная кривая Безье 3-ей степени на Builder C++
  5. Программа на основе метода наискорейшего спуска и метода Фибоначчи
  6. Ассоциативные запоминающие устройства, моделирование ассоциативной ячейки
  7. Код Фримэна на Builder C++
  8. Создание модели накопителя АЗУ на языке C++
  9. Задача минимизации методами наискорейшего спуска и поразрядного приближения
  10. Событие OnMessage, перехватчики сообщений, перехваты Windows
  11. Математические модели непрерывных динамических систем
  12. Актуальность анализа сложных систем
  13. Имитационное моделирование комбинированных (непрерывно-дискретных) систем
  14. Программирование калькулятора на C++
  15. Разработка приложения-клиент и приложения-сервер, взаимодействующие по OLE технологии в среде Delphi
  16. Примеры моделирования дискретных схем на VHDL
  17. Делегирование полномочий интерфейсов, свойство классов типа интерфейс
PostCategoryIcon Рубрика: Математика, Программирование

Комментарии запрещены.


Поиск
Категории


Статистика

Образовательный блог разработан в 2009 году.