[puzzle]华容道 15-Puzzle

头像
523066680
Administrator
Administrator
帖子: 478
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 52 times
Been thanked: 92 times
联系:

[puzzle]华容道 15-Puzzle

帖子 #1 523066680 » 2019年03月25日 10:20

wikipedia 关键词:
Klotski
Rush Hour (puzzle)
15 Puzzle Game

4x4的华容道

代码: 全选

 1  2  3  4
 5  6  7  8
 9 10 11 12
13 14 15  0


其中0是空位,随机打乱,通过平移得到有序的排列。

---- 2019-04-30 资料整理和补充 ----
Rush Hour
Klotski

无解的情况探讨:
数字华容道4×4是不有无解?
如果软件里有无解的情况,估计是开发这偷懒,直接把15个数的位置随机放置,这样会产生无解。
正确的做法应该是先按最终效果顺序摆放各个数字,然后通过移动的方式打乱,这样永远不会无解(除非你不会解)。

数字华容道会出现无解的情况吗?
拼图可解的充要条件


Sam Loyd' Cyclopedia of 5000 Puzzles, Tricks, and Conundrums (With Answers)
The Cyclopedia of Puzzles

无解情况的证明
Why the 15-Puzzle is Impossible

baike 不可还原的拼图

Rigorous proof to show that the 15-Puzzle problem is unsolvable

http://www.math.uconn.edu/~kconrad/blur ... puzzle.pdf

C++ How to check if an instance of 15 puzzle is solvable?

Formula for determining solvability

头像
523066680
Administrator
Administrator
帖子: 478
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 52 times
Been thanked: 92 times
联系:

Re: [Puzzle]华容道

帖子 #2 523066680 » 2019年03月25日 19:30

Rosettacode 网站上摘取的,Perl TK 做的同款游戏。

perltk_15puzzle.png


