Cod sursa(job #49139)

Utilizator vanila0406Ionescu Victor vanila0406 Data 5 aprilie 2007 13:34:12
Problema Loto Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.41 kb
program loto;
var f,g:text;
        s:array[1..101] of longint;
        v:array[1..1000001] of longint;
        poz:array[0..1000001] of longint;
        n,sum,lv:longint;


procedure iofile;
var i,j,k:longint;
begin
        assign(f,'loto.in');
        reset(f);
        assign(g,'loto.out');
        rewrite(g);
        readln(f,n,sum);
        for i:=1 to n do
                read(f,s[i]);
        lv:=0;
        for i:=1 to n do
            for j:=1 to n do
                for k:=1 to n do
                        begin
                                inc(lv);
                                v[lv]:=s[i]+s[j]+s[k];
                                poz[lv]:=k+(n+1)*j+(n+1)*(n+1)*i;
                        end;
        close(f);
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;
                                        aux:=poz[i];
                                        poz[i]:=poz[j];
                                        poz[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(s1,s2:longint);
var a:array[1..6] of longint;
        aux,i,j,vl1,vl2:longint;
begin
        a[1]:=s1 mod(n+1);
        s1:=s1 div(n+1);
        a[2]:=s1 mod (n+1);
        s1:=s1 div(n+1);
        a[3]:=s1 mod (n+1);
        a[4]:=s2 mod(n+1);
        s2:=s2 div(n+1);
        a[5]:=s2 mod(n+1);
        s2:=s2 div(n+1);
        a[6]:=s2 mod(n+1);
        for i:=1 to 5 do
                for j:=i+1 to 6 do
                        if a[i]>a[j] then
                                begin
                                        aux:=a[i];
                                        a[i]:=a[j];
                                        a[j]:=aux;
                                end;
        for i:=1 to 6 do
                write(g,s[a[i]],' ');
        close(g);
        halt;
end;


procedure prel;
var i:longint;
begin
        quick(1,lv);
        for i:=1 to lv do
                begin
                if cbin(i,lv,sum-v[i])<>0 then
                        afis(poz[i],poz[cbin(i,lv,sum-v[i])]);
                end;
        writeln(g,'-1');
        close(g);
end;




begin
        iofile;
        prel;
end.