Cod sursa(job #15821)

Utilizator andrewgPestele cel Mare andrewg Data 11 februarie 2007 19:16:18
Problema Amenzi Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.77 kb
const maxn = 151;
      inf = 1000000000;
      maxt = 3501;

type amenda = record
        t,p,val:longint;
     end;
     sotie = record
        t,p:longint;
     end;
     graf = array[1..maxn,1..maxn]of longint;

var f:text;
    l,n,m,q,p,k,i,j,sol:longint;
    a:graf;
    am:array[1..maxn]of amenda;
    wife:array[1..maxn]of sotie;
    t:longint;
    c:array[0..maxt]of longint;
    d:array[0..maxt]of longint;

procedure readdata;
var x,y,c:longint;
begin
   assign(f,'amenzi.in');
   reset(f);
   readln(f,n,m,q,p);
   for i:= 1 to m do
   begin
      readln(f,x,y,c);
      a[x,y]:=c;
      a[y,x]:=c;
   end;
   for i:=1 to q do
   begin
      readln(f,am[i].p,am[i].t,am[i].val);
   end;
   for i:=1 to p do
   begin
      readln(f,wife[i].p,wife[i].t);
   end;
   close(f);
end;

procedure royfloyd;
var c,d:graf;
    ok:boolean;
begin
   for i:=1 to n do
   begin
      for j:=1 to n do
      begin
         if a[i,j]=0 then a[i,j]:=inf;
      end;
   end;
   c:=a;
   d:=a;
   ok:=false;
   for i:=1 to n do
   begin
      for j:=1 to n do
      begin
         for k:=1 to n do
         begin
            if c[i,k]+c[k,j]<d[i,j] then
            begin
               d[i,j]:=c[i,k]+c[j,k];
               ok:=true;
            end;
         end;
         if ok then
         begin
            c:=d;
            ok:=false;
         end;
      end;
   end;
   a:=c;
end;

procedure sort(l,r:longint);
var i,j:longint;
    x:real;
    y:amenda;
begin
   i:=l;
   j:=r;
   x:=am[(l+r) div 2].t;
   repeat
      while am[i].t<x do i:=i+1;
      while x<am[j].t do j:=j-1;
      if i<=j then
      begin
         y:=am[i];
         am[i]:=am[j];
         am[j]:=y;
         i:=i+1;
         j:=j-1;
      end;
   until i>j;
   if l<j then sort(l,j);
   if i<r then sort(i,r);
end;

procedure solve;
begin
   royfloyd;
   sort(1,q);
   t:=am[q].t;
   c[0]:=0;
   d[0]:=1;
   l:=1;
   while l<=q do
   begin
      i:=am[l].t;
      for j:=0 to i do
      begin
         if (i-j)>=a[d[j],am[l].p] then
         begin
            if c[j]+am[l].val>c[i] then
            begin
               c[i]:=c[j]+am[l].val;
               d[i]:=am[l].p;
            end;
         end;
      end;
      inc(l);
   end;
end;

procedure writedata;
begin
   assign(f,'amenzi.out');
   rewrite(f);
   for i:=1 to p do
   begin
      sol:=0;
      for j:=1 to t do
      begin
         if a[d[j],wife[i].p]+j<=wife[i].t then
         begin
            if c[j]>sol then sol:=c[j];
         end;
      end;
      if sol=0 then
      begin
         if a[1,wife[i].p]>wife[i].t then sol:=-1;
      end;
      writeln(f,sol);
   end;
   close(f);
end;

begin
   readdata;
   solve;
   writedata;
end.