Program Laba1;
Uses Crt,Graph,Dos;
Const
     A=-Pi/2;{Левая граница интервала}
     B=Pi/2;{Правая граница интервала}
     Eps=0.001;{Точность}
     Sigma=0.01;{Точность}
     Pos:Integer=80;
     N=10000;{Количество точек используемых при построении графика}
     How=6;{Количсетво засечек на координатных осях}
     StopIter=1000;{Максимальное количество итераций}

{Исследуемая функция}
Function F(X:Double):Double;
Begin
 F:=(15*X)*Sin(0.1*X);
End;

{Первая производная от исследуемой функции}
Function F1(X:Double):Double;
Begin
 F1:=15*sin(0.1*x)+1.5*x*cos(0.1*x);
End;

{Вторая производная от исследуемой функции}
Function F2(X:Double):Double;
Begin
 F2:=3*Cos(0.1*X)-0.15*X*Sin(0.1*X);
End;

Function Func1(X:Double):Double;
Begin
 Func1:=7.5*Pi*(2*X-1)*sin(0.05*Pi*(2*X-1));
End;

{Очистка нужных областей экрана}
Procedure Refresh;
Begin
 SetColor(0);
 SetViewPort(500,150,getmaxx-21,159,False);
 ClearViewPort;
 SetViewPort(401,161,getmaxx-21,200,False);
 ClearViewPort;
 SetViewPort(0,0,getmaxx,getmaxy,False);
 SetColor(0);
 SetViewPort(514,90,getmaxx-21,99,False);
 ClearViewPort;
 SetViewPort(514,105,getmaxx-21,114,False);
 ClearViewPort;
 SetViewPort(0,0,getmaxx,getmaxy,False);
 SetColor(15);
End;

{Инициализация графики}
Procedure Init;
Var Q,W,E:Integer;
    Path:String;
Begin
 Path:='';
 Q:=DETECT;
 InitGraph(Q,W,Path);
 E:=GraphResult;
 If (E<>grOk) Then
  Begin
   WriteLn('Ошибка инициализации графики:',GraphErrorMsg(E));
   ReadKey;
   Halt(1);
  End;
End;

{Построение системы координат и графика}
Procedure SystemOfCoordinate(XA,YA,XB,YB:Integer;Min,Max:Double);
Var XC,YC,I:Integer;
    XStep,YStep,Step,X1,X2:Double;
    S:String;
Begin
 Rectangle(XA,YA,XB,YB);
 {Определение масштаба и положения оси}
 XStep:=(XB-XA-120)/(B-A);
 If (A>0) Then
  XC:=XA+40
 Else
  XC:=Trunc(XA+40+Abs(A)*XStep);
 {Построение оси Y}
 Line(XC,YA+20,XC,YB-20);
 Line(XC-3,YA+30,XC,YA+20);
 Line(XC+3,YA+30,XC,YA+20);
 OutTextXY(XC-15,YA+20,'y');
 {Определение масштаба и положения оси}
 YStep:=(YB-YA-100)/(Max-Min);
 YC:=Trunc(YA+60+Max*YStep);
 {Построение оси X}
 Line(XA+20,YC,XB-20,YC);
 Line(XB-30,YC-3,XB-20,YC);
 Line(XB-30,YC+3,XB-20,YC);
 OutTextXY(XB-25,YC+7,'x');
 {Образование засечек на осях}
  {Засечки на оси OX}
 Step:=(B-A)/How;
 For I:=0 To How Do
  Begin
   Line(XC+Trunc((A+I*Step)*XStep),YC-5,XC+Trunc((A+I*Step)*XStep),YC+5);
   Str((A+I*Step):4:2,S);
   OutTextXY(XC-10+Trunc((A+I*Step)*XStep),YC+10,S);
  End;
  {Засечки на оси OY}
 Step:=(Round(Max)-Min)/How;
 For I:=0 To How Do
  Begin
   Line(XC-5,YC-Trunc((Min+I*Step)*YStep),XC+5,YC-Trunc((Min+I*Step)*YStep));
   Str((Min+I*Step):4:2,S);
   OutTextXY(XC+10,YC-5-Trunc((Min+I*Step)*YStep),S);
  End;
 {Построение графика}
 SetColor(3);
 Step:=(B-A)/N;
 For I:=0 To (N-1) Do
  Begin
   X1:=A+Step*I;
   X2:=A+Step*(I+1);
   Line(XC+Trunc(XStep*X1),YC-Trunc(YStep*F(X1)),
        XC+Trunc(XStep*X2),YC-Trunc(YStep*F(X2)));
  End;
