Нужна помощь с заданием по нахождению экстремумов

[5251]

Нужно найти экстремумы (перегибы) функции из разряда a*sin(b*x) или также с cos(x)
кому не сложно помогите , пожалуйста

[p51x]

Какой алгоритм вы выбрали для этой задачи?

[5251]

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;
Tpoint_r=record
x,y:real;
end;
Tmas_TPoint_r=array of TPoint_r;
Tfunc=function(z:real):real;
Tmas_TPoint=array of Tpoint;

var
Form1: TForm1;
a:Tmas_Tpoint_r;
at,b:Tmas_tPoint;

implementation
{$R *.dfm}
function f1(x:real):real;
begin
f1:=sin(x);

end;
procedure Tab(xn,xk:real; N:integer; f:Tfunc;
Var z:Tmas_TPoint_r);
var h:real;i:integer;
begin
h:=(xk-xn)/n;
Setlength(z,n);
For i:=0 to n-1 do
begin
z[i].x:= xn+ i*h;
z[i].y := f(z[i].x);
end;
end;
procedure Grafic(z:Tmas_TPoint_r;Var g:Tmas_TPoint);
Var hxk,hyk:real;hxn,hyn,i,n,imax,o,imi n,t,j:integer;
var max,min,mhx,mhy,xn,xk,max1,min1:rea l;
begin
n:=length(z);
Setlength(g,n);
xn:=z[0].x;
xk:=z[n-1].x;
max:=z[0].Y; min:=z[0].Y;
for i:=0 to n-1 do
begin
if z[i].y>max then
max:=z[i].Y;
if z[i].Y<min then
min:=z[i].y ;
end;

hxn:=0; hyn:=0;
hxk:=form1.Image1.Width;
hyk:=form1.Image1.Height;

mhx:=(hxk-hxn)/abs(xk-xn);
mhy:=(hyk-hyn)/abs(max-min);

for i := 0 to n - 1 do
begin
g[i].X:=round((z[i].x-xn)*mhx)+hxn;
g[i].Y:=round((max-z[i].y)*mhy)+hyn;
end;
for i := 0 to n - 1 do
form1.Image1.Canvas.Pixels [g[i].x, g[i].Y]:=clred;
with form1.image1.Canvas do
begin
moveto(g[0].x,g[0].y);
for i := 0 to n - 1 do
lineto(g[i].X,g[i].y);
end;
max1:=g[0].Y;
for i:=1 to n-1 do
if g[i].Y<max1 then
max1:=g[i].Y;
for i:=0 to n-1 do
if g[i].Y=max1 then
begin
imax:=i;
Form1.Image1.Canvas.Brush.Color:=cl Red;
Form1.Image1.Canvas.Ellipse(g[imax].x+10,g[imax].Y +10,g[imax].x -10,g[imax].Y -10);
end;
min1:=g[0].y;
for i:=1 to n-1 do
if g[i].Y>min1 then
min1:=g[i].Y;

for i:=0 to n-1 do
if g[i].Y=min1 then
begin
imin:=i;
Form1.Image1.Canvas.Brush.Color:=cl blue;
Form1.Image1.Canvas.Ellipse(g[imin].x+10,g[imin].Y +10,g[imin].x -10,g[imin].Y -10);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Tab(-9,9,200,f1,a);
Grafic(a,at) ;

end;


end

[5251]

Только точки дублируются
так то программа более менее

[type_Oleg]

Вы не поверите, но Delphi не умеет сама находить формулы для производной функции. Тем более - если перегиб, то это уже вторая производная.
Так что, либо вы сами пишете формулу второй производной и ищите, где она =0 ( а на форуме куча тем с решением f(x)=0), либо надо как-то численно вычислять производные ( по приращениям ), и опять же искать, где они =0.

PS Пока писал, появились ответы. Это я к самому первому вопросу.

[5251]

Сообщение от type_Oleg

Вы не поверите, но Delphi не умеет сама находить формулы для производной функции. Тем более - если перегиб, то это уже вторая производная.
Так что, либо вы сами пишете формулу второй производной и ищите, где она =0 ( а на форуме куча тем с решением f(x)=0), либо надо как-то численно вычислять производные ( по приращениям ), и опять же искать, где они =0.

PS Пока писал, появились ответы. Это я к самому первому вопросу.

Сообщение от type_Oleg

Вы не поверите, но Delphi не умеет сама находить формулы для производной функции. Тем более - если перегиб, то это уже вторая производная.
Так что, либо вы сами пишете формулу второй производной и ищите, где она =0 ( а на форуме куча тем с решением f(x)=0), либо надо как-то численно вычислять производные ( по приращениям ), и опять же искать, где они =0.

PS Пока писал, появились ответы. Это я к самому первому вопросу.

А можно ссылочку

[type_Oleg]

Сообщение от 5251

А можно ссылочку

А сейчас я уже не знаю, что именно вам нужно. Я думал, надо найти перегиб, то есть решить уравнение f''(x)=0. Вот пример - ссыла

А у вас в исходнике - графика. Так может быть надо график построить, и пальцем показать на перегиб ?

[саша40]

Сообщение от 5251

Нужно найти экстремумы (перегибы) функции из разряда a*sin(b*x) или также с cos(x)
кому не сложно помогите , пожалуйста

А математика не судьба? И ежу ясно, что косинусоида имеет экстремумы в точках 1 и -1, на координатах 0 и Pi, с периодом 2*Pi для каждого экстремума.
А уравнение синусоиды будет иметь тот же экстремум только смещенный на Pi/2 относительно косинусоиды.
В вашем случае экстремум синусоиды будет:
Значение = а;
Координаты =Pi/(2*b);
Перидочность = 2*pi/b;
И аналогично для минимума.

[p51x]

А математика не судьба?

Не судьба. Т.к. задача явно на программирование и численные методы в нем.

[type_Oleg]

Да, и надо уточнить - экстремум нужно или перегиб.
Если экстремум - это там, производная f'(x) меняет знак.
А если перегиб - это там, где вторая производная f''(x) меняет знак. Там где выпуклость меняется на вогнутость или наоборот.