ac1254.pas

这是在网络上搜集到的在东京大学的ACM上面解决的一些题目的源码

{$Q-,$R-}
//Assuming no two routes share the same cost
program tju1254;
const
  maxn=50;
  zero=1e-6;
type
  point=record x,y:real;end;
var
  dot:array[-1..maxn*4]of point;
  u:array[1..maxn]of longint;
  len,cost:array[-1..maxn*4]of real;
  v:array[-1..maxn*4]of boolean;
  sect:array[1..6]of point;
  u0,n,i,j:longint;
  area:real;
  outside:point;
function dotpro(var a,b,c:point):real;
  begin
    dotpro:=(b.x-a.x)*(c.x-a.x)+(b.y-a.y)*(c.y-a.y);
  end;
function cross(var a,b,c:point):real;
  begin
    cross:=(b.x-a.x)*(c.y-a.y)-(c.x-a.x)*(b.y-a.y);
  end;
function dist(var a,b:point):real;
  begin
    dist:=sqrt(sqr(a.x-b.x)+sqr(a.y-b.y));
  end;
function intersect(var a,b,c,d:point):boolean;
  begin
    intersect:=(cross(a,b,c)*cross(a,b,d)<0) and
               (cross(c,d,a)*cross(c,d,b)<0);
  end;
function sectpoint(var a,b,c,d,e:point):boolean;
  var
    c1,c2:real;
  begin
    sectpoint:=intersect(a,b,c,d);
    if sectpoint then begin
      c1:=cross(a,b,c);c2:=cross(a,d,b);
      e.x:=(c.x*c2+d.x*c1)/(c1+c2);
      e.y:=(c.y*c2+d.y*c1)/(c1+c2);
    end;
  end;
function inseg(var p,a,b:point):boolean;
  begin
    inseg:=(abs(cross(p,a,b))<zero) and (dotpro(p,a,b)<-zero);
  end;
function inshape(var p:point;m:longint):boolean;
  begin
    if inseg(p,dot[m*4-3],dot[m*4-2]) or
       inseg(p,dot[m*4-2],dot[m*4-1]) or
       inseg(p,dot[m*4-1],dot[m*4]) or
       inseg(p,dot[m*4],dot[m*4-3]) then inshape:=false
    else inshape:=intersect(p,outside,dot[m*4-3],dot[m*4-2]) xor
                  intersect(p,outside,dot[m*4-2],dot[m*4-1]) xor
                  intersect(p,outside,dot[m*4-1],dot[m*4]) xor
                  intersect(p,outside,dot[m*4],dot[m*4-3]);
  end;
procedure go(a,b:longint);
  var
    c,i,j,p,q:longint;
    d,tcost:real;
    t:point;
  begin
    d:=dist(dot[a],dot[b]);tcost:=cost[a]+u0*d;if tcost>cost[b] then exit;
    if d<zero then begin len[b]:=len[a];cost[b]:=cost[a];exit;end;

    for i:=1 to n do begin
      sect[1]:=dot[a];c:=2;
      if sectpoint(dot[a],dot[b],dot[i*4-3],dot[i*4-2],sect[c]) then inc(c);
      if sectpoint(dot[a],dot[b],dot[i*4-2],dot[i*4-1],sect[c]) then inc(c);
      if sectpoint(dot[a],dot[b],dot[i*4-1],dot[i*4],sect[c]) then inc(c);
      if sectpoint(dot[a],dot[b],dot[i*4],dot[i*4-3],sect[c]) then inc(c);
      for j:=i*4-3 to i*4 do
        if inseg(dot[j],dot[a],dot[b]) then begin
          sect[c]:=dot[j];inc(c);
        end;
      sect[c]:=dot[b];

      for p:=1 to c-1 do begin
        j:=p;
        for q:=p+1 to c do
          if (sect[j].y-sect[q].y>zero) or (abs(sect[j].y-sect[q].y)<zero) and (sect[j].x>sect[q].x) then j:=q;
        if j>p then begin t:=sect[p];sect[p]:=sect[j];sect[j]:=t;end;
      end;

      for p:=2 to c do begin
        t.x:=(sect[p-1].x+sect[p].x)/2;t.y:=(sect[p-1].y+sect[p].y)/2;
        if inshape(t,i) then begin
          tcost:=tcost+u[i]*dist(sect[p-1],sect[p]);
          if tcost>=cost[b] then exit;
        end;
      end;
    end;
    len[b]:=len[a]+d;cost[b]:=tcost;
  end;
begin
  outside.x:=12345;outside.y:=54321;
  repeat
    readln(dot[-1].x,dot[-1].y,dot[0].x,dot[0].y,u0,n);
    area:=0;
    for i:=1 to n do begin
      read(u[i]);dec(u[i],u0);
      for j:=i*4-3 to i*4 do
        read(dot[j].x,dot[j].y);
      area:=area+(cross(dot[i*4],dot[i*4-3],dot[i*4-2])+
                  cross(dot[i*4],dot[i*4-2],dot[i*4-1]));
    end;
    writeln(area/2:0:2);

    for i:=0 to n*4 do cost[i]:=3e38;
    fillchar(v,sizeof(v),0);
    j:=-1;
    repeat
      v[j]:=true;
      for i:=0 to n*4 do
        if not v[i] then go(j,i);
      j:=0;
      for i:=1 to n*4 do
        if not v[i] and (cost[i]<cost[j]) then j:=i;
    until j=0;
    writeln(len[0]:0:2);
    writeln(cost[0]:0:2);
  until seekeof;
end.