Cod sursa(job #164464)

Utilizator th3whu2Breta Ionut th3whu2 Data 24 martie 2008 11:42:31
Problema Oz Scor 5
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.75 kb
var j,k,x,cmmmc,cmmdc,r,y,i,n,m:longint;
a,e,b,c,v:array[1..100000] of qword;
f,g:text;
h: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;
e:=a;
while i<=m do
 begin
  if (a[i]=a[i+1]) and (a[i]<>0) then
   begin
    j:=i;
    while a[j]=a[j+1] do inc(j);

  x:=c[i];
  y:=c[i+1];
  for k:=i+1 to j do
   begin
    r:=x mod y;
    while r>0 do
     begin
      x:=y;
      y:=r;
      r:=x mod y;
     end;
    x:=y;
    y:=c[k+1];
   end;
  cmmdc:=x;
  cmmmc:=c[i] div cmmdc;
  for k:=i+1 to j do
   cmmmc:=cmmmc*c[k];
  v[a[i]]:=cmmmc;
  for k:=i to j do
   a[k]:=0;
  end
  else if (a[i-1]<>a[i]) and (a[i]<>a[i-1]) then v[a[i]]:=c[i];
  inc(i);
 end;
h:=true;
a:=e;
for i:=1 to m do
 begin
  x:=v[a[i]];
  y:=v[b[i]];
  if (x>2000000000) or (y>2000000000) then h:=false;
  r:=x mod y;
  while r>0 do
   begin
    x:=y;
    y:=r;
    r:=x mod y;
   end;
  if y<>c[i] then h:=false;
 end;
if not(h) then write(g,-1)
 else
  begin
   for i:=1 to n do
    if i<n then write(g,v[i],' ')
    else if i=n then write(g,v[i]);
  end;
close(f);
close(g);
end.