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

Primary tabs

Submitted by Vitaliy123 on Sun, 11/28/2021 - 11:43

Forums:

Урок 16

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

type ar = array[1..5, 1..2] of integer;
     br = array[1..2] of integer;

var a: ar;
    b: br = (0, 0);
    bo: boolean;

procedure p0(var a1: ar);//наполняем массив А
  var i1, j1: integer;

begin
  writeln();
  for i1 := low(a1) to high(a1) do
  begin
    for j1 := low(a1[i1]) to high(a1[i1]) do
    begin
      if (j1 = low(a1[i1])) then
      begin
       writeln('Введите начало отрезка');
       readln(a1[i1, low(a1[i1])]);
      end
      else if (j1 = high(a1[i1])) then
      begin
       writeln('Введите конец отрезка');
       readln(a1[i1, high(a1[i1])]);
      end;
    end;
  end;
  writeln();
  writeln('Ваши отрезки: ');
  for i1 := low(a1) to high(a1) do
  begin
    for j1 := low(a1[i1]) to high(a1[i1]) do
      write(a1[i1][j1], ' ');
    writeln();
  end;
end;

procedure p1(a1:ar; var b1: br; var bo1: boolean);//поиск отрезка пересечения
  var i1: integer;

begin
  b1[1] := a1[low(a1), low(a1[low(a1)])];
  b1[2] := a1[high(a1), high(a1[high(a1)])];
  for i1 := low(a1) to high(a1) do
  begin
    if (a1[low(a1), low(a1[low(a1)])] <= a1[i1, high(a1[i1])]) and
       (a1[low(a1), high(a1[low(a1)])] >= a1[i1, low(a1[i1])]) then
    begin
     if a1[i1, low(a1[i1])] > b1[1] then
       b1[1] := a1[i1, low(a1[i1])]
     else if a1[i1, high(a1[i1])] < b1[2] then
       b1[2] := a1[i1, high(a1[i1])];
    end
    else
    begin
      bo1 := false;
      writeln('Пересечения нет');
      break;
    end;
  end;
end;

procedure printarray(b1:br);//печать отрезка пересечения
  var i1: integer;

begin
  writeln();
  writeln('Пересечением является отрезок с координатами: ');
  for i1 := low(b1) to high(b1) do
    write(b1[i1], ' ');
end;

begin
  bo := true;
  p0(a);
  p1(a, b, bo);
  if bo then
    printarray(b);
  readln();
end.

КОНСОЛЬ

Введите начало отрезка
0
Введите конец отрезка
15
Введите начало отрезка
14
Введите конец отрезка
25
Введите начало отрезка
5
Введите конец отрезка
17
Введите начало отрезка
-5
Введите конец отрезка
16
Введите начало отрезка
14
Введите конец отрезка
18

Ваши отрезки:
0 15
14 25
5 17
-5 16
14 18

Пересечением является отрезок с координатами:
14 15
  • Log in to post comments
  • 1848 reads
vedro-compota's picture

vedro-compota

Sun, 11/28/2021 - 13:26

ждем предыдущие

_____________
матфак вгу и остальная классика =)

Vitaliy123

Mon, 11/29/2021 - 21:08

-

Vitaliy123

Tue, 12/07/2021 - 21:36 

type ar = array[1..5, 1..2] of integer;
     br = array[1..2] of integer;

var a: ar;
    b: br;
    bo: boolean;

procedure fillArr(var a1: ar);//наполняем массив А
  var i1, j1: integer;

begin
  writeln();
  for i1 := 1 to high(a1) do
  begin
    writeln('Введите начало отрезка');
    readln(a1[i1, 1]);
    writeln('Введите конец отрезка');
    readln(a1[i1, 2]);
  end;
  writeln();
  writeln('Ваши отрезки: ');
  for i1 := 1 to high(a1) do
  begin
    writeln(a1[i1, 1], ' ', a1[i1, 2]);
  end;
end;


procedure searchSeg(a1:ar; var b1: br; var bo1: boolean);//поиск отрезка пересечения
  var i1: integer;

begin
  b1[1] := a1[1, 1];
  b1[2] := a1[1, 2];
  for i1 := 2 to high(a1) do
  begin
    if (a1[1, 1] <= a1[i1, 2]) and
       (a1[1, 2] >= a1[i1, 1]) then
    begin
     if a1[i1, 1] > b1[1] then
       b1[1] := a1[i1, 1];
     if a1[i1, 2] < b1[2] then
       b1[2] := a1[i1, 2];
    end
    else
    begin
      bo1 := false;
      writeln('Пересечения нет');
      break;
    end;
  end;
end;

begin
  b[1] := 0;
  b[2] := 0;
  bo := true;
  fillArr(a);
  searchSeg(a, b, bo);
  if bo then
  begin
    writeln('Пересечением является отрезок с координатами: ');
    write(b[1], ' ', b[2]);
  end;
  readln();
end.
vedro-compota's picture

vedro-compota

Wed, 12/08/2021 - 18:29

засчитано

_____________
матфак вгу и остальная классика =)