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

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

Вспомогательная задача (можно решить, просто используя одномерные массивы):
Пользователь вводит 4 целых числа, считаем все их координатами на прямой, а именно:

первые два числа - начало и конце отрезка 1
вторые два - начало и конец отрезка 2

Задача: напишите подпрограмму, которая определит пересекаются ли данные отрезки.

type
  massiv = array[1..2, 1..2] of integer;    // 2 подмассива по 2 элемента
var
  a: massiv;
  n, i, j: integer;
  q: boolean;

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

begin
  for i:=low(a) to high(a) do                  // внешний цикл
  begin
    writeln('Введите координаты начала и конца отрезка ', i, ':');
    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 else
    end;

  end;
  q:= prov (a);            // передаем в функцию массив, получаем результат проверки
  if q = true then
    write ('Отрезки пересекаются')
  else
    write ('Отрезки не пересекаются');
  readln();
end.

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

Введите координаты начала и конца отрезка 1:
2
19
Введите координаты начала и конца отрезка 2:
8
33
Отрезки пересекаются

Введите координаты начала и конца отрезка 1:
-7
1
Введите координаты начала и конца отрезка 2:
12
44
Отрезки не пересекаются