Cod sursa(job #171405)

Utilizator kolapsysPostelnicu Dan Marian kolapsys Data 4 aprilie 2008 11:55:11
Problema Loto Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.79 kb
{ http://infoarena.ro/problema/loto }
type stiva=array[1..6] of byte;
     vector=array[1..100] of int64;
var v:vector;
    st:stiva;
    as,ev,q:boolean;
    stemp,s:int64;
    n,k,i:byte;
    f,g:text;
{ ***** backtracking iteractiv ***** }
procedure init(k:integer; var st:stiva);
begin
    st[k]:=0;
end;

procedure succesor(k:integer; var st:stiva; var as:boolean);
begin
     if (st[k]<n) and (k<=6) then begin
                 as:=true;
                 st[k]:=st[k]+1;
                 end
            else as:=false;
end;

procedure valid(k:integer; st:stiva; var ev:boolean);
begin
     ev:=true;
end;

function sol(k:integer):boolean;
var ok:boolean;
begin
     stemp:=0;
     for i:=1 to k do
         stemp:=stemp+v[st[i]];
     ok:=(k=6) and (stemp=s);
     if ok then q:=true;
     sol:=ok;
end;
procedure tipar;
var i:integer;
begin
    for i:=1 to 6 do
        write(g,v[st[i]],' ');
end;
{ ***** sfarsit ***** }

BEGIN
     assign(f,'loto.in'); reset(f);
     assign(g,'loto.out'); rewrite(g);
     readln(f,n,s);
     for i:=1 to n do
         read(f,v[i]);
     k:=1;
     init(k,st); q:=false;
     while k>0 do
           begin
           repeat
                 succesor(k,st,as);
                 if as then valid(k,st,ev);
           until not(as) or (as and ev);
           if as then if sol(k) then begin
                                     tipar;
                                     break;
                                     end
                                else begin
                                     k:=k+1;
                                     init(k,st);
                                     end
                 else k:=k-1;
           end;
     if not(q) then writeln(g,-1);
     close(f); close(g);
END.