Cod sursa(job #14051)

Utilizator floringh06Florin Ghesu floringh06 Data 8 februarie 2007 09:21:50
Problema Loto Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.77 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;
    sc,st,dr,mj,caut,int,ll,dif,c,d,int1:longint;
    ok:boolean;

 procedure cautb(x:longint);
   begin
    st:=l;
    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);
 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;

 a[0]:=a[n];
 for i:=1 to n do
  begin
   sc:=sc+a[i];
   if sc<s then
    for j:=i to n do
    begin
     sc:=sc+a[j];
     if sc<s then
     for k:=j to n do
     begin
      sc:=sc+a[k];
      if sc<s then
      for l:=k to n do
      begin
      sc:=sc+a[l];
      if sc<s then
      for m:=l to n do
      begin
       sc:=sc+a[m];
       if (sc<s) and (s-sc>a[n]) and (s-sc<a[i]) then
       begin
        caut:=0;
        int:=s-sc;
        if int>0 then cautb(int);
        if caut<>0 then
          begin
           writeln(fo,a[i],' ',a[j],' ',a[k],' ',a[l],' ',a[m],' ',caut);
           close(fo);
           halt
          end
        end
        else
          for p:=m 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;
        sc:=sc-a[m];
       end;
      sc:=sc-a[l];
     end;
    sc:=sc-a[k];
   end;
  sc:=sc-a[j];
  end;
 sc:=sc-a[i];
end;
   writeln(fo,'-1');
   close(fo);
 end.