Создание программы для нахождения точек с наименьшими координатами по правилу Пузырика

Program PROG;

 Uses crt;

Const

 p = 50 ;                                  { Максимальное число точек }   

type

 ind = 1..p;

 V = array [ind] of Real;

 m = array [ind] of Integer;

VAR

 Rad, kof1, kof2, kof3: Real;     { Rad – Радиус Главной окружности , (kof1,kof2,kof3) – коэффициенты  }

                                                { определяющие границы Главной и 2-х малых окружностей                 }

 k, n, i, i1, t, t1, q: Integer;             { k – перемн. Для последовательного перебора , n - число точек ,         }

                                                { (t,t1) – перемен., определяющие методы ввода и вывода данных       }

                                                { I – число точек входящих в предоставленную область                          }

 x, y, x1, y1: V;                          { (x,y) – координаты точек (массив от 1 до n) , (x1,y1) – массив точек     }

                                                { входящих в предоставленную область (от 1 до i)                                   }

 res: m;                                   { res – массив , последовательно содержащий номера точек входящих }

                                                { в выбранную область                                                                                 }

 f, r, g: text;                                 { Объявление файловой пременной и исходного файла из которого мы }

                                                { считываем данные                                                                                      }

str : string ;

Procedure Puzirik (i: integer; VAR x1, y1: array of Real);

{ Процедура нахождения точек с наименьшими (x,y) , по правилу Пузырика }

 VAR

  k : integer ;

 Begin

  for k:=1 to i-1 do

    begin

     if x1[k]<x1[k+1] then           

      x1[k+1] := x1[k];                  { Подъем меньшего }

     if y1[k]<y1[k+1] then           

      y1[k+1] := y1[k];                  { Подъем меньшего }

    end;

 end;

Begin                    { Начало основной программы }

 clrscr;                   { Очистка экрана }

 Writeln ('Тип ввода данных');     { Меню ввода }

 Writeln ('1 - вручную');

 Writeln ('2 – из файла');

 Readln(t);             { Определение метода ввода }

 if t = 2 then           { Если из файла ввод }

  begin

   assign (r , 'C:\in2.log');      { Связь r с файлом  С:\in2.log }

   Reset(r);                            { открытие файла C:\in2.log для чтения }

   Readln(r,n);                       { Считывание числа точек }

   Readln(r,Rad);                   { Считывание Главного радиуса }

    for k:=1 to n do                 { Последовательное считывание координат (x,y) }

     begin

      read(r,x[k]);

      readln(r,y[k]);

     end;

  end;

 if t = 1 then                    { Если вручную ввод }

  begin

   Writeln ('Введите число точек');

    Readln(n);                  { Считывание числа точек }

   Writeln ('Введите радиус главной окружности');

    Readln(Rad);               { Считывание Главного радиуса }

   Writeln ('Введите координаты точек (x,y)');

    for k:=1 to n do             { Последовательное считывание координат (x,y) }

      begin

       read(x[k]);

       readln(y[k]);

      end;

  end;

 Writeln('Тип вывода данных');       { Меню вывода }

 Writeln('1 – ­на экран ­');

 Writeln('2 – в файл');

 Readln(t1);                                      { Определение метода вывода }

  if t1 = 2 then                                   { Если в файл }

   begin

    assign (f , 'C:\out.rtf');                   { Связь f с фалом C:\out.rtf }

    rewrite(f);                                      { открытие файла C:\out.rtf для записи }    

   end;

  i := 0 ;                                             { Обнуление 1 счетчика }

     for k:=1 to n do

    begin

     kof1 := x[k]*x[k] + y[k]*y[k] ;      { Фор-ла Главной окружности }                 

     kof2 := x[k]*x[k] + (y[k] - Rad/2) * (y[k] - Rad/2) ;   { Фор-ла Верхней малой окружности }

     kof3 := x[k]*x[k] + (y[k] + Rad/2) * (y[k] + Rad/2) ;   { Фор-ла Нижней малой окружности }

     if ( kof1 <= Rad*Rad ) and ( kof2 >= Rad*Rad/4 ) and ( kof3 >= Rad*Rad/4 ) then

      begin

       i := i + 1 ;

       res[i] := k ;              { Внесение номеров вход. Точек                                    }

       x1[i] := x[k] ;            { Составление массива коорд. x , точек вход. В обл.   }

       y1[i] := y[k] ;            { Составление массива коорд. y , точек вход. В обл.   }

      end;

     end;

   if (i <> 0) then

    begin                       { Вывод заголовка , перед перечисление вход. точек }

     if t1 = 1 then Writeln ('В заданную поверхность входят точки # ');

     if t1 = 2 then Writeln (f,'В заданную поверхность входят точки # ');

     for k:=1 to i do

      begin                     { Вывод номеров и координат , входящих точек }

       i1 := res[k];

       if t1 = 1 then Writeln ('# ',i1,' : (',x[i1]:0:2,';',y[i1]:0:2,') ');

       if t1 = 2 then Writeln (f,'# ',i1,' : (',x[i1]:0:2,';',y[i1]:0:2,') ');

      end;

    end

   else

    begin                       { Вывод инф-ии об отсутствии заданных точек в выбранной обл. }

     if t1 = 1 then Writeln ('В эту поверхность не входит ни одна из заданных точек');

     if t1 = 2 then Writeln (f,'В эту поверхность не входит ни одна из заданных точек');

    end;

  Puzirik (i , x1 , y1 );     { использование процедуры Puzirik }

  if t1 = 1 then

   begin    { Вывод наим. х }

    Writeln ('naim. x :',x1[i]:0:2);

    Writeln ('naim. y :',y1[i]:0:2);

   end;

  if t1 = 2 then

   begin    { Вывод наим. у }

    Writeln (f,'naim. x :',x1[i]:0:2);

    Writeln (f,'naim. y :',y1[i]:0:2);

   end;

i1:= 0 ;                                            { Обнуление 2-ого счетчика }

  assign (g, ‘C:\PROG.pas’);              { Связь g с фалом C:\PROG.pas}

  Reset (g);                                        { открытие файла C:\PROG.pas для записи }     

 While not eof (g) do                        { пока не кончится программа }

   Begin

    Readln(g,str);                               { прочтение интересующей строки }

     While Pos (‘:=’, str) <> 0 do        { пока в строке есть операторы присваивания }

      begin

       i1:= i1+1;                                    { добавление числа операторов присваивания }

      q:= Pos (‘:=’, str);                        { поиск оператора }

      delete (str,q,2);                           { удаление посчитанного оператора }

    end;

   end;

 if t1 = 2 then writeln (f, ‘ ‘,i1, ‘ – число повторений операторов присваивания’); 

 if t = 1 then writeln (‘ ‘,i1, ‘ – число повторений операторов присваивания’); 

 close (g);                     { Закрыть файл g }

 if t1 = 2 then close(f);  { Закрыть файл f }

 if t = 2 then close(r);    { Закрыть файл r }

END.  { Конец Kypca  }