DouKaku? Add tags

Add tags

Add tags to the following comment

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

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"))

Add tags

Tags:
The input will be splited to tags with space.

DouKaku?

Add tags

Add tags

Index

Feed

Other

Link

Pathtraq