Cod sursa(job #164468)

Utilizator LegolasCazacu Iulian Legolas Data 24 martie 2008 11:46:22
Problema Oz Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.42 kb
var f,g:text;
    p,k,l,s,r,x,y,cmmdc,n,m,i,j:longint;
    cd,a,b,c:array[1..10000] of longint;
    ok:boolean;
procedure QuickSort( Lo, Hi: Integer);
procedure Sort(l, r: Integer);
var i, j, x, y: integer;
begin
i := l; j := r; x := a[(l+r) DIV 2];
repeat
while a[i]<x do i:=i+1;
while x<a[j] do j:=j-1;
if i<=j then begin
y:=a[i]; a[i]:=a[j]; a[j]:=y;
y:=b[i]; b[i]:=b[j]; b[j]:=y;
y:=c[i]; c[i]:=c[j]; c[j]:=y;
i:=i+1; j:=j-1;
end;
until i > j;
if l < j then Sort(l, j);
if i < r then Sort(i, r);
end;
begin
sort(lo,hi);
end;
begin
assign(f,'oz.in');reset(f);
assign(g,'oz.out');rewrite(g);
read(f,n,m);
for i:=1 to m do
read(f,a[i],b[i],c[i]);
for i:=m+1 to 2*m do begin
a[i]:=b[i-m];
b[i]:=a[i-m];
c[i]:=c[i-m];
end;
m:=2*m;
quicksort(1,m);
i:=1;
p:=1;
repeat
k:=i;
if a[i]<>a[i+1] then begin cmmdc:=1; inc(i); end
else begin
x:=c[i];
while a[i]=a[i+1] do begin
y:=c[i+1];
r:=x mod y;
while r>0 do begin
x:=y;
y:=r;
r:=x mod y;
end;
x:=y;
inc(i);
end;
cmmdc:=y;
inc(i);
end;
s:=c[k] div cmmdc;
for l:=k+1 to i-1 do
if (s>200000000)and(c[l]<10) then s:=c[l]*s;
cd[p]:=s;
inc(p);
inc(j);
until i>m;
ok:=true;
for i:=1 to m do begin
x:=cd[a[i]];
y:=cd[b[i]];
r:=x mod y;
while r>0 do begin
x:=y;
y:=r;
r:=x mod y;
end;
if y<>c[i] then ok:=false;
end;
if ok=false then writeln(g,'-1')
else
for i:=1 to p-1 do
write(g,cd[i],' ');
writeln(g);
close(f);
close(g);
end.