Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

(Golf) Shortest Graph Distance

by Masem (Monsignor)
on May 11, 2001 at 22:49 UTC ( [id://79811]=perlmeditation: print w/replies, xml ) Need Help??

Given: A graph %g composed of a hash of hashes; the keys of %g are the names of the nodes of the graph, and the value of each is another hash (temporarily, call it %t); the keys of %t are other nodes in the graph that can be accessed by the current node, and the values are the distances to those nodes. So, in the case where, say "Chicago" and "Cleveland" are separated by a distance of 400, %g will look like:
%g = ( Chicago => { Cleveland=>400 }, Cleveland => { Chicago=>400 } );
All distances are non-zero, positive values. The graph is not necessarily bidirectional (That is, if the distance from 'A' to 'B' is 1, the distance from 'B' to 'A' may not necessarily be 1, nor may it be possible to go from B to A directly.) There are no disjoint parts of the graph or dead ends, so that it is possible to go to any other point from a given point. Also, you are given two node names, $a and $b.

Find a perl golf solution that returns an array of the node names in the shortest distance route from $a to $b, including $a and $b. UPDATE as suggested by MeowChow to set the order of the sub parameters as \%g, $a, $b.

More Updating Goodness: Here's a test case for ya :-)

my %g = ( Chicago=>{ Detroit=>250, Cleveland=>400, Denver=>2500, SF=>4000 }, Cleveland=>{ Chicago=>400, NYC=>2500 }, Detroit=>{ Chicago=>250, Cleveland=>200 }, NYC=>{ Cleveland=>2500, SF=>7500 }, SF=>{ NYC=>6500, Denver=>1500 }, Denver=>{ SF=>1500, Chicago=>2500 } ); d( \%g, 'Detroit', 'Cleveland'); # should be ( 'Detroit', 'Cleveland' +) d( \%g, 'Cleveland', 'Detroit' ); # should be ( 'Cleveland', 'Chicago', 'Detroit' ) d( \%g, 'NYC', 'SF' ); # should be ( 'NYC', 'Cleveland', 'Chicago', 'SF' ) OR ( 'NYC', 'Cleveland', 'Chic +ago', 'Denver', 'SF' ) d( \%g, 'SF', 'NYC' ); # should be ( 'SF', 'NYC' ) d( \%g, 'Denver', 'Cleveland' ); # should be ( 'Denver', 'Chicago', 'C +leveland' ) d( \%g, 'Cleveland', 'Denver' ); # should be ( 'Cleveland', 'Chicago', 'Denver' );
Update: yea, fixed the stupid parens here....
Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain

Replies are listed 'Best First'.
Re: (Golf) Shortest Graph Distance
by chipmunk (Parson) on May 12, 2001 at 00:15 UTC
    Here's a solution, which I'm fairly certain works as intended (but we saw where that got me last time ;)
    sub path { (*g,$f,$t)=@_;@s=map[$f,$_,$r{$_}],keys%{*r=$g{$f}}; push@s,map[@p,$_,$d+$r{$_}],keys%{*r=$g{$n}} while(@s=sort{$b->[-1]<=>$a->[-1]}@s),$d=pop@{*p=pop@s}, ($n=$p[-1])ne$t;@p }
    170 characters... Yikes! I'm sure someone can do better than that!

    Update: Hey, I don't need to do that complicated initialization of @s!

    sub path { (*g,$f,$t)=@_;@s=[$f,0]; push@s,map[@p,$_,$d+$r{$_}],keys%{*r=$g{$n}} while(@s=sort{$b->[-1]<=>$a->[-1]}@s),$d=pop@{*p=pop@s}, ($n=$p[-1])ne$t;@p }
    142 characters!

    Update:

    This solution will be very slow on the NYC to SF test case, because it gets stuck moving back and forth between Chicago, Cleveland, and Detroit for a while, because SF is so far away. However, it will find the solution eventually.

    Of course, this could be fixed by preventing the code from moving back to a node that has already been visited, but we're optimizing for character count, not for speed of execution! ;)

Re: (Golf) Shortest Graph Distance
by MeowChow (Vicar) on May 12, 2001 at 08:28 UTC
    Here's a recursive strict and -w compliant sub at 94 chars for the related problem of enumerating all possible paths (without cycles) from A to B:
    sub p { my($g,$s,$e,%v)=@_;$s eq$e?[$e]:map{map[$s,@$_],p($g,$_,$e,%v,$s,1)} +grep!$v{$_},keys%{$$g{$s}} }
       MeowChow                                   
                   s aamecha.s a..a\u$&owag.print
Re: (Golf) Shortest Graph Distance
by MeowChow (Vicar) on May 12, 2001 at 01:42 UTC
    Best I could do so far, strict and warning clean, at 158 chars:
    sub path { my($g,$s,$e,@p,$q)=@_;@_=[0,$s];{my($l,@r)=@{+shift};if(!@p||$q>$l){ +@p=@r,$q=$l if$r[-1]eq$e;my$o=$$g{$r[-1]};push@_,map[$l+$$o{$_},@r,$_ +],keys%$o}@_&&redo}@p }
       MeowChow                                   
                   s aamecha.s a..a\u$&owag.print
Re: (Golf) Shortest Graph Distance
by no_slogan (Deacon) on May 12, 2001 at 00:03 UTC
    My first try. Passes -w and strict. 172 characters.
    sub path { my($g,$a,$b,$x,$y,%s)=@_;$s{$a}=[0,[$a]];for(%$g){for(keys%s){$s{$x}&& +$s{$_}[0]+$y>$s{$x}[0]or$s{$x}=[$s{$_}[0]+$y,[@{$s{$_}[1]},$x]]while( +$x,$y)=each%{$g->{$_}}}}$s{$b}[1] }

    Update:Oops, it returns an arrayref instead of an array. No point in fixing it, chipmunk's solution puts mine to shame anyway.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlmeditation [id://79811]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

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

    No recent polls found