Question

Dany tochki A,B,S,D s swoimy koordinatami (x1,y1),(x2,y2),(x3,y3),(x4,y4).Sostawit programmu na yazyke Paskal.Peresekayetsya li otrezki AB i SD

Answer 1

Відповідь:

program intersects;

function intersects(x1, y1, x2, y2, x3, y3, x4, y4: real): boolean;

begin

 // Вычисляем коэффициенты и свободный член линейных уравнений

 // для отрезков AB и SD

 var a1, b1, c1, a2, b2, c2: real;

 a1 := y1 - y2;

 b1 := x2 - x1;

 c1 := x1 * y2 - x2 * y1;

 a2 := y3 - y4;

 b2 := x4 - x3;

 c2 := x3 * y4 - x4 * y3;

 var x, y: real;

 x := (c1 * b2 - c2 * b1) / (a1 * b2 - a2 * b1);

 y := (c1 * a2 - c2 * a1) / (b1 * a2 - b2 * a1);

var min_x1, max_x1, min_y1, max_y1: real;

 var min_x2, max_x2, min_y2, max_y2: real;

 if x1 < x2 then begin

   min_x1 := x1;

   max_x1 := x2;

 end else begin

   min_x1 := x2;

   max_x1 := x1;

 end;

 if y1 < y2 then begin

   min_y1 := y1;

   max_y1 := y2;

 end else begin

   min_y1 := y2;

   max_y1 := y1;

 end;

 if x3 < x4 then begin

   min_x2 := x3;

   max_x2 := x4;

 end else begin

   min_x2 := x4;

   max_x2 := x3;

 end;

 if y3 < y4 then begin

   min_y2 := y3;

   max_y2 := y4;

 end else begin

   min_y2 := y4;

   max_y2 := y3;

 end;

 

 intersects := (min_x1 <= x <= max_x1) and (min_y1 <= y <= max_y1) and

               (min_x2 <= x <= max_x2) and (min_y2 <= y <= max_y2);

end;

begin

 // Проверяем, пересекаются ли отрезки AB и SD

 writeln(intersects(0, 0, 2, 2, 2, 0, 0, 2)); // да

 writeln(intersects(0, 0, 2, 2, 2, 0, 3, 3)); // нет

 writeln(intersects(0, 0, 2, 2, 3, 3, 4, 4)); // нет

 writeln(intersects(0, 0, 2, 2, 1, 1, 3, 3)); // да

end.

Пояснення:

Answer 2

Вот пример программы на языке Pascal, которая проверяет, пересекаются ли отрезки AB и SD на плоскости:

pascalCopy code
program CheckSegmentIntersection;

type
  Point = record
    x, y: Real;
  end;

function IsOnSegment(p: Point; q: Point; r: Point): Boolean;
begin
  Result := (q.x <= Max(p.x, r.x)) and (q.x >= Min(p.x, r.x)) and
            (q.y <= Max(p.y, r.y)) and (q.y >= Min(p.y, r.y));
end;

function Orientation(p: Point; q: Point; r: Point): Integer;
var
  val: Real;
begin
  val := (q.y - p.y) * (r.x - q.x) - (q.x - p.x) * (r.y - q.y);
  
  if val = 0 then
    Result := 0  // точки p, q и r лежат на одной прямой
  else if val > 0 then
    Result := 1  // обход точек p, q, r - против часовой стрелки
  else
    Result := 2; // обход точек p, q, r - по часовой стрелке
end;

function DoSegmentsIntersect(A: Point; B: Point; S: Point; D: Point): Boolean;
var
  o1, o2, o3, o4: Integer;
begin
  o1 := Orientation(A, B, S);
  o2 := Orientation(A, B, D);
  o3 := Orientation(S, D, A);
  o4 := Orientation(S, D, B);
  
  // Общий случай пересечения
  if (o1 <> o2) and (o3 <> o4) then
    Result := True
  else if (o1 = 0) and IsOnSegment(A, S, B) then // Сегмент AB и SD лежат на одной прямой и пересекаются по точке S
    Result := True
  else if (o2 = 0) and IsOnSegment(A, D, B) then // Сегмент AB и SD лежат на одной прямой и пересекаются по точке D
    Result := True
  else if (o3 = 0) and IsOnSegment(S, A, D) then // Сегмент SD и AB лежат на одной прямой и пересекаются по точке A
    Result := True
  else if (o4 = 0) and IsOnSegment(S, B, D) then // Сегмент SD и AB лежат на одной прямой и пересекаются по точке B
    Result := True
  else
    Result := False;
end;

var
  A, B, S, D: Point;
  intersect: Boolean;
  
begin
  // Ввод координат точек A, B, S, D
  WriteLn('Введите координаты точки A:');
  ReadLn(A.x, A.y);
  WriteLn('Введите координаты точки B:');
  ReadLn(B.x, B.y);
  WriteLn('Введите координаты точки S:');
  ReadLn(S.x, S.y);
  WriteLn('Введите координаты