• Вписанный, описанный и записанный
  MILITARY
  
  Условие  Комментарии  Решение  Тестовые файлы  Оглавление

Описание
Военный полигон имеет форму N-угольника и обнесен по границе забором. Военные изобрели атомную бомбу очередного поколения и намереваются провести испытания этого нового вида оружия. Узнав о планах «зеленых» помешать испытаниям, главнокомандующий приказал установить сверхсовременный пеленгатор, обнаруживающий посторонних в радиусе его действия

У военных есть вполне естественное желание взорвать как можно более мощную атомную бомбу. При этом заместитель командира части по тылу настаивает, что забор полигона должен остаться целым. Тот же самый рачительный зам. по тылу хочет сэкономить как можно больше денег на электроэнергии, установив пеленгатор минимального радиуса действия, контролирующий весь полигон. Чтобы его не украли «зеленые», пеленгатор нужно установить на территории полигона

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


Входные данные
Входной файл содержит вещественные координаты вершин N-угольника (1≤N≤50), записанные в порядке обхода по (или против) часовой стрелки

Выходные данные
Запишите в выходной файл искомые координаты и радиусы действия в соответствии с форматом, приведенным в примере


Например:

MILITARY.IN
0 0
10 0
10 10
0 10

MILITARY.OUT
Установить пеленгатор в точке (5, 5) радиусом действия 7.0710678
Взорвать бомбу в точке (5, 5) радиусом действия 5.0000000





Комментарии
Задача авторами не комментировалась

Решение

{$A+,B-,D+,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}
{$M 63384,0,655360}
 
program Military;
const Infinity = 1e+40;
      eps = 1e-9;
type float = double;
     TPoint=record
              x,y:float;
            end;
     TLine=record
            a,b,c:float;
           end;
    TPLine=record
            p1,p2:TPoint;
           end;
   TCircle=record
            o:TPoint;
            r:float;
           end;
var n: integer;
    p: array [0..100] of TPoint;
    l: array [0..100] of TLine;
 time: longint absolute $0000:$046C;
   ts: longint;
 minr: float;
 maxr: float;
 minc: TCircle;
 maxc: TCircle;
 tp: TPoint;
 tmp: TCircle;
  er: boolean;
 
procedure WriteCircle (var c: TCircle);
begin
  writeln('(',c.o.x:7:7,', ',c.o.y:7:7,') радиусом действия ',c.r:7:7);
end;
 
function Less (a, b: float): boolean;
begin
  Less := (b-a) > eps;
end;
 
function eq (a, b: float): boolean;
begin
  eq := abs(b-a) <= eps;
end;
 
procedure ReadAll;
begin
  n := 0;
  assign (input, 'military.in'); reset (input);
  while not seekeof (input) do
  begin
    inc (n);
    read (p[n].x, p[n].y);
  end;
  close (input);
  p[n+1] := p[1];
end;
 
procedure InitLine(var p1,p2:TPoint;var l:TLine);
var q: float;
begin
  l.a:=p1.y-p2.y;
  l.b:=p2.x-p1.x;
  l.c:=p1.x*p2.y-p2.x*p1.y;
  q := sqrt(sqr(l.a) + sqr (l.b));
  l.a := l.a/q;
  l.b := l.b/q;
  l.c := l.c/q;
end;
 
procedure PrepareData;
var i, j: integer;
begin
  for i := 1 to n do
    InitLine (p[i], p[i+1], l[i]);
end;
 
procedure Serp(var p1,p2:TPoint;var l:TLine);
begin
  l.a:=2*(p1.x-p2.x);
  l.b:=2*(p1.y-p2.y);
  l.c:=sqr(p2.x)+sqr(p2.y)-sqr(p1.x)-sqr(p1.y);
end;
 
procedure LL_Intersection(var l1,l2:TLine;var p:TPoint);
var d:float;
begin
  d:=l1.a*l2.b-l2.a*l1.b;
  if d=0 then begin er:=true;exit;end else er:=false;
  p.x:=-(l1.c*l2.b-l2.c*l1.b)/d;
  p.y:=-(l1.a*l2.c-l2.a*l1.c)/d;
end;
 
function PP_Distance(var p1,p2:TPoint):float;
begin
    PP_Distance:=sqrt(sqr(p1.x-p2.x)+sqr(p1.y-p2.y));
end;
 
procedure InitCircle(var p1,p2,p3:TPoint;var c:TCircle);
var h1,h2:Tline;
begin
  SerP(p1,p2,h1);
  SerP(p3,p2,h2);
  LL_Intersection(h1,h2,c.o);
  if not er then c.r:= PP_Distance(c.o,p1);
end;
 
function PointInPoly (var pp: TPoint): boolean;
var i, h: integer;
    q, xx, yy: float;