End;

{Информация на экране}
Procedure Information;
Var S:String;
Begin
 Rectangle(0,0,getmaxx,getmaxy);
 OutTextXY(getmaxx div 5,20,'О Д Н О М Е Р Н А Я       О П Т И М И З А Ц И Я');
 Rectangle(10,40,350,210);
 Line(10,70,350,70);
 OutTextXY(20,50,'Перечень методов:');
 OutTextXY(20,90,'Метод дихотомии');
 OutTextXY(20,110,'Метод "золотого сечения"');
 OutTextXY(20,130,'Метод квадратичной апроксимации Пауэлла');
 OutTextXY(20,150,'Метод Ньютона-Рафсона');
 OutTextXY(20,170,'Метод Больцано');
 OutTextXY(20,190,'Метод секущих');
 Rectangle(400,40,getmaxx-20,115);
 OutTextXY(470,45,'Информация');
 Line(400,55,getmaxx-20,55);
 OutTextXY(405,60,'Eps=');
 Line(400,70,getmaxx-20,70);
 OutTextXY(405,75,'Sigma=');
 Line(400,85,getmaxx-20,85);
 OutTextXY(405,90,'Время старта:');
 Line(400,100,getmaxx-20,100);
 OutTextXY(405,105,'Время финиша:');
 Line(510,55,510,115);
 Rectangle(400,130,getmaxx-20,210);
 OutTextXY(430,135,'Информация о корне');
 Line(400,145,getmaxx-20,145);
 OutTextXY(410,150,'Метод - ');
 Line(400,160,getmaxx-20,160);
 Rectangle(15,Pos,340,Pos+20);
 S:='';
 Str(Eps:8:5,S);
 OutTextXY(510,60,S);
 S:='';
 Str(Sigma:8:5,S);
 OutTextXY(510,75,S);
End;

{Получение времени и перевод его в строковой формат}
Function Time:String;
Var Hours,Minutes,Seconds,Sec100:Word;
    S,S1:String;
Begin
  GetTime(Hours,Minutes,Seconds,Sec100);
  Str(Hours:2,S);
  S:=S+':';
  Str(Minutes:2,S1);
  S:=S+S1+':';
  Str(Seconds,S1);
  S:=S+S1+':';
  Str(Sec100,S1);
  S:=S+S1;
  Time:=S;
End;

{Формирование строкового вида интервала через математические обозначения}
Function Interval(K,K1:Double):String;
Var S,S1:String;
Begin
 S:='[';
 Str(K:8:6,S1);
 S:=S+S1+';';
 Str(K1:8:6,S1);
 S:=S+S1+']';
 Interval:=S;
End;

{Метод дихотомии}
Procedure Metod1;
Var C,D,Xm,X1,X2,F1,F2,Fm:Double;
Begin
 SetColor(15);
 OutTextXY(500,150,'Дихотомии');
 SetColor(2);
 OutTextXY(515,90,Time);
 C:=A;
 D:=B;
 While (Abs(D-C)>Eps) Do
  Begin
   Xm:=(C+D)/2;
   Fm:=F(Xm);
   X1:=Xm-Abs(D-C)/4;
   X2:=Xm+Abs(D-C)/4;
   F1:=F(X1);
   F2:=F(X2);
   If (F1<Fm) Then
    D:=Xm
   Else
    If (F2<Fm) Then
     C:=Xm
    Else
     Begin
      C:=X1;
      D:=X2;
     End;
  End;
 SetColor(15);
 OutTextXY(410,165,'Точка оптимума находиться');
 OutTextXY(450,175,'на интервале:');
 OutTextXY(420,190,Interval(C,D));
 SetColor(4);
 OutTextXY(515,105,Time);
End;

{Метод "золотого сечения"}
Procedure Metod2;
Const t=0.618;
Var W1,W2,t1,XL,XR,F1,F2:Double;
    i:Integer;
