• Спасите наши души
  SOS
  
  Условие  Комментарии  Решение  Тестовые файлы  Оглавление

Описание
В океане в точке с координатами (x,y) потерпел крушение корабль. Недалеко от места катастрофы находится остров, имеющий форму N-угольника (не обязательно выпуклого). Спасшиеся после кораблекрушения пассажиры оказались в спасательной шлюпке, которая может двигаться относительно воды в любом направлении со скоростью, не превосходящей V. В процессе движения шлюпка может менять как направление, так и величину своей скорости

В океане имеется постоянное течение, вектор скорости которого - (VT_x,VT_y). Тем самым, вектор скорости шлюпки относительно земли определяется как сумма вектора скорости течения (VT_x,VT_y) и вектора скорости шлюпки относительно воды (V_x,V_y)

Задание
Требуется найти минимальное время, за которое шлюпка сможет добраться до острова, либо определить, что из-за сильного течения это невозможно


Входные данные
Входной файл содержит (в указанном порядке) следующие данные: координаты (x,y) места крушения, количество вершин острова N (3≤N≤50), координаты вершин острова, заданные в порядке обхода острова по часовой стрелке (2N чисел), максимальную скорость спасательной шлюпки V (V>0) и вектор скорости течения (VT_x,VT_y). Все числа во входном файле, кроме N, являются вещественными и разделяются пробелами и/или символами перевода строки

Выходные данные
Выведите в выходной файл искомое время не менее чем с 6 верными значащими цифрами. Если шлюпка до острова доплыть не сможет, выходной файл должен содержать сообщение "добраться невозможно"


Например:

SOS.IN
4 3
3
0 0 0 3 3 0
2 1 1

SOS.OUT
4.828427





Комментарии
Геометрическое место точек, где может оказаться шлюпка через время t, представляет собой расширяющийся круг радиуса V·t, плывущий по направлению течения со скоростью (VT_x,VT_y). Нас интересует первый момент времени, в который этот круг коснется заданного N-угольника. Ясно, что он может коснуться либо его вершины, либо его стороны. Первый случай соответствует высадке людей из шлюпки в вершине острова, второй - на стороне острова. Понятно, что для минимизации времени шлюпка должна плыть с максимальной собственной скоростью V не меняя направления движения

В случае высадки в вершине острова скорость шлюпки относительно земли должна быть направлена на данную вершину. Надо учесть, что, в общем случае, не до всех вершин можно доплыть, так как при малой собственной скорости шлюпки рассматриваемый круг может проплыть мимо них

В случае высадки на стороне острова необходимо направить собственную скорость шлюпки перпендикулярно данной стороне (покажите это!). Здесь возможен случай, что шлюпку снесет течением, и она пройдет мимо этой стороны острова. В таком случае вариант высадки на этой стороне не рассматривается. Тем самым, для решения задачи необходимо рассмотреть все возможные варианты высадки и выбрать тот из них, который минимизирует затрачиваемое время




Решение

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X+}
{$M 65520,0,655360}

program sos;
uses crt;
const
 eps=0.000000001;
type
 pointtype=record
                 x,y:real;
           end;
 linetype=record
           a,b,c:real;
           x1,x2,y1,y2:real;
          end;
 ntype=record
        h:array[1..51] of pointtype;
        n:integer;
        f:boolean;
       end;
var
 a:ntype;
 l:array[1..51] of pointtype;
 na:integer;
 p:pointtype;
 i:integer;
 ss,v,xt,yt:real;
 t:pointtype;
 mintime:real;
 mint:boolean;

procedure makeabc(var p:linetype);
begin
 with p do
  begin
   a:=y1-y2;
   b:=x2-x1;
   c:=x1*y2-x2*y1;
  end;
end;

function r(r1,r2:real):boolean;
begin
 if (r1>=r2*(1-eps)) and (r1<=r2*(1+eps)) then r:=true
                                        else r:=false;
end;

function twoline(p1,p2:linetype;var s:pointtype):boolean;
var
 d:real;
begin
 d:=p1.a*p2.b-p1.b*p2.a;
 if r(d,0) then
  twoline:=false
                           else
  begin
   with s do
    begin
     x:=-(p1.c*p2.b-p2.c*p1.b)/d;
     y:=-(p1.a*p2.c-p2.a*p1.c)/d;
    end;
  end;
end;

procedure swap(var i,j:real);
var
 c:real;
begin
 c:=i;
 i:=j;
 j:=c;
end;

procedure sortx(var p:linetype);
begin
 with p do
  if x1>x2 then
   swap(x1,x2);
end;

procedure sorty(var p:linetype);
begin
 with p do
  if y1>y2 then
   swap(y1,y2);
end;

function pointotr(p:linetype;s:pointtype):boolean;
var
 f:boolean;
