Cod sursa(job #1180589)

Utilizator testtVasilica Ionica testt Data 30 aprilie 2014 19:51:27
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.63 kb
var n,s,i,j,k,h,p:longint;
    a:array[0..105]of longint;
    v:array[0..1000005]of longint;
    bufin:array[1..65000]of byte;
    gasit:boolean;

procedure add(x:longint);inline;
begin
  inc(v[0]);
  v[v[0]] := x;
end;

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

function cb(x:longint):longint;
var i,j,m:longint;
begin
  i := 1; j := v[0];
  repeat
    m := (i+j)div 2;
    if x <= v[m] then
      j := m - 1
    else
      i := m + 1;
  until i > j;
  if v[i] = x then cb := i else cb := -1;
end;

begin
  assign(input,'loto.in'); reset(input);
  assign(output,'loto.out'); rewrite(output);
  settextbuf(input,bufin);

  readln(n,s);
  for i := 1 to n do read(a[i]);

  v[0] := 0;
  for i := 1 to n do
    for j := i to n do
      for k := j to n do
        add(a[i]+a[j]+a[k]);

  QSort(1,v[0]);

  gasit := false;
  for i := 1 to v[0] do
  begin
    h := cb(s-v[i]);
    if h <> -1 then
    begin
      v[i] := -5; v[h] := -5;
      gasit := true;
      break;
    end;
  end;

  if not gasit then
    writeln(-1)
  else
  begin
    p := 0;

    for i := 1 to n do
      for j := i to n do
        for k := j to n do
        begin
          inc(p);
          if v[p] = -5 then write(a[i],' ',a[j],' ',a[k],' ');
        end;

  end;


  close(input);
  close(output);
end.