Cod sursa(job #115226)

Utilizator gurneySachelarie Bogdan gurney Data 16 decembrie 2007 11:45:22
Problema Gather Scor 10
Compilator fpc Status done
Runda preONI 2008, Runda 2, Clasele 11-12 Marime 3.8 kb
program gather;
  const
    fin='gather.in';
    fout='gather.out';
    mmax=2500;
    nmax=750;
    logmax=1 shl 15;
    inf=maxlongint;
var
  start,target,c,d,prev:array[1..mmax] of longint;
  dist:array[0..logmax,0..15] of longint;
  st:array[0..logmax] of record
                        x,f:longint;
                        end;
  viz:array[1..nmax] of boolean;
  este:array[0..logmax*15,0..15] of boolean;
  last:array[1..nmax] of longint;
  cell:array[0..15] of longint;
  dst,list:array[1..nmax] of longint;
  mask,push,pop,cost,nedges,i,j,x,k,m,n,y,z,t:longint;

function cnt(x:longint):longint;
  var
    c:longint;
  begin
    c:=0;
    while x<>0 do
      begin
        inc(c);
        x:=x and (x-1);
      end;
    cnt:=c;
  end;

function drum(x,y,num_d:longint):longint;
  var
    p1,p2,a,b,crt:longint;
  begin
    fillchar(viz,sizeof(viz),false);
    for i:=1 to n do
      dst[i]:=inf;
    dst[x]:=0;
    list[1]:=x;
    viz[x]:=true;
    p1:=1;p2:=2;
    while p1<>p2 do
      begin
        crt:=list[p1];
        a:=last[crt];
        while a<>0 do
          begin
            if d[a]>=num_d then
              begin
                if dst[crt]+c[a]<dst[target[a]] then
                  begin
                    dst[target[a]]:=dst[crt]+c[a];
                    if viz[target[a]]=false then
                      begin
                        viz[target[a]]:=true;
                        list[p2]:=target[a];
                        inc(p2);
                        if p2>nmax then
                          p2:=1;
                      end;
                  end;
              end;
            a:=prev[a];
          end;
        viz[crt]:=false;
        inc(p1);
        if p1>nmax then
          p1:=1;
      end;
    drum:=dst[y]*num_d;
  end;

procedure insert(x,y,z,t:longint);
  begin
    inc(nedges);
    start[nedges]:=x;
    target[nedges]:=y;
    c[nedges]:=z;d[nedges]:=t;
    prev[nedges]:=last[x];
    last[x]:=nedges;
    inc(nedges);
    start[nedges]:=y;
    target[nedges]:=x;
    c[nedges]:=z;d[nedges]:=t;
    prev[nedges]:=last[y];
    last[y]:=nedges;
  end;

begin
  assign(input,fin);
    reset(input);
    readln(k,n,m);
    mask:=(1 shl k)-1;
    nedges:=0;
    for i:=1 to k do
      readln(cell[i]);
    for i:=1 to m do
      begin
        readln(x,y,z,t);
        insert(x,y,z,t);
      end;
    for i:=0 to logmax do
      for j:=0 to k do
        dist[i,j]:=inf;
    dist[0,0]:=0;
  close(input);
  assign(output,fout);
    rewrite(output);
    pop:=1;push:=2;
    este[0,0]:=true;
    cell[0]:=1;
    st[1].x:=0;
    st[1].f:=0;
    while (push<>pop) do
      begin
        x:=mask xor st[pop].x;
        z:=cnt(st[pop].x)+1;
        while x<>0 do
          begin
            y:=x xor (x and (x-1));
            t:=trunc(ln(y)/ln(2))+1;
            cost:=drum(cell[st[pop].f],cell[t],z);
            m:=t;
            t:=st[pop].x or y;
            if t=mask then
              m:=1;
            if dist[t,m]>dist[st[pop].x,st[pop].f]+cost then
              if dist[st[pop].x,st[pop].f]+cost<dist[mask,1] then
              begin
                dist[t,m]:=dist[st[pop].x,st[pop].f]+cost;
                if este[t,m]=false then
                  begin
                    este[t,m]:=true;
                    st[push].x:=t;st[push].f:=m;
                    inc(push);
                    if push=logmax+1 then
                      push:=1;
                  end;
              end;
            x:=x and (x-1);
          end;
        este[st[pop].x,st[pop].f]:=false;
        inc(pop);
        if pop=logmax+1 then
          pop:=1;
      end;
    m:=dist[mask,1];
    for i:=2 to k do
      if dist[mask,i]<m then
        m:=dist[mask,i];
    writeln(m);
  close(output);
end.