Begin
 SetColor(15);
 OutTextXY(500,150,'"з. с."');
 SetColor(2);
 OutTextXY(515,90,Time);
 SetColor(15);
 XL:=0;
 XR:=1;
 W2:=0.618;
 W1:=0.382;
 If (Func1(W1)>Func1(W2)) Then
  Begin
   XL:=W1;
   I:=1;
  End
 Else
  Begin
   XR:=W2;
   I:=0;
  End;
 T1:=t;
 While (Abs(W2-W1)>Eps) do
  Begin
   T1:=T1*t;
   If (i=1) Then
    Begin
     W1:=W2;
     W2:=XL+T1;
     If Func1(W1)<Func1(W2) Then
      Begin
       XR:=W2;
       I:=0;
      End
     Else
      XL:=W1
    End
   Else
    Begin
     W2:=W1;
     W1:=XR-T1;
     If (Func1(W1)>Func1(W2)) Then
      Begin
       XL:=W1;
       I:=1;
      End
     Else
      XR:=W2;
    End
 End;
 OutTextXY(410,165,'Точка оптимума находиться');
 OutTextXY(450,175,'на интервале:');
 OutTextXY(420,190,Interval(XL*(B-A)+A,XR*(B-A)+A));
 SetColor(4);
 OutTextXY(515,105,Time);
End;

{Определение соседних точек для метода Пауэлла}
Procedure MiniMax(Var X1,X2,X3,X,Delta:Double);
Type Mas=Array [1..3] Of Double;
Var Mas1,Mas2:Mas;
    Len1,Len2,I,J:Integer;
Begin
 Len1:=3;
 Len2:=3;
 Mas1[1]:=X1;
 Mas1[2]:=X2;
 Mas1[3]:=X3;
 Mas2:=Mas1;
 {Выборка элементов меньших X}
 For I:=1 To Len1 Do
   If (Mas1[I]>=X) Then
    Begin
     For J:=Len1-1 Downto I Do
      Mas1[J]:=Mas1[J+1];
     Dec(Len1);
    End;
 {Нахождение максимального среди выбранных элементов}
 X1:=Mas1[1];
 For I:=1 To Len1 Do
  If ((Mas1[I]>X1) And (Mas1[I]<>X)) Then
   X1:=Mas1[I];
 If X1>X Then
  X1:=X-Delta;
 {Выборка элементов больших X}
 For I:=1 To Len2 Do
   If (Mas2[I]<=X) Then
    Begin
     For J:=Len2-1 Downto I Do
      Mas2[J]:=Mas2[J+1];
     Dec(Len2);
    End;
 {Нахождение минимального среди выбранных элементов}
 X3:=Mas2[1];
 For I:=1 To Len2 Do
  If ((Mas2[I]>X3) And (Mas2[I]<>X) And (Mas2[I]<>X1)) Then
   X3:=Mas2[I];
 If X3<X Then
  X3:=X+Delta;
 X2:=X;
End;

{Метод квадратичной апроксимации Пауэлла}
Procedure Metod3;
Var X,X1,X2,X3,Delta,F1,F2,F3,FMin,XMin,A1,A2,DeltaX,DeltaF:Double;
    S:String;
Begin
 SetColor(15);
 OutTextXY(500,150,'Пауэлла');
 SetColor(2);
 OutTextXY(515,90,Time);
 SetColor(4);
 OutTextXY(515,105,Time);
 SetColor(15);
 X1:=A;
 Delta:=0.1;
 X2:=X1+Delta;
 F1:=F(X1);
 F2:=F(X2);
 If (F1>F2) Then
  X3:=X1+2*Delta
 Else
  X3:=X1-Delta;
 Repeat
  F1:=F(X1);
  F2:=F(X2);
  F3:=F(X3);
  XMin:=X1;
  FMin:=F1;
  If (F2<FMin) Then
   Begin
    FMin:=F2;
    XMin:=X2;
   End;
  If (F3<FMin) Then
   Begin
    FMin:=F3;
    XMin:=X3;
   End;
  A1:=(F2-F1)/(X2-X1);
  A2:=(((F3-F1)/(X3-X1))-((F2-F1)/(X2-X1)))/(X3-X2);
  X:=((X2+X1)/2)-(A1/(2*A2));
  DeltaF:=Abs((FMin-F(X))/F(X));
  DeltaX:=Abs((XMin-X)/X);
  MiniMax(X1,X2,X3,X,Delta);
 Until ((DeltaF<Eps) And (DeltaX<Sigma));
 OutTextXY(410,165,'Точка оптимума');
 Str(X:8:6,S);
 OutTextXY(450,180,S);
End;

{Метод Ньютона-Рафсона}
Procedure Metod4;
Var X1,X2,Y:Double;
    Iter:Integer;
    S:String;