Code: [全选] [展开/折叠] [Download] (15-Puzzle.pl)
  1. # http://rosettacode.org/wiki/15_Puzzle_Game#Perl
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. use Getopt::Long;
  7. use List::Util 1.29 qw(shuffle pairmap first all);
  8. use Tk;
  9.     # 5 options                                 1 label text
  10. my ($verbose,@fixed,$nocolor,$charsize,$extreme,$solvability);
  11.  
  12. unless (GetOptions (
  13.                      'verbose!' => \$verbose,
  14.                      'tiles|positions=i{16}' => \@fixed,
  15.                      'nocolor' => \$nocolor,
  16.                      'charsize|size|c|s=i' => \$charsize,
  17.                      'extreme|x|perl' => \$extreme,
  18.                     )
  19.         ) { die "invalid arguments!";}
  20.  
  21. @fixed = &check_req_pos(@fixed) if @fixed;
  22.  
  23. my $mw = Tk::MainWindow->new(-bg=>'black',-title=>'Giuoco del 15');
  24.  
  25. if ($nocolor){ $mw->optionAdd( '*Button.background',   'ivory' );}
  26.  
  27. $mw->optionAdd('*Button.font', 'Courier '.($charsize or 16).' bold' );
  28. $mw->bind('<Control-s>', sub{#&init_board;
  29.                              &shuffle_board});
  30.  
  31. my $top_frame = $mw->Frame( -borderwidth => 2, -relief => 'groove',
  32.                            )->pack(-expand => 1, -fill => 'both');
  33.  
  34. $top_frame->Label( -textvariable=>\$solvability,
  35.                   )->pack(-expand => 1, -fill => 'both');
  36.  
  37. my $game_frame = $mw->Frame(  -background=>'saddlebrown',
  38.                               -borderwidth => 10, -relief => 'groove',
  39.                             )->pack(-expand => 1, -fill => 'both');
  40.  
  41. # set victory conditions in pairs of coordinates
  42. my @vic_cond =  pairmap {
  43.        [$a,$b]
  44.     } qw(0 0 0 1 0 2 0 3
  45.          1 0 1 1 1 2 1 3
  46.          2 0 2 1 2 2 2 3
  47.          3 0 3 1 3 2 3 3);
  48.  
  49. my $board = [];
  50.  
  51. my $victorious = 0;
  52.  
  53. &init_board;
  54.  
  55. if ( $extreme ){ &extreme_perl}
  56.  
  57. &shuffle_board;
  58.  
  59. MainLoop;
  60.  
  61. ################################################################################
  62. sub init_board{
  63.   # tiles from 1 to 15
  64.   for (0..14){
  65.      $$board[$_]={
  66.           btn=>$game_frame->Button(
  67.                             -text => $_+1,
  68.                             -relief => 'raised',
  69.                             -borderwidth => 3,
  70.                             -height => 2,
  71.                             -width =>  4,
  72.                                   -background=>$nocolor?'ivory':'gold1',
  73.                                   -activebackground => $nocolor?'ivory':'gold1',
  74.                                   -foreground=> $nocolor?'black':'DarkRed',
  75.                                   -activeforeground=>$nocolor?'black':'DarkRed'
  76.           ),
  77.           name => $_+1,     # x and y set by shuffle_board
  78.      };
  79.      if (($_+1) =~ /^(2|4|5|7|10|12|13|15)$/ and !$nocolor){
  80.          $$board[$_]{btn}->configure(
  81.                                   -background=>'DarkRed',
  82.                                   -activebackground => 'DarkRed',
  83.                                   -foreground=> 'gold1',
  84.                                   -activeforeground=>'gold1'
  85.          );
  86.      }
  87.    }
  88.    # empty tile
  89.    $$board[15]={
  90.           btn=>$game_frame->Button(
  91.                             -relief => 'sunken',
  92.                             -borderwidth => 3,
  93.                             -background => 'lavender',
  94.                             -height => 2,
  95.                             -width =>  4,
  96.           ),
  97.           name => 16,      # x and y set by shuffle_board
  98.      };
  99. }
  100. ################################################################################
  101. sub shuffle_board{
  102.     if ($victorious){
  103.         $victorious=0;
  104.         &init_board;
  105.     }
  106.     if (@fixed){
  107.           my $index = 0;
  108.  
  109.           foreach my $tile(@$board[@fixed]){
  110.                   my $xy = $vic_cond[$index];
  111.                   ($$tile{x},$$tile{y}) = @$xy;
  112.                   $$tile{btn}->grid(-row=>$$xy[0], -column=> $$xy[1]);
  113.                   $$tile{btn}->configure(-command =>[\&move,$$xy[0],$$xy[1]]);
  114.                   $index++;
  115.           }
  116.           undef @fixed;
  117.     }
  118.     else{
  119.         my @valid = shuffle (0..15);
  120.         foreach my $tile ( @$board ){
  121.             my $xy = $vic_cond[shift @valid];
  122.             ($$tile{x},$$tile{y}) = @$xy;
  123.             $$tile{btn}->grid(-row=>$$xy[0], -column=> $$xy[1]);
  124.             $$tile{btn}->configure(-command => [ \&move, $$xy[0], $$xy[1] ]);
  125.         }
  126.     }
  127.     my @appear =  map {$_->{name}==16?'X':$_->{name}}
  128.                   sort{$$a{x}<=>$$b{x}||$$a{y}<=>$$b{y}}@$board;
  129.     print "\n".('-' x 57)."\n".
  130.           "Appearence of the board:\n[@appear]\n".
  131.           ('-' x 57)."\n".
  132.           "current\tfollowers\t               less than current\n".
  133.           ('-' x 57)."\n" if $verbose;
  134.     # remove the, from now on inutile, 'X' for the empty space
  135.     @appear = grep{$_ ne 'X'} @appear;
  136.     my $permutation;
  137.     foreach my $num (0..$#appear){
  138.         last if $num == $#appear;
  139.          my $perm;
  140.           $perm += grep {$_ < $appear[$num]} @appear[$num+1..$#appear];
  141.           if ($verbose){
  142.             print "[$appear[$num]]\t@appear[$num+1..$#appear]".
  143.             (" " x (37 - length "@appear[$num+1..$#appear]")).
  144.             "\t   $perm ".($num == $#appear  - 1 ? '=' : '+')."\n";
  145.           }
  146.           $permutation+=$perm;
  147.     }
  148.     print +(' ' x 50)."----\n" if $verbose;
  149.     if ($permutation % 2){
  150.         print "Impossible game with odd permutations!".(' ' x 13).
  151.               "$permutation\n"if $verbose;
  152.         $solvability = "Impossible game with odd permutations [$permutation]\n".
  153.                         "(ctrl-s to shuffle)".
  154.                         (($verbose or $extreme) ? '' :
  155.                            " run with --verbose to see more info");
  156.         return;
  157.     }
  158.     # 105 is the max permutation
  159.     my $diff =  $permutation == 0 ? 'SOLVED' :
  160.                 $permutation < 35 ? 'EASY  ' :
  161.                 $permutation < 70 ? 'MEDIUM' : 'HARD  ';
  162.     print "$diff game with even permutations".(' ' x 17).
  163.           "$permutation\n" if $verbose;
  164.     $solvability = "$diff game with permutation parity of [$permutation]\n".
  165.                     "(ctrl-s to shuffle)";
  166. }
  167. ################################################################################
  168. sub move{
  169.     # original x and y
  170.     my ($ox, $oy) = @_;
  171.     my $self = first{$_->{x} == $ox and $_->{y} == $oy} @$board;
  172.     return if $$self{name}==16;
  173.     # check if one in n,s,e,o is the empty one
  174.     my $empty = first {$_->{name} == 16 and
  175.                           ( ($_->{x}==$ox-1 and $_->{y}==$oy) or
  176.                             ($_->{x}==$ox+1 and $_->{y}==$oy) or
  177.                             ($_->{x}==$ox and $_->{y}==$oy-1) or
  178.                             ($_->{x}==$ox and $_->{y}==$oy+1)
  179.                            )
  180.                       } @$board;
  181.     return unless $empty;
  182.     # empty x and y
  183.     my ($ex,$ey) = ($$empty{x},$$empty{y});
  184.     # reconfigure emtpy tile
  185.     $$empty{btn}->grid(-row => $ox, -column => $oy);
  186.     $$empty{x}=$ox;    $$empty{y}=$oy;
  187.     # reconfigure pressed tile
  188.     $$self{btn}->grid(-row => $ex, -column => $ey);
  189.     $$self{btn}->configure(-command => [ \&move, $ex, $ey ]);
  190.     $$self{x}=$ex;    $$self{y}=$ey;
  191.     # check for victory if the empty one is at the bottom rigth tile (3,3)
  192.     &check_win if $$empty{x} == 3 and $$empty{y} == 3;
  193. }
  194. ################################################################################
  195. sub check_win{
  196.      foreach my $pos (0..$#$board){
  197.         return unless ( $$board[$pos]->{'x'} == $vic_cond[$pos]->[0] and
  198.                         $$board[$pos]->{'y'} == $vic_cond[$pos]->[1]);
  199.      }
  200.      # victory!
  201.      $victorious = 1;
  202.      my @text =  ('Dis','ci','pu','lus','15th','','','at',
  203.                   'P','e','r','l','M','o','n','ks*');
  204.      foreach my $tile(@$board){
  205.             $$tile{btn}->configure( -text=> shift @text,
  206.                                     -command=>sub{return});
  207.             $mw->update;
  208.             sleep 1;
  209.      }
  210. }
  211. ################################################################################
  212. sub check_req_pos{
  213.     my @wanted = @_;
  214.     # fix @wanted: seems GetOptions does not die if more elements are passed
  215.     @wanted = @wanted[0..15];
  216.     my @check = (1..16);
  217.     unless ( all {$_ == shift @check} sort {$a<=>$b} @wanted ){
  218.         die "tiles must be from 1 to 16 (empty tile)\nyou passed [@wanted]\n";
  219.     }
  220.     return map {$_-1} @wanted;
  221. }
  222. ################################################################################
  223. sub extreme_perl {
  224.   $verbose = 0;
  225.   $mw->optionAdd('*font', 'Courier 20 bold');
  226.   my @extreme = (
  227.     'if $0',                               #1
  228.     "\$_=\n()=\n\"foo\"=~/o/g",            #2
  229.     "use warnings;\n\$^W ?\nint((length\n'Discipulus')/3)\n:'15'",   #3
  230.     "length \$1\nif \$^X=~\n\/(?:\\W)(\\w*)\n(?:\\.exe)\$\/", #4
  231.     "use Config;\n\$Config{baserev}",                   #5.
  232.     "(split '',\nvec('JAPH'\n,1,8))[0]",       #6
  233.     "scalar map\n{ord(\$_)=~/1/g}\nqw(p e r l)", #7
  234.     "\$_ = () =\n'J A P H'\n=~\/\\b\/g",   # 8
  235.     "eval join '+',\nsplit '',\n(substr\n'12345',3,2)",  #9
  236.     'printf \'%b\',2',                     #10
  237.    "int(((1+sqrt(5))\n/ 2)** 7 /\nsqrt(5)+0.5)-2",    #11
  238.    "split '',\nunpack('V',\n01234567))\n[6,4]",  # 12
  239.    'J','A','P','H'                               # 13..16
  240.  );
  241.  foreach (0..15){
  242.      $$board[$_]{btn}->configure(-text=> $extreme[$_],
  243.                                 -height => 8,
  244.                                  -width =>  16, ) if $extreme[$_];
  245.  
  246.  }
  247.  @fixed = qw(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15);
  248.  $mw->after(5000,\&shuffle_board);#
  249. }
您没有权限查看这个主题的附件。

头像
523066680
Administrator
Administrator
帖子: 478
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 52 times
Been thanked: 92 times
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 #3 523066680 » 2019年04月30日 08:58

之前做了个低效版,之后忙其他的就没有继续。
我把收集过的资料补充到了1楼,可供参考,4x4华容道游戏是存在无解的情况的。具体的理论还是看1楼

附,效率很低,暴力搜索的代码:
Code: [全选] [展开/折叠] [Download] (Untitled.pl)
  1. =info
  2.     华容道暴力搜索解
  3.     523066680/vicyang
  4.     2019-04
  5.  
  6.     效率低 4x4 15 13 14, 31.4s
  7. =cut
  8.  
  9. use Clone 'clone';
  10. STDOUT->autoflush(1);
  11.  
  12. my $src_mat = [ [1,2,3,4], [5,6,7,8], [9,10,11,12],[15,13,14,0] ];
  13. my $src_pos = {'r'=>3, 'c'=>3 };
  14.  
  15. my $t_mat = clone($src_mat);
  16. my $t_pos = clone($src_pos);
  17. our $want = join(",", (1 .. 15,0));
  18. my $history = [];
  19. func($t_mat, $t_pos, 0, '', $history);
  20.  
  21. sub func
  22. {
  23.     my ($s, $pos, $lv, $prev, $history) = @_;
  24.  
  25.     if ( check($s, $want) == 0 )
  26.     {
  27.         printf "Done, %d Steps\n", $#$history;
  28.         printf "%s\n", join(",", @$history);
  29.         #display($s);
  30.         my $tmp_mat = clone( $src_mat );
  31.         my $tmp_pos = clone( $src_pos );
  32.         excute( $tmp_mat, $tmp_pos, $history );
  33.         return;
  34.     }
  35.  
  36.     if ($lv >= 20) {
  37.         #display($s);
  38.         return;
  39.     }
  40.     # way, try L/R/U/D
  41.     # Up
  42.     if ( $prev ne 'down' and $pos->{r}-1 >= 0 ) {
  43.         exchange( $s, $pos->{r}-1, $pos->{c}, $pos->{r}, $pos->{c} );
  44.         #check($s);
  45.         #display($s);
  46.         push @$history, 'U';
  47.         func($s, { 'r'=>$pos->{r}-1, 'c'=>$pos->{c} }, $lv+1, 'up', $history );
  48.         pop @$history;
  49.         exchange( $s, $pos->{r}-1, $pos->{c}, $pos->{r}, $pos->{c} );
  50.     }
  51.  
  52.     # Down
  53.     if ( $prev ne 'up' and $pos->{r}+1 <= $#$s ) {
  54.         exchange( $s, $pos->{r}+1, $pos->{c}, $pos->{r}, $pos->{c} );
  55.         push @$history, 'D';
  56.         func($s, { 'r'=>$pos->{r}+1, 'c'=>$pos->{c} }, $lv+1, 'down', $history );
  57.         pop @$history;
  58.         #display($s);
  59.         exchange( $s, $pos->{r}+1, $pos->{c}, $pos->{r}, $pos->{c} );
  60.     }
  61.  
  62.     # Left
  63.     if ( $prev ne 'right' and $pos->{c}-1 >= 0 ) {
  64.         exchange( $s, $pos->{r}, $pos->{c}-1, $pos->{r}, $pos->{c} );
  65.         push @$history, 'L';
  66.         func($s, { 'r'=>$pos->{r}, 'c'=>$pos->{c}-1 }, $lv+1, 'left', $history );
  67.         pop @$history;
  68.         #display($s);
  69.         exchange( $s, $pos->{r}, $pos->{c}-1, $pos->{r}, $pos->{c} );
  70.     }
  71.  
  72.     # Right
  73.     if ( $prev ne 'left' and $pos->{c}+1 <= $#{$s->[0]} ) {
  74.         exchange( $s, $pos->{r}, $pos->{c}+1, $pos->{r}, $pos->{c} );
  75.         push @$history, 'R';
  76.         func($s, { 'r'=>$pos->{r}, 'c'=>$pos->{c}+1 }, $lv+1, 'right', $history );
  77.         pop @$history;
  78.         #display($s);
  79.         exchange( $s, $pos->{r}, $pos->{c}+1, $pos->{r}, $pos->{c} );
  80.     }
  81. }
  82.  
  83. sub exchange
  84. {
  85.     my ($ref, $r1, $c1, $r2, $c2) = @_;
  86.  
  87.     #($ref->[$r1][$c1], $ref->[$r2][$c2]) = ($ref->[$r2][$c2], $ref->[$r1][$c1]);
  88.     my $t = $ref->[$r1][$c1];
  89.     $ref->[$r1][$c1] = $ref->[$r2][$c2];
  90.     $ref->[$r2][$c2] = $t;
  91. }
  92.  
  93. sub excute
  94. {
  95.     my ($mat, $pos, $history) = @_;
  96.     for my $act ( @$history )
  97.     {
  98.         printf "$act\n";
  99.         if ( $act eq 'L' ) {
  100.             exchange( $mat, $pos->{r}, $pos->{c}-1, $pos->{r}, $pos->{c} );
  101.             $pos->{c}-=1;
  102.             display( $mat );
  103.         }
  104.         elsif ( $act eq 'R' ) {
  105.             exchange( $mat, $pos->{r}, $pos->{c}+1, $pos->{r}, $pos->{c} );
  106.             $pos->{c}+=1;
  107.             display( $mat );
  108.         }
  109.         elsif ( $act eq 'U' ) {
  110.             exchange( $mat, $pos->{r}-1, $pos->{c}, $pos->{r}, $pos->{c} );
  111.             $pos->{r}-=1;
  112.             display( $mat );
  113.         }
  114.         elsif ( $act eq 'D' ) {
  115.             exchange( $mat, $pos->{r}+1, $pos->{c}, $pos->{r}, $pos->{c} );
  116.             $pos->{r}+=1;
  117.             display( $mat );
  118.         }
  119.     }
  120.  
  121. }
  122.  
  123. sub display
  124. {
  125.     my ($ref) = @_;
  126.     for my $r ( 0 .. $#$ref ) {
  127.         printf "%s\n", join(" ", map {sprintf "%2d", $_} @{$ref->[$r]});
  128.     }
  129.     printf("\n");
  130. }
  131.  
  132. sub check
  133. {
  134.     my ($ref, $want) = @_;
  135.     my $buff = join ",", map { join(",", @{$ref->[$_]}) } ( 0 .. $#$ref );
  136.     return ($buff cmp $want);
  137. }


限制递归层数。

代码: 全选

Done, 17 Steps
U,L,D,L,L,U,R,D,R,U,L,L,D,R,R,U,R,D

Done, 17 Steps
L,L,L,U,R,D,R,R,U,L,L,L,D,R,R,U,R,D

头像
rubyish
崭露头角
崭露头角
帖子: 25
注册时间: 2018年04月23日 09:58
拥有现金: 锁定
Has thanked: 16 times
Been thanked: 13 times
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 #4 rubyish » 2019年05月02日 10:09

my v1:

2 3 4 8
1 6 0 7
5 10 11 12
9 13 14 15

2 3 4 8
1 6 7 0
5 10 11 12
9 13 14 15

2 3 4 0
1 6 7 8
5 10 11 12
9 13 14 15

2 3 0 4
1 6 7 8
5 10 11 12
9 13 14 15

2 0 3 4
1 6 7 8
5 10 11 12
9 13 14 15

0 2 3 4
1 6 7 8
5 10 11 12
9 13 14 15

1 2 3 4
0 6 7 8
5 10 11 12
9 13 14 15

1 2 3 4
5 6 7 8
0 10 11 12
9 13 14 15

1 2 3 4
5 6 7 8
9 10 11 12
0 13 14 15

1 2 3 4
5 6 7 8
9 10 11 12
13 0 14 15

1 2 3 4
5 6 7 8
9 10 11 12
13 14 0 15

1 2 3 4
5 6 7 8
9 10 11 12
13 14 15 0

E N W W W S S S E E E




#!/usr/bin/perl
# This is perl 5, version 28
# subversion 2 (v5.28.2)
# built for arm-android

# __________ USE __________
use 5.010;

# __________ RUN __________
my $SHOW = 1;
my @puzzle15 = map [split], <DATA>;

solve( \@puzzle15 );

# __________ SUB __________

sub finish {
my $f;
vec( $f, $_, 4 ) = $_ + 1 for 0 .. 14;
vec( $f, 15, 4 ) = 0;
return $f;
}

sub puzzle2map {
my $p = shift;
my $map;
my $k = 0;
for my $i ( 0 .. 3 ) {
vec( $map, $k++, 4 ) = $p->[$i][$_] for 0 .. 3;
}
return $map;
}

sub move {

# CODE ME!!
[ 2, 3 ], [ 1, 2, 3 ], [ 1, 2, 3 ], [ 1, 3 ],
[ 0, 2, 3 ], [ 0, 1, 2, 3 ], [ 0, 1, 2, 3 ], [ 0, 1, 3 ],
[ 0, 2, 3 ], [ 0, 1, 2, 3 ], [ 0, 1, 2, 3 ], [ 0, 1, 3 ],
[ 0, 2 ], [ 0, 1, 2 ], [ 0, 1, 2 ], [ 0, 1 ];
}

sub init {
my $map = shift;
my ($indes) = grep !vec( $map, $_, 4 ), 0 .. 15;
return [ $map, $indes, '' ];
}

sub gimme {
my ( $map, $pos, $dir ) = @_;
state $jump = [ -4, -1, 1, 4 ];
my $next = $pos + $jump->[$dir];
vec( $map, $pos, 4 ) = vec( $map, $next, 4 );
vec( $map, $next, 4 ) = 0;
return $map, $next;
}

sub show {
my ( $map, $dir ) = @_;
my @dir = split //, $dir;
push @dir, 0;
my ($pos) = grep !vec( $map, $_, 4 ), 0 .. 15;

for my $d (@dir) {
for my $i ( 0 .. 3 ) {
my $indes = $i * 4;
my @line =
map { sprintf "%3s", vec( $map, $_, 4 ) } $indes .. $indes + 3;
say @line;
}
say '';
( $map, $pos ) = gimme( $map, $pos, $d );
}
}

sub solve {
my $puz = shift;
my $finish = finish();
my $map = puzzle2map($puz);
my @move = move();
my @next = init($map);
my %has;

while (@next) {
my $test = shift @next;
my ( $try, $pos, $dir ) = @$test;
if ( $try eq $finish ) {
show( $map, $dir ) if $SHOW;
$dir =~ tr/0123/NWES/;
say join ' ', split //, $dir;
exit;
}

for my $d ( @{ $move[$pos] } ) {
my ( $try, $pos ) = gimme( $try, $pos, $d );
push @next, [ $try, $pos, $dir . $d ] if !$has{$try}++;
}

}
say "no solution";

}


__DATA__
2 3 4 8
1 6 0 7
5 10 11 12
9 13 14 15
$_

头像
rubyish
崭露头角
崭露头角
帖子: 25
注册时间: 2018年04月23日 09:58
拥有现金: 锁定
Has thanked: 16 times
Been thanked: 13 times
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 #5 rubyish » 2019年05月20日 00:35

v2: :mrgreen: :mrgreen:

N W W W N E E E N W W W S S E E E S S

2 3 4 8
5 1 6 7
9 10 11 12
13 14 15 0

2 3 4 8
5 1 6 7
9 10 11 0
13 14 15 12

2 3 4 8
5 1 6 7
9 10 0 11
13 14 15 12

2 3 4 8
5 1 6 7
9 0 10 11
13 14 15 12

2 3 4 8
5 1 6 7
0 9 10 11
13 14 15 12

2 3 4 8
0 1 6 7
5 9 10 11
13 14 15 12

2 3 4 8
1 0 6 7
5 9 10 11
13 14 15 12

2 3 4 8
1 6 0 7
5 9 10 11
13 14 15 12

2 3 4 8
1 6 7 0
5 9 10 11
13 14 15 12

2 3 4 0
1 6 7 8
5 9 10 11
13 14 15 12

2 3 0 4
1 6 7 8
5 9 10 11
13 14 15 12

2 0 3 4
1 6 7 8
5 9 10 11
13 14 15 12

0 2 3 4
1 6 7 8
5 9 10 11
13 14 15 12

1 2 3 4
0 6 7 8
5 9 10 11
13 14 15 12

1 2 3 4
5 6 7 8
0 9 10 11
13 14 15 12

1 2 3 4
5 6 7 8
9 0 10 11
13 14 15 12

1 2 3 4
5 6 7 8
9 10 0 11
13 14 15 12

1 2 3 4
5 6 7 8
9 10 11 0
13 14 15 12

1 2 3 4
5 6 7 8
9 10 11 12
13 14 15 0


code:
Code: [全选] [展开/折叠] [Download] (Untitled.pl)
  1. #!/usr/bin/perl -w
  2.  
  3. # This is perl 5, version 28,
  4. # subversion 2 (v5.28.2)
  5. # built for aarch64-linux-thread-multi
  6.  
  7. #____________________ USE ____________________
  8. use 5.010;
  9.  
  10. #____________________ RUN ____________________
  11.  
  12. my @puz = map [split], <DATA>;
  13. sol( \@puz );
  14.  
  15. #____________________ SUB ____________________
  16. sub DIS()  { 0 }
  17. sub MAP()  { 1 }
  18. sub DIR()  { 4 }
  19. sub ROOT() { 5 }
  20. sub TRUE() { 1 }
  21.  
  22. sub sol {
  23.     my $puz    = shift;
  24.     my @move   = ( -1, 1, 1, -1 );
  25.     my @next   = init($puz);
  26.     my $finish = finish();
  27.     my %this;
  28.  
  29.     while (TRUE) {
  30.         my $try = shift @next;
  31.         my ( $dis, $map, $y, $x, $dir, $root ) = @$try;
  32.         if ( $map eq $finish ) {
  33.             show( $try, $dir );
  34.             return;
  35.         }
  36.  
  37.         my $p0 = $y * 4 + $x;
  38.         for my $d ( 0 .. 3 ) {
  39.             my @ij = ( $y, $x );
  40.             my $k  = $d & 1;       # v or h
  41.             $ij[$k] += $move[$d];
  42.             next if $ij[$k] < 0 || $ij[$k] > 3;
  43.             my $p1    = $ij[0] * 4 + $ij[1];
  44.             my $state = $map;
  45.             vec( $state, $p0, 4 ) = vec( $state, $p1, 4 );
  46.             vec( $state, $p1, 4 ) = 0;
  47.             next if exists $this{$state};
  48.             $this{$state} = TRUE;
  49.             my $n    = vec( $state, $p0, 4 ) - 1;
  50.             my @des  = ( int( $n / 4 ), $n % 4 );
  51.             my $old  = abs( $des[$k] - $ij[$k] );
  52.             my $new  = abs( $des[$k] - [ $y, $x ]->[$k] );
  53.             my $jump = $dis + 1 + $new - $old;
  54.  
  55.             push @next, [ $jump, $state, @ij, $d, $try ];
  56.         }
  57.         my $min = 99999999;    # A BIG NUM
  58.         my $dit = 0;
  59.         for my $i ( 0 .. $#next ) {
  60.             my $dis = $next[$i][DIS];
  61.             if ( $dis < $min ) {
  62.                 $min = $dis;
  63.                 $dit = $i;
  64.             }
  65.         }
  66.         my $tmp = $next[0];
  67.         $next[0] = $next[$dit];
  68.         $next[$dit] = $tmp;
  69.     }
  70.  
  71. }
  72.  
  73. sub init {
  74.     my $pz = shift;
  75.     my $map;
  76.     my $pos;
  77.     my $k = 0;
  78.     for my $i ( 0 .. 3 ) {
  79.         for my $j ( 0 .. 3 ) {
  80.             vec( $map, $k++, 4 ) = $pz->[$i][$j];
  81.             $pos = $k - 1 if !$pz->[$i][$j];
  82.  
  83.         }
  84.     }
  85.     my $dis = dis($map);
  86.  
  87.     # [ dis, map, i, j, dir, root ]
  88.     return [ $dis, $map, int( $pos / 4 ), $pos % 4, '', undef ];
  89. }
  90.  
  91. sub dis {
  92.     my $map = shift;
  93.     my $des = [ map { [ int( $_ / 4 ), $_ % 4 ] } 0, 0 .. 14 ];
  94.  
  95.     my $dis = 0;
  96.     for ( 0 .. 15 ) {
  97.         my $num = vec( $map, $_, 4 );
  98.         next unless $num;
  99.         my ( $i, $j ) = ( int( $_ / 4 ), $_ % 4 );
  100.         $dis += ( abs( $i - $des->[$num][0] ) + abs( $j - $des->[$num][1] ) );
  101.     }
  102.     return $dis;
  103.  
  104. }
  105.  
  106. sub finish {
  107.     my $fin;
  108.     vec( $fin, $_, 4 ) = $_ + 1 for 0 .. 14;
  109.     vec( $fin, 15, 4 ) = 0;
  110.     return $fin;
  111. }
  112.  
  113. sub show {
  114.     my ( $this, $dir ) = @_;
  115.     unless ($this) {
  116.         $dir =~ tr/0123/NESW/;
  117.         say join ' ', split '', $dir;
  118.         return;
  119.     }
  120.     show( $this->[ROOT], $this->[DIR] . $dir );
  121.     say '';
  122.     for my $i ( 0, 4, 8, 12 ) {
  123.         say map { sprintf "%3s", vec( $this->[MAP], $_, 4 ) } $i .. $i + 3;
  124.     }
  125. }
  126. __DATA__
  127. 2 3 4 8
  128. 5 1 6 7
  129. 9 10 11 12
  130. 13 14 15 0
上次由 rubyish 在 2019年05月21日 07:54,总共编辑 1 次。
$_

头像
rubyish
崭露头角
崭露头角
帖子: 25
注册时间: 2018年04月23日 09:58
拥有现金: 锁定
Has thanked: 16 times
Been thanked: 13 times
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 #6 rubyish » 2019年05月20日 00:41

N W W W N E E E N W W W S S E E E S S
多了一個 S :mrgreen: :mrgreen:
N W W W N E E E N W W W S S E E E S
$_

头像
rubyish
崭露头角
崭露头角
帖子: 25
注册时间: 2018年04月23日 09:58
拥有现金: 锁定
Has thanked: 16 times
Been thanked: 13 times
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 #7 rubyish » 2019年05月20日 11:52

v3: :mrgreen: :mrgreen: :mrgreen:
略加速


1 2 3 4
5 6 7 8
9 10 11 12
15 13 14 0

0.065s


代码: 全选

W W W N E S E E N W W W S E E N E S

  1  2  3  4
  5  6  7  8
  9 10 11 12
 15 13 14  0

  1  2  3  4
  5  6  7  8
  9 10 11 12
 15 13  0 14

  1  2  3  4
  5  6  7  8
  9 10 11 12
 15  0 13 14

  1  2  3  4
  5  6  7  8
  9 10 11 12
  0 15 13 14

  1  2  3  4
  5  6  7  8
  0 10 11 12
  9 15 13 14

  1  2  3  4
  5  6  7  8
 10  0 11 12
  9 15 13 14

  1  2  3  4
  5  6  7  8
 10 15 11 12
  9  0 13 14

  1  2  3  4
  5  6  7  8
 10 15 11 12
  9 13  0 14

  1  2  3  4
  5  6  7  8
 10 15 11 12
  9 13 14  0

  1  2  3  4
  5  6  7  8
 10 15 11  0
  9 13 14 12

  1  2  3  4
  5  6  7  8
 10 15  0 11
  9 13 14 12

  1  2  3  4
  5  6  7  8
 10  0 15 11
  9 13 14 12

  1  2  3  4
  5  6  7  8
  0 10 15 11
  9 13 14 12

  1  2  3  4
  5  6  7  8
  9 10 15 11
  0 13 14 12

  1  2  3  4
  5  6  7  8
  9 10 15 11
 13  0 14 12

  1  2  3  4
  5  6  7  8
  9 10 15 11
 13 14  0 12

  1  2  3  4
  5  6  7  8
  9 10  0 11
 13 14 15 12

  1  2  3  4
  5  6  7  8
  9 10 11  0
 13 14 15 12

  1  2  3  4
  5  6  7  8
  9 10 11 12
 13 14 15  0


N W W W N E E E N W W W S S E E E S

2 3 4 8
5 1 6 7
9 10 11 12
13 14 15 0

2 3 4 8
5 1 6 7
9 10 11 0
13 14 15 12

2 3 4 8
5 1 6 7
9 10 0 11
13 14 15 12

2 3 4 8
5 1 6 7
9 0 10 11
13 14 15 12

2 3 4 8
5 1 6 7
0 9 10 11
13 14 15 12

2 3 4 8
0 1 6 7
5 9 10 11
13 14 15 12

2 3 4 8
1 0 6 7
5 9 10 11
13 14 15 12

2 3 4 8
1 6 0 7
5 9 10 11
13 14 15 12

2 3 4 8
1 6 7 0
5 9 10 11
13 14 15 12

2 3 4 0
1 6 7 8
5 9 10 11
13 14 15 12

2 3 0 4
1 6 7 8
5 9 10 11
13 14 15 12

2 0 3 4
1 6 7 8
5 9 10 11
13 14 15 12

0 2 3 4
1 6 7 8
5 9 10 11
13 14 15 12

1 2 3 4
0 6 7 8
5 9 10 11
13 14 15 12

1 2 3 4
5 6 7 8
0 9 10 11
13 14 15 12

1 2 3 4
5 6 7 8
9 0 10 11
13 14 15 12

1 2 3 4
5 6 7 8
9 10 0 11
13 14 15 12

1 2 3 4
5 6 7 8
9 10 11 0
13 14 15 12

1 2 3 4
5 6 7 8
9 10 11 12
13 14 15 0



  1. #!/usr/bin/perl -w
  2.  
  3. # This is perl 5, version 28,
  4. # subversion 2 (v5.28.2)
  5. # built for aarch64-linux-thread-multi
  6.  
  7. #____________________ USE ____________________
  8. use 5.010;
  9.  
  10. #____________________ RUN ____________________
  11.  
  12. my @puz = map [split], <DATA>;
  13. sol( \@puz );
  14.  
  15. #____________________ SUB ____________________
  16. sub MAP()  { 0 }
  17. sub DIR()  { 3 }
  18. sub ROOT() { 4 }
  19. sub TRUE() { 1 }
  20.  
  21. sub sol {
  22.     my $puz  = shift;
  23.     my @move = ( -1, 1, 1, -1 );
  24.     my @next;
  25.     my ( $dis, $try ) = init($puz);
  26.     my $finish = finish();
  27.     my %this;
  28.  
  29.     while (TRUE) {
  30.         my ( $map, $y, $x, $dir, $root ) = @$try;
  31.         if ( $map eq $finish ) {
  32.             show( $try, '' );
  33.             return;
  34.         }
  35.  
  36.         my $p0 = $y * 4 + $x;
  37.         my @yx = ( $y, $x );
  38.         for my $d ( 0 .. 3 ) {
  39.             my @ij = ( $y, $x );
  40.             my $k  = $d & 1;       # v or h
  41.             $ij[$k] += $move[$d];
  42.             next if $ij[$k] < 0 || $ij[$k] > 3;
  43.             my $p1    = $ij[0] * 4 + $ij[1];
  44.             my $state = $map;
  45.             vec( $state, $p0, 4 ) = vec( $state, $p1, 4 );
  46.             vec( $state, $p1, 4 ) = 0;
  47.             next if exists $this{$state};
  48.             $this{$state} = TRUE;
  49.             my $n    = vec( $state, $p0, 4 ) - 1;
  50.             my @des  = ( int( $n / 4 ), $n % 4 );
  51.             my $old  = abs( $des[$k] - $ij[$k] );
  52.             my $new  = abs( $des[$k] - $yx[$k] );
  53.             my $jump = $dis + 1 + $new - $old;
  54.  
  55.             push @{ $next[$jump] }, [ $state, @ij, $d, $try ];
  56.         }
  57.  
  58.         for my $i ( $dis .. $#next ) {
  59.             next unless defined $next[$i];
  60.             next unless @{ $next[$i] };
  61.             $dis = $i;
  62.             $try = shift @{ $next[$i] };
  63.             last;
  64.         }
  65.     }
  66.  
  67. }
  68.  
  69. sub init {
  70.     my ( $pz, $next ) = @_;
  71.     my $map;
  72.     my $pos;
  73.     my $k = 0;
  74.     for my $i ( 0 .. 3 ) {
  75.         for my $j ( 0 .. 3 ) {
  76.             vec( $map, $k++, 4 ) = $pz->[$i][$j];
  77.             $pos = $k - 1 if !$pz->[$i][$j];
  78.  
  79.         }
  80.     }
  81.     my $dis = dis($map);
  82.  
  83.     # [ map, i, j, dir, root ]
  84.     return $dis, [ $map, int( $pos / 4 ), $pos % 4, '', undef ];
  85. }
  86.  
  87. sub dis {
  88.     my $map = shift;
  89.     my $des = [ map { [ int( $_ / 4 ), $_ % 4 ] } 0, 0 .. 14 ];
  90.  
  91.     my $dis = 0;
  92.     for ( 0 .. 15 ) {
  93.         my $num = vec( $map, $_, 4 );
  94.         next unless $num;
  95.         my ( $i, $j ) = ( int( $_ / 4 ), $_ % 4 );
  96.         $dis += ( abs( $i - $des->[$num][0] ) + abs( $j - $des->[$num][1] ) );
  97.     }
  98.     return $dis;
  99.  
  100. }
  101.  
  102. sub finish {
  103.     my $fin;
  104.     vec( $fin, $_, 4 ) = $_ + 1 for 0 .. 14;
  105.     vec( $fin, 15, 4 ) = 0;
  106.     return $fin;
  107. }
  108.  
  109. sub show {
  110.     my ( $this, $dir ) = @_;
  111.     unless ($this) {
  112.         $dir =~ tr/0123/NESW/;
  113.         say join ' ', split '', $dir;
  114.         return;
  115.     }
  116.     show( $this->[ROOT], $this->[DIR] . $dir );
  117.     say '';
  118.     for my $i ( 0, 4, 8, 12 ) {
  119.         say map { sprintf "%3s", vec( $this->[MAP], $_, 4 ) } $i .. $i + 3;
  120.     }
  121. }
  122. __DATA__
  123. 2 3 4 8
  124. 5 1 6 7
  125. 9 10 11 12
  126. 13 14 15 0
上次由 rubyish 在 2019年05月21日 08:05,总共编辑 1 次。
$_

zzz19760225
出类拔萃
出类拔萃
帖子: 119
注册时间: 2017年12月25日 11:12
拥有现金: 锁定
储蓄: 锁定
Has thanked: 68 times
Been thanked: 4 times
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 #8 zzz19760225 » 2019年05月20日 12:35

不明觉厉

在静态范围,相对稳定的小变动范围,互相不确定检测监测中的互动范围,三个范围层里的数据关系升级(从简单到复杂到简易的,定义,演绎,归纳过程,一二一)。

对话树的独立,相对,互动关系。

头像
523066680
Administrator
Administrator
帖子: 478
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 52 times
Been thanked: 92 times
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 #9 523066680 » 2019年06月04日 09:18

rubyish 写了:v3: :mrgreen: :mrgreen: :mrgreen:
略加速


1 2 3 4
5 6 7 8
9 10 11 12
15 13 14 0

0.065s


[code]


好快!


回到 “算法和编码”

在线用户

用户浏览此论坛: 没有注册用户 和 1 访客