Kappa's Lair v5

В продолжение к: http://friendfeed.com/kkapp/b5d3658c

Заняло минут 40. На полпути понял, что останавливаться на первом найденном пути нельзя. В любом случае получился неоптимальный вариант, который на графах с большим количеством дуг может стать кубическим.

#! /usr/bin/perl
use strict;
use warnings;

use Test::Most;
use Data::Dump;

# a graph is stored as its adjacency array:
# for each vertex we have a list of pairs, each containing
# the index of the incident vertex and the weight of the arc to it.

sub spath {
	my ($graph, $from, $to) = @_;

	my @path = (-1) x @$graph;

	my $was_changed = 1;

	$path[$from] = 0;

	while ($was_changed) {
		$was_changed = 0;

		for my $v (grep { $path[$_] != -1 } 0 .. $#path) {
			for my $nv (@{$graph->[$v]}) {
				if  ($path[$nv->[0]] == -1
				  || $path[$nv->[0]] > $path[$v] + $nv->[1])
				{
					$path[$nv->[0]] = $path[$v] + $nv->[1];
					$was_changed = 1;
				}
			}
		}
	}

	return $path[$to];
}

is(spath([[], []], 0, 1), -1);

my $g1 = [
	[[1 => 10], [2 => 21], [3 => 100]],	# 0
	[[2 => 30], [0 => 20], [4 => 50]],	# 1
	[[5 => 40]],				# 2
	[],					# 3
	[],					# 4
	[[5 => 11]],				# 5
];

is(spath($g1, 0, 3), 100);
is(spath($g1, 0, 4), 60);
is(spath($g1, 0, 5), 61);
is(spath($g1, 1, 0), 20);
is(spath($g1, 2, 0), -1);
is(spath($g1, 2, 2), 0);
is(spath($g1, 5, 5), 0);

# A --10-> B --10-> C --10-> D
#  \-----1----------^  ------^
#   \---------1000----/

my $g2 = [
	[[1 => 10], [2 => 1], [3 => 1000]],	# 0
	[[2 => 10]],		# 1
	[[3 => 10]],		# 2
	[],			# 3
];

is(spath($g2, 0, 3), 11);
is(spath($g2, 1, 3), 20);

#  /--1000-v
# A --10-> B --10-> C --10-> D
#  \--------100-----^
#

my $g3 = [
	[[1 => 1000], [1 => 10], [2 => 100]],
	[[2 => 10]],
	[[3 => 10]],
	[],
];

is(spath($g3, 0, 1), 10);
is(spath($g3, 0, 2), 20);

done_testing;