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.