begin
  h := 0;
  xx := pp.x; yy := pp.y;
  for i := 1 to n do
  begin
    if (p[i].x > xx+eps) and (p[i+1].x > xx+eps) then continue;
    if (p[i].y < yy+eps) and (p[i+1].y < yy+eps) then continue;
    if (p[i].y > yy+eps) and (p[i+1].y > yy+eps) then continue;
    if p[i].y = p[i+1].y then continue;
    q := p[i].x + (p[i+1].x-p[i].x)/(p[i+1].y-p[i].y) * (yy-p[i].y);
    if q < xx-eps then inc (h);
  end;
  if h mod 2 = 1 then PointInPoly := true else PointInPoly := false;
end;
 
procedure OutThem;
begin
  assign (output, 'military.out'); rewrite (output);
  write('Установить пеленгатор в точке ');
  WriteCircle (MinC);
  write('Взорвать бомбу в точке ');
  WriteCircle (MaxC);
  close (output);
  halt;
end;
 
procedure TryMin (CheckIn: boolean);
var i: integer;
    r2: float;
begin
  if time-ts > 340 then OutThem;
  if tmp.r > MinR then exit;
  if CheckIn then if not PointInPoly (tmp.o) then exit;
  r2 := sqr(tmp.r);
  for i := 1 to n do
    if (sqr(p[i].x-tmp.o.x)+sqr(p[i].y-tmp.o.y)) > r2+eps then exit;
  MinC := tmp;
  MinR := tmp.r;
end;
 
procedure Proj (var p: TPoint; var l: TLine; var res: TPoint);
var d: float;
begin
  d := sqr (l.a) + sqr (l.b);
  res. x := ((l.b * p.x - l.a * p.y) * l.b - l.a * l.c) / d;
  res. y := (- l.b * l.c - (l.b * p.x - l.a * p.y) * l.a) / d;
end;
 
function OnSide (var pp:TPoint; a: integer): boolean; {???}
begin
  OnSide := false;
  if Less (pp.x, p[a].x) and Less (pp.x, p[a+1].x) then exit;
  if Less (pp.y, p[a].y) and Less (pp.y, p[a+1].y) then exit;
  if Less (p[a].x, pp.x) and Less (p[a+1].x, pp.x) then exit;
  if Less (p[a].y, pp.y) and Less (p[a+1].y, pp.y) then exit;
  OnSide := true;
end;
 
procedure TaskP;
var i, j, k: integer;
    ll: TLine;
begin
  Minr := Infinity;
  for i := 1 to n-2 do
    for j := i+1 to n-1 do
      for k := j+1 to n do
      begin
        InitCircle (p[i], p[j], p[k], tmp);
        if not er then TryMin(true);
      end;
  for i := 1 to n-1 do
    for j := i+1 to n do
    begin
      tmp.o.x := (p[i].x+p[j].x)/2;
      tmp.o.y := (p[i].y+p[j].y)/2;
      tmp.r := sqrt(sqr(p[i].x-p[j].x) + sqr(p[i].y-p[j].y))/2;
      TryMin(true);
    end;
  for i := 1 to n-2 do
    for j := i+1 to n-1 do
    begin
      SerP (p[i], p[j], ll);
      for k := 1 to n do
      begin
        LL_Intersection (ll, l[k], tmp.o);
        if (p[k].x*ll.a+p[k].y*ll.b+ll.c) *
           (p[k+1].x*ll.a+p[k+1].y*ll.b+ll.c) < 0 then
        if not er then
           begin
             tmp.r := sqrt (sqr(tmp.o.x-p[i].x)+sqr(tmp.o.y-p[i].y));
             TryMin (false);
           end;
      end;
    end;
  for i := 1 to n do
    for j := 1 to n do
      begin
        Proj (p[j], l[i], tmp.o);
        If not OnSide (tmp.o, i) then continue;
        tmp.r := sqrt (sqr(tmp.o.x-p[j].x)+sqr(tmp.o.y-p[j].y));
        TryMin (false);
      end;
    write('Установить пеленгатор в точке ');
  WriteCircle (MinC);
end;
 
procedure TryMax (CheckIn: boolean);
var i: integer;
    q, r2: float;
begin
  if time-ts > 340 then OutThem;
  if tmp.r < MaxR then exit;
  if CheckIn then if not PointInPoly (tmp.o) then exit;
  r2 := sqr(tmp.r);
  for i := 1 to n do
    if (sqr(p[i].x-tmp.o.x)+sqr(p[i].y-tmp.o.y)) < r2-eps then exit;
  for i := 1 to n do
  begin
    q := abs(l[i].a*tmp.o.x+l[i].b*tmp.o.y+l[i].c);
    if q < tmp.r-eps then
         begin
           Proj (tmp.o, l[i], tp);
           if OnSide (tp, i) then exit;
         end;
  end;
  MaxC := tmp;
  MaxR := tmp.r;
end;
 
