# Cod sursa(job #9194)

Utilizator Data 26 ianuarie 2007 23:33:27 Patrate 3 100 fpc done Arhiva de probleme 4.21 kb
``````var f:text;
i,n,j,k1,k2,k3,k4:integer;
sol:longint;
myx,myy:longint;
c:char;
ok:boolean;
a,b:array[0..1001] of longint;
procedure quicksort(l,r:word);
var i,j:word;
x,x2,y:longint;
begin
i:=l;j:=r;x:=a[(l+r) div 2];x2:=b[(l+r) div 2];
repeat
while (a[i]<x) or ((a[i]=x) and (b[i]<x2)) do i:=i+1;
while (a[j]>x) or ((a[j]=x) and (b[j]>x2)) 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;
i:=i+1;
j:=j-1;
end;
until i>j;
if l<j then quicksort(l,j);
if i<r then quicksort(i,r);
end;

begin
assign(f,'patrate3.in');
reset(f);
for i:=1 to n do begin
if c='-' then ok:=true
else ok:=false;
while c<>'.' do begin
if (c<>'.') and (c<>'-') then a[i]:=a[i]*10+ord(c)-48;
end;
while c<>' ' do begin
if c<>' ' then a[i]:=a[i]*10+ord(c)-48;
end;
if ok then a[i]:=-a[i];
if c='-' then ok:=true
else ok:=false;
while c<>'.' do begin
if (c<>'.') and (c<>'-') then b[i]:=b[i]*10+ord(c)-48;
end;
while not(eoln(f)) do begin
if not(eoln(f)) then b[i]:=b[i]*10+ord(c)-48;
end;
b[i]:=b[i]*10+ord(c)-48;
if ok then b[i]:=-b[i];
end;
close(f);
quicksort(1,n);
a[0]:=-10000001;
b[0]:=-10000001;
a[n+1]:=10000001;
b[n+1]:=10000001;
for i:=1 to n-1 do
for j:=i+1 to n do begin
if b[j]>b[i] then begin
myx:=(a[i]+a[j]-b[j]+b[i]) div 2;
myy:=(b[i]+b[j]+a[j]-a[i]) div 2;
end
else begin
myx:=(a[i]+a[j]-b[i]+b[j]) div 2;
myy:=(b[i]+b[j]-a[j]+a[i]) div 2;
end;
k1:=0;
k2:=n+1;
while k2-k1>1 do begin
if myx>a[(k1+k2) div 2] then k1:=(k1+k2) div 2
else if myx=a[(k1+k2) div 2] then
if myy>=b[(k1+k2) div 2] then k1:=(k1+k2) div 2
else k2:=(k1+k2) div 2
else k2:=(k1+k2) div 2;
end;
if (a[k1]=myx) and (b[k1]=myy) then begin
if b[j]>b[i] then begin
myx:=(a[i]+a[j]+b[j]-b[i]) div 2;
myy:=(b[i]+b[j]-a[j]+a[i]) div 2;
end
else begin
myx:=(a[i]+a[j]+b[i]-b[j]) div 2;
myy:=(b[i]+b[j]+a[j]-a[i]) div 2;
end;
k3:=0;
k4:=n+1;
while k4-k3>1 do begin
if myx>a[(k3+k4) div 2] then k3:=(k3+k4) div 2
else if myx=a[(k3+k4) div 2] then
if myy>=b[(k3+k4) div 2] then k3:=(k3+k4) div 2
else k4:=(k3+k4) div 2
else k4:=(k3+k4) div 2;
end;
if (a[k3]=myx) and (b[k3]=myy) then
inc(sol);
end;
end;
assign(f,'patrate3.out');
rewrite(f);
writeln(f,sol div 2);
close(f);
end.
``````