[原创代码] [Perl]迷宫寻路 野生算法

523066680

来自 http://迷路.jp 的图片
ありがとう「迷路.jp」２周年の迷路

以下图片，另存为 2.bmp


没看过相关算法书籍，自己写的，算法也非全自动，需要自己指定入口（那些专搞图形的家伙可以做
到自动锚定红色箭头和蓝色箭头)，我的代码经过暴力调节使其恰好能跑出去（真是弱爆了 。。。

下面三个变量指定入口坐标和初始方向
    state $ox = 137;
    state $oy = 500 - 451;
    state $ang = 70.0/360.0 * $PIx2;

此外运行还需要 OpenGL 模块的支持 ( ppm install opengl )
如果您真的搭建环境并运行了程序，按a b c d获得不同的速度

效果演示：


顺便推销一下论坛 http://www.open-gl.org/  正在改版中 。。。
验证问题答案分别是  'float'  'open-gl.org'  '12'  和 '多边形'

=info
    Code: vicyang
    Mail: 523066680@163
    Date: 2016-05
    算法: 野生的
=cut


use v5.16;
use feature "state";
use IO::Handle;
use OpenGL qw/ :all /;
use OpenGL::Config;
use Time::HiRes 'sleep','time';

STDOUT->autoflush(1);

use utf8;
use Encode;
use IO::Handle;
STDOUT->autoflush(1);
binmode(STDOUT, ":encoding(gbk)");

our $WinID;
our $win_x = 500;
our $win_y = 500;
our $PI = 3.1415927;
our $PIx2 = $PI * 2;

my $file = "2.bmp";
my $READ;

open $READ, "<:raw", $file or die "$!";

my $v;
read($READ, $v, 14, 0);
our ($type, $bfSize, $res1, $res2, $offset) = (unpack 'SLSSL', $v);

read($READ, $v, 4+4+4+2+2, 0);
our ($headSize, $width, $height, $planes, $bitCount) = (unpack 'L3S2', $v);

our $Compoments_per_pixel = $bitCount / 8;
#有可能是RGBA，4个字节 => 32位情况下
#有可能是RGB， 3个字节 => 24位情况下

printf "文件字节数：%04x -> %d\n", $bfSize, $bfSize;
printf "位图偏移量：%04x -> %d\n", $offset, $offset;
printf "   宽 × 高：%d×%d\n", $width, $height;
printf "  位图色深：%d 位\n", $bitCount;

#实际宽度
#Windows的BMP规定一个扫描行所占的字节数必须是 4字节的倍数，不足的以0填充
my $rowLen = ($bfSize - $offset) / $height;
my $rowCut = ($width * $Compoments_per_pixel) % 4; #RGBA的情况下自然为0

#跳过文件头
seek($READ, $offset, 0);

my ($R, $G, $B);
my $col = 0;
my $lines = 0;
my $j = 0;
my @Colors;
our %Coord;
our @step;
our %badway;
our %way;

=way struct
    {
        "ox oy" => 
            {
                "ang" => $ang,   #当前ang
                "way" => [ratio1, ratio2, ratio3]
            }
    }
=cut

our $theVortex;
our $delay;
our $WRT;
open $WRT,">:raw", "log.txt";


while ( read( $READ, $v, $Compoments_per_pixel, 0) )
{
    $col++;
    ($B, $G, $R) = unpack("C$Compoments_per_pixel", $v);  #C4

    $Colors[$j++] = 
    {
        'R'=>$R/255.0,
        'G'=>$G/255.0,
        'B'=>$B/255.0,
        'X'=>$col,
        'Y'=>$lines
    };

    #@{$Coord{$col}{$lines}{'R','G','B'}} = ($R, $G, $B);  #problem, keys => RGB

    $Coord{$col}{$lines} = 
    {
        'R' => $R, 
        'G' => $G, 
        'B' => $B, 
    };

    if ($col == $width)
    {
        seek($READ, $rowCut, 1);     #从当前去掉多余的填充字节
        $col = 0;
        $lines++;
    }
}

close $READ;

my @xrr;
my @yrr;
for my $info (@Colors)
{
    if ($info->{'R'} < 0.5 and $info->{'G'} < 0.5 and $info->{'B'} < 0.5 )
    {
        push @xrr, $info->{'X'};
        push @yrr, $info->{'Y'};
    }
}

#print join(", ", @xrr),"\n";
#print join(", ", @yrr);
#exit;

&Main();

