Shortest path problem

[Slaven Rezic]

Pierluigi Vittori <piero at innova.it> writes:

> 
> On ven, 15 ott 1999, Slaven Rezic wrote:
> 
> > Hello Cameron, hello Pierluigi,
> > 
> > I use the algorithm A* to get the shortest path between two places. I
> > don't know what's the format of the mapserver data, but I think it
> > should be easy to make it usable by my perl module. The module is part
> > of a larger system. The sources can be found under
> > 	http://pub.cs.tu-berlin.de/src/BBBike
> 
> Hello Slaven!
> 
> can you indicate any papers or other kind of references to turn to for a
> theoretical background on such an issue?
> I appreciate your help very much. Thanks.
> 

Here are some:

Kanal,  L.; and Kumar, V., Search in Artificial Intelligence,
Springer-Verlag New York, 1988.

Korf, Richard E., Optimal Path-Finding Algorithms, in Search
in Artificial Intelligence, Springer-Verlag New York, 1988, pages
233-241.

Below is a sample implementation of the algorithm in perl.

Regards,
	Slaven

######################################################################
# -*- perl -*-

#
# $Id: BBBikeDiplom.pm,v 1.3 1999/08/26 19:51:59 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 1999 Slaven Rezic. All rights reserved.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: eserte at cs.tu-berlin.de
# WWW:  http://user.cs.tu-berlin.de/~eserte/
#

package BBBikeDiplom;

use Strassen;

package StrassenNetz;

# implementiert die Suche mit dem Algorithmus A*
sub search_A_star {
    my($self, $from, $to) = @_;

    if ($data_format != 1) {
	die "Only implemented for data format 1";
    }

    my $net = $self->{Net};

    # %OPEN entspricht der Liste OPEN aus der Algorithmusbeschreibung
    # Der Key des Hashs ist der Knoten n (die Koordinate im
    # Straßennetz), der Value ist ein Array, wovon das erste Element
    # den Vorgänger enthält (oder undef) und das zweite Element die
    # bisherige Länge g(n).

    # Der Startknoten wird sofort in OPEN eingefügt (Punkt 1)
    my %OPEN = ($from => [undef, 0]);

    my %CLOSED;

    while (1) {

	# Punkt 2: es gibt keine Lösung
	if (keys %OPEN == 0) {
	    return ();
	}

	# Punkt 3
	my(@sort_list) = sort {
	    # nach Minimum Sortieren
	    $a->[0] <=> $b->[0]
	} map {
	    # f = g + h berechnen
	    my $f = $OPEN{$_}->[1] + Strassen::Util::strecke_s($_, $to);
	    [$f, $_];
	} keys %OPEN;
        # der Knoten (Koordinaten) des Minimums
	my $min_node = $sort_list[0]->[1];
        # ... wird aus OPEN nach CLOSED bewegt
	$CLOSED{$min_node} = $OPEN{$min_node};
	delete $OPEN{$min_node};

	# Punkt 4
	if ($min_node eq $to) {
	    my @path;
	    my $len = 0;
	    while (1) {
		push @path, $min_node;
		my $prev_node = $CLOSED{$min_node}->[0];
		if (defined $prev_node) {
		    $len += Strassen::Util::strecke_s($min_node, $prev_node);
		    $min_node = $prev_node;
		} else {
		    last;
		}
	    }
	    @path = map { [ split(/,/, $_) ] } reverse @path;
	    return (\@path, $len, 0, 0, 0);
	}

	# Punkt 5
	my @successors = keys %{ $net->{$min_node} };
	foreach my $successor (@successors) {
	    my $g = $CLOSED{$min_node}->[1] +  # bisherige Länge bis n
	      $net->{$min_node}{$successor}; # Länge bis n'
	    my $f = $g + Strassen::Util::strecke_s($min_node, $to); # h(n')
	    if (!exists $OPEN{$successor} and
		!exists $CLOSED{$successor}) {
		$OPEN{$successor} = [$min_node, $g];
	    } else {
		my $OPEN_OR_CLOSED;
		if (exists $OPEN{$successor}) {
		    $OPEN_OR_CLOSED = $OPEN{$successor};
		} else {
		    $OPEN_OR_CLOSED = $CLOSED{$successor};
		}
		if ($f < $OPEN_OR_CLOSED->[1]) {
		    $OPEN_OR_CLOSED = [$f, $min_node];
		    if (exists $CLOSED{$successor}) {
			$OPEN{$successor} = $CLOSED{$successor};
			delete $CLOSED{$successor}; # hier oder immer? XXX
		    }
		}
	    }
	}
    }
}

1;

__END__
######################################################################

-- 
use Tk;$c=tkinit->Canvas(-he,20)->grid;$x=5;map{s/\n//g;map{$c->create('line'=>
map{$a=-43+ord;($x+($a>>3)*2=>5+($a&7)*2)}split//)}split/!/;$x+=12}split/_/=>'K
PI1_+09IPK_K;-OA1_+K!;A__1;Q!7G_1+QK_3CLPI90,_+K!;A_+1!KQ!.N_K+1Q!.F_1+KN.Q__1+
KN._K+1Q!.F_1+KN.Q_+1Q__+1!KQ!.N_1;Q!7G_K3,09Q_+1!K.Q_K+1Q!.F_1+KN.Q_';MainLoop