Cod sursa(job #57001)

Utilizator CezarMocanCezar Mocan CezarMocan Data 30 aprilie 2007 21:32:15
Problema Loto Scor 35
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.63 kb
type vector=array[0..1000001]of longint;
var x,p1,p2,p3:vector;
    i,j,k,n,s,g,sum,aux:longint;
    v:array[1..1300]of longint;

procedure qsort(ls,ld:longint);
var i,j,aux:longint;
begin
  i:=ls;j:=ld;
  while true do begin
    while (x[i]<=x[j])and(i<>j) do inc(i);
    if i=j then break;
    aux:=x[i];x[i]:=x[j];x[j]:=aux;
    aux:=p1[i];p1[i]:=p1[j];p1[j]:=aux;
    aux:=p2[i];p2[i]:=p2[j];p2[j]:=aux;
    aux:=p3[i];p3[i]:=p3[j];p3[j]:=aux;
    dec(j);
    while (x[i]<=x[j])and(i<>j) do dec(j);
    if i=j then break;
    aux:=x[i];x[i]:=x[j];x[j]:=aux;
    aux:=p1[i];p1[i]:=p1[j];p1[j]:=aux;
    aux:=p2[i];p2[i]:=p2[j];p2[j]:=aux;
    aux:=p3[i];p3[i]:=p3[j];p3[j]:=aux;
    inc(i);
  end;
  if j-1>ls then qsort(ls,j-1);
  if j+1<ld then qsort(j+1,ld);
end;

function gasit(n,ls,ld:longint):longint;
var m:longint;
begin
m:=(ls+ld) div 2;
if x[m]=n then
        begin
        gasit:=m;
        exit;
        end;
if ls>=ld then
        begin
        gasit:=0;
        exit;
        end;
if n<x[m] then
        gasit:=gasit(n,ls,m-1)
else
        gasit:=gasit(n,m+1,ld);
end;

begin
assign(input,'loto.in');reset(input);
assign(output,'loto.out');rewrite(output);
readln(n,s);
for i:=1 to n do
        read(v[i]);
for i:=1 to n-1 do
        for j:=i+1 to n do
                if v[i]>v[j] then
                        begin
                        aux:=v[i];
                        v[i]:=v[j];
                        v[j]:=aux;
                        end;
for i:=1 to n do
        for j:=1 to n do
                for k:=1 to n do
                        begin
                        inc(x[0]);
                        x[x[0]]:=v[i]+v[j]+v[k];
                        p1[x[0]]:=i;
                        p2[x[0]]:=j;
                        p3[x[0]]:=k;
                        end;
qsort(1,x[0]);
for i:=1 to n do
        for j:=1 to n do
                for k:=1 to n do
                        begin
                        sum:=v[i]+v[j]+v[k];
                        sum:=s-sum;
                        if (sum>=0) then
                                begin
                                g:=gasit(sum,1,x[0]);
                                if g<>0 then
                                        begin
                                        writeln(v[i],' ',v[j],' ',v[k],' ',v[p1[g]],' ',v[p2[g]],' ',v[p3[g]]);
                                        close(output);
                                        halt;
                                        end;
                                end;
                        end;
writeln(-1);
close(input);close(output);
end.