Описание
Два многоугольника на плоскости заданы координатами своих вершин

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

  1. Многоугольники выпуклые, а координаты их вершин даны в произвольном порядке

  2. Хотя бы один из многоугольников невыпуклый, но известно, что у каждого из многоугольников не более одного угла, большего 180°, а координаты вершин даны в порядке обхода по часовой стрелке

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


Входные данные
Первая строка входного файла содержит целое число N – количество вершин в первом многоугольнике (3≤N≤50). Во второй строке записаны координаты этих вершин. Третья и четвертая строки таким же образом задают второй многоугольник. Координаты всех вершин являются целыми числами из диапазона [-32768,32767]

Выходные данные
Выведите в выходной файл искомую площадь не менее чем с шестью верными значащими цифрами


Например:

CROSSING.IN
3
0 3 0 -3 -3 0
5
-1 1 2 1 1 0 2 -1 -1 -1

CROSSING.OUT
2.0





Идеи
Пересечение отрезков, полярный угол, площадь многоугольника

Комментарии
Отсортируем вершины каждого из многоугольников по полярному углу относительно его центра масс. Если в результате получились два выпуклых многоугольника (для проверки выпуклости используйте критерий из задачи 4.1), значит нам предстоит решать пункт A, иначе - пункт B

Разберем пункт A. Очевидно, что пересечение двух выпуклых многоугольников также является выпуклым многоугольником. Какие точки будут его вершинами? Во-первых, все точки пересечения двух многоугольников. Чтобы их найти, нужно пересечь все стороны одного многоугольника со всеми сторонами другого. Во-вторых, все вершины первого многоугольника, принадлежащие второму, и наоборот, все вершины второго, принадлежащие первому. Определив все вершины пересечения, упорядочим их, отсортировав по полярному углу относительно центра масс. Далее считаем площадь получившегося многоугольника

Пункт B сводится к пункту A следующим образом. Прямая, проведенная через любую из сторон угла, большего 180°, разбивает невыпуклый многоугольник на два выпуклых. Пересекая получившиеся выпуклые многоугольники (как в пункте A) и суммируя площади их пересечений, найдем ответ на пункт B





Решение

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

program crossing;
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..100] of pointtype;
        n:integer;
       end;
var
 a:array[1..3] of ntype;
 d1,d2:linetype;
 p1,p2,s1,s2:ntype;
 p:pointtype;
 i:integer;
 ss1,ss2,ss3,ss:real;

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 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;
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;

function alloneside(p:ntype;i,j,del:integer):boolean;
var
 k,l:integer;
 ll:linetype;
 fir,fend,fgood:boolean;
begin
 ll.x1:=p.h[i].x;
 ll.y1:=p.h[i].y;
 ll.x2:=p.h[j].x;
 ll.y2:=p.h[j].y;
 fend:=true;
 fir:=true;
 for k:=1 to p.n do
  if (k<>del) and (k<>i) and (k<>j) then
   begin
    if fir then
     begin
      fir:=false;
      fgood:=updown(ll,p.h[k]);
     end
        else
     if fgood<>updown(ll,p.h[k]) then
      fend:=false;
   end;
 alloneside:=fend;
end;

procedure delown(var p:ntype);
var
 k,i,j,l,i1,i2:integer;
 ll:linetype;
label
 begfor;
