Some Robi Code
Alg-3-A
(defun run ()
(do* ((environs (whereami?)(whereami?))
(cNodes nil (adjoin curNode cNodes))
(curNode (curNodeOf environs)(curNodeOf environs))
(eNodes (list curNode) eNodes)
(myworld (list environs) myworld)
)
((sameset eNodes cNodes) myworld)
(do* ( (moves (2nd environs) moves)
(direction (1stGood moves 0)
(1stGood moves (1+ direction)))
(neighEnvirons (moveRobi direction)(moveRobi direction))
(reachedNode (curNodeOf neighEnvirons)
(curNodeOf neighEnvirons))
)
((>= direction 4) nil)
(unless (member reachedNode eNodes)
(setf eNodes (cons reachedNode eNodes))
(setf myworld (cons neighEnvirons myworld))
)
(setf myworld
(recordInfo curNode reachedNode direction myworld))
(moveRobi (oppDir direction))
)
(moveToCUnode curNode
eNodes
(cons curNode cNodes) myworld)
)
)
(defun 1stGood (moves n)
)
(defun curNodeOf (e)
)
(defun oppDir (dir)
)
(defun moveToCUnode (curNode eNodes cNodes myworld)
(let ((path (findCUnode curNode eNodes cNodes myworld))
(node curNode))
(dotimes (move (length path) node)
(setf node (moveRobi (nth move path)))
)))
(defun findCUnode (node known completed world)
(let* ((uNodes (set-difference known completed)))
(when uNodes
(do* ((nodePosn 0 (1+ nodePosn))
(treeNode (list node nil) (nth nodePosn treeNodes))
(tryNode (1st treeNode)(1st treeNode))
(pathTo (2nd treeNode) (2nd treeNode))
(treeNodes (list treeNode) treeNodes)
(nodeNeighs (getNeighs tryNode world)
(getNeighs tryNode world))
(uNode (1stUneigh nodeNeighs uNodes)
(1stUneigh nodeNeighs uNodes))
)
(uNode (append pathTo
(list (getDir uNode nodeNeighs))))
(setf treeNodes
(getNewTN nodeNeighs pathTo treeNodes))
)
)
)
)
(defun recordInfo (exploringNode foundNode dir world)
)
(defun getNeighs (node world)
)
(defun getDir (node list)
)
(defun 1stUneigh (neighs uNodes)
)
(defun getNewTN (neighs pathTo treeNodes)
(let ((returnVal treeNodes))
(dotimes (posn (length neighs) returnVal)
(unless (or (null (nth posn neighs))
(member (nth posn neighs)
returnVal
:test #'firsteq))
(setf returnVal
(backcons (list (nth posn neighs)
(backcons posn pathTo))
returnVal))
))))
;; ********************************
;; UTILITIES
;;*********************************
(defun 1st (x)
)
(defun 2nd (x)
)
(defun 3rd (x)
)
(defun 4th (x)
)
(defun firstn (n list)
(let ((len (length list)))
(if (> n len)
nil
(reverse (nthcdr (- len n) (reverse list)))
)))
(defun replace-at (loc item list)
(append (firstn loc list) (cons item (nthcdr (1+ loc) list))))
(defun firsteq (item list)(eq item (first list)))
(defun backcons (item list)(append list (list item)))
(defun sameset (set1 set2)
(neither (set-difference set1 set2)(set-difference set2 set1)))
(defun neither (x y)(and (not x)(not y)))