Cod sursa(job #57477)

Utilizator cezar305Mr. Noname cezar305 Data 2 mai 2007 11:00:01
Problema Trapez Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.81 kb
var f1,f2:text;
    i,j,n,g,nr,aux:longint;
    e,f:extended;
    a,b:array[1..1000000] of qword;
    x,y:array[1..1000] of longint;

begin
        assign(f1,'trapez.in');
        reset(f1);
        assign(f2,'trapez.out');
        rewrite(f2);
        read(f1,n);
        for i:=1 to n do
                read(f1,x[i],y[i]);
        g:=0;
        for i:=1 to n-1 do
                for j:=i+1 to n do
                begin
                        inc(g);
                        a[g]:=sqr(x[i]-x[j])+sqr(y[i]-y[j]);
                        b[g]:=sqr(y[i]-y[j]);
                        if (y[i]>y[j]) then b[g]:=b[g]*-1;
                end;
        for i:=1 to n-1 do
                for j:=i+1 to n do
                begin
                        if a[i]>a[j] then
                        begin
                                aux:=a[i];
                                a[i]:=a[j];
                                a[j]:=aux;
                                aux:=b[i];
                                b[i]:=b[j];
                                b[j]:=aux;
                        end;
                        if (a[i]=a[j])and(b[i]>b[j]) then
                        begin
                                aux:=a[i];
                                a[i]:=a[j];
                                a[j]:=aux;
                                aux:=b[i];
                                b[i]:=b[j];
                                b[j]:=aux;
                        end;
                end;
        for i:=1 to g-1 do
        begin
                e:=b[i]/a[i];
                for j:=i+1 to g do
                begin
                        f:=b[j]/a[j];
                        if e=f then inc(nr);
                end;
        end;
        writeln(f2,nr);
        close(f1);
        close(f2);
end.