Cod sursa(job #1087973)

Utilizator Mihai_ChihaiMihai Chihai Mihai_Chihai Data 20 ianuarie 2014 00:57:53
Problema Loto Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.72 kb
program loto;
label 1;
 type t=record
       x,y,z,sum:longint;
       end;
 var n,s,i,j,k,suma,nr,mid,l,r:longint;
    a:array[1..100000] of t;
     v:array[1..100000] of longint;
      ok:boolean;
 procedure qsort(l,r:longint);
 var i,j,m:longint;
     aux:t;
 begin
 i:=l;
 j:=r;
 m:=a[(i+j)div 2].sum;
 while i<=j do begin
    while a[i].sum<m do inc(I);
    while a[j].sum>m  do dec(j);
    if i<=j  then begin
                 aux:=a[i];
                 a[i]:=a[j];
                 a[j]:= aux;
                 inc(i);
                 dec(j);
                 end;
    end;
 if i<r then qsort(i,r);
 if l<j then qsort(l,j);
end;

begin
  assign(input,'loto.in'); reset(input);
  assign(output,'loto.out'); rewrite(output);
  readln(n,s);
  for i:=1 to n do read(v[i]);
  nr:=0;
  for i:=1 to n do
     for j:=i to n do
        for k:=j to n do
          begin
          inc(nr);
          a[nr].sum:=v[i]+v[j]+v[k];
          a[nr].x:=v[i];
          a[nr].y:=v[j];
          a[nr].z:=v[k];
          end;
  qsort(1,nr);

  ok:=false;
  for i:=1 to n do
    for j:=i to n do
      for k:=j to n do
       begin
         l:=1;
         r:=nr;
         suma:=v[i]+v[j]+v[k];
         suma:=s-suma;
         while (l<=r) and (not ok) do
           begin
           mid:=(l+r) div 2;
           if suma=a[mid].sum then ok:=true
             else if suma>a[mid].sum then l:=mid+1
               else r:=mid-1;
           end;
         if ok then begin write(v[i],' ',v[j],' ',v[k],' ',a[mid].x,' ');
                              write(a[mid].y,' ',a[mid].z);
                              goto 1;
                              end;
         end;
      write(-1);
1:close(output);
end.