Cod sursa(job #17517)

Utilizator hitmannCiocas Radu hitmann Data 16 februarie 2007 01:50:26
Problema Numarare triunghiuri Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.42 kb
var st:Array[1..3]of longint;
    v:array[1..1000]of longint;
    n,k,i,j:longint;
    as,ev:boolean;
    f: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]);
end;
procedure sort(s,d:integer);
var aux,i,j,e:integer;
begin
i:=s;
j:=d;
e:=v[(s+d)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 s<j then sort(s,j);
 if d>i then sort(i,d);
 end;
procedure init;
begin
st[k]:=0;
end;
procedure succesor;
begin
if st[k]<n then begin
              as:=true;
              inc(st[k]);
              end
           else as:=false;
end;
procedure valid;
begin
ev:=true;
i:=1;
while (i<=k-1)and ev do begin if st[k]=st[i] then ev:=false; inc(i); end;
if ev then if k>=2 then if st[k-1]>st[k] then ev:=false;
if ev then if k=3 then if v[st[1]]+v[st[2]]<v[st[3]] then ev:=false;
end;
function solutie:boolean;
begin
solutie:=(k=3);
end;
begin {pp}
citire;
sort(1,n);
k:=1;
init;
while k>0 do
 begin
 repeat succesor;
 if as then valid;
 until not as or (as and ev);
 if as then if solutie then inc(j)
                       else begin inc(k); init; end
       else dec(k);
 end;
assign(f,'nrtri.out');
rewrite(f);
write(f,j);
close(f);
end.