Программа


{ Вычислить расстояние от заданной точки до каждой прямой
  сформировать множество из прямых, расстояние до которых принадлежат
    заданному интервалу
  упорядочить множество в порядке возрастания расстояний }
USES CRT;
CONST NumberLine=14; {Возможное число линий}
TYPE Line=record           { Прямая }
            A,B,C:real;       { Коэффициенты }
            Distance:real;    { Расстояние от прямой до точки }
            Flag:boolean      { Флаг определенности }
          end;
     PowerType=array[1..NumberLine] of Line;  { Тип-Массив прямых }
VAR Power:PowerType;    { Массив точек }
    X,Y,MaxDistance,MinDistance:real;  { Координаты точки и границы интервала
      допустимого расстояние от точки до прямых (критерий отбора прямых) }
FUNCTION GetDistance(X,Y,A,B,C:real):real;
{ Вычисление расстояния от точки (X,Y) до прямой A*X+B*X+C=0 }
  Begin
    GetDistance:=Abs(A*X+B*Y+C)/Sqrt(Sqr(A)+Sqr(B))
  End;

PROCEDURE MakePower(var Power:PowerType);
  { Создание массива (эмулирован ввод функцией Random) }
  Var i:integer;  { Счетчик }
  Begin
    for i:=1 to NumberLine do  { Цикл набора массива }
      with Power[i] do
      if Random(3)<>0
      then begin { Определение наличия прямой }
             Flag:=TRUE;{ Подъем флага наличия прямой }
             { Определение коэффициентов прямой: }
             repeat
               A:=Random(10)-5.;
               B:=Random(10)-5.;
             until (A<>0) or (B<>0);
               {выход из цикла при получении возможной прямой}
             C:=Random(10)-5.;
             Distance:=GetDistance(X,Y,A,B,C); {Вычисление расстояния}
           end
      else Power[i].Flag:=FALSE;{ Сброс флага наличия прямой }
  End;

PROCEDURE CheckedPower(var Power:PowerType);
{ Просмотр массива и удаление прямых с расстоянием до точки, выходящим за
  за допустимые пределы }
  Var i:integer;  { Счетчик }
  Begin
    for i:=1 to NumberLine do { Цикл просмотра массива }
      if Power[i].Flag then { Если прямая определена, то - проверка расстояния
       до точки и сброс прямой, если расстояние выходит за допустимые пределы }
        begin
          with Power[i] do
          begin
            if (Distance>MaxDistance) or (Distance<MinDistance)
            then Flag:=FALSE
          end
        end
  End;

FUNCTION CheckedBest(Best,Current:Line):boolean;
  { Функция, определения точки Current, как превосходной над точкой Best }
  Begin
    if Best.Flag
      then if Current.Flag
             then CheckedBest:=
                    GetDistance(X,Y,Current.A,Current.B,Current.C)>=
                    GetDistance(X,Y,   Best.A,   Best.B,   Best.C)
             else CheckedBest:=FALSE
      else CheckedBest:=Current.Flag
    { Если Best определена
        то - если Current определена
                    то - определение функции по сравнению расстояний от
                         точек до прямой
                    иначе - определение функции как FALSE
        иначе - опрделение функции по определенности точки Current }
  End;

PROCEDURE SortPower(var Power:PowerType); { Сортировка массива }
  Var i,j,BestNumber:integer;  { Счетчики и номер элемента массива,
                                 переносимого в конец отсортированной
                                 части массива }
      Buf:Line;                { Буфер для обмена элементов }
  Begin
    for i:=1 to NumberLine-1 do  { Цикл сортировки }
      begin
        BestNumber:=i; { Начальное определение "лучшей" точки
                         по первой неотсортированной }
        for j:=i+1 to NumberLine do { Цикл просмотра неотсортированной
                                       части массива }
          if CheckedBest(Power[BestNumber],Power[j]) { Если текущая лучше, }
            then BestNumber:=j;   { то - переопределение предыдущей лучшей }
        if BestNumber<>i then { Если лучшая точка непервая из }
          begin               { неотсортированных, то - перестановка ячеек: }
            Buf:=Power[BestNumber];
            Power[BestNumber]:=Power[i];
            Power[i]:=Buf
          end
      end
  End;
FUNCTION Coef(A:real):string; {Функция форматирования коэффициента (числа)}
  Var S:String; {Всмомогательная переменная}
  Begin
    Str(A:4:1,S); { Преобразование числа в строку }
    if S[1]=' ' then S[1]:='+'; { Приписывание знака }
    Coef:=S { Определение значения функции }
  End;
PROCEDURE OutPower(Power:PowerType;StartX:byte;Heading:string);
                                                { Процедура вывода множества }
  Var i:word;   { Счетчик }
  Begin
    { Оформление шапки таблицы: }
    GoToXY(StartX,1);
    Write(Heading);
    GoToXY(StartX,2);
    Write('┌──────────────────┬────┐');
    GoToXY(StartX,3);
    Write('│    Уравнение     │Раст│ ');
    GoToXY(StartX,4);
    Write('├──────────────────┼────┤');
    for i:=1 to NumberLine do { Цикл вывода массива }
      begin
        GoToXY(StartX,i+4);
        { Вывод элемента массива: }
        with Power[i] do
        if Flag
          then Write('│',Coef(A),'*x',Coef(B),'*у',Coef(C),'=0','│',
                     Distance:4:1,'│')
          else Write('│..................│....│')
      end;
    GoToXY(StartX,NumberLine+5);
    Write('└──────────────────┴────┘')  { Закрытие таблицы }
  End;

BEGIN
  Randomize;
  ClrScr;
  { Инициализация переменных: }
  X:=Random(20)-10.0;
  Y:=Random(20)-10.0;

  MaxDistance:=Random(30);
  MinDistance:=Random(Trunc(MaxDistance));

  MakePower(Power); { Создание массива точек }
  OutPower(Power,1,'Исходное множество'); { Вывод созданного массива }
  CheckedPower(Power);  { Удаление из массива удаленных точек }
  OutPower(Power,27,'Искомое множество');{ Вывод преобразованного массива }
  SortPower(Power);  { Сортировка массива }
  OutPower(Power,53,'Отсортированное множество');{ Вывод отсортированного массива }

  GoToXY(1,WhereY+3);
  WriteLn('Точка A(',X:0:1,', ',Y:0:1,')');
  { Вывод максимально допустимого расстояния от точки до прямой: }
  WriteLn('Максимальное допустимое расстояние от точки до прямой =',MaxDistance:0:0);
  WriteLn('Минимальное  допустимое расстояние от точки до прямой =',MinDistance:0:0);
  ReadKey { Остановка программы до нажатия клавиши }
END.

Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию