Оптимизация функции нескольких переменных

[Стася]

Почему виснет программа?

Код:

unit Unit11;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, TeeProcs, TeEngine, Chart;

type
  TForm11 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Edit5: TEdit;
    Label7: TLabel;
    Edit6: TEdit;
    Edit7: TEdit;
    Label8: TLabel;
    Label9: TLabel;
    Edit8: TEdit;
    Edit9: TEdit;
    Label10: TLabel;
    Button2: TButton;
    Edit10: TEdit;
    Edit11: TEdit;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form11: TForm11;
  R:real;
  x1,x2:real;
  n1,n2:real;
  delta1,delta2:real;
  x1L,x1R,x2L,x2R:real;

implementation

{$R *.dfm}


function GetR(xx1,xx2:real):real;
begin
  R:=2*xx1*xx1+5*xx2*xx2+4*xx1*xx2-6*xx2+8;
end;


procedure TForm11.Button1Click(Sender: TObject);
Var eps,minR,minx1,minx2,x1old,x2old:real;
begin
eps:=strtofloat(edit5.text);
n1:=strtofloat(edit6.text);
n2:=strtofloat(edit7.Text);
x1L:=strtofloat(edit1.text);
x1R:=strtofloat(edit2.text);
x2L:=strtofloat(edit3.text);
x2R:=strtofloat(edit4.text);
delta1:=(x1R-x1L)/(n1-1);
delta2:=(x2R-x2L)/(n2-1);
while (delta1+delta2)>=eps do
begin
  x1:=x1L;
  while x1<=x1R do
  begin
    x2:=x2L;
   while x2<=x2R do
   begin
     if GetR(x1,x2)<minR then
     begin
       minR:=GetR(x1,x2);
       minx1:=x1;
       minx2:=x2;
     end;
     x2:=x2+delta2;
   end;
   x1:=x1+delta1;
  end;
  x1L:=minx1-delta1;
  x2L:=minx2-delta2;
  x1R:=minx1+delta1;
  x2R:=minx2+delta2;
end;
Edit8.text:=floattostr(minx1);
Edit9.text:=floattostr(minx2);
end;

procedure TForm11.Button2Click(Sender: TObject);
Var eps,x1old,x2old:real;
begin
eps:=strtofloat(edit5.text);
n1:=strtofloat(edit6.text);
n2:=strtofloat(edit7.Text);
x1L:=strtofloat(edit1.text);
x1R:=strtofloat(edit2.text);
x2L:=strtofloat(edit3.text);
x2R:=strtofloat(edit4.text);
while (delta1+delta2)>=eps do
begin
  x1old:=x1;
  x2old:=x2;
  while GetR(x1+delta1,x2)<GetR(x1,x2) do
  x1:=x1+delta1;
  while GetR(x1-delta1,x2)<GetR(x1,x2) do
  x1:=x1-delta1;
  while GetR(x1,x2+delta2)<GetR(x1,x2) do
  x2:=x2+delta2;
  while GetR(x1,x2-delta2)<GetR(x1,x2)  do
  x2:=x2-delta2;
  if x1=x1old then
  delta1:=delta1/2;
  if x2=x2old then
  delta2:=delta2/2;
  delta1:=(x1R-x1L)/(n1-1);
delta2:=(x2R-x2L)/(n2-1);
end;
Edit11.text:=floattostr(x1);
Edit10.text:=floattostr(x2);
end;

end.

[Алексей++]

Стася, запусти в отладчике и определи место, где "виснет"

[Sla]

видимо уходит в цикл

[Sands]

Насколько я помню паскаль(или дельфи в данном случае), то чтобы функция вернула значение надо это значение присвоить переменной с именем фукции, поэтому, Стася, по идее, стоит написать так

Код:

function GetR(xx1,xx2:real):real;
begin
  GetR:=2*xx1*xx1+5*xx2*xx2+4*xx1*xx2-6*xx2+8;
end;

возможно ето решит проблему зависания

[zubr]

Sands, это никоим образом не решит проблему зависания. Здесь уже правильно сказали - программа где то зацикливается. Разбираться в коде особого желания нет, проблема решается легко (по выявлению места зависания) - когда программа зациклилась, поставить точки останова в циклах.

[Dr.Yevhenius]

Вот:

