Cod sursa(job #179580)

Utilizator nightwachComanescu Mircea nightwach Data 16 aprilie 2008 08:46:23
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.71 kb
type vect=array[1..100] of longint;
var s,s2:longint;
    i,j,k,n:integer;
    v,v2:vect;
    ok:boolean;
    f:text;
procedure QuickSort(var A: vect; Lo, Hi: Integer);
procedure Sort(l, r: Integer);
var
  i, j, x, y: integer;
begin
  i := l; j := r; x := a[(l+r) DIV 2];
  repeat
    while a[i] < x do i := i + 1;
    while x < a[j] do j := j - 1;
    if i <= j then
    begin
      y := a[i]; a[i] := a[j]; a[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;

begin
  Sort(Lo,Hi);
end;
begin
assign(f,'loto.in');
reset(f);
readln(f,n,s);
for i:=1 to n do read(f,v[i]);
s2:=0;
k:=0;
ok:=true;
i:=n;
k:=0;
QuickSort(v,1,n);
for i:=1 to n do v2[i]:=0;
while ok do begin
        if (v[i]+s2<=s) then begin
                        if (k<=6) then begin
                                s2:=s2+v[i];
                                inc(k);
                                inc(v2[i]);
                                end
                        else begin
                             dec(k);
                             dec(i);
                             end;
                        end
                                else begin
                                dec(k);
                                s2:=s2-v[i];
                                dec(v2[i]);
                                dec(i);
                                end;
        if (s=s2) and (k=6) then ok:=false;
        if i=0 then ok:=false;
        end;
close(f);
assign(f,'loto.out');
rewrite(f);
if (i=0)and(s<>s2) then writeln(f,'-1')
else
        for i:=1 to n do
                for j:=1 to v[i] do write(f,v[i],' ');
close(f);
end.