Cod sursa(job #13472)

Utilizator Data 6 februarie 2007 19:44:24 Loto 10 fpc done Arhiva de probleme 2.32 kb
``````{\$IFDEF NORMAL}
{\$I-,Q-,R-,S-}
{\$ENDIF NORMAL}
{\$IFDEF DEBUG}
{\$I+,Q+,R+,S-}
{\$ENDIF DEBUG}
{\$IFDEF RELEASE}
{\$I-,Q-,R-,S-}
{\$ENDIF RELEASE}

program loto;
var fi,fo:text;
n,i,j,k,l,m,p,s:longint;
a:array[1..100] of longword;
st,dr,mj,caut,int:longint;
ok:boolean;

procedure cautb(x:longint);
begin
st:=1;
dr:=n;
while st<=dr do
begin
mj:=(st + dr) div 2;
if x=a[mj] then begin caut:=a[mj]; break; end;
if x< a[mj] then dr:=mj-1;
if x> a[mj] then st:=mj+1;
end;
end;

function part(st,dr:longint):longint;
var p,i,j,aux:longint;
sens:integer;
begin

p := st + random(dr-st+1);
aux:=a[st];
a[st]:=a[p];
a[p]:=aux;

i:=st; j:=dr; sens:=-1;
while i<j do
begin
if a[i]>a[j] then
begin
aux:=a[i];
a[i]:=a[j];
a[j]:=aux;
sens:=-sens;
end;
if sens=1 then inc(i)
else dec(j);
end;
part:=i;
end;

procedure qsort(st,dr:longint);
var p:longint;
begin
if st<dr then
begin
p:=part(st,dr);
qsort(st,p-1);
qsort(p+1,dr);
end;
end;

begin
assign(fi,'loto.in'); reset(fi);
assign(fo,'loto.out'); rewrite(fo);
for i:=1 to n do
close(fi);
qsort(1,n);
{ ok:=true;
for i:=1 to n do
begin
if (s mod a[i]=0) and (a[i]<>1) then
ok:=false;
end;
if ok=true then
begin
writeln(fo,'-1');
close(fo);
halt
end;       }
for i:=1 to n do
for j:=1 to n do
for k:=1 to n do
for l:=1 to n do
for m:=1 to n do
begin
caut:=0;
int:=s-(a[i]+a[j]+a[k]+a[l]+a[m]);
cautb(int);
if caut<>0 then
begin
writeln(fo,a[i],' ',a[j],' ',a[k],' ',a[l],' ',a[m],' ',caut);
close(fo);
halt
end
else
for p:=mj-1 to n do
if a[i]+a[j]+a[k]+a[l]+a[m]+a[p]=s then
begin
writeln(fo,a[i],' ',a[j],' ',a[k],' ',a[l],' ',a[m],' ',a[p]);
close(fo);
halt
end;
end;
writeln(fo,'-1');
close(fo);
end.
``````