Программа


CONST N_point=20;  { Максимальное количество точек во множестве }
      Quantity_K=10; { Количество параметров K }
      K_start=0.1; { Начальное значение K }
      K_finish=0.5;{ Конечное значение K }
      Step=(K_finish-K_start)/(Quantity_K-1); { Шаг изменения параметра }
TYPE PointSet=array [1..N_point] of record { Тип - Множество точек }
                                X,Y:real;  { Координаты точки }
                                Flag:boolean { Флаг наличия точки }
                              end;
VAR K:real; { Параметр второй функции }
FUNCTION Question(S:string):boolean; { Функция получения ответа на вопрос }
  Var Ch:char;                       { Буфер }
  Begin
    repeat
      Write(S,' [Y/N] ');   { Вывод вопроса }
      ReadLn(Ch) { Ввод символа }
    until Ch in ['Y','y','N','n','Н','н','Т','т'];
                           { Выход из цикла при получении корректного ответа }
    Question:=Ch in ['Y','y','Н','н'] { Определение значения функции }
  End;
PROCEDURE InputSet(var M:PointSet;Auto:boolean);  { Процедура ввода множества точек }
  Var i:1..N_point;  { Счетчик цикла }
  Begin
    if Auto  { Выбор варианта заполнения множества }
    then for i:=1 to N_point do { Цикл заполнения массива }
         begin
           M[i].Flag:=Random(4)>0; { Определение точки }
           if M[i].Flag { Если точка определена }
           then begin { то - инициализация координат точки }
                  M[i].X:=0.5+(1.4-0.5)*Random;
                  M[i].Y:=-0.9+(0.2--0.9)*Random
                end
           else;
         end
    else begin
           WriteLn('ВВОД МНОЖЕСТВА ТОЧЕК:'); { Вывод подсказки }
           for i:=1 to N_point do { Цикл заполнения массива }
           begin
             Write('Определить точку ',i,' ?'); { Вывод вопроса }
             M[i].Flag:=Question(''); { Определение точки }
             if M[i].Flag { Если точка определена }
             then begin { то - инициализация координат точки }
                    Write('Введите координату X '); { Вывод приглашения }
                    ReadLn(M[i].X); { Ввод координаты }
                    Write('Введите координату Y '); { Вывод приглашения }
                    ReadLn(M[i].Y); { Ввод координаты }
                  end
             else;
           end
         end
  End;
PROCEDURE OutputSet(Head:String;M:PointSet);  { Процедура вывода множества точек }
  Var i:1..N_point;  { Счетчик цикла }
  Begin
    WriteLn(Head); { Вывод заголовка }
    for i:=1 to N_point do { Цикл вывода множества }
      if M[i].Flag { Проверка определенности точки }
      then Write('(',M[i].X:5:2,',',M[i].Y:5:2,')   ') { Вывод точки }
      else Write('(...........)   ') { Вывод неопределенной точки }
  End;
TYPE Func=Function(X:real):real; { Тип - функция }
Function Root(a,b:real;F:Func):real; { Функция нахождения корня }
  const Eps=0; { Точность вычислений }
  var c:real;  { Средняя точка интервала локализации корня }
  Begin
    while abs(b-a)>Eps do { Сужение интервала до заданной точности }
      begin
        c:=(a+b)/2;  { Определение средней точки интервала локализации корня }
        if (c=a)or(c=b)
          then begin a:=c; b:=c end { Блокирование сбоя при потере точности }
          else if F(a)*F(c)<0 { Если функция меняет знак на левом участке }
                 then b:=c { то переопределение правой границы }
                 else if F(b)*F(c)<0
                        { иначе - если функция меняет знак на правом участке }
                        then a:=c  { то переопределение левой границы }
                        else begin
                             { Блокирование сбоя при потере точности
                               или случайном нахождении корня }
                               if F(a)=0 then begin c:=a; b:=a end;
                               if F(b)=0 then begin c:=b; a:=b end;
                               if F(a)*F(b)*F(c)=0 then begin a:=c; b:=c end
                             end
      end;
    Root:=(a+b)/2 { Определение значения функции }
  End;
