Поиск по графу

Свой вариант, написанный на Perl, я привожу ниже, а попробовать ее в действии вы можете здесь: //webscript.ru/cgi-bin/intel/intel.cgi ( http://webscript.ru///webscript.ru/cgi-bin/intel/intel.cgi )

Поиск не должен быть оптимальным, скорейшим и т.д. - такой задачи пока не стоит, надо просто отыскать верное решение.
Кроме того, данная статья - эксперимент, эксперимент над посетителями WebScript.Ru, который заключается в проверке необходимости подобных материалов.. нужно вам это или нет? Все-таки мы отдаем себе отчет в том, что данная задачка представляет скорее теоретический интерес нежели практический, хотя :) на практике некоторые идеи применить можно.

Кто сказал, что все просто?
На первый взгляд, задача кажется весьма простой (а еще проще она смотрится, если нарисовать дерево графа, но это на бумажке), весьма интересно посмотреть на другие варианты достижения поставленной задачи… А как эту задачу решить средствами PHP? ;)

Пояснения к моему решению:

%point=(1 => [4, 2],
2 => [1, 3],
3 => [4, 2, 6],
4 => [1, 5, 3],
5 => [4, 6],
6 => [5, 4, 3, 7],
7 => [6]);

if ($point==$finish){
push (@ariadna, $point);
return 'end';
}

pop @ariadna;
@{$point{$path}}=@list;
return 0;

Данный вариант поиска называется "Поиск в глубину". Если решение существует, то мы до него рано или поздно доползем, плохо то, что мы идем до упора по одному пути, пока не упремся лбом в стену... а ответ может быть совсем рядом, надо было лишь вначале свернуть в другую сторону. Есть другой способ - "Поиск в ширину", т.е. мы не идем до упора, а заглядываем во все закоулки, если не видим ответа, то заглядываем в более глубокие закоулки (но во все!) - иногда, так можно найти ответ быстрее.. но об этом в следующий раз! Хотелось бы услышать ваше мнение по поводу таких задачек - нужно ли публиковать подобное на webscript.ru или нет? Это :) эксперимент.

Сама программа:

#!/usr/bin/perl -w
#Слепой поиск в глубину
#Автор:Green Kakadu (gnezdo@webscript.ru)
#-----------------------------------------
use vars '%point', '%bid',  '$start', '$finish', '@ariadna';
#Задаем граф - ключ узел,
#значения в массиве - узлы, которые с ним связаны
%point=(1 => [4, 2],
2 => [1, 3],
3 => [4, 2, 6],
4 => [1, 5, 3],
5 => [4, 6],
6 => [5, 4, 3, 7],
7 => [6]);

&main;

sub main {
#--------------------------------------
$start||=1;
$finish||=7;
&deep_search;
}

sub deep_search {
#---------------------------------------
my $res;
push (@ariadna, $start);
my $i;
#Проверяем до тех пор не найдем результат, или проверим все пути
until($res){
$i++;
print $i,': ', @ariadna, "\n";#вывод рез-тов каждого шага
$res=&deep_search_routing;#провер-ка очередного узла
unless (@ariadna){last;}#выход из цикла если проверены все пути
}
if ($res){$my_print=join("->", @ariadna);}
else {$my_print = "К сожалению, ничего не найдено!";}
$my_print .=" Кол-во проверок: $i\n";
print $my_print;
exit;
}

sub deep_search_routing {
#----------------------------------------
my $search=&check_point($ariadna[$#ariadna]);#'расширяем' узел
if ($search){return 'Find!';}#true если есть ответ!
else{return 0;}#false - продолжаем поиск
}

sub check_point {
#-----------------------------------------
my $path=shift;
#расширяем узел и смотрим, что еще не проверено
my @list=@{$point{$path}};
unless(@list){
pop @ariadna;#тупик! сделаем шаг назад!
@{$point{$path}}=@list;
return 0;
}

foreach my $point(@{$point{$path}}){
if ($point==$finish){
#добавляем рассматриваемый узел
push (@ariadna, $point);
return 'end';#Уря! Найдено!
}
elsif ($point == $path){
#если узел тот, из которого мы только что пришли...
#
#удаляем узел из списка целей для рассматрив. узла
shift @list;
#сохраняем урезанный список целей для данного узла
@{$point{$path}}=@list;
unless(@list){
pop @ariadna;#тупик! сделаем шаг назад!
return 0;#ищем дальше!
}
}
elsif (&check_uniq(@ariadna, $point)){
#если тут мы еще не бывали...
#удаляем узел из списка целей для рассматрив. узла
shift @list;
push (@ariadna, $point);#делаем шаг вперед!
#сохраняем урезанный список целей для данного узла
@{$point{$path}}=@list;
return 0;
}

else {
#если тут мы были...
shift @list;
if (@list){@{$point{$path}}=@list;}
else {
pop @ariadna;#тупик! сделаем шаг назад!
#сохраняем урезанный список целей для данного узла
@{$point{$path}}=@list;
}
return 0;
}

}
return 0;
}

sub check_uniq {
#----------------------------------------
#Проходили мы здесь или еще нет? Надо проверить...
#
my @list=@_;
my %uniq=();
foreach my $elm(@list){
if ($uniq{$elm}){return 0;}
$uniq{$elm}++;
}
return 1;
}