Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Здравствуйте, уважаемые эксперты!
Помогите написать программу, решающую такую задачу:
Ветви параболы направлены вниз. Точки А(0, 1) и В(7, 2) лежат на разных ветвях параболы. Найти абсциссу вершины, если известна её ордината (у = 6).

Вопрос задал: Drinkenz (статус: 1-ый класс) Вопрос отправлен: 4 июля 2012, 02:30 Состояние вопроса: решён, ответов: 1.

Ответ #1. Отвечает эксперт: Толяныч

Здравствуйте, Drinkenz!
Это на первыый взгляд.
А на второй - это классическая оптимизационная задача с поиском корней и максимума.
Через точки (0,1) и (7,2) можно провести бесконечное число парабол вида y = a*x*x + b*x + c ; Поскольку у нас есть точка с абсциссой 0, с определяется сразу :
a * 0 * 0 + b * 0 + c = 1 , откуда с = 1 ; По второй точке определяем соотношение миежду a и b :
а * 7 * 7 + b * 7 + c = 2 откуда b = ( 2 - c - 49*a) / 7 ;
Теперь перебирая значения а , к примеру, методом дихотомии, находим такую параболу ( значение а ), для которой максимум будет равен 6. Поиск максимума легко выполнить методом золотого сечения. При этом в качестве побочного продукта имеем абсциссу этого максимума, т.е. искомое решение !
Хватит слов, пора к делу.

interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, 
 
Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls, ExtDlgs;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
Area: TRect ;
    { Public declarations }
  end;
var
  Form1: TForm1  ;
  x1,x3,y1,y2,y3,a1,a2,a,b,c,Xopt,Max1,Max2,Au : double 
 
;
implementation
 
{$R *.dfm}
 
procedure TForm1.FormClick(Sender: TObject);
// ------------------
function MaxFun(par : double) : double ;
var
  dx,ax1,ax2,xt1,xt2,yt1,yt2 : double ;
begin
   a := par ; b := (1-a*x3*x3)/ x3 ; c := y1 ;
   ax1 := x1 ; ax2 := x3 ;
   xt1 := ax1 + (ax2-ax1) * (1.0-Au) ;
   xt2 := ax1 + (ax2-ax1) * Au ;
   yt1 := a * xt1 * xt1 + b * xt1 + c ;
   yt2 := a * xt2 * xt2 + b * xt2 + c ;
  repeat
      if yt1<yt2 then
         begin
           ax1 := xt1 ; xt1 := xt2 ; yt1 := yt2 ;
           xt2 := ax1 + (ax2-ax1) * Au ;
           yt2 := a * xt2 * xt2 + b * xt2 + c
         end  else
         begin
           ax2 := xt2 ; xt2 := xt1 ; yt2 := yt1 ;
           xt1 := ax1 + (ax2-ax1) * (1.0-Au) ;
           yt1 := a * xt1 * xt1 + b * xt1 + c
         end ;
  until (xt2-xt1)<0.001 ;
           ;
   Result := (yt1+yt2)/2.0 ; Xopt := (xt1+xt2)/2.0 ;
end ;
// ------------------
var max : double ; i : integer ;
begin
  Max1 := MaxFun (a1) ;
  Max2 := MaxFun (a2) ; i := 1 ;
  repeat
    a := (a1+a2)/2.0 ; Max := MaxFun(a) ;
    if ((Max>y2) and (Max1>y2)) or ((Max<y2) and 
 
(Max1<y2))
    then begin a1 := a ; Max1 := Max end
    else begin a2 := a ; Max2 := Max end ;
    Memo1.Lines.Add
       (Format('%2d a=%8.6f y=%8.6f 
 
x=%8.6f',[i,a,Max,Xopt]) ) ;
    Inc(i) ;
  until Abs(a2-a1)<0.0001 ;
    Memo1.Lines.Add(Format('X2=%8.6f',[Xopt]) )
end;
 
procedure TForm1.FormActivate(Sender: TObject);
begin
  x1 := 0 ; x3 := 7.0 ; y1 := 1.0 ; y3 := 2.0 ; y2 := 
 
6.0 ;
  a1 := 0 ; a2 := -1.0 ; Au := (Sqrt(5.0)-1.0) /2.0 ;
  Memo1.Lines.Add(Format('%8.6f',[Au]) ) ;
end;
 
end.

Ответ отправил: Толяныч (статус: 4-ый класс) Время отправки: 5 июля 2012, 09:54 Оценка за ответ: 5

Мини-форум вопроса

Мережников Андрей (статус: Абитуриент), 4 июля 2012, 19:32 [#1]: алгебра, школьный курс

Толяныч (статус: 4-ый класс), 5 июля 2012, 10:00 [#2]: Это на первыый взгляд. А на второй - это классическая оптимизационная задача с поиском корней и максимума. Не собирался решать за студентов задачи, кроме случаев, когда задача покажется интересной; эта именно такая. Результат работы программы : 1 a=-0.500000 y=7.635204 x=3.642892 2 a=-0.250000 y=4.582908 x=3.785552 3 a=-0.375000 y=6.107355 x=3.690291 4 a=-0.312500 y=5.344451 x=3.728637 5 a=-0.343750 y=5.725780 x=3.708110 6 a=-0.359375 y=5.916541 x=3.698594 7 a=-0.367188 y=6.011941 x=3.695423 8 a=-0.363281 y=5.964240 x=3.696634 9 a=-0.365234 y=5.988090 x=3.695423 10 a=-0.366211 y=6.000016 x=3.695423 11 a=-0.365723 y=5.994053 x=3.695423 12 a=-0.365967 y=5.997034 x=3.695423 13 a=-0.366089 y=5.998525 x=3.695423 14 a=-0.366150 y=5.999271 x=3.695423 X2=3.695423 Видим, что начиная с 7-й иттерации x практически не изменяется, на этом основании можно прекратить вычичления, добавив во внешний цикл условие выхода. Предоставим это сделать токикстартеру. Делов-то -- пару строчек. Интересно было бы помсотреть алгебраическое решение в виде задачки школьного курса

6 июля 2012, 09:27: Статус вопроса изменён на решённый (изменил автор вопроса — Drinkenz)

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.