ребята помогите пожалуйста с разработкой алгоритма и программы этой задачи:
Сначала покажи, что ответом всегда будет либо отрезок, соединяющий эти две точки (если он не пересекается с квадратом), либо путь вида первая_точка - вершина_квадрата - соседняя_с_ней_вершина - вторая точка.
Потом напиши процедуру, которая проверяет, имеет ли данный отрезок общие *внутренние* точки с квадратом.
Потом перебирай варианты. Что не ясно будет - спрашивай.
Обрати внимание:
в самом общем виде твой отрезок имеет 0, 1 или 2 точки
перегиба-и не больше!
Ответ Michael_Rybak'а является абсолютно полным и точным, но я боюсь, что он требует некоторого "разжевывания"..
1. Сделать функцию, возвращающую TRUE, если переданный ей отрезок НЕ имеет с квадратом общих точек. Заморачиваться с внутренностями (отсеивать касания границ) нет смысла, поскольку эти случаи так или иначе будут перечислены потом. Единственное, что важно - надо проверять на общие точки внутренность отрезка, а концы выпускать. Назовем такю функцию Clear(A,B), где А и В - точки, концы отрезка.
2. Если Clear(A,B) - все, задача решена. Ответ - отрезок АВ.
3. Min:=Len(А,В)*10; in:=0; jn:=0; (Len - это функция, возвращающая длину отрезка)
4. Цикл по всем вершинам квадрата (назову их Di, 1<=i<=4).
for i:=1 to 4 do if Clear(A,Di) and Clear(Di,B) and Len(A,Di)+Len(Di,B)<Min then in:=i;
(это не совсем паскалевский текст, индексы обозначены без скобок, дальше тоже так).
5. Если in>0 , то ответ - ломаная A-Din-B, выход.
6. Цикл по вершинам
for i:=1 to 4 do begin
if Clear(A,Di) and Clear(Di+1,B) and Len(A,Di)+Len(Di+1,B)<Min then begin
in:=i;
jn:=i+1
end;
if Clear(A,Di) and Clear(Di-1,B) and Len(A,Di)+Len(Di-1,B)<Min then begin
in:=i;
jn:=i-1
end
end;
Lapp, если тебе не трудно напиши мне код функции которая определяет проходит ли отрезок через квадрат или хотя бы напиши точную формулу если есть такова, а то я никак с этим не разберусь ...
Вот полное решение. Надеюсь на твою ответственность, Bard - ты разберешься с ним честно, не так ли?
Спрашивай, что непонятно. В основном оно следует тому алгоритму, что я приводил (с небольшими исправлениями).
Программа не очень хорошо протестирована, могут быть сбои.
PS
Меня не оставляет впечатление, что я перемудрил с функцией определения пересечения отрезка с квадратом. То есть ясно, что для вершин квадрата можно упростить, но я имею в виду общий случай. Я делал так: проверял, попадают ли проекции вершин квадрата на этот отрезок внутрь квадрата. Для этого афинно двигал квадрат так, чтоб отрезок лег на ось Х, проектировал туда вершины и двигал обратно - и затем проверял. Может, проще было бы искать пересечения со сторонами, как я раньше предлагал, но меня смутили возможные неопределенности (деления на нуль) - пришлось бы их избегать..
Кто что скажет?
{A thread around a square}
{by Lapp for Bard}
uses Graph;
const
MaxX=12;
MinX=-12;
MaxY=9;
MinY=-9;
type
tPoint=record
x,y:real;
s:String
end;
tSquare=array[1..4]of tPoint;
var
Min,Leng:real;
A,B,C:tPoint;
D:tSquare;
l,gd,gm,i,j,k,iMin,jMin:integer;
procedure Shift(var p:tPoint; sx,sy:real);
begin
with p do begin
x:=x+sx;
y:=y+sy
end
end;
procedure Rotate(var p:tPoint;t:real);
var
z:real;
begin
with p do begin
z:=x;
x:=x*cos(t)-y*sin(t);
y:=z*sin(t)+y*cos(t)
end
end;
procedure WritePoint(p:tPoint);
begin
with p do WriteLn(s,': x=',x:8:4,' y=',y:8:4)
end;
procedure SetPoint(var p:tPoint; ss:String; xx,yy:real);
begin
with p do begin
s:=ss; x:=xx; y:=yy
end
end;
function Xs(x:real):integer;
begin
Xs:=Round(GetMaxX*(x-MinX)/(MaxX-MinX))
end;
function Ys(y:real):integer;
begin
Ys:=GetMaxY-Round(GetMaxY*(y-MinY)/(MaxY-MinY))
end;
procedure ShowAxes;
var
i:integer;
begin
Line(Xs(MinX),Ys(0),Xs(MaxX),Ys(0));
Line(Xs(0),Ys(MinY),Xs(0),Ys(MaxY));
i:=Round(MinX);
while i<MaxX do begin
Line(Xs(i),Ys(0)-2,Xs(i),Ys(0)+2);
Inc(i)
end;
i:=Round(MinY);
while i<MaxY do begin
Line(Xs(0)-2,Ys(i),Xs(0)+2,Ys(i));
Inc(i)
end
end;
procedure ShowPoint(p:tPoint);
begin
with p do begin
Line(Xs(x),Ys(y),Xs(x),Ys(y));
OutTextXY(Xs(x)+3,Ys(y)-3,s)
end
end;
procedure ShowSquare(D:tSquare);
var
i:integer;
begin
with D[4] do MoveTo(Xs(x),Ys(y));
for i:=1 to 4 do with D[i] do begin
LineTo(Xs(x),Ys(y));
ShowPoint(D[i])
end
end;
procedure ShowLine(p1,p2:tPoint);
begin
Line(Xs(p1.x),Ys(p1.y),Xs(p2.x),Ys(p2.y))
end;
function Clear(M,N:tPoint;E:tSquare):boolean;
var
P:tPoint;
dx,dy,al:real;
i:integer;
Flag:boolean;
begin
if M.x>N.x then begin
P:=M; M:=N; N:=P
end;
dx:=N.x-M.x;
dy:=N.y-M.y;
if Abs(dx)>Abs(dy) then al:=ArcTan(dy/dx) else al:=Pi/2-ArcTan(dx/dy);
for i:=1 to 4 do Shift(E[i],-M.x,-M.y);
for i:=1 to 4 do Rotate(E[i],-al);
for i:=1 to 4 do E[i].y:=0;
for i:=1 to 4 do Rotate(E[i],al);
for i:=1 to 4 do Shift(E[i],M.x,M.y);
Flag:=false;
for i:=1 to 4 do with E[i] do
Flag:=Flag or
(M.x<x)and(x<N.x)and(C.x-l<x)and(x<C.x+l)and(C.y-l<y)and(y<C.y+l);
Clear:=not Flag
end;
function Len(p1,p2:tPoint):real;
begin
Len:=Sqrt(Sqr(p2.x-p1.x)+Sqr(p2.y-p1.y))
end;
begin
SetPoint(A,'A',1,-3);
SetPoint(B,'B',2,8);
SetPoint(C,'C',1,4);
l:=2;
with C do begin
SetPoint(D[1],'D1',x-l,y-l);
SetPoint(D[2],'D2',x-l,y+l);
SetPoint(D[3],'D3',x+l,y+l);
SetPoint(D[4],'D4',x+l,y-l)
end;
gd:=0;
InitGraph(gd,gm,'');
SetColor(LightGray);
ShowAxes;
SetColor(White);
ShowPoint(A);
ShowPoint(B);
ShowSquare(D);
SetColor(LightGreen);
if Clear(A,B,D) then ShowLine(A,B)
else begin
Min:=Len(A,B)*10;
iMin:=0;
for i:=1 to 4 do begin
Leng:=Len(A,D[i])+Len(D[i],B);
if Clear(A,D[i],D) and Clear(D[i],B,D) and (Leng<Min) then begin
iMin:=i;
Min:=Leng
end
end;
if iMin>0 then begin
ShowLine(A,D[iMin]);ShowLine(D[iMin],B)
end
else begin
iMin:=0;
jMin:=0;
for i:=1 to 4 do begin
j:=i mod 4+1;
Leng:=Len(A,D[i])+Len(D[j],B);
if Clear(A,D[i],D) and Clear(D[j],B,D) and (Leng<Min) then begin
iMin:=i;
jMin:=j;
Min:=Leng
end;
k:=i;i:=j;j:=k;
Leng:=Len(A,D[i])+Len(D[j],B);
if Clear(A,D[i],D) and Clear(D[j],B,D) and (Leng<Min) then begin
iMin:=i;
jMin:=j;
Min:=Leng
end;
end;
ShowLine(A,D[iMin]);ShowLine(D[iMin],D[jMin]);ShowLine(D[jMin],B)
end
end;
ReadLn
end.