Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
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


In reply to Finding Hamiltonian Paths using the Regexp Engine by Abigail-II

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others pondering the Monastery: (6)
As of 2024-04-19 11:36 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found