(PAS) Заданны отрезки. Определить есть ли точка принадлежащая всем отрезкам.

[dimokin777]

В общем начало немножко знаю , а потом непонятно. Помогите пожалуйста...

const n=3;
type point=record
      x,y:real;
      end;
     otr=record
      k1,k2:point;
      end;
var i:integer;
    t:array[1..n] of otr;
begin
writeln('Введите координаты отрезков:');
for i:=1 to n do
 begin
  writeln('Отрезок #',i);
  write('x1=');readln(t[i].k1.x);
  write('y1=');readln(t[i].k1.y);
  write('x2=');readln(t[i].k2.x);
  write('y2=');readln(t[i].k2.y);
end;

end.

[Serge_Bliznykov]

начало у Вас уже неправильное. Отрезки все "плоские = одномерные" и расположены НА ОДНОЙ оси.
Поэтому каждый отрезок характеризуется двумя координатами (X1 и X2 - если Вам так будет угодно). Никаких Y,Z и т.д.
я бы банально написал простенькую функцию, которая по переданным в неё 4-м координатам (две одного отрезка и две - другого) возвращает 2 координаты - отрезок, являющийся пересечением этих двух. Если пересечения нет - функция должна возвращать либо булевское значение, либо, например, координаты общего отрезка -1, -1

Берём 1-й и 2-й отрезки. получаем общий (пересечение) отрезок.
Для полученного отрезка берём 3-й и получаем общий (пересечение предыдущего общего и текущего отрезка).
Если на очередном этапе получаем -1 (или функция возвращает false) - всё. общих точек НЕТ!
Если дошли до конца - то полученный отрезок и есть ответ - значит существует точка, которая принадлежит всем отрезкам.

Внимание. Отрезок в данной задаче явно может вырождаться в ТОЧКУ! (это когда координата начала равна координате конца отрезка).

[dimokin777]

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

Берём 1-й и 2-й отрезки. получаем общий (пересечение) отрезок.

[dimokin777]

Ну вот начало , а дальше не пойму...

const n=3;
var i,x,k:integer;
    a,b:array[1..n] of real;
begin
for i:=1 to n do
begin
writeln('Введите начало ',i,' отрезка');
readln(a[i]);
writeln('Введите конец ',i,' отрезка');
readln (b[i]);
end;

[Rin]

G0_oGle знает всё=).
а ИМЕННО

[dimokin777]

а ИМЕННО

там Делфи..
Гугл то знает , вот только я не пойму как несколько отрезков проверять...

[Rin]

Есть 3 отрезка: первый, второй, третий.
Проверяем первый - второй. Есть пересечение - записываем рез-т в переменную и идём дальше, нет - конец задачи.
Проверяем первый - третий.Нет пересечения - конец задачи. Есть пересечение - Проверяем этот рез-т с рез-том "первый - второй". Равны - идём дальше, нет - конец задачи.
Проверяем второй - третий.Нет пересечения - конец задачи. Есть пересечение. Проверяем этот рез-т с рез-том "первый - третий". Равны - Есть пересечение трёх отрезков, не равны - злой рок значит.
Я сейчас изложил тоже самое, что написал Serge_Bliznykov, только своими словами.

там Делфи..

Delphi - это среда разработки, которая юзает язык "паскаль", так что смело бери тот код.

[Serge_Bliznykov]

const n=3;
type otrezok = record x1, x2 : integer; end;

function FindCommonCut(Otr1, Otr2 : otrezok; var CommonOtr : otrezok) : boolean;
begin
  if ((Otr1.x1>=Otr2.x1) and (Otr1.x1<=Otr2.x2))
     or ((Otr1.x2>=Otr2.x1) and (Otr1.x2<=Otr2.x2))
     or ((Otr2.x1>=Otr1.x1) and (Otr2.x1<=Otr1.x2))
     or ((Otr2.x2>=Otr1.x1) and (Otr2.x2<=Otr1.x2)) then  {есть пересечение!}
     begin
       FindCommonCut := true; 
       {проверка первый полностью во втором}
       if (Otr1.x1>=Otr2.x1) and (Otr1.x2<=Otr2.x2) then CommonOtr := Otr1
       else
       {проверка второй полностью во первом}
       if (Otr2.x1>=Otr1.x1) and (Otr2.x2<=Otr1.x2) then CommonOtr := Otr2
       else

       {первый левее второго, его окончание попадает частично во второй}
       if (Otr1.x1<Otr2.x1) and (Otr1.x2>=Otr2.x1) then begin
          CommonOtr.x1 := Otr2.x1;
          CommonOtr.x2 := Otr1.x2;
       end
       else

       {второй левее первого, и его окончание попадает частично в первый}
       if (Otr2.x1<Otr1.x1) and (Otr2.x2>=Otr1.x1) then begin
          CommonOtr.x1 := Otr1.x1;
          CommonOtr.x2 := Otr2.x2;
       end
       else {а вот если мы попали в эту ветку, значит какой-то вариант 
                взаимного пересечения не учли. 
                надо выдавать ошибку и анализировать его}
       begin
          WriteLn('Error! with data Otrezok 1: ',Otr1.x1,' ',Otr1.x2,
                   '  Otrezok 2: ',Otr2.x1,' ',Otr2.x2);
          WriteLn('program was aborted after Enter!');
          Readln;
          Halt;
       end;

     end
  else begin
     {пересечения НЕТ}
     FindCommonCut := false;
     CommonOtr.x1 := -1;
     CommonOtr.x2 := -1;
  end;
