Cod sursa(job #13472)

Utilizator floringh06Florin Ghesu floringh06 Data 6 februarie 2007 19:44:24
Problema Loto Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.32 kb
{$IFDEF NORMAL}
  {$I-,Q-,R-,S-}
{$ENDIF NORMAL}
{$IFDEF DEBUG}
  {$I+,Q+,R+,S-}
{$ENDIF DEBUG}
{$IFDEF RELEASE}
  {$I-,Q-,R-,S-}
{$ENDIF RELEASE}

program loto;
var fi,fo:text;
    n,i,j,k,l,m,p,s:longint;
    a:array[1..100] of longword;
    st,dr,mj,caut,int:longint;
    ok:boolean;

 procedure cautb(x:longint);
   begin
    st:=1;
    dr:=n;
    while st<=dr do
      begin
        mj:=(st + dr) div 2;
        if x=a[mj] then begin caut:=a[mj]; break; end;
        if x< a[mj] then dr:=mj-1;
        if x> a[mj] then st:=mj+1;
      end;
   end;

 function part(st,dr:longint):longint;
   var p,i,j,aux:longint;
       sens:integer;
    begin

      p := st + random(dr-st+1);
      aux:=a[st];
      a[st]:=a[p];
      a[p]:=aux;

      i:=st; j:=dr; sens:=-1;
      while i<j do
        begin
          if a[i]>a[j] then
           begin
            aux:=a[i];
            a[i]:=a[j];
            a[j]:=aux;
            sens:=-sens;
           end;
           if sens=1 then inc(i)
               else dec(j);
        end;
      part:=i;
   end;

 procedure qsort(st,dr:longint);
   var p:longint;
   begin
     if st<dr then
       begin
        p:=part(st,dr);
        qsort(st,p-1);
        qsort(p+1,dr);
       end;
   end;


begin
 assign(fi,'loto.in'); reset(fi);
 assign(fo,'loto.out'); rewrite(fo);
 readln(fi,n,s);
 for i:=1 to n do
   read(fi,a[i]);
 close(fi);
 qsort(1,n);
{ ok:=true;
 for i:=1 to n do
  begin
   if (s mod a[i]=0) and (a[i]<>1) then
     ok:=false;
  end;
 if ok=true then
  begin
   writeln(fo,'-1');
   close(fo);
   halt
  end;       }
 for i:=1 to n do
  for j:=1 to n do
   for k:=1 to n do
    for l:=1 to n do
     for m:=1 to n do
      begin
        caut:=0;
        int:=s-(a[i]+a[j]+a[k]+a[l]+a[m]);
        cautb(int);
        if caut<>0 then
          begin
           writeln(fo,a[i],' ',a[j],' ',a[k],' ',a[l],' ',a[m],' ',caut);
           close(fo);
           halt
          end
        else
          for p:=mj-1 to n do
             if a[i]+a[j]+a[k]+a[l]+a[m]+a[p]=s then
               begin
                 writeln(fo,a[i],' ',a[j],' ',a[k],' ',a[l],' ',a[m],' ',a[p]);
                 close(fo);
                 halt
               end;
       end;
   writeln(fo,'-1');
   close(fo);
 end.