土地划分【SGOI-12】pascal 解题报…

土地划分【SGOI-12】

Time Limit:10000MS  Memory Limit:65536K
Total Submit:4 Accepted:1

Description

土地划分

　　

　　

　

Input

Output

Sample Input

12
10 41 15 41
15 41 20 41
10 36 15 36
15 36 17 36
10 31 15 31
15 31 20 31
10 41 10 36
10 36 10 31
15 41 17 38
17 38 17 36
15 36 15 31
20 41 20 31

Sample Output

4 1
6 1
7 1

Source

 

这题好蛋疼。。。
写了4K的程序。。。

叫上题库，竟编译错误。。。

只好自己一个一个测数据，过了。。。

原因题库上无法调用math。。。

于是换种方法求角度。。。

至今未果，现在只能把过了的程序贴在这里。。。

 

uses math;

type

 arr=array[1..4]of longint;

 

var

 n,minx,miny:longint;

 a:array[1..800,1..4]of longint;

 waib:array[0..400]of arr;

 tot:array[1..400]of longint;

uses math;

type

 arr=array[1..4]of longint;

 

var

 n,minx,miny:longint;

 a:array[1..800,1..4]of longint;

 waib:array[0..400]of arr;

 tot:array[1..400]of longint;

 

procedure init;

var

 i:longint;

begin

 minx:=maxlongint;

 miny:=maxlongint;

 read(n);

 for i:=1 to n do

  begin

  read(a[i,1],a[i,2],a[i,3],a[i,4]);

  a[i+n,1]:=a[i,3];

  a[i+n,2]:=a[i,4];

  a[i+n,3]:=a[i,1];

  a[i+n,4]:=a[i,2];

  if (a[i,2]<miny)or((a[i,2]=miny)and(a[i,1]<minx)) then

    begin

    minx:=a[i,1];

    miny:=a[i,2];

    end;

  end;

end;

 

function cha_ji(x,y,x1,y1,x2,y2:longint):longint;

var

 i:longint;

begin

 i:=(x1-x)*(y2-y)-(x2-x)*(y1-y);

 exit(i);

end;

 

function dian_ji(x,y,x1,y1,x2,y2:longint):longint;

var

 i:longint;

begin

 i:=(x1-x)*(x2-x)+(y2-y)*(y1-y);

 exit(i);

end;

 

 

function jiao(x,y,x1,y1,x2,y2:longint):real;

var

 r:real;

 i:longint;

begin

 i:=dian_ji(x,y,x1,y1,x2,y2);

 r:=sqrt(sqr(x-x1)+sqr(y-y1))*sqrt(sqr(x-x2)+sqr(y-y2));

 r:=i/r;

 jiao:=arccos(r);

end;

 

procedure get_wai(var now:arr);

var

 s:string;

 j,nowj:real;

 i,x,y,cj,xx,yy:longint;

begin

 xx:=now[1];

 yy:=now[2];

 x:=now[3]+now[3]-now[1];

 y:=now[4]+now[4]-now[2];

 now[1]:=now[3];

 now[2]:=now[4];

 now[3]:=0;

 now[4]:=0;

 s:='';

 for i:=1 to n*2 do

  if (a[i,1]=now[1])and(a[i,2]=now[2]) then

   if not ((a[i,3]=xx)and(a[i,4]=yy)) then

   begin

   cj:=cha_ji(now[1],now[2],x,y,a[i,3],a[i,4]);

   j:=jiao(now[1],now[2],x,y,a[i,3],a[i,4]);

   if s='' then

    begin

    now[3]:=a[i,3];

    now[4]:=a[i,4];

    if cj>0 then s:='left'

            else s:='right';

    nowj:=j;

    end

    else

   if s='left' then

    begin

    if cj>0 then

     if j<nowj then

      begin

       nowj:=j;

       now[3]:=a[i,3];

       now[4]:=a[i,4];

      end;

    if cj<=0 then

       begin

       nowj:=j;

       now[3]:=a[i,3];

       now[4]:=a[i,4];

       s:='right';

       end;

    end

    else

   if (s='right')and(cj<0) then

    if j>nowj then

    begin

     nowj:=j;

     now[3]:=a[i,3];

     now[4]:=a[i,4];

    end;

   end;

end;

 

procedure get_nei(var now:arr);

var

 s:string;

 j,nowj:real;

 i,x,y,xx,yy,cj:longint;

