Cod sursa(job #13493)

Utilizator floringh06Florin Ghesu floringh06 Data 6 februarie 2007 20:56:51
Problema Loto Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.76 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[0..100] of longword;
    st,dr,mj,caut,int,ll,dif,c: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;       }
 ll:=trunc(s/6);
 if ll=s/6 then
   for i:=1 to n do
    if a[i]=s/6 then
     begin
      for j:=1 to 6 do
          write(fo,a[i],' ');
          close(fo);
          halt;
      end;
 dif:=1000000;
 for i:=1 to n do
   if (ll-a[i]<=dif) and (ll-a[i]>=0) then
    begin
     dif:=ll-a[i];
     c:=i;
     break;
    end;
 a[0]:=a[1];
 for i:=c to n do
  begin
        caut:=0;
        int:=s-(a[p]+a[j]+a[k]+a[l]+a[m]);
        cautb(int);
        if caut<>0 then
          begin
           writeln(fo,a[p],' ',a[j],' ',a[k],' ',a[l],' ',a[m],' ',caut);
           close(fo);
           halt
          end;
  for j:=1 to n do
      begin
        caut:=0;
        int:=s-(a[i]+a[p]+a[k]+a[l]+a[m]);
        cautb(int);
        if caut<>0 then
          begin
           writeln(fo,a[i],' ',a[p],' ',a[k],' ',a[l],' ',a[m],' ',caut);
           close(fo);
           halt
          end;
   for k:=1 to n do
      begin
        caut:=0;
        int:=s-(a[i]+a[j]+a[p]+a[l]+a[m]);
        cautb(int);
        if caut<>0 then
          begin
           writeln(fo,a[i],' ',a[j],' ',a[p],' ',a[l],' ',a[m],' ',caut);
           close(fo);
           halt
          end;
    for l:=1 to n do
      begin
        caut:=0;
        int:=s-(a[i]+a[j]+a[k]+a[p]+a[m]);
        cautb(int);
        if caut<>0 then
          begin
           writeln(fo,a[i],' ',a[j],' ',a[k],' ',a[p],' ',a[m],' ',caut);
           close(fo);
           halt
          end;
     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;
      end;
     end;
    end;
   end;
   writeln(fo,'-1');
   close(fo);
 end.