end;

var
   A : array[1..n] of otrezok;
   ComCut : otrezok;
   i : integer;
begin
  for i:=1 to n do
   begin
     repeat
       writeln('Введите начало и конец ',i,' отрезка');
       Readln(A[i].x1, A[i].x2);
       if  Not ((A[i].x1<=A[i].x2) 
        and (A[i].x1>=0) and (A[i].x1<=100)
        and (A[i].x2>=0) and (A[i].x2<=100)) then begin
          WriteLn('Ошибка ввода. Надо чтобы начало <= концу, обе границы от 0 до 100.')
        end;
     until (A[i].x1<=A[i].x2) 
        and (A[i].x1>=0) and (A[i].x1<=100)
        and (A[i].x2>=0) and (A[i].x2<=100);
   end;

  ComCut := A[1];
  i:=2;
  while (i<=n) and FindCommonCut(ComCut, A[i], ComCut) do
    inc(i);

  if ComCut.x1<0 then WriteLn('Пересечений нет!')
  else begin
    WriteLn('есть пересечения!');
    WriteLn('общий отрезок: ',ComCut.x1,' ', ComCut.x2);
  end;


  Readln;

end.

[dimokin777]

Сообщение от Serge_Bliznykov

const n=3;
type otrezok = record x1, x2 : integer; end;

function FindCommonCut(Otr1, Otr2 : otrezok; var CommonOtr : otrezok) : boolean;
begin
  if ((Otr1.x1>=Otr2.x1) and (Otr1.x1<=Otr2.x2))
     or ((Otr1.x2>=Otr2.x1) and (Otr1.x2<=Otr2.x2))
     or ((Otr2.x1>=Otr1.x1) and (Otr2.x1<=Otr1.x2))
     or ((Otr2.x2>=Otr1.x1) and (Otr2.x2<=Otr1.x2)) then  {есть пересечение!}
     begin
       FindCommonCut := true; 
       {проверка первый полностью во втором}
       if (Otr1.x1>=Otr2.x1) and (Otr1.x2<=Otr2.x2) then CommonOtr := Otr1
       else
       {проверка второй полностью во первом}
       if (Otr2.x1>=Otr1.x1) and (Otr2.x2<=Otr1.x2) then CommonOtr := Otr2
       else

       {первый левее второго, его окончание попадает частично во второй}
       if (Otr1.x1<Otr2.x1) and (Otr1.x2>=Otr2.x1) then begin
          CommonOtr.x1 := Otr2.x1;
          CommonOtr.x2 := Otr1.x2;
       end
       else

       {второй левее первого, и его окончание попадает частично в первый}
       if (Otr2.x1<Otr1.x1) and (Otr2.x2>=Otr1.x1) then begin
          CommonOtr.x1 := Otr1.x1;
          CommonOtr.x2 := Otr2.x2;
       end
       else {а вот если мы попали в эту ветку, значит какой-то вариант 
                взаимного пересечения не учли. 
                надо выдавать ошибку и анализировать его}
       begin
          WriteLn('Error! with data Otrezok 1: ',Otr1.x1,' ',Otr1.x2,
                   '  Otrezok 2: ',Otr2.x1,' ',Otr2.x2);
          WriteLn('program was aborted after Enter!');
          Readln;
          Halt;
       end;

     end
  else begin
     {пересечения НЕТ}
     FindCommonCut := false;
     CommonOtr.x1 := -1;
     CommonOtr.x2 := -1;
  end;
end;

var
   A : array[1..n] of otrezok;
   ComCut : otrezok;
   i : integer;
begin
  for i:=1 to n do
   begin
     repeat
       writeln('Введите начало и конец ',i,' отрезка');
       Readln(A[i].x1, A[i].x2);
       if  Not ((A[i].x1<=A[i].x2) 
        and (A[i].x1>=0) and (A[i].x1<=100)
        and (A[i].x2>=0) and (A[i].x2<=100)) then begin
          WriteLn('Ошибка ввода. Надо чтобы начало <= концу, обе границы от 0 до 100.')
        end;
     until (A[i].x1<=A[i].x2) 
        and (A[i].x1>=0) and (A[i].x1<=100)
        and (A[i].x2>=0) and (A[i].x2<=100);
   end;

  ComCut := A[1];
  i:=2;
  while (i<=n) and FindCommonCut(ComCut, A[i], ComCut) do
    inc(i);

  if ComCut.x1<0 then WriteLn('Пересечений нет!')
  else begin
    WriteLn('есть пересечения!');
    WriteLn('общий отрезок: ',ComCut.x1,' ', ComCut.x2);
  end;


  Readln;

end.

Спасибо огромное за решение , но ведь в заданий сказано найти не общий отрезок , а есть ли общая точка с целочисленными координатаМИ , насколько я понимаю все же нужно и Х и У.