Listing polig.PAS 
Program PoligoaneAsemenea; 
type Punct=record 
x,y:Real 
end; 
MatriceDist=array[1..100,1..100] of Real; 
var P:array[1..100] of Punct; 
Q:array[1..100] of Punct; 
UP:array[1..100] of Real; 
UQ:array[1..100] of Real; 
DP,DQ:^MatriceDist; 
N,i:Byte; 
csp:array[1..100] of Real; 
csq:array[1..100] of Real; 
Procedure Citire; 
var f:Text; 
i:Byte; 
begin 
Assign(f,'POL.IN'); 
Reset(f); 
Readln(f,n); 
for i:=1 to n do 
Readln(f,P[i].x,P[i].y); 
for i:=1 to n do 
Readln(f,Q[i].x,Q[i].y); 
Close(f) 
end; 
Function Dist(a,b:Punct):Real; 
begin 
Dist:=Sqrt(Sqr(a.x-b.x)+Sqr(a.y-b.y)) 
end; 
Procedure CalculeazaDistante; 
var i,j:Byte; 
k:Byte; 
begin 
FillChar(DP^,Sizeof(DP^),0); 
for i:=1 to n do 
begin 
k:=i+1; 
if k=n+1 then k:=1; 
DP^[i,k]:=Dist(P[i],P[k]); 
DP^[k,i]:=DP^[i,k]; 
DQ^[i,k]:=Dist(Q[i],Q[k]); 
DQ^[k,i]:=DQ^[i,k]; 
Inc(k); 
if k=n+1 then k:=1; 
DP^[i,k]:=Dist(P[i],P[k]); 
DP^[k,i]:=DP^[i,k]; 
DQ^[i,k]:=Dist(Q[i],Q[k]); 
DQ^[k,i]:=DQ^[i,k] 
end 
end; 
Function Distanta(a:Punct;a1,a2:Punct):Real; 
{ Distanta dintre punctul p fata de } 
{ dreapta determinata de p1 si p2 } 
var l1,l2,l3,p,s:Real; 
begin 
l1:=Dist(a,a1); 
l2:=Dist(a,a2); 
l3:=Dist(a1,a2); 
p:=(l1+l2+l3)/2; 
s:=Sqrt(p*(p-l1)*(p-l2)*(p-l3)); 
Distanta:=2*S/l3 
end; 
Procedure DetCos; 
var i:Byte; 
begin 
csp[1]:=(Sqr(DP^[2,n])-Sqr(DP^[1,n])- 
Sqr(DP^[1,2]))/2/DP^[1,2]/DP^[1,n]; 
for i:=2 to n-1 do 
csp[i]:=(Sqr(DP^[i-1,i+1])- 
Sqr(DP^[i,i+1])-Sqr(DP^[i,i-1])) 
/2/DP^[i,i-1]/DP^[i,i+1]; 
csp[n]:=(Sqr(DP^[1,n-1])-Sqr(DP^[1,n])- 
Sqr(DP^[n,n-1]))/2/DP^[n,n-1]/ 
DP^[1,n]; 
csq[1]:=(Sqr(DQ^[2,n])-Sqr(DQ^[1,n])- 
Sqr(DQ^[1,2]))/2/DQ^[1,2]/ 
DQ^[1,n]; 
for i:=2 to n-1 do 
csq[i]:=(Sqr(DQ^[i-1,i+1])- 
Sqr(DQ^[i,i+1])-Sqr(DQ^[i,i-1])) 
/2/DQ^[i,i-1]/DQ^[i,i+1]; 
csq[n]:=(Sqr(DQ^[1,n-1])-Sqr(DQ^[1,n])- 
Sqr(DQ^[n,n-1]))/2/DQ^[n,n-1]/ 
DQ^[1,n] 
end; 
Function Egal(a,b:Real):Boolean; 
begin 
Egal:=Abs(a-b)<0.001 
end; 
Function OkUnghi(s:Byte; k:Integer):Boolean; 
var i,x:Byte; 
begin 
for i:=1 to n do 
begin 
if not Egal(csp[i],csq[s]) 
then 
begin 
OkUnghi:=false; 
Exit 
end; 
Inc(s,k); 
if s=0 then s:=n; 
if s=n+1 then s:=1 
end; 
OkUnghi:=true 
end; 
Function OkLat(s:Byte; k:Integer):Boolean; 
var prop:Real; 
x,i:Byte; 
begin 
x:=s+k; 
if x=0 then x:=n; 
if x=n+1 then x:=1; 
prop:=DP^[1,2]/DQ^[s,x]; 
for i:=2 to n-1 do 
begin 
s:=x; 
x:=x+k; 
if x=0 then x:=n; 
if x=n+1 then x:=1; 
if not Egal(DP^[i,i+1]/DQ^[s,x],prop) 
then 
begin 
OkLat:=false; 
Exit 
end 
end; 
OkLat:=true 
end; 
Procedure Scrie(s:Byte; k:Integer); 
var f:Text; 
begin 
Assign(f,'POL.OUT'); 
Rewrite(f); 
for i:=1 to n do 
begin 
Write(f,s,' '); 
s:=s+k; 
if s=0 
then s:=n; 
if s=n+1 
then s:=1 
end; 
Close(f) 
end; 
Procedure ScrieNU; 
var f:Text; 
begin 
Assign(f,'POL.OUT'); 
Rewrite(f); 
Writeln(f,0); 
Close(f) 
end; 
Begin 
New(DP); 
New(DQ); 
Citire; 
CalculeazaDistante; 
DetCos; 
for i:=1 to n do 
begin 
if OkUnghi(i,1) and OkLat(i,1) 
then 
begin 
Scrie(i,1); 
Halt 
end; 
if OkUnghi(i,-1) and OkLat(i,-1) 
then 
begin 
Scrie(i,-1); 
Halt 
end 
end; 
ScrieNU 
End.