Cod sursa(job #24725)

Utilizator ScrazyRobert Szasz Scrazy Data 3 martie 2007 13:58:53
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.72 kb
uses crt;
var
  a:array[0..600000000] of word;
  t:array[1..100] of byte;
  lot:array[1..6]of byte;
  db,x:longint;
  n,i,j:longint;
  kesz:boolean;
  s:longint;
  f:text;

function binker(e,u,mit:byte):byte;
var k:byte;
begin
  if e>u then binker:=0
  else begin
    k:=(e+u)div 2;
    if mit=t[k] then binker:=k
    else if mit<t[k] then binker:=binker(e,k-1,mit)
    else binker:=binker(k+1,u,mit)
  end;
end;

procedure rendez;
var i,j:byte;
    seged:byte;
begin
  for i:=1 to db-1 do
    for j:=i+1 to db do
      if lot[i]>lot[j] then begin
        seged:=lot[i];
        lot[i]:=lot[j];
        lot[j]:=seged;
      end;
end;

procedure ut(i,j:byte);
begin
  if a[i]<>0 then
    if a[i-t[j]]+1=a[i] then begin
      ut(i-t[j],1);db:=db+1;
      if db>6 then exit;
      lot[db]:=t[j];
    end
    else ut(i,j+1);


end;

begin
  clrscr;
  assign(f,'loto.in');
  reset(f);
  readln(f,n,s);
  for i:=1 to n do read(f,t[i]);
  a[0]:=0;
  close(f);
  for i:=1 to s do a[i]:=255;
  for i:=1 to S do
    for j:=1 to n do
     if t[j]<=i then
       if a[i-t[j]]+1<a[i] then
        a[i]:=a[i-t[j]]+1;
  assign(f,'loto.out');
  rewrite(f);
  ut(s,1);
  if db<=6 then rendez;
  if db>6 then writeln(f,'-1')
  else
  if db=6 then begin for i:=1 to 6 do write(f,lot[i],' ');end
  else begin
    x:=db;
    while db<>6 do begin
      i:=1;
      kesz:=false;
      while (i<=n) and (not kesz) do begin
       if binker(1,n,lot[x]-t[i])>0 then begin
         lot[x]:=lot[x]-t[i];
         lot[x+1]:=t[i];
         db:=db+1;
         rendez;
         kesz:=true;
       end
       else i:=i+1;
      end;
    end;
    for i:=1 to 6 do write(f,lot[i],' ');
  end;

close(f);
end.