Comment detail

マップの通り抜け (Nested Flatten)
標準入力から地図を読むようにしました。
総当りです。

$ cat | clisp maze.cl
.+.....
.+.+++.
.+.+.+.
.+++.+.
.....+.
<C-D>
通り抜けられる
$ cat | clisp maze.cl
..+...+
++.+++.
.+...++
++++.+.
.+..+.+
<C-D>
通り抜けられない
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
(defun K (x) x)
(defun start-points (map)
  (loop for i from 0 to (1- (array-dimension map 1))
        when (eql (aref map 0 i) #\+)
        collect (cons 0 i)))

(defun movablep (map path &key (x-fn #'K) (y-fn #'K))
  (destructuring-bind (x . y) (car path)
    (let ((next-x (funcall x-fn x))
          (next-y (funcall y-fn y)))
      (and (< -1 next-x (array-dimension map 0))
           (< -1 next-y (array-dimension map 1))
           (eql (aref map next-x next-y) #\+)
           (not (member (cons next-x next-y) path :test #'equal))
           (cons next-x next-y)))))

(defun next-points (map path)
  (remove-if-not
    #'K
    (mapcar #'(lambda (key fn)
                (movablep map path key fn))
            (list :x-fn :y-fn :y-fn :x-fn )
            (list #'1+ #'1+ #'1- #'1-))))

(defun throughp (map)
  (labels ((rec (map path)
                (if (eql (1- (array-dimension map 0)) (car (first path)))
                  t
                  (loop for point in (next-points map path)
                        do (let ((ret (rec map (cons point path))))
                             (if ret (return ret)))))))
    (loop for p in (start-points map)
          do (let ((ret (rec map (list p))))
               (if ret (return ret))))))

(defun main ()
  (if (throughp 
           (loop as in = (read-line *standard-input* nil nil)
                 while in 
                 collect in into data
                 finally (return 
                           (make-array (list (list-length data) (length (car data)))
                                       :initial-contents data))))
    (princ "通り抜けられる")
    (princ "通り抜けられない")))
(main)

Index

Feed

Other

Link

Pathtraq

loading...