铁人三项.pas

VIJOS中铁人三项一题。 本程序使用二维线性规划方法来求解。 二维线性规划

program core;
const
max=1000;
delta=1e-12;
type
     point=record
          x,y:extended;
          end;
     tubao=array[0..1000] of point;
     line=record
          a,b,c:extended;
          flag:boolean;
          end;
var
u,v,w:array[0..100] of extended;
i,j,k,n,m,num:longint;
a:tubao;

function sgn(x:extended):longint;
begin
if abs(x)<delta then exit(0);
if x>0 then exit(1) else exit(-1);
end;

procedure zero(var x:extended);
begin
if sgn(x)=0 then x:=0;
end;

operator =(a,b:point)c:boolean;
begin
c:=(sgn(a.x-b.x)=0)and(sgn(a.y-b.y)=0);
end;

operator *(a,b:point)c:extended;
begin
c:=a.x*b.y-a.y*b.x;
end;

procedure swap(var a,b:point);
var k:point;
begin
k:=a; a:=b; b:=k;
end;

function getpoint(a:tubao;num:longint):point;
var i:longint;
begin
getpoint.x:=0; getpoint.y:=0;
for i:=1 to num do
     begin
     getpoint.x:=getpoint.x+a[i].x;
     getpoint.y:=getpoint.y+a[i].y;
     end;
getpoint.x:=getpoint.x/num;
getpoint.y:=getpoint.y/num;
end;

procedure getline(var p:line;a,b:point);
begin
if sgn(a.x-b.x)=0 then
     begin
     p.a:=1; p.b:=0; p.c:=-a.x;
     exit;
     end;
p.a:=(a.y-b.y)/(a.x-b.x);
p.b:=-1;
p.c:=a.y-p.a*a.x;
end;

function putin(p:line;a:point):extended;
begin
putin:=p.a*a.x+p.b*a.y+p.c;
end;

procedure deal(var p:line;a:point);
var t:extended;
begin
t:=putin(p,a);
if t>0 then p.flag:=true else p.flag:=false;
end;

function parallel(a,b:line):boolean;
begin
parallel:=sgn(a.a*b.b-a.b*b.a)=0;
end;

function cross(a,b:line):point;
var p,a1,a2:extended;
begin
p:=a.a*b.b-a.b*b.a;
a1:=a.b*b.c-a.c*b.b;
a2:=a.c*b.a-a.a*b.c;
cross.x:=a1/p; cross.y:=a2/p;
end;

function iscross(p:line;a,b:point):boolean;
var Q:line; T:point;
begin
getline(Q,a,b);
if parallel(P,Q) then exit(false);
T:=cross(P,Q);
if sgn(a.x-b.x)=0 then
     begin
     if a.y>b.y then swap(a,b);
     if (a.y-delta<T.y)and(T.y<b.y+delta) then
          exit(true);
     exit(false);
     end;
if a.x>b.x then swap(a,b);
if (a.x-delta<T.x)and(T.x<b.x+delta) then
     exit(true)
else exit(false);
end;

function can(p:line;a:point):boolean;
var t:extended;
begin
t:=putin(p,a);
if (t>-delta)and(p.flag)or(t<delta)and(not p.flag) then exit(true);
exit(false);
end;

procedure cut(var a:tubao;var num:longint;p:line);
var
L:Array[1..4] of point;
LL:array[1..4] of longint;
i,n,now1,now2:longint;
T,T1,T2:point;
temp,a1,a2:tubao;
q:line;
begin
if (sgn(p.a)=0)and(sgn(p.b)=0)and(sgn(p.c)<=0) then
     begin
     fillchar(a,sizeof(a),0);
     num:=0;
     exit;
     end;
if num<=2 then
     begin
     for i:=num downto 1 do
       if not can(p,a[i]) then
          begin
          a[i].x:=0; a[i].y:=0;
          if (num=2)and(i=1) then
               begin
               a[1]:=a[2];
               a[2].x:=0; a[2].y:=0;
               end;
          dec(num);
          end;

     exit;
     end;


T:=getpoint(a,num);

for i:=1 to num do
     begin
     getline(Q,a[i],a[i mod num+1]);
     if parallel(P,Q) and (sgn(putin(P,a[i])-putin(Q,a[i]))=0) then
          if not can(p,T) then
               begin
               T1:=a[i]; T2:=a[i mod num+1];
               num:=2;
               fillchar(a,sizeof(a),0);
               a[1]:=T1; a[2]:=T2;
               exit;
               end
          else exit;
     end;

n:=0;
for i:=1 to num do
  if iscross(p,a[i],a[i mod num+1]) then
     begin
     inc(n);
     getline(Q,a[i],a[i mod num+1]);
     L[n]:=cross(P,Q); LL[n]:=i;
     end;
now1:=0; now2:=0;
fillchar(a1,sizeof(a1),0);
fillchar(a2,sizeof(a2),0);
if n=0 then
     if can(p,T) then
          exit
     else begin num:=0; exit end;

