Cod sursa(job #175879)

Utilizator chelaru_t_achelaru traian andrei chelaru_t_a Data 10 aprilie 2008 16:05:50
Problema Loto Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.22 kb
type loto=record
          a:longint;
          b:integer;
          end;
stiva=array [1..100] of loto;
var st:stiva;
  v:array [1..100] of longint;
  n,k:integer;
  s:longint;
  f,t:text;
  ok,as,ev:boolean;

 procedure citire;
  var i:integer;
  begin
   readln(f,n,s);
   for i:=1 to n do read(f,v[i]);
  end;

 procedure init(k:integer;var st:stiva);
  begin
   st[k].a:=0;
   st[k].b:=0;
  end;

 procedure succesor(k:integer;var st:stiva;var as:boolean);
  begin
   if st[k].b<n then
     begin
     st[k].b:=st[k].b+1;
     st[k].a:=v[st[k].b];
     as:=true;
     end
   else as:=false;
  end;

 procedure valid(k:integer;st:stiva;var ev:boolean);
  var i:integer;
    sum:longint;
  begin
   ev:=true;
   sum:=0;
   for i:=1 to k do sum:=sum+st[i].a;
   if sum>s then ev:=false;
  end;

 function solutie(k:integer;st:stiva):boolean;
  var sum:longint;
    i:integer;
  begin
   sum:=0;
   if k=6 then
     begin
     for i:=1 to 6 do sum:=sum+st[i].a;
     if sum=s then solutie:=true
     else solutie:=false;
     end
   else solutie:=false;
  end;

 procedure tipar;
  var i:integer;
  begin
   if k<>0 then
     for i:=1 to 6 do write(t,st[i].a,' ')
   else write(t,'-1');
  end;

 procedure qsort;
   procedure sortare(s,d:integer);
    var i,j:integer;
      aux,x:loto;
    begin
     i:=s;
     j:=d;
     x:=st[(s+d) div 2];
     repeat
     while st[i].a<x.a do i:=i+1;
     while st[j].a>x.a do j:=j-1;
     if i<=j then
       begin
       aux:=st[i];
       st[i]:=st[j];
       st[j]:=aux;
       i:=i+1;
       j:=j-1;
       end;
     until i>j;
     if s<j then sortare(s,j);
     if d>i then sortare(i,d);
    end;
  begin
  sortare(1,6);
  end;

begin
  assign(f,'loto.in');
  assign(t,'loto.out');
  reset(f);
  rewrite(t);
  citire;
  k:=1;
  init(k,st);
  ok:=false;
  while (not ok) and (k>0) do
    begin
    repeat
    succesor(k,st,as);
    valid(k,st,ev);
    until (as and ev) or (not as);
    if as then
      if solutie(k,st) then ok:=true
      else
             begin
             k:=k+1;
             init(k,st);
             end

    else k:=k-1;
    end;
  qsort;
  tipar;
  close(f);
  close(t);
end.