Cod sursa(job #68065)

Utilizator tamas_iuliaTamas Iulia tamas_iulia Data 26 iunie 2007 13:17:11
Problema Loto Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.16 kb
var i,j,n,br : byte;
    sum,z,k,m,pr,sf,x,aux : longint;
    s,ii,jj,kk,v : array[1..800000] of longint;
    a : array[1..100] of longint;
    gasit : boolean;
    f,g : text;
    nod : array[1..6] of longint;




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:=ii[i];
                                        ii[i]:=ii[j];
                                        ii[j]:=aux;
                                        aux:=jj[i];
                                        jj[i]:=jj[j];
                                        jj[j]:=aux;
                                        aux:=kk[i];
                                        kk[i]:=kk[j];
                                        kk[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;




begin
assign(f,'loto.in'); reset(f);
assign(g,'loto.out'); rewrite(g);
read(f,n,sum);
for i:=1 to n do read(f,a[i]);

for i:=1 to n do begin
        for j:=i to n do begin
                for k:=j to n do begin
                                         inc(z);
                                         ii[z]:=i; jj[z]:=j; kk[z]:=k;
                                         s[z]:=a[i]+a[j]+a[k];
                                   end;
                             end;
                   end;

v:=s;
quick(1,z);
s:=v;

for k:=1 to z do begin
 x:=sum - s[k];
 pr:=1; sf:=z; m:= z div 2;
 gasit:=false;
        repeat

           if s[m]=x then begin
           nod[1]:=a[ii[k]];
           nod[2]:=a[jj[k]] ;
           nod[3]:=a[kk[k]]  ;
           nod[4]:=a[ii[m]]   ;
           nod[5]:=a[jj[m]]    ;
           nod[6]:=a[kk[m]]     ;
           repeat
           gasit:=true;
           for br:=1 to 5 do
            if nod[br]>nod[br+1] then begin
            aux:=nod[br];
            nod[br]:=nod[br+1];
            nod[br+1]:=aux; gasit:=false;
            end;
           until gasit;

                   for br:=1 to 6 do write(g,nod[br],' ');
                   writeln(g);
                   close(g);
                   halt;
                          end
                     else if x<s[m] then sf:=m-1
                                    else pr:=m+1;
        m:=(pr+sf) div 2;
        until gasit or (m<pr) or (m>sf);



end;

writeln(g,'-1');
close(g);
end.