Cod sursa(job #134588)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 11 februarie 2008 21:57:41
Problema Trapez Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.76 kb
type point=record
     x,y:longint;
     end;

var a,b,c:array[0..1000] of point;
    f,g:text;
    q,w:int64;
    aux,j,nr,nr2,i,n,numar:longint;

procedure inter(st,mij,dr:longint);
 var i,j,k,t:longint;
 begin
  i:=st;
  j:=mij+1;
  k:=st;
  for t:=st to dr do
   b[t]:=a[t];
  while (i<=mij) and (j<=dr) do begin
   q:=b[i].x*b[j].y;
   w:=b[i].y*b[j].x;
   if q>w then begin
    a[k]:=b[j];
    inc(k);
    inc(j);
   end
   else begin
    a[k]:=b[i];
    inc(k);
    inc(i);
   end;
  end;
  for t:=i to mij do begin
   a[k]:=b[t];
   inc(k);
  end;
  for t:=j to dr do begin
   a[k]:=b[t];
   inc(k);
  end;
 end;

procedure mergesort(st,dr:longint);
 var mij:longint;
 begin
  if st<dr then begin
   mij:=(st+dr) div 2;
   mergesort(st,mij);
   mergesort(mij+1,dr);
   inter(st,mij,dr);
  end;
 end;

procedure comb(x:longint);
 var e:longint;
 begin
  e:=(x-1)*x div 2;
  inc(nr2,e);
 end;

begin
 assign(f,'trapez.in'); reset(f);
 assign(g,'trapez.out'); rewrite(g);
 read(f,n);
 for i:=1 to n do
  read(f,c[i].x,c[i].y);
 for i:=1 to n-1 do
  for j:=i+1 to n do
   if (c[i].x>c[j].x) or ((c[i].x=c[j].x) and (c[i].y>c[j].y)) then begin
    aux:=c[i].x;
    c[i].x:=c[j].x;
    c[j].x:=aux;
    aux:=c[i].y;
    c[i].y:=c[j].y;
    c[j].y:=aux;
   end;

 for i:=1 to n-1 do
  for j:=i+1 to n do begin
   inc(numar);
   a[numar].x:=c[i].x-c[j].x;
   a[numar].y:=c[i].y-c[j].y;
  end;
 n:=numar;
 mergesort(1,n);
 a[0]:=a[1];
 i:=1;
 while i<=n do begin
  nr:=1;
  q:=a[i].x*a[i+1].y;
  w:=a[i].y*a[i+1].x;
  while (q=w) and (i+1<=n) do begin
   inc(nr);
   inc(i);
   q:=a[i].x*a[i+1].y;
   w:=a[i].y*a[i+1].x;
  end;
  comb(nr);
  inc(i);
 end;
 writeln(g,nr2);
 close(g); close(f);
end.