Cod sursa(job #135287)

Utilizator petrePajarcu Alexandru-Petrisor petre Data 13 februarie 2008 14:19:22
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.56 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(x,y,k:longint):longint;
var m:longint;
begin
if (x=y) then
         if a[x,1]=k then caut:=x
                else caut:=0
         else
         begin
         m:=(x+y) div 2;
         if a[m,1]>=k then
                caut:=caut(x,m,k)
                else caut:=caut(m+1,y,k);
         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]:=i;
                a[k][3]:=j;
                a[k][4]:=l;
                end;
sort(1,k);

j:=0;
for i:=1 to  k do
        begin
        l:=caut(1,k,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.