begin
 makeabc(p);
 f:=true;
 with p do
  begin
   sortx(p);
   if not ((x1-abs(x1*eps)<=s.x) and (x2+abs(x2*eps)>=s.x)) then
    f:=false;
   sorty(p);
   if not ((y1-abs(y1*eps)<=s.y) and (y2+abs(y2*eps)>=s.y)) then
    f:=false;
  end;
 pointotr:=f;
end;

function lineotr(p1,p2:linetype;var s:pointtype):boolean;
begin
 if twoline(p1,p2,s) then
  if pointotr(p2,s) then
   begin
    lineotr:=true;
    exit;
   end;
 lineotr:=false;
end;

procedure perpen(p:linetype;s:pointtype;var l:linetype);
var
 k:pointtype;
begin
 makeabc(p);
 with l do
  begin
   x1:=s.x;
   y1:=s.y;
   a:=-p.b;
   b:=p.a;
   c:=-(a*x1+b*y1);
   if not twoline(l,p,k) then
    begin
     writeln('Error in perpen');
     halt;
    end;
    x2:=k.x;
    y2:=k.y;
  end;
end;

function twootr(p1,p2:linetype;var s:pointtype):boolean;
var
 i,j:integer;
begin
 makeabc(p1);
 makeabc(p2);
 if twoline(p1,p2,s)=false then
  twootr:=false
                           else
  begin
   if (pointotr(p1,s) and pointotr(p2,s)) then
    twootr:=true
                                            else
    twootr:=false;
  end;
end;

function updown(p:linetype;s:pointtype):boolean;{( + = )-true ( - )-false}
var
 i,j:integer;
 d:real;
begin
 makeabc(p);
 with p do
  d:=(a*s.x+b*s.y+c)/sqrt(a*a+b*b);
 if d<0 then
  updown:=false
        else
  updown:=true;
end;

function s3(p1,p2,p3:pointtype):real;
begin
 s3:=1/2*((p1.x-p3.x)*(p2.y-p3.y)-(p2.x-p3.x)*(p1.y-p3.y));
end;

function sn(p:ntype):real;
var
 i,j:integer;
 pp:pointtype;
 s:real;
begin
 pp.x:=0;
 pp.y:=0;
 s:=0;
 for i:=1 to p.n do
  begin
   if i<>p.n then
    s:=s+s3(pp,p.h[i],p.h[i+1])
             else
    s:=s+s3(pp,p.h[i],p.h[1]);
  end;
 sn:=s;
end;

procedure makeline(p1,p2:pointtype;var ll:linetype);
begin
 ll.x1:=p1.x;
 ll.y1:=p1.y;
 ll.x2:=p2.x;
 ll.y2:=p2.y;
 makeabc(ll);
end;

function pointandotr(p:linetype;s:pointtype):boolean;
var
 d:real;
begin
 makeabc(p);
 if pointotr(p,s)=false then
  begin
   pointandotr:=false;
   exit;
  end;
 with p do
  d:=(a*s.x+b*s.y+c)/sqrt(a*a+b*b);
 if abs(d)then
  pointandotr:=true
        else
  pointandotr:=false;
end;
procedure delown(var p:ntype);
var
 k,i,j,i1,i2:integer;
 ll:linetype;
label
 begfor;
begin
 begfor:
 for i:=1 to p.n do
  begin
   i1:=i;
   if i<>p.n then
    begin
     makeline(p.h[i],p.h[i+1],ll);
     i2:=i+1;
    end
             else
    begin
     makeline(p.h[i],p.h[1],ll);
     i2:=1;
    end;
   for j:=1 to p.n do
    if (j<>i1) and (j<>i2) and (pointandotr(ll,p.h[j])) then
     begin
      dec(p.n);
      for k:=j to p.n do
       p.h[k]:=p.h[k+1];
      goto begfor;
     end;
  end;
end;

procedure sortxy(var p:ntype);
var
 s:set of byte;
 l:ntype;
 allgood,f,ftek,ans,fend:boolean;
 ntek,j,i,last:integer;
 ll:linetype;
begin
 s:=[];
 l:=p;
 s:=[1];
 last:=1;
 ntek:=1;
 allgood:=true;
 while allgood do
  begin
   allgood:=false;
   i:=1;
   while (i<>p.n+1) and (not allgood) do
    if not (i in s) then
     begin
      ans:=true;
      fend:=true;
      for j:=1 to p.n do
       if (j<>i) and (j<>last) then
        begin
         ll.x1:=p.h[last].x;
         ll.y1:=p.h[last].y;
         ll.x2:=p.h[i].x;
         ll.y2:=p.h[i].y;
         ftek:=updown(ll,p.h[j]);
         if ans then
          f:=ftek
                else
          if f<>ftek then
           fend:=false;
         ans:=false;
        end;
      allgood:=fend;
      if fend=false then
       inc(i);
     end
       else
     inc(i);
    if allgood then
     begin
      last:=i;
      s:=s+[i];
      inc(ntek);
      l.h[ntek]:=p.h[i];
     end;
  end;
 p:=l;