begin

 xx:=now[1];

 yy:=now[2];

 x:=now[3]+now[3]-now[1];

 y:=now[4]+now[4]-now[2];

 now[1]:=now[3];

 now[2]:=now[4];

 now[3]:=0;

 now[4]:=0;

 s:='';

 for i:=1 to n*2 do

  if (a[i,1]=now[1])and(a[i,2]=now[2]) then

   if not ((a[i,3]=xx)and(a[i,4]=yy)) then

   begin

   cj:=cha_ji(now[1],now[2],x,y,a[i,3],a[i,4]);

   j:=jiao(now[1],now[2],x,y,a[i,3],a[i,4]);

   if s='' then

    begin

    now[3]:=a[i,3];

    now[4]:=a[i,4];

    if cj>=0 then s:='left'

            else s:='right';

    nowj:=j;

    continue;

    end;

   if (s='left')and(cj>0) then

    if j>nowj then

    begin

     nowj:=j;

     now[3]:=a[i,3];

     now[4]:=a[i,4];

     continue;

    end;

   if s='right' then

    begin

    if cj<0 then

     if j<nowj then

      begin

       nowj:=j;

       now[3]:=a[i,3];

       now[4]:=a[i,4];

      end;

    if cj>=0 then

       begin

       nowj:=j;

       now[3]:=a[i,3];

       now[4]:=a[i,4];

       s:='left';

       end;

    end

  end;

end;

 

procedure main;

var

 pan:boolean;

 i,j,ans,k:longint;

 now:arr;

 mark:array[1..400]of boolean;

begin

 now[1]:=minx-1;

 now[2]:=miny;

 now[3]:=minx;

 now[4]:=miny;

 while not ((now[3]=minx)and(now[4]=miny)and(now[1]<>minx-1)and(now[2]<>miny)) do

  begin

  get_wai(now);

  inc(waib[0,1]);

  waib[waib[0,1]]:=now;

  end;

 

 fillchar(mark,sizeof(mark),0);

 for i:=1 to waib[0,1] do

  if not mark[i] then

   begin

   mark[i]:=true;

    now:=waib[i];

    ans:=0;

    while not ((now[3]=waib[i][1])and(now[4]=waib[i][2])) do

    begin

     get_nei(now);

 

     for j:=1 to waib[0,1] do

      begin

      pan:=true;

      for k:=1 to 4 do

        if now[k]<>waib[j][k] then begin pan:=false; break; end;

      if pan then begin mark[j]:=true; break; end;

      end;

 

      inc(ans);

     end;

    inc(tot[ans+1]);

   end;

end;

 

procedure print;

var

 i:longint;

begin

 for i:=1 to 400 do

  if tot[i]>0 then writeln(i,' ',tot[i]);

end;

 

begin

 init;

 main;

 print;

end.

procedure init;

var

 i:longint;

begin

 minx:=maxlongint;

 miny:=maxlongint;

 read(n);

 for i:=1 to n do

  begin

  read(a[i,1],a[i,2],a[i,3],a[i,4]);

  a[i+n,1]:=a[i,3];

  a[i+n,2]:=a[i,4];

  a[i+n,3]:=a[i,1];

  a[i+n,4]:=a[i,2];

  if (a[i,2]<miny)or((a[i,2]=miny)and(a[i,1]<minx)) then

    begin

    minx:=a[i,1];

    miny:=a[i,2];

    end;

  end;

end;

 

function cha_ji(x,y,x1,y1,x2,y2:longint):longint;

var

 i:longint;

begin

 i:=(x1-x)*(y2-y)-(x2-x)*(y1-y);

 exit(i);

end;

 

function dian_ji(x,y,x1,y1,x2,y2:longint):longint;

var

 i:longint;

begin

 i:=(x1-x)*(x2-x)+(y2-y)*(y1-y);

 exit(i);

end;

 

 

function jiao(x,y,x1,y1,x2,y2:longint):real;

var

 r:real;

 i:longint;

begin

 i:=dian_ji(x,y,x1,y1,x2,y2);

 r:=sqrt(sqr(x-x1)+sqr(y-y1))*sqrt(sqr(x-x2)+sqr(y-y2));

 r:=i/r;

 jiao:=arccos(r);

end;

 

procedure get_wai(var now:arr);

var

 s:string;

 j,nowj:real;

 i,x,y,cj,xx,yy:longint;

