Advertisement
add1ctus

FLIP

Apr 16th, 2016
162
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 3.75 KB | None | 0 0
  1. ; read input
  2. (defun read-input(p)
  3. (cond
  4.     ((null p) nil)
  5.     (T (cons p (read-input (read nil nil))))
  6. )
  7. )
  8.  
  9. (defun readinput(i)
  10.     (cdr (read-input 1))
  11. )  
  12.  
  13. (defun run-breadth (start goal moves)
  14.   (declare (special *open*))
  15.   (declare (special *closed*))
  16.   (declare (special *goal*))
  17.   (setq *open* (list (build-record start nil)))
  18.   (setq *closed* nil)
  19.   (setq *goal* goal)
  20.   (breadth-first moves))
  21.  
  22. ;;; These functions handle the creation and access of (state parent)
  23. ;;; pairs.
  24.  
  25. (defun build-record (state parent) (list state parent))
  26.  
  27. (defun get-state (state-tuple) (nth 0 state-tuple))
  28.  
  29. (defun get-parent (state-tuple) (nth 1 state-tuple))
  30.  
  31. (defun retrieve-by-state (state list)
  32.   (cond ((null list) nil)
  33.         ((equal state (get-state (car list))) (car list))
  34.         (t (retrieve-by-state state (cdr list)))))
  35.  
  36.  
  37.  
  38. (defun breadth-first (moves)
  39.   (declare (special *open*))
  40.   (declare (special *closed*))
  41.   (declare (special *goal*))
  42.   (cond ((null *open*) nil)
  43.         (t (let ((state (car *open*)))
  44.              (setq *closed* (cons state *closed*))
  45.  
  46.              (cond
  47.     ;;; found solution: print path to it
  48.         ((equal (get-state state) *goal*) (reverse (build-solution *goal*)))
  49.              
  50.             ;;; try next child state
  51.                 (t (setq *open*
  52.                             (append (cdr *open*)
  53.                                     (generate-descendants (get-state state)
  54.                                                           moves)))
  55.                       (breadth-first moves)))))))
  56.  
  57. (defun generate-descendants (state moves)
  58.   (declare (special *open*))
  59.   (declare (special *closed*))
  60.   (cond ((null moves) nil)
  61.         (t (let ((child (funcall (car moves) state))
  62.                  (rest (generate-descendants state (cdr moves))))
  63.              (cond ((null child) rest)
  64.                    ((retrieve-by-state child rest) rest)
  65.                    ((retrieve-by-state child *open*) rest)
  66.                    ((retrieve-by-state child *closed*) rest)
  67.                    (t (cons (build-record child state) rest)))))))
  68.  
  69.  
  70. (defun build-solution (state)
  71.   (declare (special *closed*))
  72.   (cond ((null state) nil)
  73.         (t (cons state (build-solution
  74.                         (get-parent
  75.                          (retrieve-by-state state *closed*)))))))
  76.  
  77. (defvar *initial* (car (readinput nil)))
  78. ;--don't change above this line
  79.  
  80. ; write your function(s) here
  81.  
  82. (defun opposite (num)
  83.     (cond
  84.         ( (eq (nth 2 num) 1) (list (nth 0 num) (nth 1 num) 0))
  85.         ( T (list (nth 0 num) (nth 1 num) 1) )
  86.     )    
  87. )
  88.  
  89. (defun change-pos (state pos)
  90.     (cond
  91.         ( (eq pos 1) (append (list (opposite (car state))) (cdr state)) )
  92.         ( T (append (list (car state)) (change-pos (cdr state) (- pos 1))) )
  93.     )
  94. )
  95.  
  96. (defun move1 (state)
  97.     (change-pos (change-pos (change-pos state 4) 2) 1)
  98. )
  99.  
  100. (defun move2 (state)
  101.     (change-pos (change-pos (change-pos (change-pos state 5) 3) 2) 1)    
  102. )
  103.  
  104. (defun move3 (state)
  105.     (change-pos (change-pos (change-pos state 3) 2) 6)    
  106. )
  107.  
  108. (defun move4 (state)
  109.     (change-pos (change-pos (change-pos (change-pos state 1) 4) 5) 7)    
  110. )
  111.  
  112. (defun move5 (state)
  113.     (change-pos (change-pos (change-pos (change-pos (change-pos state 5) 2) 4) 6) 8)    
  114. )
  115.  
  116. (defun move6 (state)
  117.     (change-pos (change-pos (change-pos (change-pos state 6) 3) 5) 9)    
  118. )
  119.  
  120. (defun move7 (state)
  121.     (change-pos (change-pos (change-pos state 7) 4) 8)    
  122. )
  123.  
  124. (defun move8 (state)
  125.     (change-pos (change-pos (change-pos (change-pos state 8) 7) 9) 5)    
  126. )
  127.  
  128. (defun move9 (state)
  129.     (change-pos (change-pos (change-pos state 9) 6) 8)    
  130. )
  131.  
  132. (print (run-breadth *initial* '((0 0 0) (0 1 0) (0 2 0) (1 0 0) (1 1 0) (1 2 0) (2 0 0) (2 1 0) (2 2 0)) '(move1 move2 move3 move4 move5 move6 move7 move8 move9)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement