Backtracking: aranjamente

Backtracking: aranjamente:

>

{generarea aranjamentelor}
program aranjamente;  {iterativ}
type stiva=array [1..10] of integer;
var st:stiva;
      ev,as:boolean;
      n,k,p:integer;
procedure init(k:integer;var st:stiva);
begin  st[k]:=0;
end;
procedure succesor(var as:boolean;var st:stiva;k:integer);
begin if st[k]<n then begin st[k]:=st[k]+1;
                              as:=true;
                        end
                  else as:=false;
end;
procedure valid(var ev:boolean;var st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do if st[i]=st[k] then ev:=false;
if (st[k]<0) and (st[k-1]<0) then ev:=false;
end;
function solutie(k:integer):boolean;
begin
solutie:=(k=p);
end;
procedure tipar;
var i:integer;
begin
for i:=1 to p do write (st[i]);
writeln;
end;
begin;
write ('n:=');readln (n);
write ('p:=');readln (p);
k:=1;init(k,st);
while k>0 do
    begin
          repeat
              succesor (as,st,k);
              if as then valid(ev,st,k);
          until (not as) or (as and ev);
      if as then
        if solutie(k) then tipar
                             else begin
                                 k:=k+1;
                                 init(k,st)
                                   end
               else k:=k-1;
      end;
    readln;
end.
{PascalZone.uv.ro}