#!/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 # return to step O2. 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); }