--.--
--
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

09.05
Wed
一番最初に触れたてみた関数型言語ってHaskellなんですけど

あまりに理解できなかったので非純粋なLispをお勉強中のmoratoriです

題材として簡単な迷路解いてみました

迷路データは1が壁で0が道です


(setq start-pos '(1 0))
(setq goal-pos '(15 8))
(setq width 16 height 10)
(setq maze-data 
    (make-array (list height width) :initial-contents
        '(
            (1 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1)
            (1 0 1 0 0 0 0 0 0 0 0 1 0 0 0 1)
            (1 0 1 0 1 1 1 1 0 1 1 1 0 1 0 1)
            (1 0 1 0 0 0 0 1 0 0 0 1 0 1 0 1)
            (1 0 1 1 1 1 0 1 0 1 0 1 0 1 0 1)
            (1 0 0 0 0 0 0 1 0 1 0 0 0 1 0 1)
            (1 0 1 1 1 0 1 1 0 1 1 1 1 1 0 1)
            (1 0 1 1 1 0 1 1 0 1 0 0 1 1 0 1)
            (1 0 1 0 1 1 1 1 1 1 1 0 0 0 0 0)
            (1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1)
         )
    )
)

(defun delfac (lst factor)
	(if (null lst)
		nil
		(progn
			(if (equal (car lst) factor)
				(delfac (cdr lst) factor)
				(cons (car lst) (delfac (cdr lst) factor))
			)
		)
	)
)
(defun isallnull (lst)
	(if (and (= (length lst) 1 ) (null (car lst)))
		t
		(progn
			(if (null (car lst))
				(isallnull (cdr lst))
				nil
			)
		)
	)
)
(defun countfac (lst factor)
    (if (null lst)
        0
        (progn
            (if (equal (car lst) factor)
                (+ 1 (countfac (cdr lst) factor))
                (countfac (cdr lst) factor)
            )
        )
    )
)
(defun notlst (lst)
	(if (null lst)
		nil
		(cons (not (car lst)) (notlst (cdr lst)))
	)
)
(defun direction (nowpos from)
	(let ((mvbl (notlst (list (iswall (up nowpos)) (iswall (down nowpos)) (iswall (right nowpos)) (iswall (left nowpos)))))) 
		(cond
			((equal from "up")
				(setf (car mvbl) nil)
				mvbl
			)
			((equal from "down")
				(setf (cadr mvbl) nil)
				mvbl
			)
			((equal from "right")
				(setf (caddr mvbl) nil)
				mvbl
			)
			((equal from "left")
				(setf (cadddr mvbl) nil)
				mvbl
			)
		)
	)
)
(defun iswall (pos)
	(let ((x (car pos)) (y (cadr pos)))
		(if (or (> x (- width 1)) (> 0 x) (> y (- height 1)) (> 0 y))
				t
			(progn
				(if (= (aref maze-data (car (pos2arindex pos)) (cadr (pos2arindex pos))) 1)
					t
					nil
				)
			)
		)
	)
)
(defun nstr (str)
	(cond 
		((equal str "up")"down")
		((equal str "down")"up")
		((equal str "right")"left")
		((equal str "left")"right")
	)
)
(defun pos2arindex (pos)(list (cadr pos) (car pos)))
(defun left (pos) (list (- (car pos) 1) (cadr pos)))
(defun right (pos)(list (+ (car pos) 1) (cadr pos)))
(defun down (pos) (list (car pos)  (+(cadr pos)1)))
(defun up (pos)   (list (car pos)  (-(cadr pos)1)))


(defun solve-maze (startpos from &optional (result nil))
    (setq result (cons "->" (cons (nstr from) result)))
	(let ( (movable (direction startpos from)) )
		(cond
			(
				(equal startpos goal-pos)
				(print (cdr(cdr (reverse result))))
				t
			)
			(
				(isallnull movable)
				nil
			)
			(t  
				(if (equal t (car movable))    
					(solve-maze (up startpos) "down" result)
				)
				(if (equal t (cadr movable))
					(solve-maze (down startpos) "up" result)
				)
				(if (equal t (caddr movable))
					(solve-maze (right startpos) "left" result)
				)
				(if (equal t (cadddr movable))
					(solve-maze (left startpos) "right" result)
				)  
			)            
		)
	)
)



(solve-maze start-pos "up")

maze.png
スポンサーサイト

comment 0 trackback 0
トラックバックURL
http://telracsmoratori.blog.fc2.com/tb.php/133-0d8430be
トラックバック
コメント
管理者にだけ表示を許可する
 
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。