Begin
 SetColor(15);
 OutTextXY(500,150,'Ньютона-Рафсона');
 Iter:=0;
 SetColor(2);
 OutTextXY(515,90,Time);
 X1:=A;
 Repeat
  Inc(Iter);
  X2:=X1-(F1(X1)/F2(X1));
  Y:=F1(X2);
  X1:=X2;
 Until ((Abs(Y)<Eps) Or (Iter>StopIter));
 If Abs(Y)<Eps Then
  Begin
   SetColor(15);
   OutTextXY(410,165,'Точка оптимума');
   Str(X2:8:6,S);
   OutTextXY(450,180,S);
  End
 Else
  Begin
   SetColor(4);
   OutTextXY(410,165,'Метод расходиться');
  End;
  SetColor(4);
  OutTextXY(515,105,Time);
End;

{Метод Больцано}
Procedure Metod5;
Var L,R,Z,Y:Double;
    S:String;
Begin
 SetColor(15);
 OutTextXY(500,150,'Больцано');
 SetColor(2);
 OutTextXY(515,90,Time);
 L:=A;
 R:=B;
 Repeat
  Z:=(L+R)/2;
  Y:=F1(Z);
  If (Y>0) Then
   R:=Z
  Else
   L:=Z;
 Until (Abs(Y)<Eps);
 SetColor(15);
 OutTextXY(410,165,'Точка оптимума');
 Str(Z:8:6,S);
 OutTextXY(450,180,S);
 SetColor(4);
 OutTextXY(515,105,Time);
End;

{Метод секущих}
Procedure Metod6;
Var L,R,Z,Y:Double;
    S:String;
Begin
 SetColor(15);
 OutTextXY(500,150,'секущих');
 SetColor(2);
 OutTextXY(515,90,Time);
 L:=A;
 R:=B;
 Repeat
  Z:=R-((F1(R)*(R-L))/(F1(R)-F1(L)));
  Y:=F1(Z);
  If (Y>0) Then
   Begin
    If F1(R)<0 Then
       L:=Z;
    If F1(R)>0 Then
       R:=Z;
   End;
  If (Y<0) Then
   Begin
    If F1(R)<0 Then
     R:=Z;
    If F1(R)>0 Then
     L:=Z;
   End;
   Until (Abs(Y)<Eps);
  SetColor(15);
  OutTextXY(410,165,'Точка оптимума');
  Str(Z:8:6,S);
  OutTextXY(450,180,S);
  SetColor(4);
  OutTextXY(515,105,Time);
End;

{Процедура вызывающая собственно методы решения трансцедентных уравнений
 и выводящая вспомогательную информацию}
Procedure Raschet;
Begin
 Refresh;
 Case Pos Of
  80:Metod1;
  100:Metod2;
  120:Metod3;
  140:Metod4;
  160:Metod5;
  180:Metod6;
 End;
End;

{Анализ нажатых клавиш}
Procedure Analiz;
Var C:Char;
    Pos1:Integer;
Begin
 Repeat
  Pos1:=Pos;
  C:=ReadKey;
  If C=#0 Then
   Begin
    C:=ReadKey;
    If Ord(C)=72 Then
     If Pos>80 Then
      Pos:=Pos-20
     Else
      Pos:=180;
    If Ord(C)=80 Then
     If Pos<180 Then
      Pos:=Pos+20
     Else
      Pos:=80;
    SetColor(0);
    Rectangle(15,Pos1,340,Pos1+20);
    SetColor(15);
    Rectangle(15,Pos,340,Pos+20);
   End;
  If C=#13 Then
   Raschet;
 Until C=#27;
End;

{Определение максимального и минимального значения функции на интервале}
Procedure GetMinMax(Var Min:Double;Var Max:Double);
Var Step:Double;
    I:Integer;
Begin
    Step:=(B-A)/N;
    Min:=F(A);
    Max:=F(A);
    For I:=1 To N Do
     Begin
      If (F(A+I*Step)<Min) Then
       Min:=F(A+I*Step);
      If (F(A+I*Step)>Max) Then
       Max:=F(A+I*Step);
     End;
End;

{Главная процедура программы}
Procedure Main;
Var Min,Max:Double;
Begin
 ClrScr;
 Init;
 Information;
 GetMinMax(Min,Max);
 SystemOfCoordinate(20,220,getmaxx-20,getmaxy-20,Min,Max);
 Analiz;
 CloseGraph;
End;

Begin
 Main;
End.