end;

procedure makes;
var
 i,j,k,i1,i2,j2,j1:integer;
 s:pointtype;
 tim,h1,h2,h,cos1,cos2,sin1,sin2,d,dd,vx,vy,tt:real;
 l1,l2,l3,l4:linetype;
 f:boolean;
label
 beg,endfor;
begin
 mint:=false;
 mintime:=1e38;
 for i:=1 to a.n do
  begin
   l1.x1:=a.h[i].x;
   l1.y1:=a.h[i].y;
   i1:=i;
   f:=true;
   if i=a.n then
    i2:=1
            else
    i2:=i+1;
   l1.x2:=a.h[i2].x;
   l1.y2:=a.h[i2].y;
   perpen(l1,t,l2);
   for j:=1 to a.n do
    if j<>i1 then
     begin
      j1:=j;
      if j=a.n then
       j2:=1
               else
       j2:=j+1;
      l3.x1:=a.h[j1].x;
      l3.y1:=a.h[j1].y;
      l3.x2:=a.h[j2].x;
      l3.y2:=a.h[j2].y;
      makeabc(l3);
      makeabc(l2);
      if twootr(l2,l3,s) then
       f:=false;
     end;
   if f then
    begin
     with l2 do
      begin
       d:=sqrt((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2));
       if pointandotr(l1,t) then
        begin
         mintime:=0;
         mint:=true;
         exit;
        end;
       if r(d,0) then
        goto beg;
       vx:=(x2-x1)/d*v+xt;
       vy:=(y2-y1)/d*v+yt;
       l4.x1:=x1;
       l4.y1:=y1;
       l4.x2:=x1+vx;
       l4.y2:=y1+vy;
      end;
     makeabc(l4);
     makeabc(l1);
     if lineotr(l4,l1,s) then
      begin
       dd:=sqrt((t.x-s.x)*(t.x-s.x)+(t.y-s.y)*(t.y-s.y));
       tt:=dd/sqrt(vx*vx+vy*vy);
       if ttthen
        begin
         mintime:=tt;
         mint:=true;
        end;
      end;
    end;
   beg:
  end;
 for i:=1 to a.n do
  begin
   if ((sqrt(sqr(t.x-a.h[i].x)+sqr(t.y-a.h[i].y))*sqrt(xt*xt+yt*yt)))<>0 then
    cos1:=((a.h[i].x-t.x)*xt+(a.h[i].y-t.y)*yt)/(((sqrt(sqr(t.x-a.h[i].x)+sqr(t.y-a.h[i].y))*sqrt(xt*xt+yt*yt))))
                                                                          else
    cos1:=1;
   h1:=cos1*sqrt(xt*xt+yt*yt);
   sin1:=sqrt(1-cos1*cos1);
   h:=sin1*sqrt(xt*xt+yt*yt);
   if h>=v then
    goto endfor;
   sin2:=h/v;
   cos2:=sqrt(1-sin2*sin2);
   h2:=cos2*v;
   if h1+h2=0 then
    goto endfor;
   tim:=sqrt(sqr(a.h[i].x-t.x)+sqr(a.h[i].y-t.y))/(h1+h2);
   if (tim>0) and (timthen
    begin
     mintime:=tim;
     mint:=true;
    end;
   endfor:
  end;
end;

procedure writefile;
var
 f:text;
begin
 assign(f,'sos.in');
 append(f);
 if mint then
  writeln(f,mintime:6:6)
         else
  writeln(f,'добраться невозможно');
 close(f);
end;

procedure readfile;
var
 i,j,n:integer;
 f,f1:text;
begin
 assign(f,'sos.out');
 reset(f);
 read(f,t.x,t.y);
 read(f,a.n);
 for j:=1 to a.n do
  read(f,a.h[j].x,a.h[j].y);
 read(f,v);
 readln(f,xt,yt);
 makes;
 writefile;
 close(f);
end;

function pointn(p:ntype;s:pointtype):boolean;
var
 i,j:integer;
 f:boolean;
 ll:linetype;
begin
 f:=true;
 for i:=1 to p.n-2 do
  begin
   makeline(p.h[i],p.h[i+1],ll);
   if updown(ll,s)<>updown(ll,p.h[i+2]) then
    begin
     pointn:=false;
     exit;
    end;
  end;
 makeline(p.h[p.n-1],p.h[p.n],ll);
 if updown(ll,s)<>updown(ll,p.h[1]) then
  begin
   pointn:=false;
   exit;
  end;
 makeline(p.h[p.n],p.h[1],ll);
 if updown(ll,s)<>updown(ll,p.h[2]) then
  begin
   pointn:=false;
   exit;
  end;
 pointn:=true;
end;

procedure makeoutput;
var
 f:text;
begin
 assign(f,'sos.out');
 rewrite(f);
 close(f);
end;

begin
 makeoutput;
 readfile;
end.

 

© Особенности национальных задач по информатике