Cod sursa(job #999608)

Utilizator wollyFusy Wool wolly Data 20 septembrie 2013 22:47:33
Problema Loto Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.34 kb
type tab=array[1..110] of longint;
var n,s,exi:longint;
	a,b:text;
	t,u:tab;
	
procedure Sort(s,f:longint);
var i,j,p,m,g:longint;
begin
i:=s;
j:=f;
m:=(s+f) div 2;
p:=t[m];

repeat
	begin
	
	while t[i]<p do i:=i+1;
	while t[j]>p do j:=j-1; 
	
	if i<=j then
		begin
		g:=t[i];
		t[i]:=t[j];
		t[j]:=g;
		i:=i+1;
		j:=j-1;
		end;

	end;
until i>j;

if j-s>0 then sort(s,j);
if f-i>0 then sort(i,f);

end;

function correct:boolean;
var i,sum:longint;
begin
correct:=false;
sum:=0;
for i:=1 to 6 do
	sum:=sum+u[i];
if sum=s then
	begin
	correct:=true;
	exi:=1;
	end;
{writeln(sum);
for i:=1 to 6 do
	write(u[i],' ');}
end;

procedure scrie;
var i:longint;
begin
assign(b,'loto.out');
rewrite(b);
for i:=1 to 6 do
	write(b,u[i],' ');
close(b);
end;

procedure minus;
var i:longint;
begin
assign(b,'loto.out');
rewrite(b);
write(b,'-1');
close(b);
end;

procedure Citire;
var i:longint;	
begin
assign(a,'loto.in');
reset(a);
exi:=0;
read(a,n,s);

for i:=1 to n do
	read(a,t[i]);
	
close(a);
end;

procedure calc(k:longint);
var i:longint;
begin
if exi=0 then
if (k=6+1) then
	begin
	if correct then
		scrie;
	end else
	if (k<=6) then
	for i:=1 to 6 do
		begin
		u[k]:=t[i];
		calc(k+1);
		end;
end;


begin
{Citire;
Sort(1,n);
Calc(1);
If exi=0 then }minus;
end.