Cod sursa(job #168042)

Utilizator ProtomanAndrei Purice Protoman Data 30 martie 2008 17:18:29
Problema Oite Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.24 kb
const dif=10000;
      bz=150001;

type point=^nod;
     nod=record
         el:longint;
         ua:point;
     end;

var f1,f2:text;
    i,j,c,sm,a1,a2:longint;
    nr:int64;
    a:array[0..100035] of longint;
    l:array[0..bz+2] of point;

procedure clad(loc:longint);
var p:point;
begin
        new(p);
        p^.el:=dif*i+j;
        p^.ua:=l[loc];
        l[loc]:=p;
end;

procedure cauta(loc:longint);
var p:point;
begin
        p:=l[loc];
        while p<>nil do
        begin
                a1:=p^.el div dif;
                a2:=p^.el mod dif;
                if (sm-a[i]-a[j]=a[a1]+a[a2])and(a1<>i)and(a2<>i)and(a1<>j)and(a2<>j) then
                        inc(nr);
                p:=p^.ua;
        end;
end;

begin
        assign(f1,'oite.in');
        reset(f1);
        assign(f2,'oite.out');
        rewrite(f2);
        read(f1,c,sm);
        for i:=1 to c do
                read(f1,a[i]);
        for i:=1 to c-1 do
                for j:=i+1 to c do
                        clad((a[i]+a[j]) mod bz);
        for i:=1 to c-1 do
                for j:=i+1 to c do
                        cauta((sm-a[i]-a[j]) mod bz);
        writeln(f2,nr div 6);
        close(f1);
        close(f2);
end.