Cod sursa(job #47526)

Utilizator ProtomanAndrei Purice Protoman Data 3 aprilie 2007 19:35:12
Problema Loto Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.81 kb
var a:array[1..10000000,1..4] of longint; z:array[1..100] of longint; ok,ind,x,i,j,g,nr,n,s,m:longint; f1,f2:text;

procedure pozitie(var m:longint; p,u:longint);
var i,j,di,dj,aux:longint;
begin
di:=0;
dj:=-1;
i:=p;
j:=u;
while i<j do
begin
if a[i,1]>a[j,1] then
begin
aux:=di;
di:=-dj;
dj:=-aux;
aux:=a[i,1];
a[i,1]:=a[j,1];
a[j,1]:=aux;
aux:=a[i,2];
a[i,2]:=a[j,2];
a[j,2]:=aux;
aux:=a[i,3];
a[i,3]:=a[j,3];
a[j,3]:=aux;
aux:=a[i,4];
a[i,4]:=a[j,4];
a[j,4]:=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;

procedure search(li,ls:integer);
begin
m:=(li+ls) div 2;
if x=a[m,1] then nr:=m
            else if li<ls then if x<a[m,1] then search(li,m-1)
                                                       else search(m+1,ls);
end;

begin
        assign(f1,'loto.in');
        reset(f1);
        assign(f2,'loto.out');
        rewrite(f2);
        read(f1,n,s);
        for i:=1 to n do read(f1,z[i]);
        for i:=1 to n do
        for j:=i to n do
        for g:=j to n do
        begin
                inc(ind);
                a[ind,1]:=z[i]+z[j]+z[g];
                a[ind,2]:=z[i];
                a[ind,3]:=z[j];
                a[ind,4]:=z[g];
        end;
        quick(1,ind);
        ok:=0;
        for i:=1 to ind do begin
                nr:=0;
                x:=s-a[i,1];
                search(1,ind);
                if a[i,1]+a[nr,1]=s then begin
                        writeln(f2,a[i,2],' ',a[i,3],' ',a[i,4],' ',a[nr,2],' ',a[nr,3],' ',a[nr,4]);
                        ok:=1;
                        break;
                end;
        end;
        if ok=0 then writeln(f2,-1);
        close(f1);
        close(f2);
end.