begin

 xx:=now[1];

 yy:=now[2];

 x:=now[3]+now[3]-now[1];

 y:=now[4]+now[4]-now[2];

 now[1]:=now[3];

 now[2]:=now[4];

 now[3]:=0;

 now[4]:=0;

 s:='';

 for i:=1 to n*2 do

  if (a[i,1]=now[1])and(a[i,2]=now[2]) then

   if not ((a[i,3]=xx)and(a[i,4]=yy)) then

   begin

   cj:=cha_ji(now[1],now[2],x,y,a[i,3],a[i,4]);

   j:=jiao(now[1],now[2],x,y,a[i,3],a[i,4]);

   if s='' then

    begin

    now[3]:=a[i,3];

    now[4]:=a[i,4];

    if cj>0 then s:='left'

            else s:='right';

    nowj:=j;

    end

    else

   if s='left' then

    begin

    if cj>0 then

     if j<nowj then

      begin

       nowj:=j;

       now[3]:=a[i,3];

       now[4]:=a[i,4];

      end;

    if cj<=0 then

       begin

       nowj:=j;

       now[3]:=a[i,3];

       now[4]:=a[i,4];

       s:='right';

       end;

    end

    else

   if (s='right')and(cj<0) then

    if j>nowj then

    begin

     nowj:=j;

     now[3]:=a[i,3];

     now[4]:=a[i,4];

    end;

 

   end;

end;

 

procedure get_nei(var now:arr);

var

 s:string;

 j,nowj:real;

 i,x,y,xx,yy,cj:longint;

begin

 xx:=now[1];

 yy:=now[2];

 x:=now[3]+now[3]-now[1];

 y:=now[4]+now[4]-now[2];

 now[1]:=now[3];

 now[2]:=now[4];

 now[3]:=0;

 now[4]:=0;

 s:='';

 for i:=1 to n*2 do

  if (a[i,1]=now[1])and(a[i,2]=now[2]) then

   if not ((a[i,3]=xx)and(a[i,4]=yy)) then

   begin

   cj:=cha_ji(now[1],now[2],x,y,a[i,3],a[i,4]);

   j:=jiao(now[1],now[2],x,y,a[i,3],a[i,4]);

   if s='' then

    begin

    now[3]:=a[i,3];

    now[4]:=a[i,4];

    if cj>=0 then s:='left'

            else s:='right';

    nowj:=j;

    continue;

    end;

   if (s='left')and(cj>0) then

    if j>nowj then

    begin

     nowj:=j;

     now[3]:=a[i,3];

     now[4]:=a[i,4];

     continue;

    end;

   if s='right' then

    begin

    if cj<0 then

     if j<nowj then

      begin

       nowj:=j;

       now[3]:=a[i,3];

       now[4]:=a[i,4];

      end;

    if cj>=0 then

       begin

       nowj:=j;

       now[3]:=a[i,3];

       now[4]:=a[i,4];

       s:='left';

       end;

    end

  end;

end;

 

procedure main;

var

 pan:boolean;

 i,j,ans,k:longint;

 now:arr;

 mark:array[1..400]of boolean;

begin

 now[1]:=minx-1;

 now[2]:=miny;

 now[3]:=minx;

 now[4]:=miny;

 while not ((now[3]=minx)and(now[4]=miny)and(now[1]<>minx-1)and(now[2]<>miny)) do

  begin

  get_wai(now);

  inc(waib[0,1]);

  waib[waib[0,1]]:=now;

  end;

 

 fillchar(mark,sizeof(mark),0);

 for i:=1 to waib[0,1] do

  if not mark[i] then

   begin

   mark[i]:=true;

    now:=waib[i];

    ans:=0;

    while not ((now[3]=waib[i][1])and(now[4]=waib[i][2])) do

    begin

     get_nei(now);

 

     for j:=1 to waib[0,1] do

      begin

      pan:=true;

      for k:=1 to 4 do

        if now[k]<>waib[j][k] then begin pan:=false; break; end;

      if pan then begin mark[j]:=true; break; end;

      end;

 

      inc(ans);

     end;

    inc(tot[ans+1]);

   end;

end;

 

procedure print;

var

 i:longint;

begin

 for i:=1 to 400 do

  if tot[i]>0 then writeln(i,' ',tot[i]);

end;

 

begin

 init;

 main;

 print;

end.

``