Cod sursa(job #170894)

Utilizator petrePajarcu Alexandru-Petrisor petre Data 3 aprilie 2008 13:54:41
Problema Oite Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.07 kb
var a:array[1..1024] of longint;
nr,n,i,j,k,l,p:longint;

procedure Sort(l, r: Integer);
var
  i, j, x, y: integer;
begin
  i := l; j := r; x := a[(l+r) DIV 2];
  repeat
    while a[i] < x do i := i + 1;
    while x < a[j] do j := j - 1;
    if i <= j then
    begin
      y := a[i]; a[i] := a[j]; a[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;
begin
assign(input,'oite.in');
assign(output,'oite.out');
reset(input);
rewrite(output);
readln(n,l);
for i:=1 to n do read(a[i]); nr:=0;
sort(1,N);
for i:=1 to n do
        if a[i]> l div 4 then break
                else
        for j:=i+1 to n do
         if a[j]> l div 3 then break else
                for k:=j+1 to n do
         if a[k]> l div 2 then break else
                for p:=k+1 to n do
                        if a[i]+a[j]+a[k]+a[p]=l then
                                                 inc(NR)
                        else if a[i]+a[j]+a[k]+a[p]>l then break;
writeln(nr);
close(input);
close(output);
end.