#!/usr/bin/perl -w
# $Id$
# This program solves the travelling salespoeple problem from the
# Puzzling Adventures column in May 2001's Scientific American.
# This program solves the Scientific American problem by simulating a
# quantum computer.  When they work, quantum computers can test every
# solution to a problem in O(1) time.  However, because most computers
# don't operating on quantum principles, some form of concurrency is
# used to simulate them.  As a result, these pale shadows of future
# technology take O(N) time, where N is the number of possible
# solutions.  This is not practical for large problems.
# This program uses POE for its concurrency.  POE may be installed the
# same way Perl modules usually are:
#
#  % perl -MCPAN -e shell
#  cpan> install POE
#
# It may also be installed manually from the tarball found at
# poe.perl.org.  See the README file inside the archive.
use strict;

#------------------------------------------------------------------------------
# This section contains options to change how the program runs.  It
# solves the Scientific American puzzle by default, but the author was
# bored after that and added extra abilities.
# Set USE_SCI_AM_STARTERS to 1 if you want to start walking from only
# the nodes in the Scientific American puzzle.  Otherwise it will
# start walking the graph from every node.
sub USE_SCI_AM_STARTERS () { 1 }

# Set FIND_ROUTES_WITH_UNIQUE_NODES to 1 to find routes that visit
# each node only once.  This is not part of the Scientific American
# puzzle.
sub FIND_ROUTES_WITH_UNIQUE_NODES () { 0 }

# Set FIND_ROUTES_WITH_UNIQUE_EDGES to 1 to find routes that travel
# each path only once.  This is part of the SciAm puzzle.  The
# puzzle's solution will be the last node visited, and it should be
# the same for every route.
sub FIND_ROUTES_WITH_UNIQUE_EDGES () { 1 }

# Setting both FIND_ROUTES_WITH_UNIQUE_NODES and -EDGES will show both
# sets of solutions.  It does not constrain the solutions to just
# those with unique nodes and edges.
#------------------------------------------------------------------------------
# There are no more friendly tweaks beyond this point.
use POE;
my %path = (
  a => [qw( b c     )],    # Node A has paths leading to B and C.
  b => [qw( a c e g )],    # Node B has paths leading to A, C, E, and G.
  c => [qw( a b d e )],    # Etc.
  d => [qw( c e f   )],
  e => [qw( b c d g )],
  f => [qw( d g     )],
  g => [qw( b e f   )],
);

# Gather unique paths.  Node A leads to B, and node B leads to A.
# These both describe different directions on the same path.
# %unique_paths contains just A->B.
my %unique_paths;
foreach my $node (keys %path) {
  foreach my $other_node (@{$path{$node}}) {
    my $path_key = join '', sort($node, $other_node);
    $unique_paths{$path_key} = 1;
  }
}

# Start a "unique node" walker at a particular node.  As it walks from
# one node to another, it will "simulatneously" take every path to a
# node it has not yet visited.  Walkers that successfully pass through
# each node once will report the routes they've taken.
sub spawn_unique_node_walker {
  my $start = shift;
  POE::Session->create(
    inline_states => {
      _start => sub {
        my ($kernel, $heap, $start_node) = @_[KERNEL, HEAP, ARG0];

        # Track this walker's start time.
        $heap->{start_time} = time();

        # Begin walking from the start node.
        $kernel->yield(walk_from => $start_node, [], {});
      },
      walk_from => sub {
        my ($kernel, $heap, $this_node, $my_path, $seen) =
          @_[KERNEL, HEAP, ARG0 .. ARG2];

        # Mark this node as visited.
        push @$my_path, $this_node;
        $seen->{$this_node} = 1;

        # If we're done, we're done.
        if (@$my_path == keys(%path)) {
          my $elapsed_time = time() - $heap->{start_time};
          print "found a path (${elapsed_time}s): @$my_path\n";
          return;
        }

        # Branch out to unvisited nodes.
        foreach (@{$path{$this_node}}) {
          next if exists $seen->{$_};
          $kernel->yield(walk_from => $_, [@$my_path], {%$seen});
        }
      },
    },
    args => [$start],
  );
}

# Start a "unique path" walker.  These walkers have functions similar
# to the unique node walkers, but they take uncharted paths instead of
# walking to unvisited nodes.
sub spawn_unique_edge_walker {
  my $start = shift;
  POE::Session->create(
    inline_states => {
      _start => sub {
        my ($kernel, $heap, $start_node) = @_[KERNEL, HEAP, ARG0];

        # Track this walker's start time.
        $heap->{start_time} = time();
        $kernel->yield(walk_from => $start_node, [], {});
      },
      walk_from => sub {
        my ($kernel, $heap, $this_node, $my_path, $seen) =
          @_[KERNEL, HEAP, ARG0 .. ARG2];

        # If we're done, we're done.
        if (@$my_path == keys %unique_paths) {
          my $elapsed_time = time() - $heap->{start_time};
          print "found a path (${elapsed_time}s): @$my_path\n";
          return;
        }

        # Branch out on untravelled paths.
        foreach (@{$path{$this_node}}) {
          my $path_key = join '', sort($this_node, $_);
          next if exists $seen->{$path_key};

          # Copy the current hash of seen paths, and add the new
          # path to it.
          my %new_seen = %$seen;
          $new_seen{$path_key} = 1;

          # Copy the current list of paths taken on this walk, and
          # add the next path to it.
          my @new_path = @$my_path;
          push @new_path, ($this_node . $_);

          # Walk away from this node down that new path.
          $kernel->yield(walk_from => $_, \@new_path, \%new_seen);
        }
      },
    },
    args => [$start],
  );
}

# Determine the starting nodes.
my @starting_nodes;
if (USE_SCI_AM_STARTERS) {
  @starting_nodes = qw(a b c d);
}
else {
  @starting_nodes = keys %path;
}

# Spawn walkers from each starting node.
foreach (@starting_nodes) {
  &spawn_unique_node_walker($_) if FIND_ROUTES_WITH_UNIQUE_NODES;
  &spawn_unique_edge_walker($_) if FIND_ROUTES_WITH_UNIQUE_EDGES;
}

# Run the walkers until they exhaust their nodes or edges.
$poe_kernel->run();
exit 0;