Cod sursa(job #7506)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 21 ianuarie 2007 16:27:20
Problema Patrate 3 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.92 kb
var f,g:text;
    a,b:array[1..1000] of real;
    n,i,j,k,q,nr:longint;
procedure citesc;
 var r:longint;
 begin
 readln(f,n);
 for r:=1 to n do begin
  readln(f,b[r],a[r]);
 end;
 end;
procedure ordonez;
 var i,j:longint;
     x:real;
 begin
  for i:=1 to n-1 do
   for j:=i+1 to n do
    if a[i]>a[j] then begin
     x:=a[i];
     a[i]:=a[j];
     a[j]:=x;
     x:=b[i];
     b[i]:=b[j];
     b[j]:=x;
    end;
 end;
begin
 assign(f,'patrate3.in'); reset(f);
 assign(g,'patrate3.out'); rewrite(g);
 citesc; ordonez;
 nr:=0;
 for i:=1 to n-3 do
  for j:=i+1 to n-2 do
   for k:=j+1 to n-1 do
    for q:=k+1 to n do
     if (abs(b[i]-b[j])=abs(b[k]-b[q])) then
     if (abs(a[i]-a[k])=abs(a[j]-a[q])) then
     if (abs(b[i]-b[j])=abs(a[k]-a[i])) then
     if (abs(a[j]-a[k])=abs(a[i]-a[q])) then
     if (abs(b[j]-b[k])=abs(b[i]-b[q])) then
      nr:=nr+1;
 writeln(g,nr);
 close(g); close(f);
end.