Cod sursa(job #1150498)

Utilizator DjokValeriu Motroi Djok Data 23 martie 2014 10:20:01
Problema Trapez Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.49 kb
var n,rs,i,j,m:longint;
    x,y:array[1..1010] of longint;
    panta:array[1..499600] of double;

    procedure swap(var q,w:double);
      var aux:double;
       begin
        aux:=q;
        q:=w;
        w:=aux;
       end;

    procedure qsort(left,right:longint);
      var i,j:longint;
          pivot:double;
       begin
        i:=left; j:=right; pivot:=panta[(left+right) div 2];
         repeat
          while panta[i]<pivot do inc(i);
          while panta[j]>pivot do dec(j);
           if i<=j then begin
                         swap(panta[i],panta[j]);
                         inc(i);
                         dec(j);
                        end;
         until i>j;
         if j>left then qsort(left,j);
         if i<right then qsort(i,right);


       end;

begin
 assign(input,'trapez.in');
 assign(output,'trapez.out');
 reset(input);
 rewrite(output);
  readln(n);
   for i:=1 to n do
    begin
     read(x[i]);
     readln(y[i]);
    end;


    for i:=1 to n do
     for j:=i+1 to n do
      if x[i]-x[j]<>0 then begin
                            inc(m);
                            panta[m]:=(y[i]-y[j])/(x[i]-x[j]);
                           end;

      qsort(1,m);


      j:=2; rs:=0;
     for i:=1 to m do
      begin
       while panta[i]=panta[j] do
        begin
         inc(rs);
         inc(j);
        end;
       j:=i+2;
      end;

    writeln(rs);
 close(input);
 close(output);
{Totusi este trist in lume}
end.