begin
 begfor:
 for i:=1 to p.n do
  for j:=1 to p.n do
   if i<>j then
    begin
     makeline(p.h[i],p.h[j],ll);
     for k:=1 to p.n do
      if (k<>i) and (k<>j) and (pointandotr(ll,p.h[k])) and (alloneside(p,i,j,k)) then
       begin
        dec(p.n);
        for l:=k to p.n do
         p.h[l]:=p.h[l+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 makedel(var p,pp,ss:ntype);
var
 s2,s:set of byte;
 l:ntype;
 allgood,f,ftek,ans,fend:boolean;
 ntek,j,i,last:integer;
 ll:linetype;
begin
 s:=[];
 for i:=1 to p.n do
  if not (i in s) then
   for j:=1 to p.n do
    if (i<>j) and (alloneside(p,i,j,0)) then
     s:=s+[i]+[j];
 
 pp.n:=0;
 ss.n:=0;
 for i:=1 to p.n do
  if i in s then
   begin
    inc(pp.n);
    pp.h[pp.n]:=p.h[i];
   end;
 s2:=[];
 for i:=1 to p.n do
  if not (i in s) then
   begin
    s2:=s2+[i];
    if i=1 then
     s2:=s2+[p.n]
           else
     s2:=s2+[i-1];
    if i=p.n then
     s2:=s2+[1]
           else
     s2:=s2+[i+1];
   end;
 ss.n:=0;
 for i:=1 to p.n do
  if i in s2 then
   begin
    inc(ss.n);
    ss.h[ss.n]:=p.h[i];
   end;
 sortxy(pp);
 sortxy(ss);
end;

procedure readfile;
var
 i,j:integer;
 f:text;
begin
 assign(f,'crossing.in');
 reset(f);
 readln(f,a[1].n);
 for i:=1 to a[1].n do
  begin
   with a[1].h[i] do
    read(f,x,y);
  end;
 readln(f);
 readln(f,a[2].n);
 for i:=1 to a[2].n do
  begin
   with a[2].h[i] do
    read(f,x,y);
  end;
 close(f);
end;

function pointn(p:ntype;s:pointtype):boolean;
var
 i,j:integer;
 f:boolean;
 ll:linetype;
begin
 if p.n<3 then
  begin
   pointn:=false;
   exit;
  end;
 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;

function makes(p1,p2:ntype):real;
var
 i,j,k:integer;
 s:pointtype;
 l1,l2:linetype;
 s3,p3:ntype;
 sss:real;
label
 begfor;
begin
 a[3].n:=0;
 for i:=1 to p1.n do
  if pointn(p2,p1.h[i]) then
   begin
    inc(a[3].n);
    a[3].h[a[3].n]:=p1.h[i];
   end;
 for i:=1 to p2.n do
  if pointn(p1,p2.h[i]) then
   begin
    inc(a[3].n);
    a[3].h[a[3].n]:=p2.h[i];
   end;
 for i:=1 to p1.n do
  begin
   if i=p1.n then
    makeline(p1.h[i],p1.h[1],l1)
               else
    makeline(p1.h[i],p1.h[i+1],l1);
   for j:=1 to p2.n do
    begin
     if j=p2.n then
      makeline(p2.h[j],p2.h[1],l2)
                 else
      makeline(p2.h[j],p2.h[j+1],l2);
     if twootr(l1,l2,s) then
      begin
       inc(a[3].n);
       a[3].h[a[3].n]:=s;
      end;
    end;
  end;
 begfor:
 for i:=1 to a[3].n do
  for j:=1 to a[3].n do
   if ((a[3].h[i].x=a[3].h[j].x) and (a[3].h[i].y=a[3].h[j].y)) and (i<>j) then
    begin
     dec(a[3].n);
     for k:=j to a[3].n do
      a[3].h[k]:=a[3].h[k+1];
     goto begfor;
    end;
 makedel(a[3],p3,s3);
 sss:=abs(sn(p3));
 makes:=sss;
end;

procedure writefile;
var
 f:text;
begin
 assign(f,'crossing.out');
 rewrite(f);
 writeln(f,ss:10:10);
 close(f);
end;

begin
 readfile;
 delown(a[1]);
 delown(a[2]);
 makedel(a[1],p1,s1);
 makedel(a[2],p2,s2);
 ss1:=makes(p1,p2);
 ss2:=makes(s1,p2);
 ss3:=makes(s2,p1);
 ss:=makes(s1,s2);
 ss:=ss1-ss2-ss3+ss;
 writefile;
end.

 

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