Cod sursa(job #139883)

Utilizator ProtomanAndrei Purice Protoman Data 20 februarie 2008 20:58:19
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.22 kb
type loto=record
          a1,a2,a3,a4:longint;
     end;

var f1,f2:text;
    ok,ind,x,i,j,g,nr,n,s,m,dimh:longint;
    z:array[1..100] of longint;
    a:array[1..1000000] of loto;

procedure pozitie(var m:longint; p,u:longint);
var i,j,di,dj,aux1:longint;
    aux:loto;
begin
        di:=0;
        dj:=-1;
        i:=p;
        j:=u;
        while i<j do
        begin
                if a[i].a1>a[j].a1 then
                begin
                        aux1:=di;
                        di:=-dj;
                        dj:=-aux1;
                        aux:=a[i];
                        a[i]:=a[j];
                        a[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(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].a1:=z[i]+z[j]+z[g];
                                a[ind].a2:=z[i];
                                a[ind].a3:=z[j];
                                a[ind].a4:=z[g];
                        end;
        dimh:=ind;
        quick(1,ind);
        ok:=0;
        i:=1;
        j:=ind;
        while i<=j do
        begin
                nr:=0;
                x:=s-a[i].a1;
                if a[i].a1+a[j].a1=s then
                begin
                        writeln(f2,a[i].a2,' ',a[i].a3,' ',a[i].a4,' ',a[nr].a2,' ',a[nr].a3,' ',a[nr].a4);
                        ok:=1;
                        break;
                end
                else if a[i].a1+a[j].a1>s then
                        dec(j)
                     else inc(i);
        end;
        if ok=0 then
                writeln(f2,-1);
        close(f1);
        close(f2);
end.