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

Primary tabs

Submitted by nglag on Wed, 11/24/2021 - 16:22

Forums:

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

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

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

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

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

Type
segment = array[1..100]of integer;
var i:integer;
a,b,s:segment;
f:boolean;
Procedure intersection(a1,b1,a2,b2: integer; var s:segment; var f1:boolean);
var i,s1,s2: integer;
begin
  a[1]:= a1;
  b[1]:= b1;
  a[2]:= a2;
  b[2]:= b2;
  s1:=a[1];
  s2:=b[1];

  for i:=1 to 2 do
  begin
    if a[i]>s1 then
    s1:=a[i];
  if b[i]<s2 then
    s2:=b[i];
  s[1]:=s1;
  s[2]:=s2;
     end;
  f1:=true;

  for i:=1 to 2 do
  begin
    if s1>b[i]then
      f1:=false;
    if s2<a[i]then
      f1:=false;
  end;
 end;

 begin
   for i:=1 to 2 do
   begin
     writeln('Enter the ends of the segment');
     readln(a[i],b[i]);
   end;
   intersection(a[1],b[1],a[2],b[2], s, f);
   if f then
     writeln('Yes! Segment of the intersection: ',s[1],' - ',s[2])
   else
     writeln('no intersection');
   readln();
end.
  • Log in to post comments
  • 2286 reads
vedro-compota's picture

vedro-compota

Wed, 11/24/2021 - 18:17 

  a[1]:= a1;
  b[1]:= b1;
  a[2]:= a2;
  b[2]:= b2;

--лишняя перестройка, можно сразу работать с числами по-идее

2) форматирование

3) 

s1:=a[1];
  s2:=b[1];
 
  for i:=1 to 2 do
  begin
    if a[i]>s1 then
    s1:=a[i];
  if b[i]<s2 then
    s2:=b[i];
  s[1]:=s1;
  s[2]:=s2;
     end;

- в первой итерации условия точно не выполнять, а значит присваивание :

  s[1]:=s1;
  s[2]:=s2;

можно провести до цикла

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

nglag

Mon, 11/29/2021 - 11:36

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

type
segment = array[1..2]of integer;

var i:integer;
a,          // правые координаты сегментов
b,          // левые координаты сегментов
s:segment;  // искомый сегмента пересечения
f:boolean;
Procedure intersection(var a,b,s:segment; var f1:boolean);
var i,x,y: integer;
begin
  x:=a[1]; // правая граница сегмента пересечения
  y:=b[1]; // левая граница сегмента пересечения

  for i:=1 to 2 do
  begin
    if a[i] > x then
      x:= a[i];
    if b[i] < y then
      y:= b[i];
  end;

  f1:=true;
  s[1]:= x;
  s[2]:= y;

  for i:=1 to 2 do
  begin
    if x > b[i]then
      f1:= false;
    if y < a[i]then
      f1:= false;
  end;
 end;

 begin
   for i:=1 to 2 do
   begin
     writeln('Enter the ends of the segment');
     readln(a[i],b[i]);
   end;
   intersection(a,b,s,f);
   if f then
     writeln('Yes! Segment of the intersection: ',s[1],' - ',s[2])
   else
     writeln('No intersection');
   readln();
end.
vedro-compota's picture

vedro-compota

Sun, 12/05/2021 - 13:44

1)

Procedure intersection(var a,b,s:segment; var f1:boolean);

- то что не собираемся менять лучше передавать по значению

2)


  x:=a[1]; // правая граница сегмента пересечения
  y:=b[1]; // левая граница сегмента пересечения
 
  for i:=1 to 2 do
  begin
    if a[i] > x then
      x:= a[i];
    if b[i] < y then
      y:= b[i];
  end;

-- в первой итерации оба if всегда вернут false, значит она вообще не нужно

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

nglag

Mon, 12/06/2021 - 08:50 

type
segment = array[1..2]of integer;

var i:integer;
a,          // правые координаты сегментов
b,          // левые координаты сегментов
s:segment;  // искомый сегмента пересечения
f:boolean;
Procedure intersection( a,b:segment; var s:segment; var f1:boolean);
var i,x,y: integer;
begin
  x:=a[1]; // правая граница сегмента пересечения
  y:=b[1]; // левая граница сегмента пересечения

  for i:=2 to 2 do
  begin
    if a[i] > x then
      x:= a[i];
    if b[i] < y then
      y:= b[i];
  end;

  f1:=true;
  s[1]:= x;
  s[2]:= y;

  for i:=1 to 2 do
  begin
    if x > b[i]then
      f1:= false;
    if y < a[i]then
      f1:= false;
  end;
 end;

 begin
   for i:=1 to 2 do
   begin
     writeln('Enter the ends of the segment');
     readln(a[i],b[i]);
   end;
   intersection(a,b,s,f);
   if f then
     writeln('Yes! Segment of the intersection: ',s[1],' - ',s[2])
   else
     writeln('No intersection');
   readln();
end.