⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ac1165.pas

📁 同济大学 Online在线题库 AC源代码合集 程序设计竞赛必看资料
💻 PAS
字号:
program tju1165;
const
  maxn=5000;
  zero=1e-6;
var
  x,y:array[-1..maxn]of integer;
  k,b,x0,y0,r2,n,i,p:longint;
  angle:real;
function turn(a:word):real;
  var
    x1,y1,x2,y2:integer;
  begin
    x1:=x[a]-x[a-1];y1:=y[a]-y[a-1];
    x2:=x[a+1]-x[a];y2:=y[a+1]-y[a];
    turn:=(x1*x2+y1*y2)/sqrt(sqr(x1)+sqr(y1))/sqrt(sqr(x2)+sqr(y2));
    if abs(turn)<zero then turn:=pi/2
                      else turn:=arctan(sqrt(1-sqr(turn))/turn);
    if turn<0 then turn:=turn+pi;
    if x1*y2<x2*y1 then turn:=-turn;
  end;
function func(f,a:word):longint;
  begin
    case f of
      1:func:=y[a]-k*x[a]-b;
      2:func:=sqr(x[a]-x0)+sqr(y[a]-y0)-r2;
    end;
  end;
function across(a:word):boolean;
  begin
    across:=(func(1,a)>0)=(func(1,a+1)<0);
  end;
procedure beeline;
  var
    count1,count2:word;
  begin
    count1:=1;count2:=1;angle:=0;
    for i:=1 to n do begin
      p:=(p+1) mod n;angle:=angle+turn(p);
      if across(p) then begin
        if angle<0 then if func(1,p)<0 then inc(count1) else inc(count2);
        angle:=0;
      end;
    end;
    write(count1,' ',count2,' ');
  end;
function cutcircle(p:word):boolean;
//Checks whether a segment with both ends outside the circle cuts the circle
  var
    a2,b2,c2,d2:real;
  begin
    a2:=sqr(x[p]-x0)+sqr(y[p]-y0);
    b2:=sqr(x[p+1]-x0)+sqr(y[p+1]-y0);
    c2:=sqr(x[p]-x[p+1])+sqr(y[p]-y[p+1]);
    d2:=(a2*b2-sqr(a2+b2-c2)/4)/c2;
    if d2>=r2 then begin cutcircle:=false;exit;end;
    cutcircle:=(b2+c2>a2) and (a2+c2>b2);
  end;
function go_in(p:word):boolean;
  begin
    go_in:=(func(2,p)>0) and ((func(2,p+1)<0) or cutcircle(p));
  end;
function go_out(p:word):boolean;
  begin
    go_out:=(func(2,p+1)>0) and ((func(2,p)<0) or cutcircle(p));
  end;
procedure circle;
  var
    t,count:word;
  begin
    count:=1;t:=p;
    repeat
      p:=(p+1) mod n;angle:=angle+turn(p);
      if go_in(p) then begin
        if angle<0 then inc(count);
        angle:=0;
        while not go_out(p) do p:=(p+1) mod n;
      end;
    until p=t;
    writeln(count);
  end;
function cross(xa,ya,xb,yb,xc,yc:integer):longint;
  var
    x1,y1,x2,y2:integer;
  begin
    x1:=xb-xa;y1:=yb-ya;
    x2:=xc-xa;y2:=yc-ya;
    cross:=x1*y2-x2*y1;
  end;
function intersect(xa,ya,xb,yb,xc,yc,xd,yd:integer):boolean;
  begin
    intersect:=((cross(xa,ya,xb,yb,xc,yc)>0)=(cross(xa,ya,xb,yb,xd,yd)<0))
           and ((cross(xc,yc,xd,yd,xa,ya)>0)=(cross(xc,yc,xd,yd,xb,yb)<0));
  end;
function heart_in_cake:boolean;
  begin
    p:=0;
    for i:=1 to n do
      if intersect(x0,y0,x0+1,10001,x[i-1],y[i-1],x[i],y[i]) then inc(p);
    writeln(p and 1);
  end;
begin
  repeat
    read(k,b,x0,y0,r2,n);r2:=sqr(r2);
    for i:=1 to n do read(x[i],y[i]);
    x[-1]:=x[n-1];y[-1]:=y[n-1];
    x[0]:=x[n];y[0]:=y[n];

    p:=0;
    while (p<n) and not across(p) do inc(p);
    if p<n then beeline else if func(1,0)>0 then write('1 0 ') else write('0 1 ');

    p:=0;
    while (p<n) and not go_out(p) do inc(p);
    if p<n then circle else heart_in_cake;
  until seekeof;
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -