Cod sursa(job #150294)

Utilizator TudorRTudor Radacineananu TudorR Data 6 martie 2008 20:21:09
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.77 kb
  var f,g:text;    
      n,s,i,j,k,l,x,y,p:longint;    
      a:array[1..100]of longint;    
      ok:boolean;    
      
  begin    
  assign(f,'loto.in');    
  reset(f);    
  assign(g,'loto.out');    
  rewrite(g);    
  readln(f,n,s);    
  for i:=1 to n do read(f,a[i]);    
  for i:=1 to n-1 do    
     for j:=i+1 to n do    
        if a[i]<a[j] then begin    
                          p:=a[i];    
                          a[i]:=a[j];    
                          a[j]:=p;    
                          end;    
  i:=0;    
  ok:=true;    
  while (i<n)and v do begin    
     i:=i+1;    
     p:=a[i];    
     j:=i-1;    
     while (j<n) and v and (p<s+1) do begin    
        j:=j+1;    
        p:=p+a[j];    
        k:=j-1;    
        while (k<n) and v and(p<s+1) do begin    
           k:=k+1;    
           p:=p+a[k];    
           l:=k-1;    
           while (l<n) and v and (p<s+1) do begin    
              l:=l+1;    
              p:=p+a[l];    
              x:=l-1;    
              while (x<n) and v and (p<s+1) do begin    
                 x:=x+1;    
                 p:=p+a[x];    
                 y:=x-1;    
                 while (y<n) and v and (p<s+1) do begin    
                 y:=y+1;    
                   if p+a[y]=s then begin    
                                    v:=false;    
                                    write(g,a[i],' ',a[j],' ',a[k],' ',a[l],' ',a[x],' ',a[y]);    
                                    end;    
                 end;    
                 p:=p-a[x];    
              end;    
              p:=p-a[l];    
           end;    
           p:=p-a[k];    
        end;    
        p:=p-a[j];    
     end;    
  end;    
  if v then write(g,-1);    
  close(g);    
  end.