ダイクストラ法

gistfile1.pl

#!/usr/bin/perl

use strict;
use warnings;
use constant INF => 1000000000000000000000;
use List::Util qw/first/;

my $node = [
  {
    id          => 0,
    point       => [1,2,3],
    cost        => {1=>1,2=>7,3=>2},
    distance    => INF,
    done        => undef,
    from        => undef,
  },
  {
    id          => 1,
    point       => [0,4,5],
    cost        => {0=>1,4=>2,5=>4},
    distance    => INF,
    done        => undef,
    from        => undef,
  },
  {
    id          => 2,
    point       => [0,5,6],
    cost        => {0=>7,5=>2,6=>3},
    distance    => INF,
    done        => undef,
    from        => undef,
  },
  {
    id          => 3,
    point       => [0,6],
    cost        => {0=>2,6=>5},
    distance    => INF,
    done        => undef,
    from        => undef,
  },
  {
    id          => 4,
    point       => [1,5],
    cost        => {1=>2,5=>1},
    distance    => INF,
    done        => undef,
    from        => undef,
  },
  {
    id          => 5,
    point       => [1,2,4,7],
    cost        => {1=>4,2=>2,4=>1,7=>6},
    distance    => INF,
    done        => undef,
    from        => undef,
  },
  {
    id          => 6,
    point       => [2,4,7],
    cost        => {2=>3,3=>5,7=>2},
    distance    => INF,
    done        => undef,
    from        => undef,
  },
  {
    id          => 7,
    point       => [5,6],
    cost        => {5=>6,6=>2},
    distance    => INF,
    done        => undef,
    from        => undef,
  },
];

my $start = 0;
&search($node,$start);

sub search{
  my $node = shift;
  my $now_point = shift;
  my $start = $now_point ;
  my $next = $now_point;
  my $list = [$now_point];
  $node->[$start]->{done} = 1;
  $node->[$start]->{distance} = 0;
  $node->[$start]->{from} = $start;

  while(scalar @$list <= scalar @$node){ 
    my $min = INF;
    for my $key(keys $node->[$now_point]->{cost}){
      my $cost = $node->[$now_point]->{cost}->{$key}+$node->[$now_point]->{distance};
      if($cost <  $node->[$key]->{distance}){
        $node->[$key]->{distance} = $cost;
        $node->[$key]->{from} = $now_point;
        $node->[$key]->{done} = 1;
      } 
      if($cost < $min && !defined(first{$_ == $key} @$list)){
        $min = $cost;
        $next = $key;
      }

    }
    for my $key(keys $node->[$next]->{cost}){
      my $cost = $node->[$next]->{cost}->{$key}+$node->[$key]->{distance};
      if($cost <  $node->[$next]->{distance}){
        $node->[$next]->{distance} = $cost;
        $node->[$next]->{from} = $key;
      }
    }
    $now_point = $next;
    push @$list , $next;
  }

  for my $dis_tmp (0..(scalar @$node -1)){
    print "$start -> $dis_tmp \ncost:$node->[$dis_tmp]->{distance}\nway:";
    my $tmp_way = $dis_tmp;
    my $way;
    while($tmp_way != $start ){
       $tmp_way = $node->[$tmp_way]->{from};
       unshift @$way,$tmp_way;
    }
    for(@$way){
     print "$_ -> ";
    }
    print " $dis_tmp ->終了\n\n";
  }

}