Cod sursa(job #499)

Utilizator gurneySachelarie Bogdan gurney Data 11 decembrie 2006 13:59:11
Problema Trapez Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.81 kb
program trapez;
  const
    fin='trapez.in';
    fout='trapez.out';
    nmax=1000;
    eps=maxlongint;
  type
    pct=record
        x,y:longint;
        end;

  var
    a:array[1..nmax] of pct;
    nr:int64;
    c:longint;
    comb,k,x,n:int64;
    i,j,l,dim:longint;
    n1,n2,ind:array[1..nmax*nmax] of longint;

  function cmmdc(x,y:longint):longint;
    var
      rest:longint;
    begin
      if x=0 then
        cmmdc:=y
      else
        if y=0 then
          cmmdc:=x
        else
        begin
      repeat
        rest:=x mod y;
        x:=y;
        y:=rest;
      until rest=0;
      cmmdc:=x;
      end;
    end;

  function part(st,dr:longint):longint;
    var
      x1,x2:longint;
      aux,i,j:longint;
    begin
      i:=st-1;j:=dr+1;
      x1:=n1[st];x2:=n2[st];
      while i<j do
        begin
          repeat
            inc(i);
          until (n1[i]*x2>=n2[i]*x1);
          repeat
            dec(j);
          until (n1[j]*x2<=n2[j]*x1);
          if i<j then
            begin
              aux:=n1[i];n1[i]:=n1[j];n1[j]:=aux;
              aux:=n2[i];n2[i]:=n2[j];n2[j]:=aux;
            end;
        end;
      part:=j;
    end;

  procedure qsort(st,dr:longint);
    var
      p:longint;
    begin
      if st<dr then
        begin
          p:=part(st,dr);
          qsort(st,p);
          qsort(p+1,dr);
        end;
    end;

begin
  assign(input,fin);
    reset(input);
    readln(n);
    for i:=1 to n do
      readln(a[i].x,a[i].y);
  close(input);
  assign(output,fout);
    rewrite(output);
    dim:=0;
    for i:=1 to n-1 do
      for j:=i+1 to n do
        begin
          inc(dim);
          if a[i].x-a[j].x<>0 then
            begin
              n1[dim]:=a[i].y-a[j].y;n2[dim]:=a[i].x-a[j].x;
              c:=cmmdc(n1[dim],n2[dim]);
              if (c<>0)and(n1[dim]<>0) then
              begin
              n1[dim]:=n1[dim] div c;
              n2[dim]:=n2[dim] div c;
              if n2[dim]<0 then
                begin
                  n2[dim]:=-n2[dim];
                  n1[dim]:=-n1[dim];
                end;
              ind[dim]:=dim;
              end
              else if n1[dim]=0 then
                begin
                  n1[dim]:=eps -1;
                  n2[dim]:=1;
                  ind[dim]:=dim;
                end;
            end
          else
            begin
              ind[dim]:=dim;
              n1[dim]:=eps;n2[dim]:=1;
            end;
        end;
    qsort(1,dim);
    i:=1;
    while i<=dim do
      begin
        k:=1;j:=i+1;
        while (j<=dim)and((n1[i]=n1[j])and(n2[i]=n2[j])) do
          begin
            inc(k);
            inc(j);
          end;
        inc(nr,k*(k-1) div 2);
        i:=j;
      end;
    writeln(nr);
  close(output);
end.