Cod sursa(job #150252)

Utilizator Vlad-andreiVlad Fisca Vlad-andrei Data 6 martie 2008 19:33:02
Problema Loto Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.98 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:longint);
 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.