[puzzle]华容道 15-Puzzle

头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

[puzzle]华容道 15-Puzzle

帖子 523066680 »

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
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

Re: [Puzzle]华容道

帖子 523066680 »

Rosettacode 网站上摘取的,Perl TK 做的同款游戏。
perltk_15puzzle.png
(5.55 KiB) 已下载 88 次
# http://rosettacode.org/wiki/15_Puzzle_Game#Perl

use strict;
use warnings;

use Getopt::Long;
use List::Util 1.29 qw(shuffle pairmap first all);
use Tk;
# 5 options 1 label text
my ($verbose,@fixed,$nocolor,$charsize,$extreme,$solvability);

unless (GetOptions (
'verbose!' => \$verbose,
'tiles|positions=i{16}' => \@fixed,
'nocolor' => \$nocolor,
'charsize|size|c|s=i' => \$charsize,
'extreme|x|perl' => \$extreme,
)
) { die "invalid arguments!";}

@fixed = &check_req_pos(@fixed) if @fixed;

my $mw = Tk::MainWindow->new(-bg=>'black',-title=>'Giuoco del 15');

if ($nocolor){ $mw->optionAdd( '*Button.background', 'ivory' );}

$mw->optionAdd('*Button.font', 'Courier '.($charsize or 16).' bold' );
$mw->bind('<Control-s>', sub{#&init_board;
&shuffle_board});

my $top_frame = $mw->Frame( -borderwidth => 2, -relief => 'groove',
)->pack(-expand => 1, -fill => 'both');

$top_frame->Label( -textvariable=>\$solvability,
)->pack(-expand => 1, -fill => 'both');

my $game_frame = $mw->Frame( -background=>'saddlebrown',
-borderwidth => 10, -relief => 'groove',
)->pack(-expand => 1, -fill => 'both');

# set victory conditions in pairs of coordinates
my @vic_cond = pairmap {
[$a,$b]
} qw(0 0 0 1 0 2 0 3
1 0 1 1 1 2 1 3
2 0 2 1 2 2 2 3
3 0 3 1 3 2 3 3);

my $board = [];

my $victorious = 0;

&init_board;

if ( $extreme ){ &extreme_perl}

&shuffle_board;

MainLoop;