FUNCTION F1(Y:real):real; { Первая функция }
  Begin
    F1:=Exp(Y)+0.25
  End;
FUNCTION F2(Y:real):real; { Вторая функция }
  Begin
    F2:=5*(Y+K)
  End;
FUNCTION F3(Y:real):real; { Третья функция }
  Begin
    F3:=Sqrt((1+Sqr(Y)/1.21)*0.25)
  End;
FUNCTION F1F2(Y:real):real;far; { Уравнение F1=F2 }
  Begin
    F1F2:=F1(Y)-F2(Y)
  End;
FUNCTION F2F3(Y:real):real;far; { Уравнение F2=F3 }
  Begin
    F2F3:=F2(Y)-F3(Y)
  End;
FUNCTION F3F1(Y:real):real;far; { Уравнение F3=F1 }
  Begin
    F3F1:=F3(Y)-F1(Y)
  End;
PROCEDURE FilterSet(M:PointSet;var P:PointSet); { Процедура преобразования множества }
  Var i:1..N_point;  { Счетчик цикла }
      HiY,MedY,LoY:real; { Границы области (Y-координаты точек пересечения линий) }
  Begin
    { Определение Y-координат точек пересечения линий: }
    HiY:=Root(-10, 2,F1F2);
   MedY:=Root(-10,10,F2F3);
    LoY:=Root(-10,10,F3F1);
    for i:=1 to N_point do { Цикл просмотра множества }
      if M[i].Flag   { Проверка определенности точки }
         and
         (LoY<M[i].Y) and (M[i].Y<HiY) { Проверка по диапазону аргумента }
         and
         (M[i].X<F1(M[i].Y)) and  { Точка должна быть "левее" F1}
           ((MedY<M[i].Y)and(M[i].X>F2(M[i].Y)) { правее F2, если Y выше "средней" точки границы }
            or
            (M[i].X>F3(M[i].Y)))  { или - "правее" F3 }
      then P[i]:=M[i]
      else P[i].Flag:=FALSE
  End;
PROCEDURE Stop; { Процедура остановки программы }
  Begin
    Write('Нажмите <Enter>'); { Вывод приглашения нажать <Enter> }
    ReadLn                    { Остановка программы до нажатия <Enter> }
  End;
FUNCTION Stringer(N:real):string;  { Функция преобразования числа в строку }
  Var St:string;  { Переменная для преобразования числа в строку }
  Begin
    Str(N:4:2,St);  { Преобразование }
    Stringer:=St  { Определение значения функции }
  End;
VAR M,P:PointSet; { Множество точек }
    Auto:boolean; { Флаг автоматического формирования исходных данных }
    i:byte; { Счетчик параметра K }
BEGIN
  WriteLn;  { Пропуск строки }
  Auto:=Question('Сформировать исходные данные автоматически?');
                     { Определение порядка создания (ввода) исходных данных }
  if Auto then Randomize;  { Инициализация генератора случайных чисел }
  InputSet(M,Auto); { Ввод множества точек }
  WriteLn;  { Пропуск строки }
  OutputSet('ИСХОДНОЕ МНОЖЕСТВО ТОЧЕК M:',M); { Вывод исходного множества }
  WriteLn;  { Пропуск строки }
  for i:=0 to Quantity_K-1 do { Цикл перебора значений K }
  begin
    if Auto
    then K:=K_start+Step*i { Определение значения K }
    else begin
           Write('Введите K [0.1...0.5] ');  { Вывод подсказки }
           ReadLn(K)  { Ввод коэффициента }
         end;
    FilterSet(M,P); { Преобразование заданного множества в подмножество }
    OutputSet('ПОДМНОЖЕСТВО ТОЧЕК P (K='+Stringer(K)+'):',P); { Вывод полученного множества }
    Stop; { Остановка программы }
    WriteLn  { Пропуск строки }
  end
END.

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