Cod sursa(job #9942)

Utilizator andrei_infoMirestean Andrei andrei_info Data 27 ianuarie 2007 19:31:16
Problema Amenzi Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.69 kb
//infoarena amenzi
type pnod = ^tnod;
     tnod =  record
                x:byte;
                c:integer;
                next:pnod;
                end;
     rr= record
        head,last:pnod;
        end;

var n,m,k,p:integer;
    mm : array[1..150] of rr;
    a:array[1..150,0..3500] of longint;
    y:array[1..150,0..3500] of integer;

procedure addlist(var r:rr; x,c:integer);
var p:pnod;
begin
new(p); p^.x:=x; p^.c:=c; p^.next:=nil;
if r.head= nil then r.head:=p
else r.last^.next:=p;
r.last:=p;
end;


procedure calcul;
var i,j:integer;
    p:pnod;
begin
for i:=1 to n do
        for j:=0 to 3500 do a[i,j]:=-1;
a[1,0]:=0;
for j:=0 to 3500 do
    for i:=1 to n do
       if a[i,j] <> -1 then
                begin
                p:=mm[i].head;
                while p <> nil do
                        begin
                         if j+p^.c <= 3500 then
                        if a[p^.x,j+p^.c] < a[i,j]+y[p^.x,j+p^.c] then
                                a[p^.x,j+p^.c]:=a[i,j]+y[p^.x,j+p^.c];
                        p:=p^.next;
                        end;
                end;
end;

procedure citire;
var i,x,z,c:integer;
begin
assign(input,'amenzi.in');reset(input);
assign(output,'amenzi.out'); rewritE(output);
readln(n,m,k,p);
for i:=1 to m do
        begin
        readln(x,z,c);
        addlist(mm[x],z,c);
        addlist(mm[z],x,c);
        end;
for i:=1 to k do
        begin
        readln(x,z,c);
        y[x,z]:=c;
        end;
for i:=1 to n do addlist(mm[i],i,1);
calcul;
for i:=1 to p do
        begin
        readln(x,z);
        writeln(a[x,z]);
        end;
close(input);
close(output);
end;

begin
citire;
end.