Cod sursa(job #356248)

Utilizator cristinabCristina Brinza cristinab Data 13 octombrie 2009 22:20:33
Problema Trapez Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.78 kb
type punct=record
           numarator,numitor:int64;
           end;

var panta:array[1..100000] of punct;
    x,y:array[1..1000] of longint;
    n:longint;
    k,numar:int64;

procedure citire;
var f:text;
    i:longint;
begin
assign(f,'trapez.in'); reset(f);
readln(f,n);
for i:=1 to n do readln(f,x[i],y[i]);
close(f);
end;


procedure panta_;
var i,j:longint;
begin

for i:=1 to n-1 do
    for j:=i+1 to n do
        begin
        inc(k);
        panta[k].numarator:=y[j]-y[i];
        panta[k].numitor:=x[j]-x[i];
        if panta[k].numitor<0 then
           begin
           panta[k].numarator:=panta[k].numarator*(-1);
           panta[k].numitor:=panta[k].numitor*(-1);
           end
        end;

end;

procedure qsort(l,r:integer);
var i,j:longint;
    aux,p:punct;

begin

i:=l;
j:=r;
p.numarator:=panta[(i+j) div 2].numarator;
p.numitor:=panta[(i+j) div 2].numitor;

repeat
  while p.numarator*panta[i].numitor>p.numitor*panta[i].numarator do inc(i);
  while p.numarator*panta[j].numitor<p.numitor*panta[j].numarator do dec(j);

  if i<=j then
     begin
     aux:=panta[i];
     panta[i]:=panta[j];
     panta[j]:=aux;
     inc(i);
     dec(j);
     end;

until i>=j;

if l<j then qsort(l,j);
if i<r then qsort(i,r);
end;

procedure numar_;
var i,j:int64;

begin

i:=1;

while i<=k-1 do
      begin
      j:=i+1;
      while j<=k do
            begin
            if panta[i].numarator*panta[j].numitor=panta[i].numitor*panta[j].numarator then inc(numar);
            inc(j);
            end;
      inc(i);
      end;
end;


procedure afisare;
var g:text;
begin
assign(g,'trapez.out'); rewrite(g);
writeln(g,numar);
close(g);
end;

begin
numar:=0;
citire;
panta_;
qsort(1,n);
numar_;
afisare;
end.