Cod sursa(job #319560)

Utilizator marta_diannaFII Filimon Marta Diana marta_dianna Data 1 iunie 2009 10:28:43
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.96 kb
program p1;   
var f,g:text;   
    x:array[1..800] of longint;   
    i,n,p,u,nr,j,l,st,dr,m:longint;

procedure part(st,dr:longint;var m:longint);
var p,aux,s,d:longint;
begin
     p:=x[st];s:=st;d:=dr;
     while s<d do
           begin
                while (s<=dr) and (x[s]<=p) do s:=s+1;
                while (d>st) and (x[d]>p) do d:=d-1;
                if s<d then begin
                            aux:=x[s];
                            x[s]:=x[d];
                            x[d]:=aux;
                            end;
           end;
     m:=d;
     aux:=x[st];
     x[st]:=x[m];
     x[m]:=aux;
end;

procedure quick(st,dr:longint);
var m:longint;
begin
     if dr>st then begin
                        part(st,dr,m);
                        if st<m-1 then quick(st,m-1);
                        if m+1<dr then quick(m+1,dr);
                  end;
end;

begin
     assign(f,'nrtri.in');reset(f);
     assign(g,'nrtri.out');rewrite(g);
     read(f,n);
     for i:=1 to n do read(f,x[i]);
     nr:=0;
     quick(1,n);
     for i:=1 to n-2 do
         for j:=i+1 to n-1 do
             begin
                  p:=0;
                  u:=x[i]+x[j];
                  if u>=x[n] then p:=n-j
                             else if u>=x[j+1] then begin
                                                    st:=j+1;
                                                    dr:=n;
                                                    repeat
                                                    m:=(st+dr) div 2;
                                                    if x[m]>=u then st:=m
                                                               else dr:=m;
                                                    until dr-st=0;
                                                    p:=st-j;
                                               end;
                  nr:=nr+p;
             end;
     writeln(g,nr);
     close(f);   
     close(g);   
end.