Cod sursa(job #738593)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 21 aprilie 2012 00:35:22
Problema Drumuri minime Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.62 kb
Program dmin;
 const eps=0.000000001;
 type tip=record
       x,y:integer;
       c:double;
         end;
 var a:array [1..5000] of tip;
     nrd:array [1..1500] of longint;
     v:array [1..1500] of double;
     i,n,m,x,y,t,md:longint;
     ok:boolean;
     fi,fo:text;
procedure sort(l,r:longint);
 var k,i,j:longint;
     y:tip;
 begin
  i:=l; j:=r;
   k:=a[(l+r) div 2].x;
 repeat
  while a[i].x<k do inc(I);
   while a[j].x>k do dec(j);
 if i<=j then begin
               y:=a[i];
                a[i]:=a[j];
                  a[j]:=y;
                     inc(i); dec(j);
              end;
 until i>=j;
  if l<j then sort(l,j);
   if i<r then sort(i,r);
 end;
begin
 assign(fi,'dmin.in');
  assign(fo,'dmin.out');
 reset(fi); rewrite(fo); readln(fi,n,m); i:=1;  md:=104659;
 while i<2*m do begin
                 readln(fi,a[i].x,a[i].y,t); a[i].c:=ln(t); inc(i);
                 a[i].x:=a[i-1].y; a[i].y:=a[i-1].x; a[i].c:=a[i-1].c; inc(i);
                 end;
 for i:=1 to n do v[i]:=-1; m:=m*2;
    v[1]:=0; ok:=true; nrd[1]:=1;  sort(1,m);
{ while ok do begin
              ok:=false;}
              for i:=1 to m do
               if (v[a[i].x]<>-1) and ((v[a[i].y]=-1) or (v[a[i].y]-v[a[i].x]-a[i].c>eps)) then
                begin
                 v[a[i].y]:=v[a[i].x]+a[i].c;
                  nrd[a[i].y]:=nrd[a[i].x];
                 ok:=true;
                 end
                else if (v[a[i].x]<>-1) and (abs(v[a[i].y]-v[a[i].x]-a[i].c)<eps) then nrd[a[i].y]:=(nrd[a[i].y]+nrd[a[i].x]) mod md;
           {   end; }
  for i:=2 to n do write(fo,nrd[i],' ');
 close(fo);
end.