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

Primary tabs

Submitted by avast36 on Fri, 04/15/2022 - 11:24

Forums:

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

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

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

Задача: напишите подпрограмму, которая определит какой отрезок является пересечением этих двух заданных отрезков (если это пересечение вообще есть).

Примечание: оформить поиск пересечения в виде процедуры, которая получает на вход 4 координаты, а также 2 параметра по ссылке:

одномерный массив из 2 элементов, куда будет записано пересечение (если оно будет найдено)
булево значение, которое показывает найдено ли пересечение

Решение:

program u16z03;
type newArr = array[1..2] of integer;
var arr:newArr;
  s: boolean;
  i,a1,a2,a3,a4: integer;

procedure writeArr(arr:newArr);
begin
  for i:=low(arr) to high(arr) do
    write(arr[i],' ');
end;
procedure otrezki(a1,a2,a3,a4:integer; arr:newArr; var s:boolean);
begin
  if (a1>a3)and(a2<a4) then
  begin
    arr[1]:=a1;
    arr[2]:=a2;
    writeArr(arr);
    writeln();
    s:=TRUE;
  end
  else
    if (a1<a3)and(a2>a4) then
    begin
      arr[1]:=a3;
      arr[2]:=a4;
      writeArr(arr);
      writeln();
      s:=TRUE;
    end
    else
      if (a1<3)and(a2>a3)and(a2<a4) then
      begin
        arr[1]:=a3;
        arr[2]:=a2;
        writeArr(arr);
        writeln();
        s:=TRUE;
      end
      else
        if (a2>a4)and(a1<a4)and(a1>a3) then
        begin
          arr[1]:=a1;
          arr[2]:=a4;
          writeArr(arr);
          writeln();
          s:=TRUE;
        end
        else
          s:=FALSE;
end;

begin
  write('vvedite koordinat - ');
  readln(a1);
  write('vvedite koordinat - ');
  readln(a2);
  write('vvedite koordinat - ');
  readln(a3);
  write('vvedite koordinat - ');
  readln(a4);
  otrezki(a1,a2,a3,a4,arr,s);
  writeln(s);
  readln();
end.

Консоль:

vvedite koordinat - 1
vvedite koordinat - 7
vvedite koordinat - 2
vvedite koordinat - 11
2 7
TRUE
  • Log in to post comments
  • 2078 reads
vedro-compota's picture

vedro-compota

Wed, 06/15/2022 - 19:38

рекомендую проверить на разных значениях, сигнатура правильная

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

avast36

Tue, 07/05/2022 - 09:40

Решение:

program u16z03;
type newArr = array[1..2] of integer;
var arr:newArr;
  s: boolean;
  j,a3,a4: integer;

procedure writeArr(arr:newArr);
begin
  for j:=low(arr) to high(arr) do
    write(arr[j],' ');
end;
procedure otrezki(a3,a4:integer; var arr:newArr; var s:boolean);
begin
  if (a3<=arr[1]) and (arr[1]<=a4) then
    begin
      if (a4<arr[2]) then                   // x2|x1|y2|y1
      begin
        s:= TRUE;
        arr[2]:=a4;
      end
      else                                  // x1=x2|y1=y2 and x2|x1|y1|y2
        s:=TRUE;
    end
  else if (arr[1]<=a3) and (a3<=arr[2]) then
    begin
      if (arr[2]<=a4) then                  // x1|x2|y1|y2
      begin
        s:= TRUE;
        arr[1]:=a3;
      end
      else                                  // x1|x2|y2|y1
      begin
        s:= TRUE;
        arr[1]:=a3;
        arr[2]:=a4;
      end;
    end
  else
    s:= FALSE;                              // x1|y1|   |x2|y2
end;

begin
  s:=FALSE;
  write('vvedite koordinat - ');
  readln(arr[1]);
  write('vvedite koordinat - ');
  readln(arr[2]);
  write('vvedite koordinat - ');
  readln(a3);
  write('vvedite koordinat - ');
  readln(a4);
  otrezki(a3,a4,arr,s);
  if s then
  begin
    write('otrezok peresecheniya: ');
    writeArr(arr);
  end
  else
    writeln('otrezki ne peresekayutsya');
  readln();
end.

Консоль:

vvedite koordinat - 1
vvedite koordinat - 2
vvedite koordinat - 2
vvedite koordinat - 4
otrezok peresecheniya: 2 2

vvedite koordinat - 1
vvedite koordinat - 3
vvedite koordinat - 2
vvedite koordinat - 4
otrezok peresecheniya: 2 3 

vvedite koordinat - 1
vvedite koordinat - 4
vvedite koordinat - 2
vvedite koordinat - 3
otrezok peresecheniya: 2 3 

vvedite koordinat - 1
vvedite koordinat - 2
vvedite koordinat - 3
vvedite koordinat - 4
otrezki ne peresekayutsya
vedro-compota's picture

vedro-compota

Wed, 07/06/2022 - 20:43

исправить сигнатуру

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

avast36

Thu, 07/07/2022 - 09:41

Решение:

program u16z03;
type newArr = array[1..2] of integer;
var arr:newArr;
  s: boolean;
  j,a1,a2,a3,a4: integer;

procedure writeArr(arr:newArr);
begin
  for j:=low(arr) to high(arr) do
    write(arr[j],' ');
end;

procedure otrezki(a1,a2,a3,a4:integer; var arr:newArr; var s:boolean);
begin
  if (a3<=a1) and (a1<=a4) then
  begin
    if (a4<a2) then                   // x2|x1|y2|y1
    begin
      s:= TRUE;
      arr[1]:=a1;
      arr[2]:=a4;
    end
    else                              // x1=x2|y1=y2 and x2|x1|y1|y2
      s:=TRUE;
      arr[1]:=a1;
      arr[2]:=a2;
  end
  else if (a1<=a3) and (a3<=a2) then
  begin
    if (a2<=a4) then                  // x1|x2|y1|y2
    begin
      s:= TRUE;
      arr[1]:=a3;
      arr[2]:=a2;
    end
    else                              // x1|x2|y2|y1
    begin
      s:= TRUE;
      arr[1]:=a3;
      arr[2]:=a4;
    end;
  end
  else
    s:= FALSE;                        // x1|y1|   |x2|y2
end;

begin
  s:=FALSE;
  write('vvedite koordinat - ');
  readln(a1);
  write('vvedite koordinat - ');
  readln(a2);
  write('vvedite koordinat - ');
  readln(a3);
  write('vvedite koordinat - ');
  readln(a4);
  otrezki(a1,a2,a3,a4,arr,s);
  if s then
  begin
    write('otrezok peresecheniya: ');
    writeArr(arr);
  end
  else
    writeln('otrezki ne peresekayutsya');
  readln();
end.