Cod sursa(job #139879)

Utilizator ProtomanAndrei Purice Protoman Data 20 februarie 2008 20:51:01
Problema Loto Scor 35
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.46 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..10000000] of loto;

procedure repair(i:longint);
var l,r,max:longint;
    aux:loto;
begin
        l:=2*i;
        r:=l+1;
        max:=i;
        if (l<=dimh)and(a[l].a1>a[max].a1) then
                max:=l;
        if (r<=dimh)and(a[r].a1>a[max].a1) then
                max:=r;
        if max<>i then
        begin
                aux:=a[i];
                a[i]:=a[max];
                a[max]:=aux;
                repair(max);
        end;
end;

procedure buildheap(h:longint);
var i:longint;
begin
        for i:=h div 2 downto 1 do
                repair(i);
end;

procedure heapsort(h:longint);
var i:longint;
    aux:loto;
begin
        buildheap(h);
        for i:=h downto 2 do
        begin
                aux:=a[1];
                a[1]:=a[i];
                a[i]:=aux;
                dec(dimh);
                repair(1);
        end;
end;

procedure search(li,ls:longint);
begin
        m:=(li+ls) div 2;
        if x=a[m].a1 then
                nr:=m
        else if li<ls then
                if x<a[m].a1 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].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;
        heapsort(ind);
        ok:=0;
        for i:=1 to ind do
        begin
                nr:=0;
                x:=s-a[i].a1;
                search(1,ind);
                if a[i].a1+a[nr].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;
        end;
        if ok=0 then
                writeln(f2,-1);
        close(f1);
        close(f2);
end.