#!/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;