Cod sursa(job #159678)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 14 martie 2008 12:19:45
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.3 kb
Program cel;
Type vector=array[1..1000000] of longint;
var f,g:text;
    suma,x:vector;
    n,m,i,j,k,s,ic,sf,mij:longint;
    ok:boolean;

{procedure sortare(var x:vector;n:longint);
var min,t:longint;
Begin
For i:=1 to n-1 do
 Begin
  min:=x[i];
  t:=i;
  For j:=i+1 to n do
   If min>x[j] then Begin
                     t:=j;
                     min:=x[j];
                    end;
  If t<>i then Begin
                x[t]:=x[i];
                x[i]:=min;
               end;
 end;
end;}

procedure Sort(var a:vector;l, r: Integer);
var
  i, j, x, y: integer;
begin
  i := l; j := r; x := a[(l+r) DIV 2];
  repeat
    while a[i] < x do i := i + 1;
    while x < a[j] do j := j - 1;
    if i <= j then
    begin
      y := a[i]; a[i] := a[j]; a[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;


procedure afisare(p:longint);
var i,j,k,e:longint;
Begin
e:=0;
For i:=1 to n do
 For j:=1 to n do
  For k:=1 to n do
   If (x[i]+x[j]+x[k]=suma[p]) and (e=0) then Begin
                                               Write(g,x[i],' ',x[j],' ',x[k],' ');
                                               inc(e);
                                              end;
end;

Begin
Assign(f,'loto.in');Reset(f);
Assign(g,'loto.out');Rewrite(g);
Readln(f,n,s);
For i:=1 to n do Read(f,x[i]);
m:=0;
For i:=1 to n do
 For j:=1 to n do
  For k:=1 to n  do
   Begin
    m:=m+1;
    suma[m]:=x[i]+x[j]+x[k];
   end;
Sort(suma,1,m);
ok:=false;
ic:=1;
sf:=m;
 While ic<=sf do
  Begin
   mij:=(ic+sf) div 2;
   If suma[ic]+suma[sf]=S then Begin
                                ok:=true;
                                afisare(ic);
                                afisare(sf);
                                ic:=sf+1;
                               end
                           else Begin
                                 While (suma[ic]+suma[sf]>S) and (sf>=1) do dec(sf);
                                 While (suma[ic]+suma[sf]<S) and (ic<=n) do inc(ic);
                                end;
                                {If suma[ic]+suma[sf]>S then sf:=mij-1
                                                       else ic:=mij+1;}
   end;
If not ok then Write(g,-1);
Close(f);
Close(g);
end.