This is a Lisp program that solves any level of the game Wappo. It’s a Java game that came with Siemens mobile phones.
You have to code the layout of the level you want to solve. At the end of the program you can see the example for the first three levels of the game. You have to enter the starting coordinates of Wappo, one or more Yumchaks (the enemies), the pits, the walls (in this case you enter the coordinates of the two tiles that surround the wall), and the exit.
It will print the sequence of moves you have to make. Works at least with CLISP for Windows
;; (board wappo (yumchaks) (pits) (walls))
;; (setq state (cons (make-list 6 :initial-element (make-list 6)) '((3 4) ((5 4)) ((1 4)) ((1 3 1 4) (3 4 3 5) (5 4 5 5) (5 4 4 4) (5 0 4 0)))))
(defun allowed (state from to)
(let (wall pit)
(setq from (subseq from 0 2))
(if
(or
(> (first to) 5)
(< (first to) 0)
(> (second to) 5)
(< (second to) 0)
)
nil
(if
(dolist (wall (fourth state) t)
(if (or (equal (append from to) wall) (equal (append to from) wall))
(return nil)))
(if (equal from (first state))
(dolist (pit (third state) t)
(if (equal to pit)
(return nil)))
t)
)
)
)
)
(defun randomize-list (l)
(if (not (null l))
(let ((element (nth (random (length l)) l)))
(cons element (randomize-list (remove element l)))
)
)
)
(defun depth-search (state)
(let ((offsets '((1 0) (0 1) (-1 0) (0 -1))) offset destination yumchak i j return-value state2 pit)
(if (equal (first state) (fifth state))
t
(dolist (offset (randomize-list offsets))
(format t "~%>>~A ~A<<" (first state) offset)
; (setq return-value nil)
(setq destination (mapcar #'+ offset (first state)))
(if (allowed state (first state) destination)
(progn
(setq state2 (copy-tree state))
(setf (first state2) destination)
(if (dotimes (j (length (second state2)) t)
(decf (third (nth j (second state2))))
(dolist (i '(1 2))
(if (<= (third (nth j (second state2))) 0) (progn
(setq yumchak (nth j (second state2)))
(cond
((and
(< (first yumchak) (first (first state2)))
(allowed state2 yumchak (list (+ 1 (first yumchak)) (second yumchak))))
(incf (first (nth j (second state2)))))
((and
(> (first yumchak) (first (first state2)))
(allowed state2 yumchak (list (- (first yumchak) 1) (second yumchak))))
(decf (first (nth j (second state2)))))
((and
(< (second yumchak) (second (first state2)))
(allowed state2 yumchak (list (first yumchak) (+ 1 (second yumchak)))))
(incf (second (nth j (second state2)))))
((and
(> (second yumchak) (second (first state2)))
(allowed state2 yumchak (list (first yumchak) (- (second yumchak) 1))))
(decf (second (nth j (second state2)))))
)
(dolist (pit (third state2) t)
(if (equal (subseq (nth j (second state2)) 0 2) pit) (progn (print 'pozo)
(setf (third (nth j (second state2))) 4))) )
))
)
(if (equal (first state2) (subseq (nth j (second state2)) 0 2))
(progn (print 'yumchak) (return nil)))
; (return nil))
)
;(progn (break)
(setq return-value (depth-search state2))
;(break))
)
(if return-value (return (cons (first state) return-value)))
)))
)
)
)
; (wappo (yumchaks) (pits) (walls) (exit))
(let (state)
(setq level1 '((3 4) ((5 4 0)) ((1 4)) ((1 3 1 4) (3 4 3 5) (5 4 5 5) (5 4 4 4) (5 0 4 0)) (3 0)))
(setq level2 '((4 1) ((5 0 0)) ((2 4)) ((0 0 0 1) (1 0 1 1) (4 0 4 1) (3 1 3 2) (0 3 0 4)) (1 0)))
(setq level3 '((5 0) ((3 3 0)) ((3 1) (5 2)) ((0 0 1 0) (1 0 2 0) (3 0 4 0) (3 0 3 1) (4 0 4 1) (3 1 3 2) (3 2 3 3) (2 2 2 3) (0 3 1 3) (2 4 2 5) (4 4 4 5) (4 4 3 4)) (2 0)))
; (trace depth-search)
(print (depth-search level3))
)