if n=2 then
     begin
     if L[1]=L[2] then
          if can(p,T) then
               exit
          else begin
               num:=1;
               fillchar(a,sizeof(a),0);
               a[1]:=L[1];
               exit
               end;

     for i:=1 to LL[1] do
          begin
          inc(now1);
          a1[now1]:=a[i];
          end;
     inc(now1); a1[now1]:=L[1];
     inc(now1); a1[now1]:=L[2];
     for i:=LL[2]+1 to num do
          begin
          inc(now1);
          a1[now1]:=a[i];
          end;
     inc(now2); a2[now2]:=L[1];
     for i:=LL[1]+1 to LL[2] do
          begin
          inc(now2);
          a2[now2]:=a[i];
          end;
     inc(now2); a2[now2]:=L[2];
     T1:=getpoint(a1,now1); T2:=getpoint(a2,now2);
     if can(p,T1) then
          begin a:=a1; num:=now1; end
     else begin a:=a2; num:=now2; end;
     exit;
     end;

if n=3 then
     begin
     if L[1]=L[2] then
          begin
          for i:=1 to LL[1] do
               begin
               inc(now1);
               a1[now1]:=a[i];
               end;
          inc(now1); a1[now1]:=L[1];
          inc(now1); a1[now1]:=L[3];
          for i:=LL[3]+1 to num do
               begin
               inc(now1);
               a1[now1]:=a[i];
               end;
          inc(now2); a2[now2]:=L[1];
          for i:=LL[1]+2 to LL[3] do
               begin
               inc(now2);
               a2[now2]:=a[i];
               end;
               inc(now2); a2[now2]:=L[3];
          end
     else if L[1]=L[3] then
          begin
          for i:=1 to LL[2] do
               begin
               inc(now1);
               a1[now1]:=a[i];
               end;
          inc(now1); a1[now1]:=L[2];

          inc(now2); a2[now2]:=L[2];
          for i:=LL[2]+1 to num do
               begin
               inc(now2);
               a2[now2]:=a[i];
               end;
          inc(now2); a2[now2]:=L[1];
          end
     else begin
          for i:=1 to LL[1] do
               begin
               inc(now1);
               a1[now1]:=a[i];
               end;
          inc(now1); a1[now1]:=L[1];
          inc(now1); a1[now1]:=L[2];
          for i:=LL[2]+2 to num do
               begin
               inc(now1);
               a1[now1]:=a[i];
               end;
          inc(now2); a2[now2]:=L[1];
          for i:=LL[1]+1 to LL[2] do
               begin
               inc(now2);
               a2[now2]:=a[i];
               end;
          inc(now2); a2[now2]:=L[2];
          end;
     T1:=getpoint(a1,now1); T2:=getpoint(a2,now2);
     if can(p,T1) then
          begin a:=a1; num:=now1; end
     else begin a:=a2; num:=now2; end;
     exit;
     end;

if n=4 then
     begin
     if L[1]=L[4] then
          begin
          for i:=1 to LL[2] do
               begin
               inc(now1);
               a1[now1]:=a[i];
               end;
          inc(now1); a1[now1]:=L[2];

          inc(now2); a2[now2]:=L[2];
          for i:=LL[2]+2 to num do
               begin
               inc(now2);
               a2[now2]:=a[i];
               end;
          inc(now2); a2[now2]:=L[1];
          end
     else begin
          for i:=1 to LL[1] do
               begin
               inc(now1);
               a1[now1]:=a[i];
               end;
          inc(now1); a1[now1]:=L[1];
          inc(now1); a1[now1]:=L[3];
          for i:=LL[3]+2 to num do
               begin
               inc(now1);
               a1[now1]:=a[i];
               end;
          inc(now2); a2[now2]:=L[1];
          for i:=LL[1]+2 to LL[3] do
               begin
               inc(now2);
               a2[now2]:=a[i];
               end;
          inc(now2); a2[now2]:=L[3];
          end;
     T1:=getpoint(a1,now1); T2:=getpoint(a2,now2);
     if can(p,T1) then
          begin a:=a1; num:=now1; end
     else begin a:=a2; num:=now2; end;
     exit;
     end;
end;

function canwin(k:longint):boolean;
var i,j,num:longint; p:line;
begin
fillchar(a,sizeof(a),0);
num:=3;
a[1].x:=0; a[1].y:=0;
a[2].x:=0; a[2].y:=max;
a[3].x:=max; a[3].y:=0;
for i:=1 to n do
     if i<>k then
          begin
          p.a:=v[i]-w[i]-(v[k]-w[k]);
          p.b:=u[i]-w[i]-(u[k]-w[k]);
          p.c:=(w[i]-w[k])*max;
          p.flag:=true;
          cut(a,num,p);
          for j:=1 to num do
               begin zero(a[i].x); zero(a[i].y) end;
          if num<=2 then break;
          end;
if num<=2 then exit(false) else exit(true)
end;

procedure init;
begin
readln(n);
for i:=1 to n do
     begin
     readln(v[i],u[i],w[i]);
     v[i]:=1/v[i]; u[i]:=1/u[i]; w[i]:=1/w[i];
     end;
end;

procedure work;
var i,j,k:longint;
begin
for i:=1 to n do
     if canwin(i) then
          writeln('Yes')
     else writeln('No');
end;

begin
init;
work;
end.