Download the raw code. And LinkedLists.pm6. And Multiset.pm6. And Partition.pm6.
# -*- mode: cperl6; -*-
# 2011 Perl 6 Coding Contest
# Edgar Gonzàlez i Pellicer
use v6;
use LinkedLists;
use Multiset;
use Partition;
# Tree
class Tree {
# Children
has @.children;
# Walk along a tree
method walk() {
# Recurse
my Int $pos = 1;
# Gather
my @result = gather {
self.walk-rec($pos);
}
# Remove the last one, unless there is only one
@result.pop unless @result == 1;
# Return
return @result;
}
# Walk along a tree
# Recursive version
method walk-rec(Int $start is rw) {
# Our number is...
my Int $ours = $start++;
take $ours;
# Any children?
for @.children -> $child {
# Call for each children
$child.walk-rec($start);
# Back to where we were
take $ours;
}
}
}
# Rooted trees
my @rooted-trees;
@rooted-trees[0] = [];
@rooted-trees[1] = [ Tree.new ];
# Combine subtrees
sub combine-subtrees(Array $parts, Int $i, Array $cur, Array $result) {
# End?
if $i == $parts.elems {
# Add it
$result.push(Tree.new(children => $cur.list));
}
else {
# How many of which cardinality
my $cardinality = $parts[$i].key;
my $how-many = $parts[$i].value;
# Find all subtree multisets
my @msets = multisets(rooted-trees($cardinality), $how-many);
# For each one
for @msets -> $mset {
# Add it
my $len = $mset.elems;
$cur.push(|$mset);
# Recurse
combine-subtrees($parts, $i + 1, $cur, $result);
# Remove it
$cur.pop for ^$len;
}
}
}
# Join two subtrees
sub join-two-subtrees(Array $trees, Array $result) {
# Loop
for $trees.keys -> $i {
for $i ..^ $trees.elems -> $j {
# Join one to the other (i.e., add one as children)
my @children = $trees[$i].children;
@children.push($trees[$j]);
$result.push(Tree.new(children => @children));
}
}
}
# Rooted trees
sub rooted-trees(Int $n) {
# Generate them
for @rooted-trees.elems .. $n -> $i {
# Trees i
my $trees-i = [];
# Find the partitions of $n - 1
for int-partitions($i - 1) -> $part {
# Combine subtrees
combine-subtrees($part.uniq-c, 0, [], $trees-i);
}
# Set it
@rooted-trees[$i] = $trees-i;
}
# Return them
return @rooted-trees[$n].list;
}
# We use Jordan's Theorem, as in:
#
# Roberto ARINGHIERI, Pierre HANSEN, Federico MALUCELLI
# Chemical Trees Enumeration Algorithms
# 4OR: A Quarterly Journal of Operations Research, 1(1), 67--83, 2003
#
# but lifting the maximum degree restriction
# Unrooted-trees
sub unrooted-trees(Int $n) {
# Cases
given $n {
# Negative or zero
when * .. 0 {
# Nothing
return;
}
# One
when 1 {
# A single tree
return Tree.new;
}
# Otherwise
default {
# Result
my @result;
# Parity?
if $n %% 2 {
# Even
# Partitions
my @partitions = int-partitions($n - 1);
my $start = partitions-below-or-eq(@partitions, $n div 2 - 1);
# For each case
for @partitions[$start ..^ @partitions.elems] -> $part {
# Skip one- and two-element partitions
next if $part.elems <= 2;
# Combine subtrees
combine-subtrees($part.uniq-c, 0, [], @result);
}
# Join two subtrees
join-two-subtrees(rooted-trees($n div 2), @result);
}
else {
# Odd
# Partitions
my @partitions = int-partitions($n - 1);
my $start = partitions-below-or-eq(@partitions, $n div 2);
# For each case
for @partitions[$start ..^ @partitions.elems] -> $part {
# Skip one-element partitions
next if $part.elems == 1;
# Combine subtrees
combine-subtrees($part.uniq-c, 0, [], @result);
}
}
# Return them
return @result;
}
}
}
# Main
sub MAIN(Str $n-str) {
# Number
my Int $n = $n-str.Int;
# Find the trees
for unrooted-trees($n) -> $tree {
say($tree.walk.join('-'));
}
}
# Call main
# @maybe This should be done automatically?
MAIN(|@*ARGS);
LinkedLists.pm6:
# -*- mode: cperl6; -*-
# 2011 Perl 6 Coding Contest
# Edgar Gonzàlez i Pellicer
# Linked lists
module LinkedLists;
# Linked list
class LinkedList is export {
has $.head;
has LinkedList $.tail;
# Elements
method elems() {
# Result
my $result = 0;
# Follow the list
my LinkedList $l = self;
# Next
while $l.defined {
# One more
++$result;
# Continue
$l .= tail;
}
# Return
return $result;
}
# To array
method to-array() {
# Result
my @result;
# Follow the list
my LinkedList $l = self;
# Next
while $l.defined {
# Add the head
@result.push($l.head);
# Continue
$l .= tail;
}
# Return
return @result;
}
# Uniq -c
method uniq-c() {
# Result
my @result;
# Follow the list
my LinkedList $l = self;
# Next
while $l.defined {
# Get it
my $start = $l.head;
my $how-many = 1;
# Continue
$l .= tail;
while $l.defined && $l.head == $start {
$l .= tail;
++$how-many;
}
# Add
@result.push($start => $how-many);
}
# Return
return @result;
}
}
Multiset.pm6:
# -*- mode: cperl6; -*-
# 2011 Perl 6 Coding Contest
# Edgar Gonzàlez i Pellicer
# Multisets
module Multiset;
# Take a n-multiset
# Recursive helper function
sub multisets-rec(Array $src, Int $n, Int $i, Array $cur) {
# No more?
if $n == 0 {
# Add it
take [ $cur.clone ];
}
else {
# For each one
for $i ..^ $src.elems -> $j {
# Add it to current
$cur.push($src[$j]);
# Recurse from there
multisets-rec($src, $n - 1, $j, $cur);
# Remove
$cur.pop;
}
}
}
# Generate all n-multisets
sub multisets(Array $src, Int $n) is export {
return gather {
# Recurse
multisets-rec($src, $n, 0, []);
}
}
Partition.pm6:
# -*- mode: cperl6; -*-
# 2011 Perl 6 Coding Contest
# Edgar Gonzàlez i Pellicer
# Integer partitions
module Partition;
use LinkedLists;
# Stored partitions
my @partitions;
@partitions[0] = [ LinkedList ];
@partitions[1] = [ LinkedList.new(head => 1, tail => LinkedList) ];
@partitions[2] = [ LinkedList.new(head => 2, tail => LinkedList),
LinkedList.new(head => 1, tail => @partitions[1][0]) ];
# Find the start of the partitions whose largest value is below
# or equal to the given value
# Partitions are sorted by decreasing lexicographical order
# It is a lower bound
sub partitions-below-or-eq(Array $partitions, Int $largest) is export {
# Binary search
my $l = 0;
my $r = $partitions.elems;
# Loop
while $l < $r {
# Middle
my $m = ($l + $r) div 2;
if $partitions[$m].head > $largest {
$l = $m + 1;
}
else {
$r = $m;
}
}
# Return the point
return $l;
}
# Integer partitions
sub int-partitions(Int $n) is export {
# Generate them
for @partitions.elems .. $n -> $i {
# Partitions i
my $partitions-i = [ LinkedList.new(head => $i, tail => LinkedList) ];
# Choose the largest element
for $i - 1, $i - 2 ... 1 -> $largest {
# Tails
my $tails = @partitions[$i - $largest];
my $start = partitions-below-or-eq($tails, $largest);
# For each one
for $tails[$start ..^ $tails.elems] -> $tail {
$partitions-i.push(LinkedList.new(head => $largest, tail => $tail));
}
}
# Set it
@partitions[$i] = $partitions-i;
}
# Return them
return @partitions[$n].list;
}
The code is correct. This is the only correct submission to this problem.
It looks like the LinkedLists
module needn't have been included from the main
script.
Sincere bonus points on this comment.
# We use Jordan's Theorem, as in:
#
# Roberto ARINGHIERI, Pierre HANSEN, Federico MALUCELLI
# Chemical Trees Enumeration Algorithms
# 4OR: A Quarterly Journal of Operations Research, 1(1), 67--83, 2003
#
# but lifting the maximum degree restriction
It always feels comforting to know that what we're doing is not groping in the dark, but science.
The MAIN
method looks very to-the-point.
Many of the comments in the program feel pretty superfluous, as if the programmer has a compulsion to comment things even when it doesn't improve the reader's understanding:
# Main
sub MAIN(Str $n-str) {
The code has very nice speed and memory characteristics. It's difficult to compare it against the other submissions, since they are on Rakudo and this is on Niecza.
If someone wants to contribute a time complexity analysis, the p6cc organizers are happy to include it here.
multisets-rec
could perhaps have been declared inside of multisets
,
restricting access to it to its only legitimate caller. Ditto walk-rec
, or
the method could be made private.
This program is split into four files, and uses quite a bit of code to get where it wants.