Cod sursa(job #47603)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 3 aprilie 2007 20:32:39
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.83 kb
var a:array[1..8000000] of longint;
    n,i,j,k,t,op,s,q:longint;
    b,d,w:array[1..8000000] of int64;
    c:array[1..200] of longint;
    f,g:text;
    ok:boolean;
procedure interclasez(st,mij,dr:longint);
 var i,j,k:longint;
 begin
  for i:=st to dr do begin
   b[i]:=a[i];
   w[i]:=d[i];
  end;
  i:=st; j:=mij+1; k:=st;
  while (i<=mij) and (j<=dr) do
   if b[i]>b[j] then begin
    a[k]:=b[i];
    d[k]:=w[i];
    inc(k);
    inc(i);
   end
   else begin
    a[k]:=b[j];
    d[k]:=w[j];
    inc(k);
    inc(j);
   end;
  for t:=i to mij do begin
   a[k]:=b[t];
   d[k]:=w[t];
   inc(k);
  end;
  for t:=j to dr do begin
   a[k]:=b[t];
   d[k]:=w[t];
   inc(k);
  end;
 end;
procedure mergesort(st,dr:longint);
 var mij:longint;
 begin
  if st<>dr then begin
   mij:=(st+dr) div 2;
   mergesort(st,mij);
   mergesort(mij+1,dr);
   interclasez(st,mij,dr);
  end;
 end;
function cauta(x,st,dr:longint):longint;
 var mij:longint;
 begin
  if st>dr then cauta:=0
  else
   begin
    mij:=(st+dr)div 2;
    if a[mij]=x then
     cauta:=mij
    else
     if a[mij]<x then
      cauta:=cauta(x,st,mij-1)
     else
      cauta:=cauta(x,mij+1,dr);
   end;
 end;
begin
 assign(f,'loto.in'); reset(f);
 assign(g,'loto.out'); rewrite(g);
 read(f,n,s);
 for i:=1 to n do
  read(f,c[i]);
 for i:=1 to n do
  for j:=i to n do
   for k:=j to n do begin
    inc(op);
    a[op]:=c[i]+c[j]+c[k];
    d[op]:=i*1000000+j*1000+k;
   end;
 mergesort(1,op);
 i:=1;
 ok:=false;
 for i:=1 to op do begin
  q:=cauta(s-a[i],1,op);
  if q<>0 then begin
   writeln(g,d[i] div 1000000,' ',(d[i] mod 1000000) div 1000,' ',d[i] mod 1000,' ',d[q] div 1000000,' ',(d[q] mod 1000000) div 1000,' ',d[q] mod 1000);
   ok:=true;
   break;
  end;
 end;
 if ok=false then
  writeln(g,'-1');
 close(f); close(g);
end.