Скачиваний:
5
Добавлен:
01.05.2014
Размер:
3 Кб
Скачать
   uses tpcrt;                                         {®Ўп§ -}
 const nword=30;                                       {⥫м- }
 type                                                  {­ п   }
    word=string[nword];                                {бЁб-  }
    tips=(integ,rel,wrd);                              {⥬-  }
    domen=record case kind:tips of integ:(di:integer); {­ п   }
      rel:(dr:real); wrd:(dw:word);end;                {з бвм }

 {ЂЋ‘ ¬Ґв®¤г ”ЁЎ®­ ззЁ}
 const
  a0=1; b0=10;
 function f(x:real):real;
  begin f:=sqr(x-2.5); end;
 var
  a,b,x1,x2,eps:real;
  step,N   :integer;
procedure eval_proc(number:integer; par:domen; var val:word);
 procedure initial(var a,b:real);  {­ з «м­ п гбв ­®ўЄ }
 begin
  val:='Їа®ўҐ¤Ґ­ ';
  a:=a0; b:=b0; eps:=0.1;
  framewindow(43, 3, 77, 14, 47, 60,'­ з. гбв ­®ўЄ ');
  window(44, 4, 76, 13);
  gotoxy(5, 1);  writeln('ЂЋ‘ ¬Ґв®¤г ‡®«®в®Ј® ‘ҐзҐ­Ёп');
  gotoxy(10, 3);writeln('f:=sqr(x-2.5)');
  gotoxy(10, 5);writeln('a0 < x < b0');
  gotoxy(5, 7);writeln(' a0=',a0,'        b0=',b0);
  repeat
   gotoxy(10, 9);write('eps :'); read(eps)
  until (eps<=1) and (eps>=0);
 window(3, 3, 77, 14);
 end;
 procedure aa1(var x1,x2:real);  {¬Ґв®¤ ‡®«®в®Ј® ‘ҐзҐ­Ёп}
 begin
    val:='Їа®ўҐ¤Ґ­ ';
    x1:=((3-sqrt(5))/2)*(b-a)+a;
    x2:=b-((3-sqrt(5))/2)*(b-a);
 end;
 procedure a2;  {Ё­д®а¬ жЁп}
 begin   val:='ўлўҐ¤Ґ­ ';    { clrscr; }
   writeln('a=',a:6:3,' f(a)=',f(a):6:3);
   writeln('x1=',x1:6:3,' f(x1)=',f(x1):6:4);
   writeln('x2=',x2:6:3,' f(x2)=',f(x2):6:4);
   writeln('b=',b:6:3,' f(b)=',f(b):6:3);
 end;
 procedure a3(a1:real; var a:real); {Ја ­Ёж _a}
 begin
    if f(x2)<f(x1) then a:=x1;
    if abs(a-a1)<=eps then val:='¤ '
    else val:='­Ґв';
 end;
 procedure a4(b1:real; var b:real);  {Ја ­Ёж _b}
 begin
    if f(x2)>=f(x1) then b:=x2;
    if abs(b-b1)<=eps then val:='¤ '
    else val:='­Ґв';
 end;
 procedure a5(a,b:real;ans:word);  {Є®­Ґж}
 var val1:word;
 begin
  if abs(a-b)<=eps+eps/100 then val1:='¤ ' else val1:='­Ґв';
  if val1=ans then val:='¤ ' else val:='­Ґв';
 end;
 procedure a6; {१г«мв вл}
 begin clrscr;
  writeln('  ђ … ‡ “ ‹ њ ’ Ђ ’ ›');
  writeln('x1=',x1:6:4,' f(x1)=',f(x1):6:4);
  writeln('x2=',x2:6:4,' f(x2)=',f(x2):6:4);
 end;
 begin (*eval_proc*)             {®Ўп§ вҐ«м­ п}
  val:='¤ ';                     {бЁб⥬-     }
  window(3, 3, 77, 14);          {­ п         }
  case number of                 {з бвм       }
   3 : initial(a,b);   {­ з «м­ п гбв ­®ўЄ }
   4 : aa1(x1,x2);     {¬Ґв®¤ ‡®«®в®Ј® ‘ҐзҐ­Ёп}
   5 : a2;             {Ё­д®а¬ жЁп         }
   6 : a3(par.dr,a);   {Ја ­Ёж _a          }
   7 : a4(par.dr,b);   {Ја ­Ёж _b          }
   8 : a5(a,b,par.dw); {Є®­Ґж              }
   9 : a6;             {१г«мв вл         }
  end;                           {®Ўп§ вҐ«м-}
  window(3, 17, 77, 24); clrscr; {­ п       }
 end(*eval_proc*);               {бЁб⥬-   }
 (*$i aoc.pas*)                  {­ п       }
begin aoc; delay(5000);  end.    {з бвм     }
Соседние файлы в папке LAB_GOLD