Урок 16 Задача 5

Урок 16 Задача 5:

Пользователь вводит N (N

Напишите подпрограмму, которая определит - есть ли у них общее пересечение, и если есть - вычислит координаты отрезка-пересечения.

type
  dvmassiv = array [1..4] of array [1..2] of integer;
var
  a: dvmassiv;
  min, max, i, j: integer;

{функция получает двум-й массив, координаты предполагаемого общего отрезка,
проверяет, все ли числа предполагаемого общего отрезка
встречаются в каждом из отрезков,
возвращает результат в виде значения булевой переменной}
function prov (a: dvmassiv; nach, kon: integer): boolean;
var
  i, j, h: integer;
  q: boolean;
begin
  for i:=nach to kon do            // обход координат общего отрезка
  begin
    for j:=low(a) to high(a) do    // обход массива отрезков
    begin
      q:= false;
      for h:=a[j][1] to a[j][2] do // обход координат отрезков
        if i = h then
        begin
          q:= true;
          break;
        end;
      if q= false then
        break;
    end;
    if q= false then
      break;
  end;
  result:= q;
end;

{процедура-обертка
получает на вход двум-й массив, мин. и макс. координаты,
перебирает и отправляет в функцию
для проверки предполагаемые координаты общего пересечения,
получает результат в виде значения булевой переменной,
выводит в консоль итоговый результат}
procedure kons (a: dvmassiv; min, max: integer);
var
  i, x, razn, nach, kon: integer;
  q: boolean;
begin
  razn:= max - min;
  while not (razn < 0) do
  begin
    for nach:= min to min + x do
    begin
      kon:= nach+razn;
      q:= prov(a, nach, kon); // передаем на проверку дв-й массив и предполагаемые координаты
      if q = true then
        break;
    end;
    if q = true then
    begin
      writeln ('Начало общего отрезка: ', nach);
      writeln ('Конец общего отрезка: ', kon);
      break;
    end else
    begin
      if razn=0 then
        writeln ('Нет общего пересечения');
      razn:= razn-1;
      x:= x+1;
      end;
    end;
  end;

{функция принимает двум-й массив, в зависимости от х,
возвращает минимальное либо максимальное значение, содерж-ся в этом двум-м массиве}
function minmax (a: dvmassiv; x: integer): integer;
var
  i, m: integer;
begin
  m:= a[1][x];
  for i:=2 to high(a) do
    if (x=1) and (a[i][x] < m) or (x=2) and (a[i][x] > m) then
      m:= a[i][x];
  result:= m;
end;

{функция считывает введенное значение в элемент подмассива,
если первый элемент подмассива больше, чем второй, то меняет их местами,
возвращает инициализированный массив}
function vvod (a: dvmassiv): dvmassiv;
var
  i, j, n: integer;
begin
  writeln('Введите координаты: ');
  for i:=low(a) to high(a) do
  begin
    for j:=low(a[i]) to high(a[i]) do
    begin
      readln (a[i][j]);
      if (j = 2) and (a[i][2] < a[i][1]) then
      begin
        n:= a[i][2];
        a[i][2]:= a[i][1];
        a[i][1]:= n;
      end;
    end;
    writeln;
  end;
  result:= a;
end;

begin
  a:= vvod(a);         // инициализируем двум-й массив
  min:= minmax(a, 1);  // узнаем минимальную координату в массиве
  max:= minmax(a, 2);  // узнаем максимальную координату в массиве
  kons(a, min, max);   // вызываем процедуру для вывода в консоль результата
  readln();
end.

Вывод в консоли:

Введите координаты: 
-1
8
0
6
1
7
-3
12
Начало общего отрезка: 1
Конец общего отрезка: 6