Download the raw code.
#!/usr/bin/env perl6
# This is perl6 version 2012.01 built on parrot 3.11.0 revision 0
sub shorten ( @arr is copy ) {
my $pos = @arr.end;
my $sum = 0;
loop ( ; $pos >= 0; $pos-- ) {
my $value-at-pos = @arr[$pos];
$sum += $value-at-pos;
if $value-at-pos > 1 {
my $new-value = $value-at-pos - 1;
@arr.splice( $pos );
@arr[ $pos ] = $new-value;
$sum -= $new-value;
while $sum {
$new-value = $new-value < $sum ?? $new-value !! $sum;
@arr.push( $new-value );
$sum -= $new-value;
}
return @arr;
}
}
return;
}
sub get-branch-lens( $remains is copy ) {
my @res;
my @row = $remains;
while @row.elems {
my @cp = @row;
@res.push( @cp.item );
@row = shorten( @row );
}
return @res;
}
sub append( @arr, @brr, $base ) {
my @res;
for @arr -> $a {
for @brr -> $b {
@res.push( ( $a, $base, $b ).join( "-" ) );
}
}
if @arr.elems == 0 {
for @brr -> $b {
@res.push( "$b" );
}
}
return @res;
}
sub generate-rooted-trees ( $start-at, $grow ) {
if $grow == 0 {
return [ "$start-at" ];
}
if $grow == 1 {
my @vals = $start-at, $start-at + 1, $start-at;
return [ @vals.join( "-" ) ];
}
my @arr = get-branch-lens( $grow );
my @trees;
for @arr -> @ar {
my @growing-trees;
my $grow-at = $start-at + 1;
for @ar -> $a {
my @growth = generate-rooted-trees( $grow-at, $a - 1 );
@growing-trees = append( @growing-trees, @growth, $start-at );
$grow-at += $a;
}
for @growing-trees {
@trees.push( ($start-at, $_, $start-at).join( "-" ) );
}
}
return @trees;
}
sub filter-trees ( @arr ) { # this is a joke :-)
my %seen;
my @res;
for @arr -> $a {
my %cnt = 1 => 1;
my @nodes = $a.split( '-' );
for @nodes -> $n {
%cnt{ $n } += 2;
}
%cnt{ @nodes.end } -= 1;
my $k = %cnt.values.sort.join( "-" );
if not %seen.exists( $k ) {
@res.push( $a );
%seen{ $k } = 1;
}
}
return @res;
}
sub MAIN ( Int $n ) {
if $n <= 0 {
exit 0;
}
elsif $n == 1 {
say 1; exit 0;
};
my @rooted-trees = generate-rooted-trees( 2, $n.Int - 2 );
my @unrooted-trees = filter-trees( @rooted-trees );
for @unrooted-trees -> $t {
say "1-$t";
}
}
The program fails for N = 6
:
$ nom solutions/t5/az5112 6
1-2-3-4-5-6-5-4-3-2
1-2-3-4-5-4-6-4-3-2
1-2-3-4-3-5-3-6-3-2
1-2-3-4-3-5-3-2-6-2
1-2-3-2-4-2-5-2-6-2
That corresponds to these trees:
o--o--o--o--o--o
o--o--o--o--o
|
o
o
|
o--o--o--o
|
o
o--o--o--o
| |
o o
o o
\ /
o--o--o
|
o
But there is a distinct sixth one, 1-2-3-4-5-4-3-6-3-2, which it should also have emitted:
o--o--o--o--o
|
o
The problem, in short, is that the filter-trees
subroutine uses an
equivalence relation which can't distinguish between this omitted tree and the
second one. The equivalence relation is essentially "how many times was each
node visited", which happens to be the same for these two trees.
Nothing in particular to say here.
The code is nice, and clear. It doesn't get fancy.
The MAIN
method is nice and clear because all the heavy lifting is done in
routines that were defined before that.
This line seems confused beyond the reviewer's ability to explain it:
%cnt{ @nodes.end } -= 1;
Not applicable as the program is incorrect.
The code leans more towards "generic procedural code" than towards exploiting the strengths of Perl 6 in particular.
On line 21 there's a missed opportunity to use min=
.
These lines
my $pos = @arr.end;
loop ( ; $pos >= 0; $pos-- ) {
probably more idiomatically written as
for (^@arr).reverse -> $pos {
The code lets itself breathe without being verbose.