t5/edgar

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;
}

Correctness

The code is correct. This is the only correct submission to this problem.

Consistency

It looks like the LinkedLists module needn't have been included from the main script.

Clarity of intent

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) {

Algorithmic efficiency

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.

Idiomatic use of Perl 6

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.

Brevity

This program is split into four files, and uses quite a bit of code to get where it wants.