задача 4 урок 16

задача 4 урок 16

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

Решение

Вариант №1

program task4_lesson16;
type
  koordinat = array[1..2] of integer;
  arr = array[1..3, 1..2] of integer;
function per(x1, y1, x2, y2, x3, y3: integer) : boolean;  // проверка на пересечение
var i: integer;
begin
  result := true;
  if (x1 >= y2) or (x1 >= y3) then
    result := false
  else if (x2 >= y1) or (x2 >= y3) then
    result := false
  else if (x3 >= y1) or (x3 >= y2) then
    result := false;
end;

function find(x1, y1, x2, y2, x3, y3: integer) : koordinat; // поиск координыт пересечения
var a: koordinat;
    i, n, m: integer;
begin      // координаты отрезка это больший X и меньший Y
  if (x1 >= x2) and (x1 >= x3) then
    a[1] := x1
  else if (x2 >= x1) and (x2 >= x3) then
    a[1] := x2
  else if (x3 >= x1) and (x3 >= x2) then
    a[1] := x3;
  if (y1 <= y2) and (y1 <= y3) then
    a[2] := y1
  else if (y2 <= y1) and (y2 <= y3) then
    a[2] := y2
  else if (y3 <= y1) and (y3 <= y2) then
    a[2] := y3;
  result := a;
end;

var
  a: arr;
  c: koordinat;
  i, j, n: integer;
  b: boolean;
begin
  for i := 1 to 3 do
    begin
      writeln('vvedite koordinati ',i,'-go otrezka');
      for j := 1 to 2 do
        begin
          readln(n);
          a[i][j] := n;
        end;
    end;
  b := per(a[1][1], a[1][2], a[2][1], a[2][2], a[3][1], a[3][2]);
  if b then
    begin
      c := find(a[1][1], a[1][2], a[2][1], a[2][2], a[3][1], a[3][2]);
      write('koordinati pereseceniya x-', c[1],' y-',c[2]);
    end
  else
      write('net pereseceniy');
  readln
end.

Консоль - нет пересечений

vvedite koordinati 1-go otrezka
1
2
vvedite koordinati 2-go otrezka
3
4
vvedite koordinati 3-go otrezka
5
6
net pereseceniy

Консоль есть пересечения

vvedite koordinati 1-go otrezka
-5
100
vvedite koordinati 2-go otrezka
-5
1
vvedite koordinati 3-go otrezka
-1
0
koordinati pereseceniya x--1 y-0

Вариант №2

program task4_lesson16;
type
  koordinat = array[1..2] of integer;
  arr = array[1..2, 1..3] of integer;
procedure per(a: arr);
var i: integer;
    b, n, m: integer;
begin
  b := 0;
  for i := 1 to 3 do
    begin   // пересечение только если !все! X слева, а !все! Y справа   x1---x2-x3---y3--y1---y2
    if (a[2][i] > a[1][1]) and (a[2][i] > a[1][2]) and (a[2][i] > a[1][3]) then
      b += 1;
    end;
  if (b = 3) then
    begin
      writeln('peresecenie est`');  // Ккоординаты это самый большой X и самый меньший Y
      for i := 1 to 2 do
      begin
        if a[1][i] <= a[1][i+1] then
          n := a[1][i+1]
        else
          begin
            n := a[1][i];
            a[1][i+1] := n;
          end;
      end;
      for i := 1 to 2 do
      begin
        if a[2][i] >= a[2][i+1] then
          m := a[2][i+1]
        else
          m := a[2][i];
          a[2][i+1] := m;
      end;
      writeln('koordinati pereseceniya : ',n,'|',m);
    end
  else
    writeln('otrezki ne peresekautsya');
end;
var
  a: arr;
  i, j, n: integer;
begin
  for i := 1 to 2 do
    begin
      writeln('vvodim ',i ,' koordinat otrezkov '); // [x1|x2|x3, y1|y2|y3];
      for j := 1 to 3 do
        begin
          readln(n);
          a[i][j] := n;
        end;
    end;
  per(a);
  readln
end.

Консоль

vvodim 1 koordinat otrezkov
1
5
1
vvodim 2 koordinat otrezkov
9
10
15
peresecenie est`
koordinati pereseceniya : 5|9