in reply to what is wrong with my Dijkstram algorithm?

This is how I would write Dijkstra's algorithm. 
#
# Takes a graph and a root element as arguments.
# The graph is a doubled keyed hash, with
#    $graph{a}{b} = x;
# indicating there's an edge from a to b with distance x.
#
# If the graph is supposed to be bidirectional, make sure that
# for all a, b, $graph{a}{b} = $graph{b}{a}.
#
sub dijkstra {
    my $graph = shift;
    my $root = shift;

    my %dist;   # Distance to root element.
    my @todo = [$root, 0];

    {
        my ($to, $distance) = @{shift @todo};
        unless (exists $dist{$to}) {
            #
            # Have not been here
            #
            $dist{$to} = $distance;
            @todo = sort {$$a[1] <=> $$b[1]}
                   @todo,
                    map {[$_, $distance + $$graph{$to}{$_}]} keys %{$$
+graph{$to}};
        }
    }

    return \%dist;
}

[download]
How does it work? %dist keeps track of which nodes with can reach from the root node, and the length of the shortest path. @todo is a list of nodes and their distance from the root that we know we can reach, ordered by distance from the root. If the first element of @todo is already in %dist, we've already found a shortest path to said node, and we continue with the next. Else, we have discovered a shortest path. In that case, put all neighbours, with their distances, in @todo, and record the distance of this node in %dist.

Dijkstra's algorithm can be implemented in O(N log N) time (with N the number of edges in the graph), but the above isn't -- you'd need a binary search tree (or another datastructure) which does inserts and extract-minimum operations in (amortized) O(log N) time. The above implementation is lazy, and uses arrays and sort to keep an ordered list, resulting in an O(N2) run time. (Note that it isn't O(N2 log N) as Perls merge sort implementation is smart enough to take the fact that @todo is sorted already into account).

Update: fixed a bug in the algorithm.

Replies are listed 'Best First'.
Re^2: what is wrong with my Dijkstram algorithm?
by Michael Z. (Initiate) on Dec 29, 2011 at 03:59 UTC

    thanks Java Fan, but can you show me how to work with the following example.

    %graph = (
  'ARR1' => {'ARR1' => 1,'CHOP' => 1,'CIN5' => 1},
  'MET4' => {'cJun' => 1,'OASIS' => 1,'cMaf'=> 1,'cJun' => 1},
  'JunD' => {'OASIS' => 1,'MafK' => 1,'NFE2'=> 1,'p21SNFT' => 1},
  'MafB' => {'MafB' => 1,cMaf => 1},
  'MafG'=> {'MafG' => 1,'MafK' => 1,NFE2=> 1,'NFE2L1' => 1},
);

    [download]

    I have a graph like this with 57 unique protein(node) linked to a minimum of 1 which is linked to it self. these are samples of it. and note that each node has equal weight. which is 1

    thanks again

    Michael Z.

[reply]
[d/l]
      What have you tried? What is unclear to my explanation of how the dijkstra routine should be called? Do you actually want Dijkstras algorithm, or do you need an "all shortest paths" algorithm?
[reply]

        HI perl monks, I have undirected graph with 57 nodes and 204 linkages. I calculate the shortest path of all nodes with its sub nodes using Dijkstram algorithm, but I couldn't able to print the path of the nodes from a given root. here is how i tried. 

        ########## the dijkstram algorithm#################
sub dijkstra {
    my ($graph, $root) = @_;
    my (%dist, %prev);

    foreach $n (keys %{$graph}) { $dist{$n} = inf; $prev{$n}=$n; }
    # .. except the source
    $dist{$root} = 0;

    # loop while we have unsolved nodes
    # sort unsolved by distance from root
    foreach my $n1 (sort keys %{$graph}) {
        foreach my $n2 (keys %{$graph->{$n1}}) {
            if (($dist{$n2} eq inf)) {
                $dist{$n2} = $dist{$n1} + $graph->{$n1}{$n2};
                $prev{$n2} = $n1;
            }
        }
    }
    return (\%prev, \%dist);
}
######## print the path and the distance for a given node#############
sub printPaths {
    my ($graph, $prev, $dist) = @_;
    my $path;

    foreach $n (keys %{$graph}) {
        my $t = $n;
        $path = $t;
        while ($t ne $root) {
            $t = $prev->{$t}; $path = "$t -> " . $path;
        }
        print "$n\t$dist->{$n}\t$path\n";
    }
}

        [download]

        the problem occurs on the while loop. when it gets a node that doesn't have the same root and when the previous node always returns the same node. please help me or give me any suggestion. thanks

[reply]
[d/l]

In Section Seekers of Perl Wisdom