{############################################################################}
{#                          Курсовая работа                                 #}
{#                      студента группа В-315                               #}
{#                              МПТ                                         #}
{#                          Руденко Алексея                                 #}
{#          Вычисление интеграла по методу Симпсона и Гаусса                #}
{#                           Николаев 2007                                  #}
{############################################################################}
program integral;
uses crt,math;
const         a1=-0.5;  b1=2.0;  {Границы интегрирования}
              a2=-0.8;  b2=0.9;
              a3=0.0;   b3=2.5;
              a4=0.5;   b4=4.0;

              s1 = 'x^2/(1+x)^3';  {Подинтегральные функции}
              s2 = '2*x/(1-x^4)';
              s3 = '(1+2*x)/(2+';
              s31 = 'x)/sqrt(2+x)';
              s4 = 'x^2*ln(x)  ';

              gsc = 7;    { шаг при вычислениях по методу Гаусса}
              {Правила ввода формул}
              rules:array[1..15] of string = ('  Вы можете использовать следующие операции:',
              '  ^ - возведение в степень, * , / , + , - ',
              '  Операцию отрицания всегда помещайте в скобки: (-х)',
              '  Вы можете использовать функции:',
              '  sin(x) - синус Х',
              '  cos(x) - косинус Х',
              '  tg(x) - тангенс Х',
              '  ctg(x) - котангенс Х',
              '  arctan(x) - арктангенс Х',
              '  ln(x) - логарифм натуральный от Х',
              '  log(x) - логарифм десятичный от Х',
              '  exp(x) - экспонет e^X  ',
              '  В данной программе функции могут иметь аргументом только Х,',
              '  то есть прочие буквы a..z рассматриваются как константы.',
              '  Буквы A..Z латинского алфавита и буквы русского алфавита нельзя использовать.');


var n,                                 {хранит номер выбранного пункта меню  }
    i,                                 {испльзуется для счета в циклах}
    pointer:integer;                   {указатель на последний элемент стека}
    automatic:boolean;                 {хранит результат выбора автоматических вычислений}
    count,                             {хранит временное кол-во обращений к подинтегральной функции}
    counts,                            {хранит кол-во обращений к подинтегральной функции для метода Симпсона}
    countg,                            {хранит кол-во обращений к подинтегральной функции для метода Гаусса}
    nsmp:array[1..6] of integer;       {хранит  }
    gss,                               {значение по гауссу}
    smp,                               {значение по симпсону}
    tint,
    toch:array[1..6] of real;          {хранит точность}
    a6,                                {хранит границы интегрирования}
    b6:real;                           {произвольной функции}
    postfix,                           {формула в обратной польской записи}
    postfixp,
    formula,                           {формула}
    formulap,
    s6,                                {формула}
    ns:string;                         {строка для считывания пункта меню}
    stack:array[1..100] of string[8];  {стек}

{совершает выход из программы}
procedure restart;
begin
     writeln('Программа будет закрыта ...');
     readln;
     halt;
end;
{Обрабатывает ошибки}
procedure error( n : integer );
begin
case n of
     1 : writeln('Ошибка возведения в степень. проверьте аргументы');
     2 : writeln('Ctg(x) при х = 0  не существует');
     3 : writeln('При вычислении ln(x) х должен быть положительным');
     4 : writeln('При вычислении log(x) х должен быть положительным');
     5 : writeln('Недопустимые символы в формулу');
end;
restart;
end;

{Возведение числа в степень}
function stepen( X : real; N : real):real;
var s:real;
    i:integer;
begin
     if N<>0 then begin
        if x>0 then
           s:=exp(n*ln(x))
        else
        if x=0 then
           s:=0
        else
        if x<0 then
           begin
                if N<1 then
                error(1)
                else
                if n-trunc(n)<>0 then
                error(1) else
                begin
                s:=exp(n*ln(abs(x)));
                if odd(trunc(n)) then s:=(-1)*s;
                end;
           end;
     end else
     if N=0 then begin
     s:=1;
     end;

stepen:=s;
end;

{вычисляет десятичный логарифм}
function Lg( X : real ) : real;
begin
Lg :=  1/Ln(10)*Ln(X);
end;

{очищает стек}
procedure init;
var i:integer;
begin
for i:=1 to 100 do
    stack[i]:='';
pointer:=-1;
end;

{заносит строку в стек}
procedure to_stack(st:string);

{передвигает все элементы стека на один}
procedure to_(Ai:string; I:integer);
var t:string;
begin
if i<>pointer then
begin
   t:=stack[i+1];
   stack[i+1]:=ai;
   inc(i);
   to_(t,i);
end;
end;

begin
if pointer = -1                 {если стек пуст, то}
then begin
     stack[1]:=st;              {ставим строку на вершину стека}
     pointer:=2;                {указателю присваиваем 2, что значит - в стеке 1 элемент}
     end
else begin                      {если не пуст, то}
     to_(stack[1],1);           {передвигаем элементы}
     stack[1]:=st;              {на вершину ставим строку}
     inc(pointer);              {увеличиваем значение указателя}
     end;
end;

{достает строку из стека}
function from_stack:string;
var i:integer;
    st:string;
begin
if (pointer=-1) or (pointer=1) then     {Если стек пуст}
   st:='error'                          {возвращаем ошибку}
   else begin                           {если не пуст}
        st:=stack[1];                   {возврщаем строку на вершине стека}
        for i:=1 to pointer-1 do        {передвигаем элементы на один влево}
            stack[i]:=stack[i+1];
        dec(pointer);                   {уменьшаем значение указателя}
        end;
from_stack:=st;
end;

{Заменяет функции в формуле на большие буквы}
procedure fn_to_ch(var formula:string);
var k,i:integer;
begin
     k:=pos('sin',formula);
     if (k<>0) and (formula[k-1] <>'c') then begin delete(formula, k, 3); insert('A',formula,k); end;

     k:=pos('cos',formula);
     if (k<>0) and (formula[k-1] <>'c') then begin delete(formula, k, 3); insert('B',formula,k); end;

     k:=pos('tg',formula);
     if (k<>0) and (formula[k-1] <>'c') then begin delete(formula, k, 2); insert('C',formula,k); end;

     k:=pos('ctg',formula);
     if k<>0 then begin delete(formula, k, 3); insert('D',formula,k); end;

     k:=pos('arctan',formula);
     if k<>0 then begin delete(formula, k, 6); insert('E',formula,k); end;

     k:=pos('ln',formula);
     if k<>0 then begin delete(formula, k, 2); insert('F',formula,k); end;

     k:=pos('log',formula);
     if k<>0 then begin delete(formula, k, 3); insert('G',formula,k); end;

     k:=pos('exp',formula);
     if k<>0 then begin delete(formula, k, 3); insert('H',formula,k); end;


end;

{переводит формулу в польскую запись}
procedure poland(formula:string; var postfix:string);
type
  Digits = set of char;
  Letters = set of 'A'..'H';
  SmLetter = set of 'a'..'z';
const
  Even: Digits = ['0'..'9','.'];
  Large: Letters = ['A'..'J'];
  Small: SmLetter = ['a'..'z'];
  signs: digits = ['*','/','+','-','^'];
var i,
    k:integer;
    stroka,
    st:string;
    ch:char;

{определяет приоритет операций}
function prior(stroka:string):integer;
begin
if stroka='(' then prior:=254 else
if stroka='^' then prior:=1 else
if (stroka='*') or (stroka='/') then prior:=2 else
if (stroka='+') or (stroka='-') then prior:=3 else
prior:=255;
end;

begin
postfix:='';
i:=1;
while i<=length(formula) do begin               {пока i <= длины строки формулы}
    stroka:='';
    if formula[i] in Even then                  {если символ принадлежит к числам}
                  begin
                  k:=1;
                  while formula[i+k] in Even do {то считываем число полностью}
                        inc(k);
                  stroka:=copy(formula,i,k);
                  i:=i+k-1;
                  postfix:=postfix+stroka+' ';  {и помещаем его в выходящую строку}
                  end else
    if formula[i] in Large then                 {если символ принадлежит к большим буквам(функция)}
                  begin
                  stroka:=formula[i];           {то просто помещаем символ в выходящую строку}
                  to_stack(stroka);
                  end else
    if formula[i] in small then                 {если символ принадлежит к маленьким буквам(константам)}
                  begin
                  ch:=formula[i];               {то помещаем его в выходящую строку}
                  stroka:=ch;
                  postfix:=postfix+stroka+' ';
                  end else
    if formula[i] in signs then                 {если символ принадлежит к знакам операций}
                  begin
                  if ((formula[i+1] in small) or (formula[i+1] in large) or {если знак(-) имеет возле себя только }
                  (formula[i+1] in even)) and (formula[i-1] ='(') then      {один цифровой символ, то (операция унарная)}
                  postfix:=postfix+'0'+' ';                                 {помещаем в выходящую строку 0}
                  stroka:=formula[i];
                  st:=from_stack;                                           {считываем вершину стека}
                  if st<>'error' then                                       {если стек не пуст}
                  begin
                       to_stack(st);                                        {то помещаем строку назад в стек}
                       while prior(stroka)>=prior(stack[1]) do              {и пока приоритет текущей операции больше }
                             postfix:=postfix+from_stack+' ';               {или равен приортету операции на вершине стека
                                                                            выводим в выходящую строку вершину стека}
                  end;
                  to_stack(stroka);                                         {помещаем в стек текущий знак}
                  end else
    if formula[i]='(' then             {если символ  - (}
                   begin
                   stroka:=formula[i];
                   to_stack(stroka);   {помещаем его в стек}
                   end else
    if formula[i]=')' then
                   begin
                        repeat                                          {пока строка не ( или ошибка}
                             stroka:=from_stack;
                             if (stroka='(')  or (stroka='error') then
                             break;
                             postfix:=postfix+stroka+' ';                {выводим в выходящую строку вершину стека}
                        until (stroka<>'(') or (stroka<>'error');
                        if (stack[1][1] in large) then
                        postfix:=postfix+from_stack+' ';

                   end;
                   inc(i);

 end;
    while stroka<>'error' do
    begin
         stroka:=from_stack;                         {извлекаем все из стека в выходящую строку}
         if stroka='error' then break;
         postfix:=postfix+stroka+' ';
    end;

end;

{вычисляет формулу записанную в постфиксной формуле}
function find(x:real;  postfix:string):real;
var st,
    temp,
    temp1:string;
    k,
    i,
    code,
    digit:integer;
    rl,
    rl1,
    rl2:real;
type
  Digits = set of char;
  Letters = set of 'A'..'H';
  SmLetter = set of 'a'..'z';
const
  Even: Digits = ['0'..'9','.'];
  Large: Letters = ['A'..'J'];
  Small: SmLetter = ['a'..'z'];
  signs: digits = ['*','/','+','-','^'];
begin
  i:=1;
  while postfix<>'' do
    begin
       k:=pos(' ',postfix);
       st:=copy(postfix,1,k-1);
       delete(postfix,1,k);
       if st[1] in even then                            {если строка числовая}
          begin
          to_stack(st);                                 {то помещаем в стек}
          end              else
                          if st[1] in small then        {если строка - констнта}
                              begin
                              if st<>'x' then           {и не равна х}
                              begin
                                   writeln('введите значение ', st);
                                   repeat
                                         readln(temp);                {вводим значение константы}
                                         val(temp,digit,code);
                                   until  code=0;
                              end else
                              begin
                                   str(x:8:4,st);
                              end;
                              to_stack(st);                           {заносим строку-значение-константы в стек}
                              end else
                              if st[1] in large then      {если строка - большая буква}
                              case st[1] of               {то вычисляем соответственную функцию и заносим результат в стек}
                              'A': begin
                              temp:=from_stack;
                              val(temp,rl,code);
                              rl:=sin(rl); str(rl:8:8,temp); to_stack(temp);  end;
                              'B': begin
                              temp:=from_stack;
                              val(temp,rl,code);
                              rl:=cos(rl); str(rl:8:8,temp); to_stack(temp);  end;
                              'C': begin
                              temp:=from_stack;
                              val(temp,rl,code);
                              rl:=sin(rl)/cos(rl); str(rl:8:8,temp); to_stack(temp);  end;
                              'D': begin
                              temp:=from_stack;
                              val(temp,rl,code);
                              if rl=0 then error(2); rl:=cos(rl)/sin(rl); str(rl:8:8,temp); to_stack(temp);  end;
                              'E': begin
                              temp:=from_stack;
                              val(temp,rl,code);
                              rl:=arctan(rl); str(rl:8:8,temp); to_stack(temp);  end;
                              'F': begin
                              temp:=from_stack;
                              val(temp,rl,code);
                              if rl<=0 then error(3); rl:=ln(rl); str(rl:8:8,temp); to_stack(temp);  end;
                              'G': begin
                              temp:=from_stack;
                              val(temp,rl,code);
                              if rl<=0 then error(4); rl:=lg(rl); str(rl:8:8,temp); to_stack(temp);  end;
                              'H': begin
                              temp:=from_stack;
                              val(temp,rl,code);
                              rl:=exp(rl); str(rl:8:8,temp); to_stack(temp);  end;
                              end else
                              if st[1] in signs then                    {если строка знак операции}
                                       begin
                                       case st[1] of
                                       '*':begin temp:=from_stack;      {то, если строка знак *
                                                                        извлекаем два значения из стека и выполняем умножение
                                                                        - затем помещаем результат в стек}
                                                 temp1:=from_stack;
                                                 val(temp,rl,code);
                                                 val(temp1,rl1,code);
                                                 rl2:=rl*rl1;
                                                 str(rl2:8:8,temp);
                                                 to_stack(temp);
                                           end;
                                       '/':begin temp1:=from_stack;     {то, если строка знак /
                                                                        извлекаем два значения из стека и выполняем деление
                                                                        второго на первое значение(в порядке извлечения)
                                                                        - затем помещаем результат в стек}
                                                 temp:=from_stack;
                                                 val(temp,rl,code);
                                                 val(temp1,rl1,code);
                                                 rl2:=rl/rl1;
                                                 str(rl2:8:8,temp);
                                                 to_stack(temp);
                                           end;
                                       '+':begin temp:=from_stack;      {то, если строка знак +
                                                                        извлекаем два значения из стека и выполняем сложение
                                                                        - затем помещаем результат в стек}
                                                 temp1:=from_stack;
                                                 val(temp,rl,code);
                                                 val(temp1,rl1,code);
                                                 rl2:=rl+rl1;
                                                 str(rl2:8:8,temp);
                                                 to_stack(temp);
                                           end;
                                       '-':begin temp1:=from_stack;     {то, если строка знак -
                                                                        извлекаем два значения из стека и выполняем вычитание
                                                                        первого из второго значение(в порядке извлечения)
                                                                        - затем помещаем результат в стек}
                                                 temp:=from_stack;
                                                 val(temp,rl,code);
                                                 val(temp1,rl1,code);
                                                 rl2:=rl-rl1;
                                                 str(rl2:8:8,temp);
                                                 to_stack(temp);
                                           end;
                                       '^':begin temp:=from_stack;      {то, если строка знак ^
                                       извлекаем два значения из стека и выполняем возведение
                                       первого значения в степень второго значение(в порядке извлечения)
                                       - затем помещаем результат в стек}
                                                 temp1:=from_stack;
                                                 val(temp,rl,code);
                                                 val(temp1,rl1,code);
                                                 rl2:=stepen(rl1,rl);
                                                 str(rl2:8:8,temp);
                                                 to_stack(temp);
                                           end;
                                       end;
                                       end;

       inc(i);
  end;
 val(from_stack,rl,code);   {извлекаем значение из стека и переводим его в строку}
 find:=rl;                  {это и есть результат вычисления}
end;

{вычислет подинтегральную функцию заданую в программе}
function f(x:real; choice:integer):real;
begin
     count[choice]:=count[choice]+1;
     case choice of
     1:f:=(x*x)/((1+x)*(1+x)*(1+x));
     2:f:=(2*x)/(1-x*x*x*x);
     3:f:=(1+2*x)/(2+x)/sqrt(2+x);
     4:f:=x*x*ln(x);
     6:f:=find(x,postfix);
     end;
end;

{вычисляет первообразную }
function f1(choice:integer):real;
begin
     case choice of
     1:f1:=(4*b1+3)/(2*(1+b1)*(1+b1)) + ln(1+b1) - (4*a1+3)/(2*(1+a1)*(1+a1)) - ln(1+a1);

     2:f1:=0.5*ln((1+b2*b2)/(1-b2*b2)) - 0.5*ln((1+a2*a2)/(1-a2*a2));

     3:f1:=(14+4*b3)/sqrt(2+b3) - (14+4*a3)/sqrt(2+a3);

     4:f1:=(b4*b4*b4*((ln(b4)/3) - (1/9))) - (a4*a4*a4*((ln(a4)/3) - (1/9)));
     6:f1:=find(b6,postfixp)  - find(a6,postfixp);
     end;
end;

{выводит меню}
function menu:integer;
var n,code:integer; ns:string;
begin
     code:=0;
     repeat
     clrscr;
     writeln('                            Курсовая работа');
     writeln('                         cтудента группы В-315');
     writeln('                                  НПТ');
     writeln('                            Руденко Алексея');
     writeln;
     writeln;
     writeln('                             ЗАДАНИЕ ');
     writeln('          Составить программу, которая вычисляет интеграл от функций');
     writeln('             1) ',s1,';');
     writeln('             2) ',s2,';');
     writeln('             3) ',s3,s31,';');
     writeln('             4) ',s4,';');
     writeln('          методами Симпсона и Гаусса и сравнить эффективность этих методов');
     writeln;
     writeln;
     writeln('          Выберите нужный пункт:');
     writeln('          1. Вычисление интеграла от функции y = ',s1);
     writeln('          2. Вычисление интеграла от функции y = ',s2);
     writeln('          3. Вычисление интеграла от функции y = ',s3,s31);
     writeln('          4. Вычисление интеграла от функции y = ',s4);
     writeln('          5. Автоматическое вычисление всех интегралов');
     writeln('          6. Вычисление интеграла от своей функции');
     writeln('          9. Выход из программы');
     if code<>0 then
     begin
           writeln;
           writeln('            Ошибка! Введено неверное значение.');
           writeln;
     end;
     write('            Введите номер пункта ');
     write('  ');
     readln(ns);
     val(ns,n,code);
     until ((n=1) or (n=9) or(n=2) or (n=3) or (n=4) or (n=5) or (n=6)) and (code=0);
     menu:=n;
end;

{считает по формуле Симпсона до тех пор пока |f(n)-f(2n)|>=e}
procedure simpson(choice:integer);
var n,i,code:integer; integ,integraln,e:real;
es:string;

function msimpson(n:integer; choice:integer):real;
var a,b,h,x,y1,y2,temp:real; i:integer;
begin
     case choice of
     1:begin a:=a1; b:=b1; end;
     2:begin a:=a2; b:=b2; end;
     3:begin a:=a3; b:=b3; end;
     4:begin a:=a4; b:=b4; end;
     6:begin a:=a6; b:=b6; end;
     end;
     h:=(b-a)/n;
     x:=a+h;
     y1:=0;

     while x<=b-h do
     begin
     temp:=f(x,choice);
     y1:=y1+temp;
     x:=x+2*h;
     end;

     x:=a+2*h;
     y2:=0;

     while x<=b-2*h do
     begin
     temp:=f(x,choice);
     y2:=y2+temp;
     x:=x+2*h;
     end;

     msimpson:=((b-a)/(3*n))*(f(a,choice) + f(b,choice) + 4*y1 + 2*y2);
end;

begin
     writeln;
     clrscr;
     case choice of
     1:writeln('  Вычисление интеграла функции ',s1,' на промежутке [',a1:1:1,';',b1:1:1,'] с точностью e');
     2:writeln('  Вычисление интеграла функции ',s2,' на промежутке [',a2:1:1,';',b2:1:1,'] с точностью e');
     3:writeln('  Вычисление интеграла функции ',s3,s31,' на промежутке [',a3:1:1,';',b3:1:1,'] с точностью e');
     4:writeln('  Вычисление интеграла функции ',s4,' на промежутке [',a4:1:1,';',b4:1:1,'] с точностью e');
     6:writeln('  Вычисление интеграла функции ',s6,' на промежутке [',a6:1:1,';',b6:1:1,'] с точностью e');
     end;
     n:=8;
     e:=0.001;
     clrscr;
     case choice of
     1:writeln('  Результаты вычисления интеграла по методу Симпсона от ',s1);
     2:writeln('  Результаты вычисления интеграла по методу Симпсона от ',s2);
     3:writeln('  Результаты вычисления интеграла по методу Симпсона от ',s3,s31);
     4:writeln('  Результаты вычисления интеграла по методу Симпсона от ',s4);
     6:writeln('  Результаты вычисления интеграла по методу Симпсона от ',s6);
     end;
     writeln('  N|  Кол-во итераций  |  Интеграл      ');
     writeln('-------------------------------------------');
     i:=1;
     repeat
           integ:=msimpson(n,choice);
           if n<10 then
           writeln('  ',i,'|                  ',n,'|   ',integ:10:9)
           else
           if n<100 then writeln('  ',i,'|                 ',n,'|   ',integ:10:9)
           else writeln('  ',i,'|                ',n,'|   ',integ:10:9);
           count[choice]:=0;
           inc(n,n);
           integraln:=msimpson(n,choice);
           inc(i);
     until abs(integ-integraln)<=e;
     toch[choice]:=e;
     if n<99 then
     writeln('  ',i,'|                 ',n,'|   ',integraln:10:9) else
     if n>99 then
     writeln('  ',i,'|                ',n,'|   ',integraln:10:9);
     writeln;
     writeln('  Интеграл равен ', integraln:10:9);
     smp[choice]:=integraln;
     nsmp[choice]:=n;
end;

{считает по методу Гаусса при n=5 и k=7}
procedure gauss(choice:integer);
var a,b,x,xn,h,s,z:real;
k:integer;

function mgauss(choice:integer; a,b:real):real;
var x,s:real; i:integer;
const
t:array[1..5] of real = (-0.90618, -0.538469, 0.0, 0.538469, 0.90618);
c:array[1..5] of real = (0.23693, 0.47863, 0.56889, 0.47863, 0.23693);
begin
     s:=0;
     for i:=1 to 5 do
     begin
     x:=(a+b)/2 + ( ((b-a) / 2)*t[i] );
     z:=f(x,choice);
     s:=s + z*c[i];
     end;
     s:=s*(b-a)/2;
     mgauss:=s;
end;

begin
     case choice of
          1:begin a:=a1; b:=b1;end;
          2:begin a:=a2; b:=b2; end;
          3:begin a:=a3; b:=b3; end;
          4:begin a:=a4; b:=b4; end;
          6:begin a:=a6; b:=b6; end;
     end;
     h:=(b-a)/gsc;
     x:=a;
     xn:=a+h;
     s:=0;
     case choice of
     1:writeln('   Вычисление интеграла по методу Гаусса от функции ',s1);
     2:writeln('   Вычисление интеграла по методу Гаусса от функции ',s2);
     3:writeln('   Вычисление интеграла по методу Гаусса от функции ',s3,s31);
     4:writeln('   Вычисление интеграла по методу Гаусса от функции ',s4);
     end;
     writeln;
     writeln('  Интервал [',a:1:1,';',b:1:1,'] ');
     writeln('   K  |       A    |     B   |      Интеграл ');
     writeln('-------------------------------------------------');
     for k:=1 to gsc do
     begin
          s:=s+mgauss(choice,x,xn);
          if (x>0) then
          writeln('   ',k,'  |       ', x:2:2, ' |    ',xn:2:2, '|  ', s:15:14) else
          if (x<0) then
          writeln('   ',k,'  |      ', x:2:2, ' |    ',xn:2:2, '|  ', s:15:14);
          x:=xn;
          xn:=xn+h;
     end;
     writeln;
     case choice of
     1:writeln('  Интеграл по формуле Гаусса от ',s1,' равен',s:15:14);
     2:writeln('  Интеграл по формуле Гаусса от ',s2,' равен',s:15:14);
     3:writeln('  Интеграл по формуле Гаусса от ',s3,s31,' равен',s:15:14);
     4:writeln('  Интеграл по формуле Гаусса от ',s4,' равен',s:15:14);
     end;
     gss[choice]:=s;
end;

{выводит итог по вычислениям}
procedure itog(n:integer);
procedure vivod(st:string; choice:integer);
begin
        writeln;
        writeln('                                  ИТОГ       ');
        writeln('------------------------------------------------------------------------------');
        writeln('             Параметр    |    метод Симпсона     |    метод Гаусса');
        writeln('------------------------------------------------------------------------------');
        writeln(' Подинтегральная функция |                 ',st            );
        writeln('------------------------------------------------------------------------------');
        writeln('       Интеграл          |      ',smp[choice]:10:9  ,'      |    ',gss[choice]:10:9);
        writeln('------------------------------------------------------------------------------');
        writeln('     Точное значение     |                  ',f1(choice):10:9 ,'               ');
        writeln('------------------------------------------------------------------------------');
        case choice of
        1:writeln('       Интервал          |                  [',a1:1:1,';',b1:1:1,']   ');
        2:writeln('       Интервал          |                  [',a2:1:1,';',b2:1:1,']   ');
        3:writeln('       Интервал          |                  [',a3:1:1,';',b3:1:1,']   ');
        4:writeln('       Интервал          |                  [',a4:1:1,';',b4:1:1,']   ');
        6:writeln('       Интервал          |                  [',a6:1:1,';',b6:1:1,']   ');
        end;
        writeln('------------------------------------------------------------------------------');
        writeln('      Точность           |         ', toch[choice]:8:6,'      |             -       ');
        writeln('------------------------------------------------------------------------------');
        writeln(' Итоговое кол-во шагов(n)|           ',nsmp[choice],'         |    N = 5  K = ',gsc  );
        writeln('------------------------------------------------------------------------------');
        writeln('   Кол-во вызовов        |                       |');
        writeln(' подинтегральной функции |          ',counts[choice],'          |       ',countg[choice]);
        writeln('------------------------------------------------------------------------------');

end;

begin
case n of
1:vivod(s1,n);
2:vivod(s2,n);
3:vivod(s3+s31,n);
4:vivod(s4,n);
6:vivod(s6,n);
end;
end;

{выводит итог всех четырех функций}
procedure all_type;
var i:integer; s,st:string;
begin
writeln('                           Общий итог');
writeln;
writeln;
writeln('     Функция    |  метод  Симпсона  |  метод Гаусса  |   ');
writeln('----------------|-------------------|----------------|---');

writeln(' ',s1,'    |  ',smp[1]:8:8,'       |  ', gss[1]:8:8, '    |  ' );
writeln('----------------|-------------------|----------------|---');

writeln(' ',s2,'    |  ',smp[2]:8:8,'       |  ', gss[2]:8:8, '    |  ' );
writeln('----------------|-------------------|----------------|---');

writeln(' ',s3,'    |  ',smp[3]:8:8,'       |  ', gss[3]:8:8, '    |  ' );
writeln(' ',s31,'   |                   |                |' );

writeln('----------------|-------------------|----------------|---');

writeln(' ',s4,'    |  ',smp[4]:8:8,'      |  ', gss[4]:8:8, '   |  ' );
writeln('----------------|-------------------|----------------|---');

writeln('Нажмите ENTER для возврта в меню. ESC - для выхода.');
write('  ');
end;

procedure check(strng:string);

type
  Letters = set of char;
const
  Large: Letters = ['A'..'J','а'..'я', 'А'..'Я'];
var
i:integer;
begin
for i:=1 to length(strng[i]) do
if strng[i] in large then
error(5);
end;

begin
repeat
for n:=1 to 4 do
count[n]:=0;
clrscr;
n:=menu;
automatic:=false;
case n of
1..4:begin
       simpson(n);
       writeln;
       writeln('  Нажмите ENTER для вывода результатов вычисления интеграла по методу Гаусса');
       write('  ');
       repeat
       until readkey=#13;
       clrscr;
       counts[n]:=count[n];
       count[n]:=0;
       gauss(n);
       countg[n]:=count[n];
       count[n]:=0;
       writeln;
       writeln('  Нажмите ENTER для вывода итога');
       write('  ');
       repeat
       until readkey=#13;
       clrscr;
       itog(n);
       writeln;
       writeln('  Нажмите ENTER для выхода в меню. ESC - для выхода.');
  end;
5:begin
       automatic:=true;
       for n:=1 to 4 do
       begin
       simpson(n);
       clrscr;
       counts[n]:=count[n];
       count[n]:=0;
       gauss(n);
       countg[n]:=count[n];
       count[n]:=0;
       clrscr;
       end;
       all_type;write('  ');
  end;
6:begin
       clrscr;
       init;
       for i:=1 to 15 do
       writeln(rules[i]);
       writeln('  Введите подинтегральную функцию:');
       write('  ');
       readln(formula);
       check(formula);
       writeln('  Введите границы интегрирования [a;b] :');write('  ');
       readln(a6,b6);
       s6:=formula;
       fn_to_ch(formula);
       poland(formula,postfix);
       writeln('  Введите первообразную функцию:');
       write('  ');
       readln(formulap);
       check(formulap);
       fn_to_ch(formulap);
       poland(formulap,postfixp);
       simpson(n);
       writeln;
       writeln('  Нажмите ENTER для вывода результатов вычисления интеграла по методу Гаусса');
       write('  ');
       repeat
       until readkey=#13;
       clrscr;
       counts[n]:=count[n];
       count[n]:=0;
       gauss(n);
       countg[n]:=count[n];
       count[n]:=0;
       writeln;
       writeln('  Нажмите ENTER для вывода итога');
       write('  ');
       repeat
       until readkey=#13;
       clrscr;
       writeln;
       itog(n);
       writeln('  Нажмите ENTER для выхода в меню. ESC - для выхода.');
       write('  ');
  end;
9:begin halt; end;
end;
until (readkey=#27);
end.