procedure ProcessParabola (var pp: TPoint; var ll: TLine;
                           x1, y1, x2, y2: float);
var dd, aa, bb, cc, a, b, c, d, e, f: float;
 
begin
  a := sqr(ll.a)-1;
  b := 2 * ll.a * ll.b;
  c := sqr(ll.b)-1;
  d := 2 * ll.a * ll.c + 2 * pp.x;
  e := 2 * ll.b * ll.c + 2 * pp.y;
  f := sqr(ll.c) - sqr (pp.x) - sqr (pp.y);
  aa := a * sqr(x2) + b * x2*y2 + c * sqr(y2);
  bb := 2 * x1 * x2 * a;
  bb := bb + (x2*y1+y2*x1)*b;
  bb := bb + 2 * y1 * y2 * c + d*x2+e*y2;
  cc := a * sqr(x1) + b*x1*y1 + c*sqr(y1)+d*x1+e*y1+f;
  if abs(aa) < 1e-14 then
     begin
       if bb = 0 then exit;
       a := -cc/bb;
       b := -cc/bb;
     end else
     begin
       dd := bb * bb - 4 * aa * cc;
       if dd < -eps then exit;
       if dd < 0 then dd := 0;
       dd := sqrt (dd);
       a := 0.5*(-bb + dd)/aa;
       b := 0.5*(-bb - dd)/aa;
     end;
  tmp.o.x := x1 + a * x2;
  tmp.o.y := y1 + a * y2;
  tmp.r := sqrt(sqr(tmp.o.x-pp.x) + sqr(tmp.o.y-pp.y));
  TryMax (true);
  tmp.o.x := x1 + b * x2;
  tmp.o.y := y1 + b * y2;
  tmp.r := sqrt(sqr(tmp.o.x-pp.x) + sqr(tmp.o.y-pp.y));
  TryMax (true);
end;
 
procedure Biss(var l1, l2: TLine; var  bb: TLine; i: integer);
begin
  if i = 1 then
   begin
    bb.a := l1.a + l2.a;
    bb.b := l1.b + l2.b;
    bb.c := l1.c + l2.c;
   end else
   begin
    bb.a := l1.a - l2.a;
    bb.b := l1.b - l2.b;
    bb.c := l1.c - l2.c;
   end;
end;
 
procedure CheckTriangle (a, b, c: integer);
var p1, p2, p3: TPoint;
    e1, e2: boolean;
    b1, b2: TLine;
    i, j: integer;
begin
  for i := 1 to 2 do
  begin
    Biss (l[a], l[b], b1, i);
    if sqr(b1.a)+sqr(b1.b) < eps then continue;
    for j := 1 to 2 do
    begin
      Biss (l[b], l[c], b2, j);
      if sqr(b2.a)+sqr(b2.b) < eps then continue;
      LL_Intersection (b1, b2, tmp.o);
      if er then continue;
      tmp.r := abs(tmp.o.x * l[a].a + tmp.o.y * l[a].b + l[a].c);
      TryMax (true);
    end;
  end;
end;
 
procedure TaskB;
var i, j, k, q: integer;
    xx, yy, dx, dy: float;
    ll: TLine;
begin
  MaxR := 0; maxc.r := 0; maxc.o.x := 0; maxc.o.y := 0;
  for i := 1 to n-2 do
    for j := i+1 to n-1 do
      for k := j+1 to n do
      begin
        InitCircle (p[i], p[j], p[k], tmp);
        if not er then TryMax(true);
      end;
  for i := 1 to n-1 do
    for j := i+1 to n do
      begin
        xx := (p[i].x+p[j].x)*0.5;
        yy := (p[i].y+p[j].y)*0.5;
        InitLine (p[i], p[j], ll);
        dx := ll.a;
        dy := ll.b;
        for k := 1 to n do
        if (k<>i) and (k+1<>i) and (k<>j) and (k+1<>j) then
          ProcessParabola (p[i], l[k], xx, yy, dx, dy);
      end;
  for i := 1 to n-2 do
    for j := i+1 to n-1 do
      for k := j+1 to n do
        CheckTriangle (i, j, k);
  for i := 1 to n-1 do
    for j := i+1 to n do
    begin
      LL_Intersection (l[i], l[j], tp);
      if er then continue;
      for k := 2 to n+1 do
      if (k<>i) and (k<>i+1) and (k<>j) and (k<>j+1) then
        for q := 1 to 2 do
        begin
          Biss (l[i], l[j], ll, i);
          ProcessParabola (p[k], l[i], tp.x, tp.y, ll.a, ll.b);
        end;
    end;
  write('Взорвать бомбу в точке ');
  WriteCircle (MaxC);
end;
 
begin
  ts := time;
  ReadAll;
  PrepareData;
  assign (output, 'military.out'); rewrite (output);
  TaskP;
  TaskB;
  close (output);
end.


 

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