Cod sursa(job #50518)

Utilizator andrewgPestele cel Mare andrewg Data 7 aprilie 2007 20:34:07
Problema Drumuri minime Scor 5
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.31 kb
const maxn = 1501;
      inf = 2000000000;
      baza = 2;
      eps = 0.0000001;
      modul = 104659;

type lista = ^list;
     list = record
        nod:longint;
        next:lista;
     end;

var f:text;
    n,m,i,len:longint;
    j:extended;
    c:array[1..maxn,0..maxn]of longint;
    st,sol:array[1..maxn]of longint;
    d:array[1..maxn,1..maxn]of double;
    dist:array[1..maxn]of double;

{procedure add(x,y:longint);
var aux:lista;
begin
   new(aux);
   aux^:=c[y]^;
   if fol[y]=true then
   begin
      aux:=nil;
      fol[y]:=false;
   end;
   c[y]^.nod:=x;
   c[y]^.next:=aux;
end;                        }

function log(x:double):double;
var y,p:double;
    v,t:double;
begin
   y:=baza;
   p:=baza;
   v:=1;
   t:=1;
   if x=y then
   begin
      log:=1;
      exit;
   end;
   while abs(y*p/x-1)>eps do
   begin
      while y*p-x<eps do
      begin
         v:=v+t;
         y:=y*p;
      end;
      if abs(y-x)<eps then
      begin
         break;
      end;
      p:=sqrt(p);
      t:=t/2;
   end;
   if y*baza=x then v:=v+1;
   log:=v;
end;

procedure add(x,y:longint);
begin
   inc(c[x,0]);
   c[x,c[x,0]]:=y;
   d[x,y]:=j;
end;

procedure readdata;
var x,y:longint;
begin
   assign(f,'dmin.in');
   reset(f);
   readln(f,n,m);
{   for i:=1 to n do
   begin
      new(c[i]);
      fol[i]:=true;
   end;          }
   for i:=1 to m do
   begin
      readln(f,x,y,j);
      j:=log(j);
      add(x,y);
      add(y,x);
   end;
   close(f);
end;

procedure relax(u,v:longint);
begin
   if dist[v]>dist[u]+d[u,v] then
   begin
      dist[v]:=dist[u]+d[u,v];
      inc(len);
      st[len]:=v;
      sol[v]:=0;
   end;
   if abs(dist[v]-(dist[u]+d[u,v]))<eps then
   begin
      sol[v]:=(sol[v]+sol[u]) mod modul;
   end;
end;

procedure solve;
var j:longint;
begin
   for i:=1 to n do dist[i]:=inf;
   len:=1;
   st[1]:=1;
   dist[st[1]]:=0;
   i:=1;
   sol[1]:=1;
   while i<=len do
   begin
      for j:=1 to c[st[i],0] do
      begin
         relax(st[i],c[st[i],j]);
      end;
      inc(i);
   end;
end;

procedure writedata;
begin
   assign(f,'dmin.out');
   rewrite(f);
   for i:=2 to n-1 do write(f,sol[i],' ');
   writeln(f,sol[n]);
   close(f);
end;

begin
   readdata;
   solve;
   writedata;
end.