Cod sursa(job #633493)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 13 noiembrie 2011 21:11:10
Problema Loto Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.85 kb
Program loto;
type tip=record
    s,x,y,z:longint;
      end;
 var a:array [0..100] of longint;
    b:array [0..500000] of tip;
    b1,b2:array [1..1 shl 10] of char;
    i,j,k,n,t,g,s,p,l:longint;
    s1:string;
    fi,fo:text;
function citire:longint;
 var aux:longint;
begin
 aux:=0;
 while (s1[p]>='0') and (s1[p]<='9') and (p<=l) do begin
                                            aux:=aux*10+ord(s1[p])-48;
                                             if p=l then begin
                                             read(fi,s1);
                                                 p:=0;
                                               l:=length(s1);
                                                  end;
                                                 inc(p);
                                                  end;
while ((s1[p]<'0') or (s1[p]>'9'))and(s1<>'') do begin
                                                inc(p);
                                                if p>l then begin
                                                   read(fi, s1);
                                                      p:=1;
                                                      l:=length(s1);
                                                            end;
                                                  end;
citire:=aux;
end;
procedure sort(l,r:longint);
 var i,j,k:longint;
      y:tip;
begin
 i:=l; j:=r; k:=b[(l+r) div 2].s;
 repeat
  while k>b[i].s do inc(i);
   while k<b[j].s do dec(j);
  if i<=j then begin
              y:=b[i]; b[i]:=b[j]; b[j]:=y;
              inc(i); dec(j);
              end;
 until i>=j;
 if i<r then sort(i,r);
  if j>l then sort(l,j);
end;
procedure cauta(l,r:longint);
 var mid:longint;
begin
 mid:=(l+r) div 2;
  if l<=r then begin
              if b[mid].s>s-a[i]-a[j]-a[k] then cauta(l,mid-1)
                else if b[mid].s<s-a[i]-a[j]-a[k] then cauta(mid+1,r)
                 else g:=mid;
                end
 else g:=-1;
end;
begin
 assign(fi,'loto.in');
  assign(fo,'loto.out');
 settextbuf(fi,b1); settextbuf(fo,b2);
 reset(fi); rewrite(fo);
 readln(fi,n,s);
 read(fi,s1); l:=length(s1); p:=1;
  for i:=1 to n do a[i]:=citire;
  for i:=1 to n do
   for j:=i to n do
    for k:=j to n do begin
                      inc(t); b[t].s:=a[i]+a[j]+a[k];
                       b[t].x:=a[i]; b[t].y:=a[j]; b[t].z:=a[k];
                      end;
   sort(1,t);
 for i:=1 to n do
  for j:=i to n do
   for k:=j to n do
    if a[i]+a[j]+a[k]<s then begin
                    cauta(1,t);
                     if g<>-1 then begin
                         write(fo,b[g].x,' ',b[g].y,' ',b[g].z,' ',a[i],' ',a[j],' ',a[k]);
                         close(fo);
                          exit;
                           end;
                    end
    else break;
 write(fo,'-1');
close(fo);
end.