Cod sursa(job #165396)

Utilizator eugen.nodeaEugen Nodea eugen.nodea Data 25 martie 2008 22:16:07
Problema Oz Scor 5
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.61 kb
var f:text;
    c1,c2,N,M,i,j,d,k:longint;
    A:array[1..10001] of LongInt;
    x,y:real;
    ok:boolean;
    B:array[1..100000,1..3] of integer;
Function cmmdc(x,y:longint):longint;
var r:longint;
begin
     repeat
           r:=x Mod y;
           x:=y;
           y:=r;
     until r=0;
     cmmdc:=x;
end;
Begin
     assign(f,'oz.in'); reset(f);
     Readln(f,N,M);
     For k:=1 To N do
         A[k]:=1;
     ok:=True;
     For k:=1 To M do
     begin
          Readln(f,i,j,d);
          B[k,1]:=i; B[k,2]:=j; B[k,3]:=d;
          c1:=cmmdc(A[i],d);
          c2:=cmmdc(A[j],d);
          x:=A[i]*d/c1;
          y:=A[j]*d/c2;
          if (x>2000000000) Or (y>2000000000) then begin
                                ok:=False; break;
                            end
                           else begin
                                     A[i]:=Trunc(x);
                                     A[j]:=Trunc(y);
                                end;
     end;
     close(f);
     assign(f,'oz.out'); rewrite(f);
     if Not ok then write(f,'-1')
           else begin
                For k:= 1 to M do
                {cmmdc(A[B[k,1]],A[B[k,2]])<>B[k,3]}
                    if   (A[B[k,1]] Mod d<>0) Or (A[B[k,2]] Mod d<>0) then begin
                         ok:=False;
                         break;
                       end;
                    if Not ok then write(f,'-1')
                       else begin
                           For i:=1 To N-1 do
                               write(f,A[i],' '); write(f,A[N]);
                       end;
                end;
     close(f);
End.