нить, задача на расстояние Опции

[Bard]

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

На плоскости расположены квадрат и 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

у кого есть идеи???

Сообщение отредактировано: Bard - 23.05.2007 18:25

[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.