Permutations: Difference between revisions

Content deleted Content added
Fixed lazy D version
Line 123: Line 123:
-- print all permutations of 1 .. n
-- print all permutations of 1 .. n
-- where n is given as a command line argument
-- where n is given as a command line argument
-- to compile with gnat : gnatmake perm.adb
-- to compile with GNAT : gnat make perm.adb
-- to call : perm n
-- to call on command line : perm n
with ada.text_io, ada.command_line;
with Ada.Text_IO, Ada.Command_Line;


procedure perm is
procedure Perm is
use ada.text_io, ada.command_line;
use Ada.Text_IO, Ada.Command_Line;
n : integer;
N : Integer;
begin
begin
if argument_count /= 1
if Argument_Count /= 1
then
then
put_line (command_name & " n (with n >= 1)");
Put_Line (Command_Name & " n (with n >= 1)");
return;
return;
else
else
n := integer'value (argument (1));
N := Integer'Value (Argument (1));
end if;
end if;
declare
declare
subtype element is integer range 1 .. n;
subtype Element is Integer range 1 .. N;
type permutation is array (element'range) of element;
type Permutation is array (Element'Range) of Element;
p : permutation;
P : Permutation;
is_last : boolean := false;
Is_Last : Boolean := False;
procedure Swap (A, B : in out Integer) is
C : Integer := A;
begin
A := B;
B := C;
end;
-- compute next permutation in lexicographic order
-- compute next permutation in lexicographic order
Line 151: Line 158:
-- exchange the element x preceding the tail, with the minimum value in the tail,
-- exchange the element x preceding the tail, with the minimum value in the tail,
-- that is also greater than x
-- that is also greater than x
procedure next is
procedure Next is
i, j, k, t : element;
I, J, K : Element;
begin
begin
-- find longest tail decreasing sequence
-- find longest tail decreasing sequence
Line 158: Line 165:
-- and the ith element will be exchanged later
-- and the ith element will be exchanged later
-- with some element of the tail
-- with some element of the tail
is_last := true;
Is_Last := True;
i := n - 1;
I := N - 1;
loop
loop
if p (i) < p (i+1)
if P (I) < P (I+1)
then
then
is_last := false;
Is_Last := False;
exit;
exit;
end if;
end if;
Line 169: Line 176:
-- next instruction will raise an exception if i = 1, so
-- next instruction will raise an exception if i = 1, so
-- exit now (this is the last permutation)
-- exit now (this is the last permutation)
exit when i = 1;
exit when I = 1;
i := i - 1;
I := I - 1;
end loop;
end loop;
-- if all the elements of the permutation are in
-- if all the elements of the permutation are in
-- decreasing order, this is the last one
-- decreasing order, this is the last one
if is_last then
if Is_Last then
return;
return;
end if;
end if;
-- sort the tail, i.e. reverse it, since it is in decreasing order
-- sort the tail, i.e. reverse it, since it is in decreasing order
j := i + 1;
J := I + 1;
k := n;
K := N;
while j < k loop
while J < K loop
t := p (j);
Swap (P (J), P (K));
p (j) := p (k);
J := J + 1;
p (k) := t;
K := K - 1;
j := j + 1;
k := k - 1;
end loop;
end loop;
-- find lowest element in the tail greater than the ith element
-- find lowest element in the tail greater than the ith element
j := n;
J := N;
while p (j) > p (i) loop
while P (J) > P (I) loop
j := j - 1;
J := J - 1;
end loop;
end loop;
j := j + 1;
J := J + 1;
-- exchange them
-- exchange them
-- this will give the next permutation in lexicographic order,
-- this will give the next permutation in lexicographic order,
-- since every element from ith to the last is minimum
-- since every element from ith to the last is minimum
t := p (i);
Swap (P (I), P (J));
p (i) := p (j);
p (j) := t;
end next;
end next;
procedure print is
procedure Print is
begin
begin
for i in element'range loop
for I in Element'Range loop
put (integer'image (p (i)));
Put (Integer'Image (P (I)));
end loop;
end loop;
new_line;
New_Line;
end print;
end Print;
-- initialize the permutation
-- initialize the permutation
procedure init is
procedure Init is
begin
begin
for i in element'range loop
for I in Element'Range loop
p (i) := i;
P (I) := I;
end loop;
end loop;
end init;
end Init;


begin
begin
init;
Init;
loop
while not Is_Last loop
print;
Print;
next;
Next;
exit when is_last;
end loop;
end loop;
end;
end;
end perm;</lang>
end Perm;</lang>


=={{header|ALGOL 68}}==
=={{header|ALGOL 68}}==