Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ нить

Автор: Bard 23.05.2007 22:20

ребята помогите пожалуйста с разработкой алгоритма и программы этой задачи:
good.gif

Цитата

На плоскости расположены квадрат и 2 точки. Указанные точки не могут находиться внутри квадрата, а лежат вне или на его границе. Между точками нужно натянуть нить. Нить не может проходить внутри квадрата, она может лишь соприкасаться с его границей. Нить достаточно тонкая, и ее толщиной можно пренебречь.
Квадрат задан координатами центра (Xc,Yc) и координатами одной из вершин (Xv,Yv). Точки заданы своими координатами (Xa,Ya) и (Xb,Yb). Все числа Xc, Yc, Xv, Yv, Xa, Ya, Xb, Yb являются целыми и не превосходят по модулю 10000. Стороны квадрата параллельны осям координат. На рисунке представлены два примера натяжения нити минимальной длины. Пунктиром показано неверное натяжение нити.
Найти наименьшую длину нити.

Например если вводиться
0 0 -1 -1 -1 -2 2 1
То надо вывести
4.47


у кого есть идеи??? smile.gif


Эскизы прикрепленных изображений
Прикрепленное изображение

Автор: Michael_Rybak 24.05.2007 2:55

Сначала покажи, что ответом всегда будет либо отрезок, соединяющий эти две точки (если он не пересекается с квадратом), либо путь вида первая_точка - вершина_квадрата - соседняя_с_ней_вершина - вторая точка.

Потом напиши процедуру, которая проверяет, имеет ли данный отрезок общие *внутренние* точки с квадратом.

Потом перебирай варианты. Что не ясно будет - спрашивай.

Автор: Чужак 24.05.2007 4:02

Обрати внимание:
в самом общем виде твой отрезок имеет 0, 1 или 2 точки
перегиба-и не больше!

Автор: Lapp 24.05.2007 11:18

Ответ Michael_Rybak'а является абсолютно полным и точным, но я боюсь, что он требует некоторого "разжевывания".. smile.gif

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;


7. Ответ - ломаная A-Din-Djn-B

Вот, примерно, так.. smile.gif

Автор: Bard 24.05.2007 20:30

Цитата

1. Сделать функцию, возвращающую TRUE, если переданный ей отрезок НЕ имеет с квадратом общих точек. Заморачиваться с внутренностями (отсеивать касания границ) нет смысла, поскольку эти случаи так или иначе будут перечислены потом. Единственное, что важно - надо проверять на общие точки внутренность отрезка, а концы выпускать. Назовем такю функцию Clear(A,B), где А и В - точки, концы отрезка.


А каким методом или формулой мне это написать? blink.gif

И еще я не понял какую же работу выполняет 4-й пункт?

Автор: Lapp 25.05.2007 11:29

Цитата(Bard @ 24.05.2007 17:30) *

А каким методом или формулой мне это написать? blink.gif
Например, можно смотреть пересечения со сторонами квадрата, как с отрезками. Достаточно отслеживать три любые стороны. Про пересечение отрезков было, например, тут: http://forum.pascal.net.ru/index.php?s=&showtopic=16693&view=findpost&p=98157 . Но здесь должно быть проще, так как стороны параллельны осям.
Цитата(Bard @ 24.05.2007 17:30) *

И еще я не понял какую же работу выполняет 4-й пункт?
Он проверяет на касание только одной вершины (как в первой картинке на твоем рисунке). В принципе, можно включить это во второй цикл, но тогда придется делать специальный признак для распознавания, одна вершина или две..

Автор: Bard 25.05.2007 14:59

Lapp, если тебе не трудно напиши мне код функции которая определяет проходит ли отрезок через квадрат mega_chok.gif или хотя бы напиши точную формулу если есть такова, а то я никак с этим не разберусь blink.gif ...

Автор: Lapp 26.05.2007 15:35

Вот полное решение. Надеюсь на твою ответственность, Bard - ты разберешься с ним честно, не так ли? smile.gif
Спрашивай, что непонятно. В основном оно следует тому алгоритму, что я приводил (с небольшими исправлениями).
Программа не очень хорошо протестирована, могут быть сбои.

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.