Cod sursa(job #177311)

Utilizator sandulescu_alisandulescu alexandra sandulescu_ali Data 12 aprilie 2008 17:40:16
Problema Combinari Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.12 kb
type vector=array[1..1000]of longint;
var x,a:vector;
    ev,as:boolean;
    k,n,l,i:longint;
    fin,fout:text;
procedure succesor(var x:vector;k:integer; var as:boolean);
begin
if x[k]<n then
   begin
   as:=true;
   x[k]:=x[k]+1;
   end
   else as:=false;
end;

procedure valid(x:vector;k:integer;var ev:boolean);
var i:longint;
    ok1,ok2:boolean;
begin
ok1:=true;
for i:=1 to k-1 do if x[i]=x[k] then ok1:=false;
ok2:=true;
if (k>=2)and(x[k]<x[k-1])then ok2:=false;
if ok1 and ok2 then ev:=true
               else ev:=false;
end;

procedure afisare(x:vector;k:integer);
var i:integer;
begin
for i:=1 to k do write(fout,a[x[i]],' ');
writeln(fout);
end;

begin
assign(fin,'combinari.in');reset(fin);
assign(fout,'combinari.out');rewrite(fout);
read(fin,n,l);
for i:=1 to n do a[i]:=i;
k:=1;x[k]:=0;
while k>0 do
      begin
      repeat
      succesor(x,k,as);
      if as then valid(x,k,ev);
      until (as and ev)or (not as);
      if as then if k=l then afisare(x,k)
                        else begin inc(k);x[k]:=0;end
            else dec(k);
      end;
close(fin);close(fout);
end.