http://www.perlmonks.org?node_id=282049

A few days ago BrowserUk had a question involving finding a path through a set of strings where each step was between two strings that only differed by a single transposition.

It turned out that he wanted to do most of the work with a regexp. A large subproblem is, how to find a Hamiltonian path in a graph. (A Hamiltonian path in a graph is a path that visits each node once, and only once. Finding such a path (or just answering the question whether such a path exists) is a very hard problem for arbitrary graphs, unlike the problem of finding an Euler path (a path that visits each edge of a graph, once and only once)).

The question kept nagging, and I managed to find Hamiltonian paths in a graph using the regexp machine. It uses only (?{ }), and (?(?{ })|) constructs, so it isn't a 'pure' regexp. I think there's a pure regexp solution as well, but everything I tried so far requires an exponentially sized query string.

The code below expects a description of the graph in the __DATA__ area, in a simple format. One line for each node, consisting of the node name, a colon, and a comma separated list of neighbours. The information is stored in a global hash %graph, and a global array @nodes is used to store all nodes in. The function hamiltonian returns an appropriate regex. Running the regex against the empty string returns false if there's no Hamiltonian path, and true otherwise. In the latter case, the global array @path will be set, containing the vertices on the path, in the appropriate order.

#!/usr/bin/perl use strict; use warnings; use re 'eval'; my %graph; my @path; while (<DATA>) { chomp; my ($node, $edges) = split /\s*:\s*/; my @edges = split /\s*,\s*/ => $edges; foreach my $edge (@edges) { $graph {$node} {$edge} = 1 } } my @nodes = keys %graph; sub hamiltonian { my $regex = ""; foreach my $c (0 .. $#nodes) { $regex .= '(?:'; $regex .= join "|\n " => map {"(?{local \$q [$c] = \$nodes [$_]})"} 0 .. $# +nodes; $regex .= ")\n"; next unless $c; $regex .= "(?(?{"; foreach my $d (0 .. $c - 1) { $regex .= "\$q [$c] eq \$q [$d] ||\n "; } $regex .= "!\$graph {\$q [" . ($c - 1) . "]} {\$q [" . $c . "] +}"; $regex .= "})x|)\n"; } $regex .= "(?{ \@path = \@q })"; $regex; } my $regex = hamiltonian; if ("" =~ /$regex/x) { local $" = ", "; print "Found path [@path]\n"; } else { print "No path found.\n"; } __DATA__ v1: v2 v2: v1, v3, v4 v3: v2, v4 v4: v2, v3, v5 v5: v4, v6, v8 v6: v5, v7, v8 v7: v6, v8 v8: v5, v6, v7

Running this gives:

Found path [v7, v8, v6, v5, v4, v3, v2, v1]

It's straightforward to turn this into a regex that finds a hamiltonian cycle, or one that finds all hamiltonian paths/cycles.

Abigail