G-chan Square

じーちゃん/へたっぴの綴る、日々のつれづれとか。
twitterのまとめとゲームネタが中心。2015年からロードバイク/ミニベロ始めました。

[Perl] ハイパーロボット解答探索プログラム

こんばんわ、じーちゃんです。

さて、じーちゃんなんですが、ハイパーロボットの問題が全然解けないので、ハイパーロボットの問題を力技で解答するプログラムを作ってみました。
で・・・作ってみたのですが、解答手数が14手くらいになると検索局面数が1千万局面を超えて、使用メモリ量が4GBを超えて”out of memory”となって終了してしまいますw
なので、最短手数でも15手はかかるような問題は解くことが出来ないという(^^;

で、世の中調べてみると同じようにもうハイパーロボットの問題をプログラムで解く試みはされているようで、ドキュメントもありました。

Hyper Robot の解法プログラムについて
ただ、こちらのドキュメントの場合、ロボットの台数が4台までとなっているので条件が緩和している様子。
だいたいの問題ではロボット数が5なので、局面数が跳ね上がるんですよねぇ。


ま、とりあえず、ささっと作って動かしてみたものなので、出来はよろしくないんですが、今後何かに役立つかも知れないと思ったので載せておきます。


hyper_robot_solver_v1_3.pl
#!/usr/bin/perl
package _;
use strict;
use Data::Dumper;
$| = 1;
our $X_NUM = 16;
our $Y_NUM = 16;
my @COLORS = qw(red blue yellow green gray);
my %COLOR2ID = ();
for (my $i = 0; $i < scalar(@COLORS); $i++) {
  $COLOR2ID{$COLORS[$i]} = $i;
}
my @DIRECTIONS = ('+x', '-x', '+y', '-y');
my %DIRECTION_TO_ARROW = ('+x' => '→',  '-x' => '←', '+y' => '↓',  '-y' => '↑');
if ($X_NUM < 4 || $Y_NUM < 4) {
  die "縦か横の壁の数が4未満になっています。";
}
if ($X_NUM > 16 || $Y_NUM > 16) {
  die "縦か横の壁の数が16を超えています。";
}
if ($X_NUM & 1 || $Y_NUM & 1) {
  die "縦か横の壁の数が奇数になっています。";
}
my @cells = ();
our @wall_x = ();
our @wall_y = ();
require './question_04.pl';
my %unit_infos = %_::unit_infos;
# 盤面をテキストで表示
disp_wall_by_text();
my $init_pos_str = get_initial_unit_pos_str();
solve($init_pos_str);
sub solve {
  my $init_pos_str = shift;
  my @pos_stack = ();
  my %prev_pos_hash = ();
  push(@pos_stack, $init_pos_str);
  $prev_pos_hash{$init_pos_str} = '';
  my $pos_str = $init_pos_str;
  my $moved_pos_str;
  my $solved_flg = 0;
  my $time1 = time();
  my $current_move_num = 0;
  my $skipped = 0;
  MAIN_LOOP: for (my $count = 0; $count < 20000000; $count++) {
    if ($count > $#pos_stack) {
      last;
    }
    $pos_str = $pos_stack[$count];
    for (my $i = 0; $i < scalar(@COLORS); $i++) {
      my $color = $COLORS[$i];
      for (my $j = 0; $j < scalar(@DIRECTIONS); $j++) {
        my $direction = $DIRECTIONS[$j];
        $moved_pos_str = get_moved_unit_pos_str($pos_str, $color, $direction);
        if ($moved_pos_str ne $pos_str && !defined($prev_pos_hash{$moved_pos_str})) {
          my $color_id = $COLOR2ID{$color};
          push(@pos_stack, $moved_pos_str);
          $prev_pos_hash{$moved_pos_str} = $pos_str;
          if (is_goal($moved_pos_str)) {
            $solved_flg = 1;
            last MAIN_LOOP;
          }
        }
      }
    }
    if (($count % 1000) == 0) {
      my $move_num = get_move_num($pos_str, \%prev_pos_hash);
      printf("count:% 9d move:% 2d", $count, $move_num + 1);
      if ($current_move_num != $move_num) {
        $current_move_num = $move_num;
        my $time3 = time();
        printf(" %02d:%02d\n", ($time3 - $time1) / 60, ($time3 - $time1) % 60);
      }
      else {
        print "\r";
      }
    }
  }
  print("\n\n");
  my $time2 = time();
  printf("passed time:%d:%d sec\n\n", ($time2 - $time1) / 60, ($time2 - $time1) % 60);
  if (!$solved_flg) {
    print "解答を見つけられませんでした。\n";
    return;
  }
  my $clear_pos_str = $moved_pos_str;
  $pos_str = $clear_pos_str;
  my @move_arr = ();
  while ($pos_str ne $init_pos_str) {
    push(@move_arr, $pos_str);
    $pos_str = $prev_pos_hash{$pos_str};
  }
  push(@move_arr, $init_pos_str);
  @move_arr = reverse(@move_arr);
  my $count = 0;
  for (my $i = 0; $i < scalar(@move_arr); $i++) {
    my $pos_str = $move_arr[$i];
    if ($i == 0) {
      next;
    }
    my $prev_pos_str = $move_arr[$i - 1];
    for (my $j = 0; $j < scalar(@COLORS); $j++) {
      my $color = $COLORS[$j];
      if (substr($prev_pos_str, $j * 2, 2) ne substr($pos_str, $j * 2, 2)) {
        my $direction = '';
        if (substr($prev_pos_str, $j * 2, 1) ne substr($pos_str, $j * 2, 1)) {
          $direction = '+y';
          if (hex(substr($prev_pos_str, $j * 2, 1)) - hex(substr($pos_str, $j * 2, 1)) > 0) {
            $direction = '-y';
          }
        }
        else {
          $direction = '+x';
          if (hex(substr($prev_pos_str, $j * 2 + 1, 1)) - hex(substr($pos_str, $j * 2 + 1, 1)) > 0) {
            $direction = '-x';
          }
        }
        printf("% 2d : %s %s\n",
          $i, $unit_infos{$color}->{start}->{symbol},
          $DIRECTION_TO_ARROW{$direction}
        );
      }
    }
  }
}
sub get_moved_unit_pos_str {
  my (
    $current_pos_str,
    $unit_color,
    $direction,      # 動かす方向
  ) = @_;
  my $unit_x;
  my $unit_y;
  my @other_unit_pos = ();
  $current_pos_str = $current_pos_str;
  my $rhUnitPos = parse_unit_pos_str($current_pos_str);
  for (my $i = 0; $i < scalar(@COLORS); $i++) {
    my $color = $COLORS[$i];
    my $x = $rhUnitPos->{$color}{x};
    my $y = $rhUnitPos->{$color}{y};
    if ($color eq $unit_color) {
      $unit_x = $x;
      $unit_y = $y;
    }
    else {
      $other_unit_pos[$y][$x] = 1;
    }
  }
  if ($direction eq '+x') {
    while (!$wall_y[$unit_y][$unit_x + 1] && !$other_unit_pos[$unit_y][$unit_x + 1]) {
      $unit_x++;
    }
  }
  elsif ($direction eq '-x') {
    while (!$wall_y[$unit_y][$unit_x] && !$other_unit_pos[$unit_y][$unit_x - 1]) {
      $unit_x--;
    }
  }
  elsif ($direction eq '+y') {
    while (!$wall_x[$unit_y + 1][$unit_x] && !$other_unit_pos[$unit_y + 1][$unit_x]) {
      $unit_y++;
    }
  }
  elsif ($direction eq '-y') {
    while (!$wall_x[$unit_y][$unit_x] && !$other_unit_pos[$unit_y - 1][$unit_x]) {
      $unit_y--;
    }
  }
  $rhUnitPos->{$unit_color}{x} = $unit_x;
  $rhUnitPos->{$unit_color}{y} = $unit_y;
  my $new_unit_pos_str;
  $new_unit_pos_str = $current_pos_str;
  my $temp = sprintf("%x%x", $unit_y, $unit_x);
  if ($unit_color eq $COLORS[0]) {
    substr($new_unit_pos_str, 0, 2, $temp);
  }
  elsif ($unit_color eq $COLORS[1]) {
    substr($new_unit_pos_str, 2, 2, $temp);
  }
  elsif ($unit_color eq $COLORS[2]) {
    substr($new_unit_pos_str, 4, 2, $temp);
  }
  elsif ($unit_color eq $COLORS[3]) {
    substr($new_unit_pos_str, 6, 2, $temp);
  }
  elsif ($unit_color eq $COLORS[4]) {
    substr($new_unit_pos_str, 8, 2, $temp);
  }
  return $new_unit_pos_str;
}
sub is_goal {
  my $pos_str = shift;
  for (my $i = 0; $i < scalar(@COLORS); $i++) {
    my $color = $COLORS[$i];
    if ($unit_infos{$color}{goal}{x} == $X_NUM || $unit_infos{$color}{goal}{y} == $Y_NUM) {
      next;
    }
    my $x = hex(substr($pos_str, $i * 2 + 1, 1));
    my $y = hex(substr($pos_str, $i * 2    , 1));
    if ($unit_infos{$color}{goal}{x} != $x || $unit_infos{$color}{goal}{y} != $y) {
      return 0;
    }
  }
  return 1;
}
sub parse_unit_pos_str  {
  my $pos_str = shift;
  my $rhUnitPos = {};
  for (my $i = 0; $i < scalar(@COLORS); $i++) {
    my $color = $COLORS[$i];
    my $char_x = substr($pos_str, $i * 2 + 1, 1);
    my $char_y = substr($pos_str, $i * 2    , 1);
    my $x = $char_x eq 'z' ? $X_NUM : hex($char_x);
    my $y = $char_y eq 'z' ? $Y_NUM : hex($char_y);
    $rhUnitPos->{$color}{x} = $x;
    $rhUnitPos->{$color}{y} = $y;
  }
  return $rhUnitPos;
}
sub get_color_unit_pos_str  {
  my $pos_str = shift;
  my $unit_color = shift;
  for (my $i = 0; $i < scalar(@COLORS); $i++) {
    my $color = $COLORS[$i];
    if ($unit_color eq $color) {
      return substr($pos_str, $i * 2, 2);
    }
  }
  die "異常事態発生。\n";
}
sub get_unit_pos_str  {
  my $rhUnitPos = shift;
  my $str = '';
  for my $color (@COLORS) {
    my $x = $rhUnitPos->{$color}{x};
    my $y = $rhUnitPos->{$color}{y};
    my $x_chr = ($x == $X_NUM) ? 'z' : sprintf("%x", $x);
    my $y_chr = ($y == $Y_NUM) ? 'z' : sprintf("%x", $y);
    $str .= $y_chr . $x_chr;
  }
  return $str;
}
sub get_initial_unit_pos_str  {
  my $str = '';
  for my $color (@COLORS) {
    my $x = $unit_infos{$color}{start}{x};
    my $y = $unit_infos{$color}{start}{y};
    my $x_chr = ($x == $X_NUM) ? 'z' : sprintf("%x", $x);
    my $y_chr = ($y == $Y_NUM) ? 'z' : sprintf("%x", $y);
    $str .= $y_chr . $x_chr;
  }
  return $str;
}
sub get_move_num {
  my $pos_str = shift;
  my $rhPosStackHash = shift;
  my $move_num = 0;
  while ($rhPosStackHash->{$pos_str}) {
    $pos_str = $rhPosStackHash->{$pos_str};
    $move_num++;
  }
  return $move_num;
}
sub disp_wall_by_text {
  for (my $yy = 0; $yy <= $Y_NUM * 2; $yy++) {
    for (my $xx = 0; $xx <= $X_NUM * 2; $xx++) {
      my $y = int($yy / 2);
      my $x = int($xx / 2);
      if ($xx & 1 && $yy & 1) {
        my $symbol_draw_flg = 0;
        for my $color (@COLORS) {
          for my $pos (qw(start goal)) {
            my $rhUnitInfo = $unit_infos{$color}{$pos};
            if ($rhUnitInfo->{x} == $x && $rhUnitInfo->{y} == $y) {
              print $rhUnitInfo->{symbol};
              $symbol_draw_flg = 1;
            }
          }
        }
        if (!$symbol_draw_flg) {
          print '・';
        }
      }
      elsif ($yy & 1 && !($xx & 1)) {
        if ($wall_y[$y][$x]) {
          print '┃';
        }
        else {
          print '  ';
        }
      }
      elsif ($xx & 1) {
        if ($wall_x[$y][$x]) {
          print '━';
        }
        else {
          print '  ';
        }
      }
      else {
        if ($y == 0) {
          if ($x == 0) {
            print '┏';
          }
          elsif ($x == $X_NUM) {
            print '┓';
          }
          else {
            if ($wall_x[$y][$x - 1] && $wall_x[$y][$x]) {
              if ($wall_y[$y][$x]) {
                print '┳';
              }
              else {
                print '━';
              }
            }
          }
        }
        elsif ($y == $Y_NUM) {
          if ($x == 0) {
            print '┗';
          }
          elsif ($x == $X_NUM) {
            print '┛';
          }
          else {
            if ($wall_y[$y - 1][$x]) {
              print '┻';
            }
            else {
              print '━';
            }
          }
        }
        else {
          if ($x == 0) {
            if ($wall_x[$y][$x]) {
              print '┣';
            }
            else {
              print '┃';
            }
          }
          elsif ($x == $X_NUM) {
            if ($wall_x[$y][$x - 1]) {
              print '┫';
            }
            else {
              print '┃';
            }
          }
          else {
            if ($wall_y[$y - 1][$x] && $wall_y[$y][$x] && $wall_x[$y][$x - 1] && $wall_x[$y][$x]) {
              print '╋';
            }
            elsif (!$wall_y[$y - 1][$x] && $wall_y[$y][$x] && $wall_x[$y][$x - 1] && $wall_x[$y][$x]) {
              print '┳';
            }
            elsif ($wall_y[$y - 1][$x] && !$wall_y[$y][$x] && $wall_x[$y][$x - 1] && $wall_x[$y][$x]) {
              print '┻';
            }
            elsif ($wall_y[$y - 1][$x] && $wall_y[$y][$x] && !$wall_x[$y][$x - 1] && $wall_x[$y][$x]) {
              print '┣';
            }
            elsif ($wall_y[$y - 1][$x] && $wall_y[$y][$x] && $wall_x[$y][$x - 1] && !$wall_x[$y][$x]) {
              print '┫';
            }
            elsif (!$wall_y[$y - 1][$x] && $wall_y[$y][$x] && !$wall_x[$y][$x - 1] && $wall_x[$y][$x]) {
              print '┏';
            }
            elsif (!$wall_y[$y - 1][$x] && $wall_y[$y][$x] && $wall_x[$y][$x - 1] && !$wall_x[$y][$x]) {
              print '┓';
            }
            elsif ($wall_y[$y - 1][$x] && !$wall_y[$y][$x] && !$wall_x[$y][$x - 1] && $wall_x[$y][$x]) {
              print '┗';
            }
            elsif ($wall_y[$y - 1][$x] && !$wall_y[$y][$x] && $wall_x[$y][$x - 1] && !$wall_x[$y][$x]) {
              print '┛';
            }
            elsif (!$wall_y[$y - 1][$x] && !$wall_y[$y][$x] && $wall_x[$y][$x - 1] && $wall_x[$y][$x]) {
              print '━';
            }
            elsif ($wall_y[$y - 1][$x] && $wall_y[$y][$x] && !$wall_x[$y][$x - 1] && !$wall_x[$y][$x]) {
              print '┃';
            }
            else {
              print '  ';
            }
          }
        }
      }
    }
    print "\n";
  }
}
sub init_wall {
  for (my $y = 0; $y <= $Y_NUM; $y++) {
    for (my $x = 0; $x <= $X_NUM; $x++) {
      $wall_x[$y][$x] = 0;
      $wall_y[$y][$x] = 0;
      if (($y == 0 || $y == $Y_NUM) && $x < $X_NUM) {
        $wall_x[$y][$x] = 1;
      }
      if (($x == 0 || $x == $X_NUM) && $y < $Y_NUM) {
        $wall_y[$y][$x] = 1;
      }
    }
  }
  # 中心壁初期化
  $wall_x[$Y_NUM / 2 - 1][$X_NUM / 2 - 1] = 1;
  $wall_x[$Y_NUM / 2 - 1][$X_NUM / 2    ] = 1;
  $wall_x[$Y_NUM / 2 + 1][$X_NUM / 2 - 1] = 1;
  $wall_x[$Y_NUM / 2 + 1][$X_NUM / 2    ] = 1;
  $wall_y[$Y_NUM / 2 - 1][$X_NUM / 2 - 1] = 1;
  $wall_y[$Y_NUM / 2 - 1][$X_NUM / 2 + 1] = 1;
  $wall_y[$Y_NUM / 2    ][$X_NUM / 2 - 1] = 1;
  $wall_y[$Y_NUM / 2    ][$X_NUM / 2 + 1] = 1;
}


question_02.pl
package _;
# v1.3
# count:     1000 move: 5 00:00
# count:     2000 move: 6 00:01
# count:     7000 move: 7 00:02
# count:    22000 move: 8 00:07
# count:    66000 move: 9 00:21
# count:   193000 move: 10 01:00
# count:   535000 move: 11 02:47
# count:  1380000 move: 11
#
# passed time:7:14 sec
#
#  1 : ■ ↓
#  2 : ■ ←
#  3 : ■ ↑
#  4 : ■ →
#  5 : ■ ↓
#  6 : ● ←
#  7 : ● ↑
#  8 : ● →
#  9 : ● ↓
#  10 : ■ ↑
#  11 : ■ →
#
# memory: 0.568 GB
our %unit_infos = (
  'red' => {
    'start' => {
      'symbol' => '●',
      'x' => 13,
      'y' => 13,
    },
    'goal'  => {
      'symbol' => '○',
      'x' => 11,
      'y' => 14,
    },
  },
  'blue' => {
    'start' => {
      'symbol' => '▲',
      'x' => 12,
      'y' => 9,
    },
    'goal'  => {
      'symbol' => '△',
      'x' => $_::X_NUM,
      'y' => $_::Y_NUM,
    },
  },
  'yellow' => {
    'start' => {
      'symbol' => '★',
      'x' => 9,
      'y' => 12,
    },
    'goal'  => {
      'symbol' => '☆',
      'x' => $_::X_NUM,
      'y' => $_::Y_NUM,
    },
  },
  'green' => {
    'start' => {
      'symbol' => '■',
      'x' => 5,
      'y' => 4,
    },
    'goal'  => {
      'symbol' => '□',
      'x' => 11,
      'y' => 2,
    },
  },
  'gray' => {
    'start' => {
      'symbol' => '◆',
      'x' => 13,
      'y' => 15,
    },
    'goal'  => {
      'symbol' => '◇',
      'x' => $_::X_NUM,
      'y' => $_::Y_NUM,
    },
  },
);
# 外壁初期化
_::init_wall();
# 内壁
$_::wall_x[ 1][ 9] = 1;
$_::wall_x[ 2][ 6] = 1;
$_::wall_x[ 3][ 1] = 1;
$_::wall_x[ 3][11] = 1;
$_::wall_x[ 4][15] = 1;
$_::wall_x[ 4][ 5] = 1;
$_::wall_x[ 6][ 2] = 1;
$_::wall_x[ 6][ 7] = 1;
$_::wall_x[ 6][13] = 1;
$_::wall_x[ 7][ 0] = 1;
$_::wall_x[ 7][10] = 1;
$_::wall_x[ 9][12] = 1;
$_::wall_x[10][ 3] = 1;
$_::wall_x[10][15] = 1;
$_::wall_x[11][ 0] = 1;
$_::wall_x[11][ 5] = 1;
$_::wall_x[12][ 9] = 1;
$_::wall_x[14][ 1] = 1;
$_::wall_x[14][ 6] = 1;
$_::wall_x[14][14] = 1;
$_::wall_x[15][11] = 1;
$_::wall_y[ 0][ 4] = 1;
$_::wall_y[ 0][11] = 1;
$_::wall_y[ 1][ 6] = 1;
$_::wall_y[ 1][10] = 1;
$_::wall_y[ 2][12] = 1;
$_::wall_y[ 3][ 2] = 1;
$_::wall_y[ 4][ 5] = 1;
$_::wall_y[ 5][ 3] = 1;
$_::wall_y[ 5][ 8] = 1;
$_::wall_y[ 5][13] = 1;
$_::wall_y[ 7][10] = 1;
$_::wall_y[ 9][ 4] = 1;
$_::wall_y[ 9][13] = 1;
$_::wall_y[11][ 5] = 1;
$_::wall_y[12][ 9] = 1;
$_::wall_y[13][ 1] = 1;
$_::wall_y[13][14] = 1;
$_::wall_y[14][ 7] = 1;
$_::wall_y[14][12] = 1;
$_::wall_y[15][ 5] = 1;
$_::wall_y[15][14] = 1;
1;

コメントする