Cod sursa(job #196618)

Utilizator AndreiDDiaconeasa Andrei AndreiD Data 27 iunie 2008 15:10:54
Problema Loto Scor 5
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.75 kb
type list=array[1..1000000] of longint;
var f,g:text;
ss,x:list;
n,m,i,j,k,s,st,dr,mij,max:longint;
ok:boolean;

procedure QuickSort(var A: List; Lo, Hi: Integer);

procedure Sort(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;

begin {QuickSort};
  Sort(Lo,Hi);
end;


procedure afisare(p:longint);
var i,j,k:longint;
begin
ok:=true;
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]=ss[p]) and ok then begin
                           write(g,x[i],' ',x[j],' ',x[k],' ');
                           ok:=false;
                           break;
                           end;
end;


Begin
assign(f,'loto.in');reset(f);
assign(g,'loto.out');rewrite(g);
readln(f,n,s);
max:=0;
for i:=1 to n do begin
                 read(f,x[i]);
                 if x[i]>max then max:=x[i];
                 end;
m:=0;
for i:=1 to n do
 for j:=1 to n do
    for k:=1 to n do begin
    inc(m);
    ss[m]:=x[i]+x[j]+x[k];
   end;
quicksort(ss,1,m);
st:=1;
dr:=m;
while st<=dr do begin
mij:=(st+dr) div 2;
if ss[st]+ss[dr]=s then begin
                     afisare(st);
                     afisare(dr);
                     st:=dr+1;
                          end
              else begin
              while (ss[st]+ss[dr]>s) and (dr>=1) do dec(dr);
              While (ss[st]+ss[dr]<s) and (st<=m) do inc(st);
                    end;
end;
if (6*max<s) then write(g,'-1');
close(f);
close(g);
end.