Cod sursa(job #20435)

Utilizator hitmannCiocas Radu hitmann Data 21 februarie 2007 15:06:48
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.65 kb
program numtri;
var v:Array[1..800]of integer;
    n,i,j,x,p:integer;
    g:text;
procedure citire;
var f:text;
begin
assign(f,'nrtri.in'); reset(f);
read(f,n);
for i:=1 to n do read(f,v[i]);
close(f);
end;
procedure quicksort(s,d:integer);
var i,j,e,aux:integer;
begin
i:=s;
j:=d;
e:=v[(i+j)div 2];
repeat
while v[i]<e do inc(i);
while v[j]>e do dec(j);
if i<=j then
        begin
        aux:=v[i];
        v[i]:=v[j];
        v[j]:=aux;
        inc(i);
        dec(j);
        end;
until i>j;
if i<d then quicksort(i,d);
if j>s then quicksort(s,j);
end;
function search(x:integer):integer;
var e,s,d,pozitie:integer;
ok:boolean;
begin
search:=0;
pozitie:=0;
s:=j+1;
d:=n;
ok:=true;

while (s<=d)and ok do
 begin
 e:=(s+d)div 2;
 if x=v[e] then begin
                pozitie:=e; ok:=false; end
           else if x>v[e] then begin
                               pozitie:=e;
                               s:=e+1;
                               end

                          else
                               begin
                               d:=e-1;
                               pozitie:=e;
                               end;
 end;
if v[pozitie]>x then dec(pozitie);
if (pozitie<1)or(pozitie<j+1)or(pozitie>n)or(v[pozitie]>x) then search:=0
                else search:=pozitie;
end;
begin {pp}
citire;
quicksort(1,n);
writeln('solutii wrong');
for i:=1 to n-2 do
 for j:=i+1 to n-1 do
 begin
 p:=search(v[i]+v[j]);
 if p<>0 then begin
              x:=x+(p-j);
              writeln(v[i],' ',v[j],' ',v[p]);
              end;
 end;
assign(g,'nrtri.out');rewrite(g);
write(g,x);
close(g);
end.