Cod sursa(job #288540)

Utilizator cristinabCristina Brinza cristinab Data 25 martie 2009 21:32:27
Problema Loto Scor 15
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.14 kb
{loto infoarena/ culegere clasa a 9a}

type parte=record
           suma:longint;
           val1,val2,val3:longint;
           end;

var a:array[1..100] of longint;
    v:array[1..1000000] of parte;
    s:longint;
    n:byte;
    f,g:text;
    ok:boolean;
    k:longint;
    termen,retin:parte;

procedure citire;
var i:integer;
begin
assign(f,'loto.in'); reset(f);
readln(f,n,s);
for i:=1 to n do read(f,a[i]);
close(f);
end;


procedure qsort(l,r:longint);
var i,j:longint;
    aux:parte;
    x:longint;
begin

i:=l;
j:=r;
x:=v[(l+r) div 2].suma;

repeat
  while v[i].suma<x do inc(i);
  while v[j].suma>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 j>l then qsort(l,j);
if i<r then qsort(i,r);
end;

function caut_binar(x:longint):boolean;
var stanga,dreapta,mijloc:longint;
    ok:boolean;
begin
stanga:=1;
dreapta:=k;
ok:=false;

while (stanga<=dreapta) and not ok do
      begin
      mijloc:=(stanga+dreapta) div 2;
      if x<v[mijloc].suma then dreapta:=mijloc-1
      else if x>v[mijloc].suma then stanga:=mijloc+1
           else begin
                ok:=true;
                termen:=v[mijloc];
                end;
      end;

if ok then caut_binar:=true
      else caut_binar:=false;
end;


procedure rezolvare;
var i,j,l:integer;
    ceva:longint;
begin

k:=0;

for i:=1 to n do
    for j:=1 to n do
        for l:=1 to n do
            begin
            inc(k);
            v[k].suma:=a[i]+a[j]+a[l];
            v[k].val1:=a[i];
            v[k].val2:=a[j];
            v[k].val3:=a[l];
            end;

qsort(1,k);

ok:=false;

for i:=1 to k do
    begin
    ceva:=s-v[i].suma;
    if caut_binar(ceva) then
       begin
       ok:=true;
       retin:=v[i];
       break;
       end
    end;

end;


procedure afisare;
begin
assign(g,'loto.out'); rewrite(g);
if ok then
   writeln(g,retin.val1,' ',retin.val2,' ',retin.val3,' ',termen.val1,' ',termen.val2,' ',termen.val3)
else writeln(g,-1);
close(g);
end;

begin
citire;
rezolvare;
afisare;
end.