Cod sursa(job #175985)

Utilizator chelaru_t_achelaru traian andrei chelaru_t_a Data 10 aprilie 2008 17:17:45
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.7 kb
var v:array [1..100] of longint;
  n:integer;
  s:longint;
  f,t:text;

 procedure citire;
  var i:integer;
  begin
   readln(f,n,s);
   for i:=1 to n do read(f,v[i]);
  end;
 procedure qsort;
   procedure sortare(s,d:integer);
    var i,j:integer;
      aux,x:longint;
    begin
     i:=s;
     j:=d;
     x:=v[(s+d) div 2];
     repeat
     while v[i]<x do i:=i+1;
     while v[i]>x do j:=j-1;
     if i<=j then
       begin
       aux:=v[i];
       v[i]:=v[j];
       v[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,n);
  end;


 procedure suma;
  var h,i,j,k,l,m:integer;
    ok:boolean;
    sum:longint;
  begin
   h:=0;
   ok:=false;
   while (h<>n) and (not ok) do
     begin
     h:=h+1;
     i:=0;
     while (i<>n) and (not ok) do
       begin
       i:=i+1;
       j:=0;
       while (j<>n) and (not ok) do
         begin
         j:=j+1;
         k:=0;
         while (k<>n) and (not ok) do
           begin
           k:=k+1;
           l:=0;
           while (l<>n) and (not ok) do
             begin
             l:=l+1;
             m:=0;
             while (m<>n) and (not ok) do
               begin
               m:=m+1;
               sum:=v[h]+v[i]+v[j]+v[k]+v[l]+v[m];
               if sum=s then ok:=true;
               end;
             end;
           end;
         end;
       end;
     end;
   if not ok then write(t,'-1')
   else write(t,v[h],' ',v[i],' ',v[j],' ',v[k],' ',v[l],' ',v[m]);
  end;

begin
  assign(f,'loto.in');
  assign(t,'loto.out');
  citire;
  qsort;
  suma;
  close(f);
  close(t);
end.