Cod sursa(job #216529)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 24 octombrie 2008 19:52:20
Problema Loto Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.68 kb
var f,g:text;
    p:array[0..110]of longint;
    v:array[0..1000000]of longint;
    n,s,m,r,i,j,y,a,b,k1,k2:longint;

procedure quick(l,r:longint);
var i,j,x,aux:longint;
begin
  i:=l;
  j:=r;
  x:=v[(l+r)div 2];
  repeat
        while (v[i]<x)do inc(i);
        while (v[j]>x)do dec(j);
        if (i<=j)then
          begin
            aux:=v[i];
            v[i]:=v[j];
            v[j]:=aux;
            inc(i);
            dec(j);
          end;
  until i>j;
  if (l<j)then quick(l,j);
  if (i<r)then quick(i,r);
end;

function search(x:longint):longint;
var r,k:longint;
begin
  r:=-1;
  while (a<=b)do
    begin
      k:=(a+b)div 2;
      if (x<v[k])then b:=k-1 else
      if (x>v[k])then a:=k+1 else
        begin
          r:=k;
          break;
        end;
    end;
  search:=r;
end;


begin
assign(f,'loto.in');
assign(g,'loto.out');
reset(f);
rewrite(g);
read(f,n,s);
for i:=1 to n do read(f,p[i]);
for i:=1 to n do
  for j:=i to n do
    for y:=j to n do
      begin
        inc(m);
        v[m]:=p[i]+p[j]+p[y];
      end;
quick(1,m);
for i:=1 to m do
  begin
    a:=1;
    b:=m;
    r:=search(s-v[i]);
    if (r>-1)then
      break;
  end;
if (r=-1)then write(g,r) else
begin
  r:=v[r];
  for i:=1 to n do
    for j:=i to n do
      for y:=j to n do
        begin
          if (p[i]+p[j]+p[y]=r)and(k1=0)then
            begin
              write(g,p[i],' ',p[j],' ',p[y],' ');
              k1:=1;
            end;
          if (p[i]+p[j]+p[y]=s-r)and(k2=0)then
            begin
              write(g,p[i],' ',p[j],' ',p[y],' ');
              k2:=1;
            end;
        end;
end;
close(f);
close(g);
end.