################################################################################
sub init_board{
# tiles from 1 to 15
for (0..14){
$$board[$_]={
btn=>$game_frame->Button(
-text => $_+1,
-relief => 'raised',
-borderwidth => 3,
-height => 2,
-width => 4,
-background=>$nocolor?'ivory':'gold1',
-activebackground => $nocolor?'ivory':'gold1',
-foreground=> $nocolor?'black':'DarkRed',
-activeforeground=>$nocolor?'black':'DarkRed'
),
name => $_+1, # x and y set by shuffle_board
};
if (($_+1) =~ /^(2|4|5|7|10|12|13|15)$/ and !$nocolor){
$$board[$_]{btn}->configure(
-background=>'DarkRed',
-activebackground => 'DarkRed',
-foreground=> 'gold1',
-activeforeground=>'gold1'
);
}
}
# empty tile
$$board[15]={
btn=>$game_frame->Button(
-relief => 'sunken',
-borderwidth => 3,
-background => 'lavender',
-height => 2,
-width => 4,
),
name => 16, # x and y set by shuffle_board
};
}
################################################################################
sub shuffle_board{
if ($victorious){
$victorious=0;
&init_board;
}
if (@fixed){
my $index = 0;

foreach my $tile(@$board[@fixed]){
my $xy = $vic_cond[$index];
($$tile{x},$$tile{y}) = @$xy;
$$tile{btn}->grid(-row=>$$xy[0], -column=> $$xy[1]);
$$tile{btn}->configure(-command =>[\&move,$$xy[0],$$xy[1]]);
$index++;
}
undef @fixed;
}
else{
my @valid = shuffle (0..15);
foreach my $tile ( @$board ){
my $xy = $vic_cond[shift @valid];
($$tile{x},$$tile{y}) = @$xy;
$$tile{btn}->grid(-row=>$$xy[0], -column=> $$xy[1]);
$$tile{btn}->configure(-command => [ \&move, $$xy[0], $$xy[1] ]);
}
}
my @appear = map {$_->{name}==16?'X':$_->{name}}
sort{$$a{x}<=>$$b{x}||$$a{y}<=>$$b{y}}@$board;
print "\n".('-' x 57)."\n".
"Appearence of the board:\n[@appear]\n".
('-' x 57)."\n".
"current\tfollowers\t less than current\n".
('-' x 57)."\n" if $verbose;
# remove the, from now on inutile, 'X' for the empty space
@appear = grep{$_ ne 'X'} @appear;
my $permutation;
foreach my $num (0..$#appear){
last if $num == $#appear;
my $perm;
$perm += grep {$_ < $appear[$num]} @appear[$num+1..$#appear];
if ($verbose){
print "[$appear[$num]]\t@appear[$num+1..$#appear]".
(" " x (37 - length "@appear[$num+1..$#appear]")).
"\t $perm ".($num == $#appear - 1 ? '=' : '+')."\n";
}
$permutation+=$perm;
}
print +(' ' x 50)."----\n" if $verbose;
if ($permutation % 2){
print "Impossible game with odd permutations!".(' ' x 13).
"$permutation\n"if $verbose;
$solvability = "Impossible game with odd permutations [$permutation]\n".
"(ctrl-s to shuffle)".
(($verbose or $extreme) ? '' :
" run with --verbose to see more info");
return;
}
# 105 is the max permutation
my $diff = $permutation == 0 ? 'SOLVED' :
$permutation < 35 ? 'EASY ' :
$permutation < 70 ? 'MEDIUM' : 'HARD ';
print "$diff game with even permutations".(' ' x 17).
"$permutation\n" if $verbose;
$solvability = "$diff game with permutation parity of [$permutation]\n".
"(ctrl-s to shuffle)";
}
################################################################################
sub move{
# original x and y
my ($ox, $oy) = @_;
my $self = first{$_->{x} == $ox and $_->{y} == $oy} @$board;
return if $$self{name}==16;
# check if one in n,s,e,o is the empty one
my $empty = first {$_->{name} == 16 and
( ($_->{x}==$ox-1 and $_->{y}==$oy) or
($_->{x}==$ox+1 and $_->{y}==$oy) or
($_->{x}==$ox and $_->{y}==$oy-1) or
($_->{x}==$ox and $_->{y}==$oy+1)
)
} @$board;
return unless $empty;
# empty x and y
my ($ex,$ey) = ($$empty{x},$$empty{y});
# reconfigure emtpy tile
$$empty{btn}->grid(-row => $ox, -column => $oy);
$$empty{x}=$ox; $$empty{y}=$oy;
# reconfigure pressed tile
$$self{btn}->grid(-row => $ex, -column => $ey);
$$self{btn}->configure(-command => [ \&move, $ex, $ey ]);
$$self{x}=$ex; $$self{y}=$ey;
# check for victory if the empty one is at the bottom rigth tile (3,3)
&check_win if $$empty{x} == 3 and $$empty{y} == 3;
}
################################################################################
sub check_win{
foreach my $pos (0..$#$board){
return unless ( $$board[$pos]->{'x'} == $vic_cond[$pos]->[0] and
$$board[$pos]->{'y'} == $vic_cond[$pos]->[1]);
}
# victory!
$victorious = 1;
my @text = ('Dis','ci','pu','lus','15th','','','at',
'P','e','r','l','M','o','n','ks*');
foreach my $tile(@$board){
$$tile{btn}->configure( -text=> shift @text,
-command=>sub{return});
$mw->update;
sleep 1;
}
}
################################################################################
sub check_req_pos{
my @wanted = @_;
# fix @wanted: seems GetOptions does not die if more elements are passed
@wanted = @wanted[0..15];
my @check = (1..16);
unless ( all {$_ == shift @check} sort {$a<=>$b} @wanted ){
die "tiles must be from 1 to 16 (empty tile)\nyou passed [@wanted]\n";
}
return map {$_-1} @wanted;
}
################################################################################
sub extreme_perl {
$verbose = 0;
$mw->optionAdd('*font', 'Courier 20 bold');
my @extreme = (
'if $0', #1
"\$_=\n()=\n\"foo\"=~/o/g", #2
"use warnings;\n\$^W ?\nint((length\n'Discipulus')/3)\n:'15'", #3
"length \$1\nif \$^X=~\n\/(?:\\W)(\\w*)\n(?:\\.exe)\$\/", #4
"use Config;\n\$Config{baserev}", #5.
"(split '',\nvec('JAPH'\n,1,8))[0]", #6
"scalar map\n{ord(\$_)=~/1/g}\nqw(p e r l)", #7
"\$_ = () =\n'J A P H'\n=~\/\\b\/g", # 8
"eval join '+',\nsplit '',\n(substr\n'12345',3,2)", #9
'printf \'%b\',2', #10
"int(((1+sqrt(5))\n/ 2)** 7 /\nsqrt(5)+0.5)-2", #11
"split '',\nunpack('V',\n01234567))\n[6,4]", # 12
'J','A','P','H' # 13..16
);
foreach (0..15){
$$board[$_]{btn}->configure(-text=> $extreme[$_],
-height => 8,
-width => 16, ) if $extreme[$_];

}
@fixed = qw(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15);
$mw->after(5000,\&shuffle_board);#
}
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 523066680 »

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

附,效率很低,暴力搜索的代码:
=info
    华容道暴力搜索解
    523066680/vicyang
    2019-04

    效率低 4x4 15 13 14, 31.4s
=cut

use Clone 'clone';
STDOUT->autoflush(1);

my $src_mat = [ [1,2,3,4], [5,6,7,8], [9,10,11,12],[15,13,14,0] ];
my $src_pos = {'r'=>3, 'c'=>3 };

my $t_mat = clone($src_mat);
my $t_pos = clone($src_pos);
our $want = join(",", (1 .. 15,0));
my $history = [];
func($t_mat, $t_pos, 0, '', $history);

sub func
{
    my ($s, $pos, $lv, $prev, $history) = @_;

    if ( check($s, $want) == 0 )
    {
        printf "Done, %d Steps\n", $#$history;
        printf "%s\n", join(",", @$history);
        #display($s);
        my $tmp_mat = clone( $src_mat );
        my $tmp_pos = clone( $src_pos );
        excute( $tmp_mat, $tmp_pos, $history );
        return;
    }

    if ($lv >= 20) {
        #display($s);
        return;
    }
    # way, try L/R/U/D
    # Up
    if ( $prev ne 'down' and $pos->{r}-1 >= 0 ) {
        exchange( $s, $pos->{r}-1, $pos->{c}, $pos->{r}, $pos->{c} );
        #check($s);
        #display($s);
        push @$history, 'U';
        func($s, { 'r'=>$pos->{r}-1, 'c'=>$pos->{c} }, $lv+1, 'up', $history );
        pop @$history;
        exchange( $s, $pos->{r}-1, $pos->{c}, $pos->{r}, $pos->{c} );
    }

    # Down
    if ( $prev ne 'up' and $pos->{r}+1 <= $#$s ) {
        exchange( $s, $pos->{r}+1, $pos->{c}, $pos->{r}, $pos->{c} );
        push @$history, 'D';
        func($s, { 'r'=>$pos->{r}+1, 'c'=>$pos->{c} }, $lv+1, 'down', $history );
        pop @$history;
        #display($s);
        exchange( $s, $pos->{r}+1, $pos->{c}, $pos->{r}, $pos->{c} );
    }

    # Left
    if ( $prev ne 'right' and $pos->{c}-1 >= 0 ) {
        exchange( $s, $pos->{r}, $pos->{c}-1, $pos->{r}, $pos->{c} );
        push @$history, 'L';
        func($s, { 'r'=>$pos->{r}, 'c'=>$pos->{c}-1 }, $lv+1, 'left', $history );
        pop @$history;
        #display($s);
        exchange( $s, $pos->{r}, $pos->{c}-1, $pos->{r}, $pos->{c} );
    }

    # Right
    if ( $prev ne 'left' and $pos->{c}+1 <= $#{$s->[0]} ) {
        exchange( $s, $pos->{r}, $pos->{c}+1, $pos->{r}, $pos->{c} );
        push @$history, 'R';
        func($s, { 'r'=>$pos->{r}, 'c'=>$pos->{c}+1 }, $lv+1, 'right', $history );
        pop @$history;
        #display($s);
        exchange( $s, $pos->{r}, $pos->{c}+1, $pos->{r}, $pos->{c} );
    }
}

sub exchange
{
    my ($ref, $r1, $c1, $r2, $c2) = @_;

    #($ref->[$r1][$c1], $ref->[$r2][$c2]) = ($ref->[$r2][$c2], $ref->[$r1][$c1]);
    my $t = $ref->[$r1][$c1];
    $ref->[$r1][$c1] = $ref->[$r2][$c2];
    $ref->[$r2][$c2] = $t;
}

sub excute
{
    my ($mat, $pos, $history) = @_;
    for my $act ( @$history )
    {
        printf "$act\n";
        if ( $act eq 'L' ) {
            exchange( $mat, $pos->{r}, $pos->{c}-1, $pos->{r}, $pos->{c} );
            $pos->{c}-=1;
            display( $mat );
        }
        elsif ( $act eq 'R' ) {
            exchange( $mat, $pos->{r}, $pos->{c}+1, $pos->{r}, $pos->{c} );
            $pos->{c}+=1;
            display( $mat );
        }
        elsif ( $act eq 'U' ) {
            exchange( $mat, $pos->{r}-1, $pos->{c}, $pos->{r}, $pos->{c} );
            $pos->{r}-=1;
            display( $mat );
        }
        elsif ( $act eq 'D' ) {
            exchange( $mat, $pos->{r}+1, $pos->{c}, $pos->{r}, $pos->{c} );
            $pos->{r}+=1;
            display( $mat );
        }
    }

}

sub display
{
    my ($ref) = @_;
    for my $r ( 0 .. $#$ref ) {
        printf "%s\n", join(" ", map {sprintf "%2d", $_} @{$ref->[$r]});
    }
    printf("\n");
}

sub check
{
    my ($ref, $want) = @_;
    my $buff = join ",", map { join(",", @{$ref->[$_]}) } ( 0 .. $#$ref );
    return ($buff cmp $want);
}
限制递归层数。

代码: 全选

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
渐入佳境
渐入佳境
帖子: 52
注册时间: 2018年04月23日 09:58
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 rubyish »

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
渐入佳境
渐入佳境
帖子: 52
注册时间: 2018年04月23日 09:58
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 rubyish »

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:
#!/usr/bin/perl -w

# This is perl 5, version 28,
# subversion 2 (v5.28.2)
# built for aarch64-linux-thread-multi

#____________________ USE ____________________
use 5.010;

#____________________ RUN ____________________

my @puz = map [split], <DATA>;
sol( \@puz );

#____________________ SUB ____________________
sub DIS() { 0 }
sub MAP() { 1 }
sub DIR() { 4 }
sub ROOT() { 5 }
sub TRUE() { 1 }

sub sol {
my $puz = shift;
my @move = ( -1, 1, 1, -1 );
my @next = init($puz);
my $finish = finish();
my %this;

while (TRUE) {
my $try = shift @next;
my ( $dis, $map, $y, $x, $dir, $root ) = @$try;
if ( $map eq $finish ) {
show( $try, $dir );
return;
}

my $p0 = $y * 4 + $x;
for my $d ( 0 .. 3 ) {
my @ij = ( $y, $x );
my $k = $d & 1; # v or h
$ij[$k] += $move[$d];
next if $ij[$k] < 0 || $ij[$k] > 3;
my $p1 = $ij[0] * 4 + $ij[1];
my $state = $map;
vec( $state, $p0, 4 ) = vec( $state, $p1, 4 );
vec( $state, $p1, 4 ) = 0;
next if exists $this{$state};
$this{$state} = TRUE;
my $n = vec( $state, $p0, 4 ) - 1;
my @des = ( int( $n / 4 ), $n % 4 );
my $old = abs( $des[$k] - $ij[$k] );
my $new = abs( $des[$k] - [ $y, $x ]->[$k] );
my $jump = $dis + 1 + $new - $old;

push @next, [ $jump, $state, @ij, $d, $try ];
}
my $min = 99999999; # A BIG NUM
my $dit = 0;
for my $i ( 0 .. $#next ) {
my $dis = $next[$i][DIS];
if ( $dis < $min ) {
$min = $dis;
$dit = $i;
}
}
my $tmp = $next[0];
$next[0] = $next[$dit];
$next[$dit] = $tmp;
}

}

sub init {
my $pz = shift;
my $map;
my $pos;
my $k = 0;
for my $i ( 0 .. 3 ) {
for my $j ( 0 .. 3 ) {
vec( $map, $k++, 4 ) = $pz->[$i][$j];
$pos = $k - 1 if !$pz->[$i][$j];

}
}
my $dis = dis($map);

# [ dis, map, i, j, dir, root ]
return [ $dis, $map, int( $pos / 4 ), $pos % 4, '', undef ];
}

sub dis {
my $map = shift;
my $des = [ map { [ int( $_ / 4 ), $_ % 4 ] } 0, 0 .. 14 ];

my $dis = 0;
for ( 0 .. 15 ) {
my $num = vec( $map, $_, 4 );
next unless $num;
my ( $i, $j ) = ( int( $_ / 4 ), $_ % 4 );
$dis += ( abs( $i - $des->[$num][0] ) + abs( $j - $des->[$num][1] ) );
}
return $dis;

}

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

sub show {
my ( $this, $dir ) = @_;
unless ($this) {
$dir =~ tr/0123/NESW/;
say join ' ', split '', $dir;
return;
}
show( $this->[ROOT], $this->[DIR] . $dir );
say '';
for my $i ( 0, 4, 8, 12 ) {
say map { sprintf "%3s", vec( $this->[MAP], $_, 4 ) } $i .. $i + 3;
}
}
__DATA__
2 3 4 8
5 1 6 7
9 10 11 12
13 14 15 0
上次由 rubyish 在 2019年05月21日 07:54,总共编辑 1 次。
$_
头像
rubyish
渐入佳境
渐入佳境
帖子: 52
注册时间: 2018年04月23日 09:58
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 rubyish »

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
渐入佳境
渐入佳境
帖子: 52
注册时间: 2018年04月23日 09:58
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 rubyish »

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
#!/usr/bin/perl -w

# This is perl 5, version 28,
# subversion 2 (v5.28.2)
# built for aarch64-linux-thread-multi

#____________________ USE ____________________
use 5.010;

#____________________ RUN ____________________

my @puz = map [split], <DATA>;
sol( \@puz );

#____________________ SUB ____________________
sub MAP() { 0 }
sub DIR() { 3 }
sub ROOT() { 4 }
sub TRUE() { 1 }

sub sol {
my $puz = shift;
my @move = ( -1, 1, 1, -1 );
my @next;
my ( $dis, $try ) = init($puz);
my $finish = finish();
my %this;

while (TRUE) {
my ( $map, $y, $x, $dir, $root ) = @$try;
if ( $map eq $finish ) {
show( $try, '' );
return;
}

my $p0 = $y * 4 + $x;
my @yx = ( $y, $x );
for my $d ( 0 .. 3 ) {
my @ij = ( $y, $x );
my $k = $d & 1; # v or h
$ij[$k] += $move[$d];
next if $ij[$k] < 0 || $ij[$k] > 3;
my $p1 = $ij[0] * 4 + $ij[1];
my $state = $map;
vec( $state, $p0, 4 ) = vec( $state, $p1, 4 );
vec( $state, $p1, 4 ) = 0;
next if exists $this{$state};
$this{$state} = TRUE;
my $n = vec( $state, $p0, 4 ) - 1;
my @des = ( int( $n / 4 ), $n % 4 );
my $old = abs( $des[$k] - $ij[$k] );
my $new = abs( $des[$k] - $yx[$k] );
my $jump = $dis + 1 + $new - $old;

push @{ $next[$jump] }, [ $state, @ij, $d, $try ];
}

for my $i ( $dis .. $#next ) {
next unless defined $next[$i];
next unless @{ $next[$i] };
$dis = $i;
$try = shift @{ $next[$i] };
last;
}
}

}

sub init {
my ( $pz, $next ) = @_;
my $map;
my $pos;
my $k = 0;
for my $i ( 0 .. 3 ) {
for my $j ( 0 .. 3 ) {
vec( $map, $k++, 4 ) = $pz->[$i][$j];
$pos = $k - 1 if !$pz->[$i][$j];

}
}
my $dis = dis($map);

# [ map, i, j, dir, root ]
return $dis, [ $map, int( $pos / 4 ), $pos % 4, '', undef ];
}

sub dis {
my $map = shift;
my $des = [ map { [ int( $_ / 4 ), $_ % 4 ] } 0, 0 .. 14 ];

my $dis = 0;
for ( 0 .. 15 ) {
my $num = vec( $map, $_, 4 );
next unless $num;
my ( $i, $j ) = ( int( $_ / 4 ), $_ % 4 );
$dis += ( abs( $i - $des->[$num][0] ) + abs( $j - $des->[$num][1] ) );
}
return $dis;

}

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

sub show {
my ( $this, $dir ) = @_;
unless ($this) {
$dir =~ tr/0123/NESW/;
say join ' ', split '', $dir;
return;
}
show( $this->[ROOT], $this->[DIR] . $dir );
say '';
for my $i ( 0, 4, 8, 12 ) {
say map { sprintf "%3s", vec( $this->[MAP], $_, 4 ) } $i .. $i + 3;
}
}
__DATA__
2 3 4 8
5 1 6 7
9 10 11 12
13 14 15 0
上次由 rubyish 在 2019年05月21日 08:05,总共编辑 1 次。
$_
zzz19760225
一代宗师
一代宗师
帖子: 930
注册时间: 2017年12月25日 11:12
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 zzz19760225 »

不明觉厉

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

对话树的独立,相对,互动关系。
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 523066680 »

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


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

0.065s

代码: 全选

[/quote]

好快!
24game
渐入佳境
渐入佳境
帖子: 54
注册时间: 2016年09月02日 22:09
联系:

Re: [puzzle]华容道 15-Puzzle

帖子 24game »

发个能玩的 UI 上来, 保存为 htm 单文件即可浏览器运行, 无任何依赖
图片
codepen 预览
https://codepen.io/neorobin/pen/wvMQORp

UI 原作者: John Garcia,
https://codepen.io/johnbgarcia/pen/vgdroe

但其原作没有生成随机布局部分, 贴在代码里的唯一固定排列还是不可解的.

我在其基础上加入了 可解性检测, 生成随机可解排列(先生成完全随机排列, 检测不可解后交换两个非空白块实现)

页面刷新一次就生成一个随机可解排列.

现在没有写求解算法, 下回打算写上模拟我自己的大脑解法.
<h1>Puzzle 15</h1>
<!-- UI 参考(by John Garcia) https://codepen.io/johnbgarcia/pen/vgdroe -->
<p class="lead">by neorobin</p>
<p id="solvability"></p>
<div class="game">
<p class="win hide">YOU ROCK! YOU WON!你胜了</p>
</div>
<canvas id="board"></canvas>

<style>
:root {
--map_size: 400px;
}

.hide {
display: none;
}

body {
background: #ccd1e0;
text-align: center;
font-family: "Barrio", cursive, STHupo; /* STCaiyun */
color: #3A3335;
}

body h1 {
font-size: 4em;
margin-bottom: 0;
}

body .lead {
margin-bottom: 2em;
}

body .game {
position: relative;
}

body .game .win {
position: absolute;
top: 10px;
left: 50%;
width: 300px;
margin-left: -150px;
-webkit-text-stroke: 1px black;
color: #FDF0D5;
text-shadow: 3px 3px 0 #000, -1px -1px 0 #000, 1px -1px 0 #000, -1px 1px 0 #000, 1px 1px 0 #000;
transform: rotate(-15deg);
font-size: 3.5em;
}

.fall {
display: block;
animation: fall-down 2s ease-in-out;
}

@keyframes fall-down {
0% {
top: -50px;
opacity: 0;
}
}

#board {
width: var(--map_size);
height: var(--map_size);
margin: auto;
background: #3A3335;
border: 2px solid #3A3335;
box-sizing: border-box;
display: block;
box-shadow: 0 10px 30px -10px #000000;
font-family: Oswald;
}

</style>
<script>
const map_r_len = 4, map_c_len = 4;
var VEB = map_r_len * map_c_len; // value of empty block
const map_size = 400;
var block_size = map_size / map_r_len;
document.addEventListener("DOMContentLoaded", function () {
var c = document.getElementById("board");
var ctx = c.getContext("2d");
c.width = map_size;
c.height = map_size;

var map = [
[1, 2, 3, 4],
[5, 6, 7, 8],
[9, 10, 11, 12],
[13, 14, 15, VEB]
];

var winMap = [
[1, 2, 3, 4],
[5, 6, 7, 8],
[9, 10, 11, 12],
[13, 14, 15, VEB]
];

var tileMap = [];

var tile = {
width: block_size,
height: block_size
};

var pos = {
x: 0,
y: 0,
textx: block_size / 2 - 5,
texty: block_size / 2 + 5
};

var drawTile = function () {
ctx.fillStyle = "#EB5E55";
ctx.shadowColor = "#000";
ctx.shadowBlur = 4;
ctx.shadowOffsetX = 0;
ctx.shadowOffsetY = 2;
ctx.fillRect(pos.x + 5, pos.y + 5, tile.width - 10, tile.height - 10);
ctx.shadowColor = "transparent";
ctx.fillStyle = "#FFFFFF";
ctx.font = "20px Arial";
//adjust center for larger numbers
if (map[i][j] >= 10) {
ctx.fillText(map[i][j], pos.textx - 2, pos.texty);
} else {
ctx.fillText(map[i][j], pos.textx + 2, pos.texty);
}
};

var buildBoard = function () {
for (i = 0; i < map_r_len; i++) {
tileMap[i] = [];

for (j = 0; j < map_c_len; j++) {
var currentTile = {
tileName: map[i][j],
x: pos.x,
y: pos.y,
width: block_size,
height: block_size,
colIndex: j
};

if (map[i][j] !== VEB) {
//create our numbered box
drawTile();
//push box id and cords to tilemap array
} else {
//create our zero box
}
tileMap[i].push(currentTile);
pos.textx += block_size;
pos.x += block_size;
}
pos.x = 0;
pos.textx = block_size / 2 - 5 - 2;
pos.texty += block_size;
pos.y += block_size;
}
};

//get mouse position
function getPosition(event) {
var x = event.x;
var y = event.y;
x -= c.offsetLeft;
y -= c.offsetTop;

//Check to see which box we are in
for (var i = 0; i < tileMap.length; i++) {
for (var j = 0; j < tileMap[i].length; j++) {
if (
y > tileMap[i][j].y &&
y < tileMap[i][j].y + tileMap[i][j].height &&
x > tileMap[i][j].x &&
x < tileMap[i][j].x + tileMap[i][j].width
) {
checkMove(tileMap[i][j].tileName, tileMap[i][j].colIndex);
}
}
}
}

// detect if move is possible
// 移动前 item: 被点击的数字; colIndex: 点击所在的 列号(从0开始)
var checkMove = function (item, colIndex) {
//check column for zero and clicked box
// 列向移动
var checkColumn = function () {
// 移动前,空块所在的列号(从0开始)
var empty_block_col_index = null;
//check for zero, 搜索 空块 的 列号(从0开始)
for (var x = 0; x < map_r_len; x++) {
t = map[x].indexOf(VEB);
if (t > -1) {
empty_block_col_index = t;
break;
}
}
if (empty_block_col_index === colIndex) { // 同列检测
//create a new array with column values
var tempArr = [];
for (var i = 0; i < map_r_len; i++) {
tempArr.push(map[i][empty_block_col_index]);
}
//keep track of our clicked item and zero
// 移动前,空块所在的行号(从0开始)
var empty_block_row_index = tempArr.indexOf(VEB);
// 移动前,点击处的行号(从0开始)
var clicked_row_index = tempArr.indexOf(item);

// 将空块移动到点击位置, 同列非空块相对位置不变
tempArr.splice(clicked_row_index, 0, tempArr.splice(empty_block_row_index, 1)[0]);

//update our map with the correct values for the column
for (var l = 0; l < map_r_len; l++) {
map[l][empty_block_col_index] = tempArr[l];
}
}
};

//check row for zero and clicked box
var checkRow = function () {
for (var i = 0; i < map_r_len; i++) {
var clicked_col_index = map[i].indexOf(item);
var empty_block_col_index = map[i].indexOf(VEB);
//if zero and clicked box are present in same row
if (clicked_col_index > -1 && empty_block_col_index > -1) {
// 将空块移动到点击位置, 同行非空块相对位置不变
map[i].splice(clicked_col_index, 0, map[i].splice(empty_block_col_index, 1)[0]);
break;
}
}
};

checkColumn();
checkRow();

clear();
};

var clear = function () {
ctx.clearRect(0, 0, map_size, map_size);
pos = {
x: 0,
y: 0,
textx: block_size / 2 - 5,
texty: block_size / 2 + 5
};
buildBoard();
checkWin();
};

var checkWin = function () {
var allMatch = true;
for (var i = 0; i < winMap.length; i++) {
if (!allMatch) {
break;
}
for (var j = 0; j < winMap[i].length; j++) {
if (map[i][j] !== winMap[i][j]) {
allMatch = false;
break;
}
}
}
if (allMatch) {
var winMessage = document.querySelector(".win");
winMessage.classList.remove("hide");
winMessage.classList.add("fall");
}
};

var check_solvability = function () {
var cnt_inversions = 0;
old_cnt_inversions = cnt_inversions;
var taxicab_distance_EB;
for (var i = 0; i < map_r_len; i++) {
for (var j = 0; j < map_c_len; j++) {
for (var r = i; r < map_r_len; r++) {
for (var c = 0; c < map_c_len; c++) {
if (r * map_r_len + c > i * map_r_len + j && map[r][c] < map[i][j]) {
cnt_inversions++;
}
}
}
// console.log(cnt_inversions- old_cnt_inversions);
// old_cnt_inversions = cnt_inversions;

// 空块离右下角的出租车距离 taxicab_distance_EB
if (map[i][j] == VEB) {
taxicab_distance_EB = (map_r_len - 1) - i + (map_c_len - 1) - j;
}
}
}
return ((cnt_inversions + taxicab_distance_EB) & 1) == 0;
};

var random_map = function () {
var tempArr = [];
for (var i = 0; i < VEB; i++) {
tempArr.push(i + 1);
}
for (var i = 0; i < map_r_len; i++) {
for (var j = 0; j < map_c_len; j++) {
var rand_i = Math.floor(Math.random() * tempArr.length);
map[i][j] = tempArr.splice(rand_i, 1)[0];
}
}
}

var random_solvable_map = function () {
random_map();
// 若不可解, 随意交换两个非空块
if (!check_solvability()) {
var r = -1, c = -1;
var done = false;
for (var i = 0; i < map_r_len; i++) {
for (var j = 0; j < map_c_len; j++) {
if (map[i][j] != VEB && !done) {
if (r < 0) {
r = i;
c = j;
} else {
t = map[i][j];
map[i][j] = map[r][c];
map[r][c] = t;
done = true;
}
}
if (done) break;
}
if (done) break;
}
}
if (!check_solvability()) {
alert("生成可解排列失败");
}
}

// random_map();
random_solvable_map();

buildBoard();
c.addEventListener("mousedown", getPosition, false);

document.getElementById("solvability").innerHTML = check_solvability() ? "可解" : "不可解";
});

</script>
回复

在线用户

正浏览此版面之用户: 没有注册用户 和 2 访客