# Cod sursa(job #164464)

Utilizator Data 24 martie 2008 11:42:31 Oz 5 fpc done Arhiva de probleme 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);
for i:=1 to m do
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.
``````