Cod sursa(job #135294)

Utilizator petrePajarcu Alexandru-Petrisor petre Data 13 februarie 2008 14:44:04
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.55 kb
var a:array[0..1000000,1..4] of longint;
p:array[1..100] of longint;
n,i,j,k,s,l:longint;

procedure Sort(l, r: Integer);
var
  i, j, x, y: integer;
begin
  i := l; j := r; x := a[(l+r) DIV 2,1];
  repeat
    while a[i,1] < x do i := i + 1;
    while x < a[j,1] do j := j - 1;
    if i <= j then
    begin
      a[0] :=a[i]; a[i]:=a[j]; a[j]:=a[0];
      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;

function caut(l:longint):longint;
var x,y,m:longint;
begin
x:=1;
y:=k;
caut:=0;
while (x<y)and(caut=0) do
        begin
        m:=(x+y)div 2;
        if a[m,1]=l then caut:=m
        else
         if a[m,1]<l then
                        x:=m+1
            else y:=m-1;
        end;
end;


begin
assign(input,'loto.in');
assign(output,'loto.out');
reset(input);
rewrite(output);
readln(n,s);
for i:=1 to n do read(p[i]);



for i:=1 to n do
   for j:=1 to n do
        for l:=1 to n do
                begin
                inc(k);
                a[k][1]:=p[i]+p[j]+p[l];
                a[k][2]:=p[i];
                a[k][3]:=p[j];
                a[k][4]:=p[l];
                end;
sort(1,k);

j:=0;
for i:=1 to  k do
        begin
        l:=caut(s-a[i,1]);
        if l<>0 then
                 begin
                 writeln(a[i,2],' ',a[i,3],' ',a[i,4],' ',a[l,2],' ',a[l,3],' ',a[l,4]);
                 j:=1;
                 break;
                 end;
        end;
if j=0 then writeln(-1);
close(input);
close(output);
end.