# t5/zbiciak

``````#!/usr/local/bin/perl6

# Use Algorithm O from Knuth 7.2.1.6 to generate all "free trees".
#
# Algorithm O generates oriented forests.  A modification described in
# exercise 90 from 7.2.1.6 indicates how to modify this algorithm to
# generate free trees, which is the name Knuth uses for unrooted trees.
sub Modified_Algorithm_7216O(Int \$nodes)
{
my (@p, Int \$i, Int \$j, Int \$k, Int \$d, Int \$m, Int \$kk);

# O1. [Initialize]  Set p[k] = k - 1 for 0 <= k <= n.
#                   Let m = floor(n/2).  Set p[m+1] = 0.
#                   Set p[2m+1] = 0 if n is odd. (?)
\$m = \$nodes div 2;
@p = -1 ..^ \$nodes;
@p[  \$m + 1] = 0;
#   @p[2*\$m + 1] = 0 if !(\$nodes %% 2);  # Is this an error in Knuth?

while (1)
{
# O2. [Visit]   Visit the forest represented by parent pointers
#               p[1] .. p[n].  If you include node 0 (with parent
#               -1), this represents a unique "free tree".
emit(@p[0..\$nodes]);

# O3. [Easy case?]  If p[n] > 0, set p[n] = p[p[n]] and
if (@p[\$nodes] > 0) {
@p[\$nodes] = @p[@p[\$nodes]];
next;
}

# O4. [Find j and k.]   Find the largest k < n such that p[k] != 0.
#                       Terminate the algorithm if k = 0; otherwise
#                       set j = p[k] and d = k - j;

for 0 ..^ \$nodes -> \$kk {
\$k = \$kk if @p[\$kk] != 0;
}

return if \$k == 0;

\$j = @p[\$k];
\$d = \$k - \$j;

# O4'. [Extension]  Set i = j.  While p[i] != 0, set i = p[i];
#                   Then i is the root of the tree containing j
#                   and k.
\$i = \$j;
while (@p[\$i] != 0) { \$i = @p[\$i]; }

# O5'. [Extension]  If k = i + m and i < j, set j = i and d = m.
if \$k == \$i + \$m && \$i < \$j {
\$j = \$i;
\$d = \$m;
}

# O5. [Clone.]  If p[k-d] = p[j], set p[k] = p[j]; otherwise set
#               p[k] = p[k-d] + d.
#
#               Return to O2 if k = n, otherwise set k = k + 1
#               and repeat this step.
repeat {
@p[\$k] = @p[\$k - \$d] == @p[\$j] ?? @p[\$j] !! @p[\$k - \$d] + \$d;
} while (\$k++ != \$nodes);
\$k = \$nodes;
}
}

# Find and print the traversal path through the tree given the parents
# table computed by the modified Algorithm 7.2.1.6O.
sub emit(@parents)
{
my %p_tree = @parents.pairs;
my %tree;

%tree.push( %p_tree.invert );   # Convert parent pointers to children.
%tree.delete(-1);               # Don't need -1 node.

my \$visited = 0;

sub recurse(\$node)
{
my \$name = ++\$visited;
my @path = ( \$name );

if %tree{\$node}.defined {
for @( %tree{\$node} ) {
push @path, recurse(\$_), \$name;
}
}
return @path;
}

my  @path = recurse(0);
pop @path;              # Omit last step that takes us back to 1

say @path.join("-");
}

sub MAIN(\$nodes)
{
Modified_Algorithm_7216O(\$nodes.Int - 1);
}
``````

## Correctness

The program is incorrect, which is a shame, because it's really nice. I guess the lesson here is "Never go against Donald Knuth when correctness is on the line."

The fix is not as simple as just removing the commented-out line. Things are still wrong after that.

## Consistency

Inconsistent use of parentheses around some conditions and not others.

## Clarity of intent

Very nicely and carefully laid out. The relationship with the original algorithm from the book is immediate.

## Algorithmic efficiency

Not applicable since the program is incorrect.

## Idiomatic use of Perl 6

`while (1)` perhaps better written `loop`.

## Brevity

One of the shortest programs in terms of lines. Definitely the shortest in terms of lines of code.