sub display 
{
    state $times = 0;
    our $WinID;
    our %coord;
    our @step;
    our %badway;
    our %way;

    our $PI;
    our $PIx2;

    my $radDelta = $PIx2 / 50.0 ;
    my $limit = 120.0/360.0*$PIx2 ;
    my $len = 8.0;
    my $testlen = 10.0;
    my $ratio;
    my $rad;
    my $angx;

    my $ref;

    state $ox = 137;
    state $oy = 500 - 451;
    state $ang = 70.0/360.0 * $PIx2;

    my ($tx, $ty);
    my ($n_x, $n_y);

    glPushMatrix();
        glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT);
        
        glCallList($theVortex); 

        my $flag;

        my $ways = 0;
        if (not defined $way{"$ox $oy"} )
        {
LV1:        for ( $ratio = -$limit; $ratio <= $limit; $ratio += $radDelta )
            {
                $angx = $ang + $ratio;

                $flag = linetest( $ox, $oy, $len, $angx );
                if ($flag == 1)
                {
                    $ways++;

                    #走中间线
                    $rad = 0.0;
                    do 
                    {
                        $rad += $radDelta;
                    } 
                    while ( (linetest( $ox, $oy, $testlen, $angx+$rad ) == 1) and ($rad < $PI) );

                    $angx += $rad/2;  #中间位置
                    $ratio += $rad + (10.0/360.0*$PIx2);   #略过这个连续区域

                    $tx = $ox + around( $len * cos($angx) );
                    $ty = $oy + around( $len * sin($angx) );

                    glColor4f(1.0, 0.0, 1.0, 0.7);
                    draw_line($ox, $oy, $tx, $ty, 1.0);

                    push @{$way{"$ox $oy"}{'way'}}, 
                            {
                                'angx' => $angx, 
                                'tx'   => $tx, 
                                'ty'   => $ty,
                            };
                }
            }
        }

        
        glBlendFunc(GL_DST_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
        glBegin(GL_LINE_STRIP);
        glColor4f(0.0, 0.2, 0.2, 0.8);
        for my $i ( 0 .. $#step )
        {
            glVertex3f( $step[$i]->[0], $step[$i]->[1], 1.0 );
        }
        glEnd();
        

        $ref = $way{"$ox $oy"}{'way'};

        if ( $#{$ref} >= 0 )  #存在多条路径的时候，存储当前节点，回退的时候用
        {
            push @step, [$ox, $oy, $ang];
        }

        printf "%3d %3d %7.3f times :%d step: %d ways: %d \n",
            $ox, $oy, $ang ,$times, $#step+1, $ways;

        #print $ref->[0]{'ty'};
            #exit;

        if ( $#{$ref} >= 0 )
        {
            draw_line($ox, $oy, $ref->[0]{'tx'}, $ref->[0]{'ty'}, 1.0);

            $ox = $ref->[0]{'tx'};
            $oy = $ref->[0]{'ty'};
            $ang = $ref->[0]{'angx'};
            shift @{$ref};
        }   
        else
        {
            print "there is no way!\n";
            #pop @step;
            ($ox, $oy, $ang) = @{ $step[$#step] };
            pop @step;
        }
        
    glPopMatrix();
    glutSwapBuffers();
    $times++;
}

sub init 
{
    glClearColor(0.0, 0.0, 0.0, 1.0);
    our $t=1.0;
    our $delay;

    $delay = 0.1;
    glPointSize(1.0);
    glLineWidth(2.0);
    glEnable(GL_DEPTH_TEST);
    glEnable(GL_BLEND);
    glEnable(GL_POINT_SMOOTH);
    glEnable(GL_LINE_SMOOTH);

    $theVortex=glGenLists(1);
    glNewList($theVortex, GL_COMPILE);
    drawbmp();
    glEndList();
}

sub drawbmp()
{
        glBegin(GL_POINTS);

        for my $c (@Colors)
        {
            glColor4f( @$c{'R','G','B'}, 1.0 );
            glVertex3f( $c->{'X'}, $c->{'Y'}, 0.0);
        }
        glEnd();
}

sub idle 
{
    sleep $delay;
    glutPostRedisplay();
}

sub Reshape 
{
    our $width;
    our $height;
    glViewport(0.0, 0.0, $win_x, $win_y);
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity();
    glOrtho(0.0, 500.0, 0.0, 500.0, 0.0,200.0);
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity();
    gluLookAt(0.0,0.0,100.0,0.0,0.0,0.0, 0.0,1.0,100.0);
}

sub hitkey 
{
    our $WinID;
    our %badway;

    my $keychar = lc(chr(shift));
    given ( $keychar )
    {
        when (/q/i) { glutDestroyWindow($WinID); dump_data( \%badway, "batway.txt" ); }
        when (/a/i) { $delay = 2.0; }
        when (/b/i) { $delay = 1.0; }
        when (/c/i) { $delay = 0.5; }
        when (/d/i) { $delay = 0.01; }
        when (/f/i) { glutPostRedisplay()  }
    }
}

sub mouse
{
    our %Coord;
    my (undef, undef, $x, $y) = @_;

    printf "Position %d %d, Color: %d %d %d\n", 
        $x, $y,
        $Coord{$x}{500-$y}{'R'},
        $Coord{$x}{500-$y}{'G'},
        $Coord{$x}{500-$y}{'B'},
    ;
}

sub Main 
{
    glutInit();
    glutInitDisplayMode( GLUT_DEPTH | GLUT_RGBA | GLUT_DOUBLE );
    glutInitWindowSize($win_x, $win_y);
    glutInitWindowPosition(1,1);
    our $WinID = glutCreateWindow("title");
    &init();
    glutDisplayFunc(\&display);
    glutReshapeFunc(\&Reshape);
    glutKeyboardFunc(\&hitkey);
    glutMouseFunc(\&mouse);
    glutIdleFunc(\&idle);
    glutMainLoop();
}

=Function
=cut

sub around
{
    my $num = shift;
    my $n = int($num);

    if ( $num - $n >= 0.5)
    {
        return $n + 1;
    }
    else
    {
        return $n;
    }
}

sub dump_data
{
    use Data::Dumper;
    my ($hashref, $file) = @_;

    open WRT, ">:raw:crlf", $file or warn "$!";
    print WRT Data::Dumper->Dump([$hashref], ['*badway']);
    close WRT;

    no YAML;
}

sub linetest
{
    our %coord;
    my ($ox, $oy, $len, $angx) = @_;
    my $ref;
    my $flag;
    my $tx;
    my $ty;

    $flag = 1;
    for my $test (1 .. $len+1)
    {
        for my $w ( -1..1 )
        {
            $tx = $ox + around( $test * cos( $angx ) -    $w * sin( $angx)  );
            $ty = $oy + around(    $w * cos( $angx ) + $test * sin ($angx)  );


            if ($ty < 0 or $tx < 0)
            {
                die "What?\n"
            }

            $ref = $Coord{ $tx }{ $ty };
            
            if ( $ref->{'R'} < 150 and $ref->{'G'} < 150 and $ref->{'B'} < 150 )
            {
                $flag = 0;
            }
            else
            {
                # glColor4f(0.5, 0.0, 0.5, 1.0);
                # glBegin(GL_LINES);
                # glVertex3f( $ox, $oy, 0.5);
                # glVertex3f( $tx, $ty, 0.5);
                # glEnd();
            }
        }
    }

    return $flag;
}

sub draw_line
{
    my ($ox, $oy, $tx, $ty, $z) = @_;
    glBegin(GL_LINES);
        glVertex3f( $ox, $oy, $z);
        glVertex3f( $tx, $ty, $z);
    glEnd(); 
}
复制代码

aa77dd@163.com

回复 1# 523066680


从2 小时 到 3 小时了, KA, 还是我第一个来哦

523066680

回复 2# aa77dd@163.com


    谢谢捧场

codegay

我想说你论坛之前的注册问题太难了。

aa77dd@163.com

回复 3# 523066680

以前 用 PASCAL 写过解迷宫, 后来也写过迷宫生成 WIKIPEDIA 上有些算法, 比较好奇: 这个站的迷宫图都是用什么东东生成的, 因为我不愿相信那是手工一点点绘制的

另外, 关于那个箭头呢, 基本琢磨了一下, 不是很妙的方法, 但觉得可行:

1. 按边缘算法对整图分区, 好多区的话效率并不高.

2. 在填色为 蓝色/红色 的封闭(边缘都在图内部, 没有开放边缘--也就是以图片边缘为边缘)区内, 边缘寻迹, 需要直线判定, 角判定,

那个箭头的特征是: 5 凸角, 2凹角, 并要依照 凸凸凸凹凸凸凹, 这样一个环形次序. 要更精确, 还可对相关边作平行检测

这样就能把箭头识别出来, 根据填色确定 入/出口

aa77dd@163.com

关于迷宫(做成水平面流体槽形), 流体从入口注入, 在重力作用下, 无论迷宫如何复杂宠大, 流体最后都会从出口流出, 流体并没有意识, 但在重力压强的作用下, 完成了对迷宫的广度优先式搜索算法, 最终从出口流出, 在流到出口之前, 会将所有入口能通达的路径全部并行填充. 即使找到一个出口后, 只要其他路径还能继续流动(没有探索完全),  就会继续向前探索, 直到所有非出口分支都不可流动.

aa77dd@163.com

迷路生成アルゴリズムなどは使わず、手作業で道順を作っています。

迷宫生成算法等不使用，手工制作的路线。

居然真是手工制作的路线!!!

523066680

回复 7# aa77dd@163.com


    业界良心

而且看上面很多特殊的形状：一些动漫人物、日常物品的轮廓   就能感觉到至少是人工参与设计的。

523066680

回复 4# codegay


    正准备修改问题，还没想好

523066680

回复 5# aa77dd@163.com


    关于找箭头的事情，我又看到一个这样的，真是啥情况都有，不过好在，除了箭头 其他都是黑白
业余还是玩不动，我去看点书好了

523066680

回复 6# aa77dd@163.com


    之前见过一种方法是用PHOTOSHOP 模糊填充
这种方法原理是沿着迷宫的墙壁一直走，总能走出去。上面的图是个例外！