DouKaku? 5279 shiro: 効率を度外視して素直に書きました。全...(必ず解ける迷路)

Comment detail

効率を度外視して素直に書きました。
全部埋まった状態から掘れるだけ掘って、行き詰まったらバックトラックするだけです。

gosh> (show-maze (maze 4 4))
■■■■■■■■■
■　■　　　■　■
■　■　■　■　■
■　■　■　　　■
■　■　■■■　■
■　　　■　　　■
■■■■■　■■■
■　　　　　　　■
■■■■■■■■■
#<undef>

1024x1024にかかった時間は177秒でした。
(Gauche 0.8.12, Pentium 4 2.0GHz)

;; -*- coding: euc-jp -*-
(use gauche.array)
(use srfi-27)
(use srfi-42)
(use util.match)
(use gauche.sequence)

(set! (setter array-ref) array-set!) ;; missing in gauche.array
(random-source-randomize! default-random-source)

(define (advance pos d)
  (match-let1 (x . y) pos
    (case d
      [(N) (cons x (- y 1))]
      [(E) (cons (+ x 1) y)]
      [(W) (cons (- x 1) y)]
      [(S) (cons x (+ y 1))])))

(define (inverse d) (case d ((N) 'S) ((S) 'N) ((E) 'W) ((W) 'E)))

(define (maze n m)
  (let1 tab (make-array (shape 0 n 0 m) '())
    (define (diggable? x y)
      (and (<= 0 x (- n 1)) (<= 0 y (- m 1)) (null? (array-ref tab x y))))
    (define (dig pos d)
      (let1 newpos (advance pos d)
        (cond [(diggable? (car newpos) (cdr newpos))
               (push! (array-ref tab (car pos) (cdr pos)) d)
               (push! (array-ref tab (car newpos) (cdr newpos)) (inverse d))
               newpos]
              [else #f])))
    (let rec ((pos '(0 . 0)) (from #f))
      (and pos
           (dolist (d (shuffle '(N E W S)))
             (unless (eq? d from) (rec (dig pos d) (inverse d))))))
    tab))

(define (show-maze tab)
  (dotimes (y (array-ref (array-shape tab) 0 1))
    (dotimes (x (array-ref (array-shape tab) 1 1))
      (display (if (memq 'N (array-ref tab x y)) "■\u3000" "■■")))
    (display "■\n")
    (dotimes (x (array-ref (array-shape tab) 1 1))
      (display (if (memq 'W (array-ref tab x y)) "\u3000\u3000" "■\u3000")))
    (display "■\n"))
  (dotimes (x (array-ref (array-shape tab) 1 1))
    (display "■■"))
  (display "■\n"))

続いて高速化版です。

1024x1024、出力無しで7秒弱になりました(Pen4 2.0GHz)。約25倍。

- 接続をビットマップで保持
- 方向を整数値で表して条件判断を減らす
- トライすべき方向のリストをshuffleで毎回作るのではなく、すべての可能な組み合わせをあらかじめ計算しといて、ループ内ではそのうち一つをランダムに選ぶ

最後のが一番効きました。shuffleはgeneric functionのディスパッチがあるし、結果のリストのアロケートも行われるのでinner loopで使うと重いのでしょう。

;; -*- coding: euc-jp -*-
(use srfi-27)
(use srfi-42)
(use util.combinations)

(random-source-randomize! default-random-source)

(define-constant N -1)
(define-constant S  1)
(define-constant W -2)
(define-constant E  2)

(define (dir->mask d) (ash 1 (+ d 2)))

(define-constant NMASK (dir->mask N))
(define-constant SMASK (dir->mask S))
(define-constant WMASK (dir->mask W))
(define-constant EMASK (dir->mask E))

(define-macro (trials from)
  (define (gen-combs src)
    (list->vector (permutations src)))
  `(vector-ref (case ,from
                 ((,N) ',(gen-combs `(,S ,W ,E)))
                 ((,S) ',(gen-combs `(,N ,W ,E)))
                 ((,W) ',(gen-combs `(,N ,S ,E)))
                 ((,E) ',(gen-combs `(,N ,S ,W))))
               (random-integer 6)))

(define (maze n m)
  (let1 tab (make-vector (* n m) 0)
    (let-syntax [(maze-ref
                  (syntax-rules ()
                    [(_ x y) (vector-ref tab (+ x (* y n)))]))
                 (maze-flag-ior!
                  (syntax-rules ()
                    [(_ x y d)
                     (let1 i (+ x (* y n))
                       (vector-set! tab i (logior (vector-ref tab i)
                                                  (dir->mask d))))]))]
      (define (dig x y d)
        (receive (dx dy) (quotient&remainder d 2)
          (let ((nx (+ x dx)) (ny (+ y dy)))
            (cond [(and (<= 0 nx) (< nx n) (<= 0 ny) (< ny m)
                        (= 0 (maze-ref nx ny)))
                   (maze-flag-ior! x y d)
                   (maze-flag-ior! nx ny (- d))
                   (rec nx ny (- d))]
                  [else #f]))))
      (define (rec x y from)
        (let loop ((ds (trials from)))
          (unless (null? ds)
            (dig x y (car ds))
            (loop (cdr ds)))))
      (rec 0 0 N)
      tab)))

(define (show-maze n m)
  (let1 tab (maze n m)
    (do-ec (: y 0 (* n m) n)
           (begin
             (dotimes (x n)
               (display (if (= 0 (logand NMASK (vector-ref tab (+ x y))))
                          "■■" "■\u3000")))
             (display "■\n")
             (dotimes (x n)
               (display (if (= 0 (logand WMASK (vector-ref tab (+ x y))))
                          "■\u3000" "\u3000\u3000")))
             (display "■\n")))
    (dotimes (x n) (display "■■"))
    (display "■\n")))

DouKaku?

Comment detail

Index

Feed

Other

Link

Pathtraq