Cod sursa(job #47808)

Utilizator vanila0406Ionescu Victor vanila0406 Data 3 aprilie 2007 23:54:54
Problema Loto Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.68 kb
program loto;
var f,g:text;
        v:array[1..101] of longint;
        s,n:longint;
        b:array[1..6] of byte;
        viz:array[1..101] of byte;





procedure iofile;
var i:longint;
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]);
        close(f);
        fillchar(viz,sizeof(viz),0);
end;


procedure pozitie(var m:longint;p,u:longint);
var i,j,di,dj,aux:longint;
begin
        i:=p;
        j:=u;
        di:=0;
        dj:=-1;
        while i<j do
                begin
                        if v[i]<v[j] then
                                begin
                                        aux:=di;
                                        di:=-dj;
                                        dj:=-aux;
                                        aux:=v[i];
                                        v[i]:=v[j];
                                        v[j]:=aux;
                                end;
                        i:=i+di;
                        j:=j+dj;
                end;
        m:=i;
end;



procedure quick(p,u:longint);
var m:longint;
begin
        if p<u then
                begin
                        pozitie(m,p,u);
                        quick(p,m-1);
                        quick(m+1,u);
                end;
end;





function cbin(p,u,x:longint):byte;
var m:longint;
begin
        if p>u then
                cbin:=0 else
                begin
                        m:=(p+u) div 2;
                        if v[m]=x then cbin:=m else
                        if v[m]>x then cbin:=cbin(m+1,u,x) else
                        if v[m]<x then cbin:=cbin(p,m-1,x);
                end;
end;


procedure afis;
var i,j:longint;
begin
        for i:=n downto 1 do
                for j:=1 to viz[i] do
                        write(g,v[i],' ');
        close(g);
        halt;
end;

procedure prel(k:byte;sum:longint);
var i:longint;
begin
        if k=6 then
                begin
                if cbin(1,n,sum)<>0 then
                        begin
                        inc(viz[cbin(1,n,sum)]);
                afis; end; end  else
        for i:=1 to n do
                begin
                        if v[i]<=sum then
                           begin
                                inc(viz[i]);
                                prel(k+1,sum-v[i]);
                                dec(viz[i]);
                           end;
                end;
end;



begin
        iofile;
        quick(1,n);
        prel(1,s);
        writeln(g,'-1');
        close(g);
end.