Cod sursa(job #9194)

Utilizator fogabFodor Gabor fogab Data 26 ianuarie 2007 23:33:27
Problema Patrate 3 Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 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);
readln(f,n);
for i:=1 to n do begin
                 read(f,c);
                 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;
                                 read(f,c);
                                 end;
                 while c<>' ' do begin
                                 read(f,c);
                                 if c<>' ' then a[i]:=a[i]*10+ord(c)-48;
                                 end;
                 if ok then a[i]:=-a[i];
                 read(f,c);
                 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;
                                 read(f,c);
                                 end;
                 while not(eoln(f)) do begin
                                 read(f,c);
                                 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];
                 readln(f);
                 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.