procedure TForm11.Button1Click(Sender: TObject);
...
begin
...
delta1:=(x1R-x1L)/(n1-1);
delta2:=(x2R-x2L)/(n2-1);
while (delta1+delta2)>=eps do
begin
  x1:=x1L;
  while x1<=x1R do
  begin
    x2:=x2L;
    while x2<=x2R do
    begin
      if GetR(x1,x2)<minR then
      begin
        minR:=GetR(x1,x2);
        minx1:=x1;
        minx2:=x2;
      end;
      x2:=x2+delta2;
    end;
    x1:=x1+delta1;
  end;
  x1L:=minx1-delta1;
  x2L:=minx2-delta2;
  x1R:=minx1+delta1;
  x2R:=minx2+delta2;
end;
...
end;

delta1, delta2 и eps в этой функции не меняются. Результат - (delta1+delta2)>=eps бесконечно возвращает одно и то же значение.

[Dr.Yevhenius]

Но на первом месте я исправил бы функцию GetR, как сказал Sands, а то результат возвращается в переменную R, которая ни разу в коде не использовалась.

[Dr.Yevhenius]

На счёт

procedure TForm11.Button2Click(Sender: TObject);
...
end;

ничего полезного сказать не могу из-за нагромождений циклов и условий. 

[Sands]

zubr, Согласен, проблему зависания ето не решит, заработалсо...
Но во всяком случае хотелось бы услышать комментарии автора вопроса относительно алгоритма, идеи и всего такого. ))

[Стася]

Теперь работает, спасибо Вам.

Код:

unit Unit11;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, TeeProcs, TeEngine, Chart;

type
  TForm11 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    Button1: TButton;
    Edit5: TEdit;
    Label7: TLabel;
    Edit6: TEdit;
    Edit7: TEdit;
    Label8: TLabel;
    Label9: TLabel;
    Edit8: TEdit;
    Edit9: TEdit;
    Label10: TLabel;
    Button2: TButton;
    Edit10: TEdit;
    Edit11: TEdit;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form11: TForm11;
  R:real;
  x1,x2:real;
  n1,n2:real;
  delta1,delta2:real;
  x1L,x1R,x2L,x2R:real;

implementation

{$R *.dfm}


function GetR(xx1,xx2:real):real;
begin
  R:=2*xx1*xx1+5*xx2*xx2+4*xx1*xx2-6*xx2+8;
end;


procedure TForm11.Button1Click(Sender: TObject);
Var eps,minR,minx1,minx2,x1old,x2old:real;
begin
eps:=strtofloat(edit5.text);
n1:=strtofloat(edit6.text);
n2:=strtofloat(edit7.Text);
x1L:=strtofloat(edit1.text);
x1R:=strtofloat(edit2.text);
x2L:=strtofloat(edit3.text);
x2R:=strtofloat(edit4.text);
delta1:=(x1R-x1L)/(n1-1);
delta2:=(x2R-x2L)/(n2-1);
while (delta1+delta2)>=eps do
begin
  x1:=x1L;
  while (x1<=x1R) do
  begin
    x2:=x2L;
   while x2<=x2R do
   begin
     if GetR(x1,x2)<minR then
     begin
       minR:=GetR(x1,x2);
       minx1:=x1;
       minx2:=x2;
     end;
     x2:=x2+delta2;
   end;
   x1:=x1+delta1;
  end;
  x1L:=minx1-delta1;
  x2L:=minx2-delta2;
  x1R:=minx1+delta1;
  x2R:=minx2+delta2;
  delta1:=(x1R-x1L)/(n1-1);
  delta2:=(x2R-x2L)/(n2-1);
end;
Edit8.text:=floattostr(minx1);
Edit9.text:=floattostr(minx2);
end;

procedure TForm11.Button2Click(Sender: TObject);
Var eps,x1old,x2old:real;
begin
eps:=strtofloat(edit5.text);
n1:=strtofloat(edit6.text);
n2:=strtofloat(edit7.Text);
x1L:=strtofloat(edit1.text);
x1R:=strtofloat(edit2.text);
x2L:=strtofloat(edit3.text);
x2R:=strtofloat(edit4.text);
delta1:=(x1R-x1L)/(n1-1);
delta2:=(x2R-x2L)/(n2-1);
while (delta1+delta2)>=eps do
begin
  x1old:=x1;
  x2old:=x2;
  while GetR(x1+delta1,x2)<GetR(x1,x2) do
  x1:=x1+delta1;
  while GetR(x1-delta1,x2)<GetR(x1,x2) do
  x1:=x1-delta1;
  while GetR(x1,x2+delta2)<GetR(x1,x2) do
  x2:=x2+delta2;
  while GetR(x1,x2-delta2)<GetR(x1,x2)  do
  x2:=x2-delta2;
  if x1=x1old then
  delta1:=delta1/2;
  if x2=x2old then
  delta2:=delta2/2;
end;
Edit11.text:=floattostr(x1);
Edit10.text:=floattostr(x2);
end;

end.