;******************************************************************************
  Four peg , n ring Towers of Hanoi
;******************************************************************************

;******************************************************************************
  State representation
;******************************************************************************

  Represent a state by a list of four lists , where each sub - list represents
  the ring stack on a peg .   The peg lists are in order from peg 1 to peg 4
; within the state list.  A peg list consists of the numbers representing
; rings that are on that peg, from smallest to largest.  Rings are numbered
  1 to n , with 1 being smallest .

;******************************************************************************
; Initial state
;******************************************************************************

; Initial state constructor -- we can't get away with enumerating the ring
  numbers to form the stack on peg 1 , because we do n't know how big n is .
; So we'll need a function to construct the initial state after we ask the
; user for n.

; This forms a list of numbers from i to n where i <= n.

(defun TH_form_list_i_to_n (i n)
   (if (equal i (1+ n))
          ; If we're past n, we don't need more numbers.
          NIL
          ; Else form list from i+1 to n, and add current ring number on
          ; the front of it.
          (cons i (TH_form_list_i_to_n (1+ i) n))))

; Get number of rings from the user.  Form the state list by calling the
  above function to make the peg 1 list , with NIL for the other lists .

(defun TH_get_initial_state ()
   (list
      (TH_form_list_i_to_n 1 (read (format t "~%Number of rings: ")))
      NIL
      NIL
      NIL))

;******************************************************************************
; Goal test
;******************************************************************************

  Require the first three pegs to be empty , and the fourth to contain a list
  of numbers from 1 to n.   If we trust our procedure to properly maintain
  legal ring stacks , then we really only need to test that the first three
; pegs are empty.  Since this program does intend to maintain legal stacks,
; it is a bug if they are not legal, which should be fixed.  Therefore assume
; the state is legal, and check only for empty pegs.

(defun TH_goal_test (state)
  (and (null (first state))
       (null (second state))
       (null (third state))))

;******************************************************************************
  Operations
;******************************************************************************

  If allowed , move the top ring from peg_X to  and return
; the state corresponding to the situation after the move. The
  move is not allowed if the top ring on peg_X is larger than
; the top ring on peg_Y, or if peg_X = peg_Y, or if there is no
  ring on peg_X. If not allowed , return NIL .

; In addition, the operations serve as their own print functions,
; when called with a state argument of -1.  This can't be mistaken
; for a legal state, because a state is a list not a number.

(defun TH_move (peg_X peg_Y state)

 ; First see if we want to show or perform the operation.
 (if (equal state -1)

   ; Here if want to return a description.
   (format NIL "~%Move ring from peg ~A to peg ~A~&" peg_X peg_Y)

   ; Else perform the operation:
   ; Get the numbers of the top rings, for ease of testing.
  Since peg_X and peg_Y are numbers , they can be used as
   ; arguments of "nth" to pull out from the state the list
   ; corresponding to those pegs. Only wrinkle is that nth
  regards 0 to mean the first element . In a serious program ,
  the pegs would be numbered 0 through 3 internally , and
  only printed as 1 through 4 -- this would get rid of the
   ; (1- peg_N) calls.

   (let ((ring_on_X (first (nth (1- peg_X) state)))
         (ring_on_Y (first (nth (1- peg_Y) state))))

      ; Test for conditions that disallow the move:

      (unless 
  No ring on peg_X ?
             (equal peg_X peg_Y)            ; Move to same peg?
             (and (not (null ring_on_Y))    ; Have ring on peg_Y
                  (> ring_on_X ring_on_Y))) ; and rings would end
                                            ; up out of order?

         ; Unless returns NIL if its test argument above is true.
         ; If the test is false, i.e. if the move is allowed,
  then it returns the second argument , below .

  Construct the new state here , by forming a list of
  four lists representing the new stacks on each peg .
         ; If the number of pegs were not fixed, it would be
         ; necessary to recurse or loop to construct the state
  list one peg at a time . Here , we can get away with
         ; constructing the state in place.

  For convenience , form the new stacks on peg_X and
  peg_Y first .

         (let (; Source stack has its top ring removed.
               (new_X (rest (nth (1- peg_X) state)))
               ; Destination stack has that ring added to top.
               (new_Y (cons ring_on_X (nth (1- peg_Y) state))))

            ; For each peg element in the state list, check if
  that peg is peg_X or  , in which case use
            ; their pre-constructed lists. If not, use the list
            ; that's in that position now.

  peg 1
                        ((equal peg_Y 1) new_Y)
                        (t (first state)))
  peg 2
                        ((equal peg_Y 2) new_Y)
                        (t (second state)))
  peg 3
                        ((equal peg_Y 3) new_Y)
                        (t (third state)))
  peg 4
                        ((equal peg_Y 4) new_Y)
                        (t (fourth state)))))))))


  Return a list of all moves .   Since four is a small number , it 's
; simplest to enumerate the possibilities.  Don't include any moves to
; same peg, but otherwise don't weed out any possibilities -- the move
; function itself will handle that.  Each move is a lambda expression
  that packages up the general move with two peg number arguments to
; form a function that takes only the state as an arg.

(defun TH_ops (state)
   (list
      #'(lambda (state) (TH_move 1 2 state))
      #'(lambda (state) (TH_move 1 3 state))
      #'(lambda (state) (TH_move 1 4 state))
      #'(lambda (state) (TH_move 2 1 state))
      #'(lambda (state) (TH_move 2 3 state))
      #'(lambda (state) (TH_move 2 4 state))
      #'(lambda (state) (TH_move 3 1 state))
      #'(lambda (state) (TH_move 3 2 state))
      #'(lambda (state) (TH_move 3 4 state))
      #'(lambda (state) (TH_move 4 1 state))
      #'(lambda (state) (TH_move 4 2 state))
      #'(lambda (state) (TH_move 4 3 state))))

;******************************************************************************
; Format functions
;******************************************************************************

; The operations will return their descriptions when called with an argument
; of -1 which is never a legal state.

(defun TH_show_op (op)
   (funcall op -1))

; Use the default printer format for the state -- it's sufficiently easy
; to read.  It's possible to make "stacks" of numbers representing the
; rings on each peg, with a little effort, but I don't have the time.

(defun TH_show_state (state)
   state)

;******************************************************************************
  Main program
;******************************************************************************

(defun hanoi ()
   (let*
      (; Get search parameters.
       (search-type
          (progn
             ; These are split up to keep the line length in the source less
  than 80 chars .   Wish I knew a way to split a quoted string
             ; across a line boundary.  Perhaps there's function or macro
             ; that would let me do it.  Could always *write* a macro, I
             ; suppose...
             (format t "~&Search type options are:~%")
             (format t " depth-first~% breadth-first~% iterative-deepening~%")
             (format t "Search type? ")
             (read)))
       (excl-type
          (progn
             (format t "~&Repeated state handling options are:~%")
             (format t " exclude-if-visited~% exclude-if-in-path~%")
             (format t " exclude-same-as-parent~% no-exclusion~%")
             (format t "Repeated state handling option? ")
             (read)))
       (max-depth (read (format t "~&Maximum search depth? "))))

      ; Call blind-search.
      (blind-search
  First arg is the problem list , which contains the initial state , the
         ; goal function, which is a closure that tests against the end-num,
         ; and the above functions that provide the list of operations and show
         ; a state an operation.
         (list
            ; Ask user for number of rings and form initial state.
            (TH_get_initial_state)
            ; Goal function.
            #'TH_goal_test
            ; Function to return the op-list.
            #'TH_ops
            ; Function to format a state (but not much...)
            #'TH_show_state
            ; Function to get the description that goes with an operation.
            #'TH_show_op)
         ; Remaining args are keyword args.
         :search-type search-type
         :repeated-state-handling excl-type
         :maximum-depth max-depth)))


******************************************************************************
******************************************************************************
******************************************************************************
******************************************************************************
 within the state list.  A peg list consists of the numbers representing
 rings that are on that peg, from smallest to largest.  Rings are numbered
******************************************************************************
 Initial state
******************************************************************************
 Initial state constructor -- we can't get away with enumerating the ring
 So we'll need a function to construct the initial state after we ask the
 user for n.
 This forms a list of numbers from i to n where i <= n.
 If we're past n, we don't need more numbers.
 Else form list from i+1 to n, and add current ring number on
 the front of it.
 Get number of rings from the user.  Form the state list by calling the
******************************************************************************
 Goal test
******************************************************************************
 pegs are empty.  Since this program does intend to maintain legal stacks,
 it is a bug if they are not legal, which should be fixed.  Therefore assume
 the state is legal, and check only for empty pegs.
******************************************************************************
******************************************************************************
 the state corresponding to the situation after the move. The
 the top ring on peg_Y, or if peg_X = peg_Y, or if there is no
 In addition, the operations serve as their own print functions,
 when called with a state argument of -1.  This can't be mistaken
 for a legal state, because a state is a list not a number.
 First see if we want to show or perform the operation.
 Here if want to return a description.
 Else perform the operation:
 Get the numbers of the top rings, for ease of testing.
 arguments of "nth" to pull out from the state the list
 corresponding to those pegs. Only wrinkle is that nth
 (1- peg_N) calls.
 Test for conditions that disallow the move:
 Move to same peg?
 Have ring on peg_Y
 and rings would end
 up out of order?
 Unless returns NIL if its test argument above is true.
 If the test is false, i.e. if the move is allowed,
 If the number of pegs were not fixed, it would be
 necessary to recurse or loop to construct the state
 constructing the state in place.
 Source stack has its top ring removed.
 Destination stack has that ring added to top.
 For each peg element in the state list, check if
 their pre-constructed lists. If not, use the list
 that's in that position now.
 simplest to enumerate the possibilities.  Don't include any moves to
 same peg, but otherwise don't weed out any possibilities -- the move
 function itself will handle that.  Each move is a lambda expression
 form a function that takes only the state as an arg.
******************************************************************************
 Format functions
******************************************************************************
 The operations will return their descriptions when called with an argument
 of -1 which is never a legal state.
 Use the default printer format for the state -- it's sufficiently easy
 to read.  It's possible to make "stacks" of numbers representing the
 rings on each peg, with a little effort, but I don't have the time.
******************************************************************************
******************************************************************************
 Get search parameters.
 These are split up to keep the line length in the source less
 across a line boundary.  Perhaps there's function or macro
 that would let me do it.  Could always *write* a macro, I
 suppose...
 Call blind-search.
 goal function, which is a closure that tests against the end-num,
 and the above functions that provide the list of operations and show
 a state an operation.
 Ask user for number of rings and form initial state.
 Goal function.
 Function to return the op-list.
 Function to format a state (but not much...)
 Function to get the description that goes with an operation.
 Remaining args are keyword args.
  Four peg , n ring Towers of Hanoi

  State representation

  Represent a state by a list of four lists , where each sub - list represents
  the ring stack on a peg .   The peg lists are in order from peg 1 to peg 4
  1 to n , with 1 being smallest .


  numbers to form the stack on peg 1 , because we do n't know how big n is .


(defun TH_form_list_i_to_n (i n)
   (if (equal i (1+ n))
          NIL
          (cons i (TH_form_list_i_to_n (1+ i) n))))

  above function to make the peg 1 list , with NIL for the other lists .

(defun TH_get_initial_state ()
   (list
      (TH_form_list_i_to_n 1 (read (format t "~%Number of rings: ")))
      NIL
      NIL
      NIL))


  Require the first three pegs to be empty , and the fourth to contain a list
  of numbers from 1 to n.   If we trust our procedure to properly maintain
  legal ring stacks , then we really only need to test that the first three

(defun TH_goal_test (state)
  (and (null (first state))
       (null (second state))
       (null (third state))))

  Operations

  If allowed , move the top ring from peg_X to  and return
  move is not allowed if the top ring on peg_X is larger than
  ring on peg_X. If not allowed , return NIL .


(defun TH_move (peg_X peg_Y state)

 (if (equal state -1)

   (format NIL "~%Move ring from peg ~A to peg ~A~&" peg_X peg_Y)

  Since peg_X and peg_Y are numbers , they can be used as
  regards 0 to mean the first element . In a serious program ,
  the pegs would be numbered 0 through 3 internally , and
  only printed as 1 through 4 -- this would get rid of the

   (let ((ring_on_X (first (nth (1- peg_X) state)))
         (ring_on_Y (first (nth (1- peg_Y) state))))


      (unless 
  No ring on peg_X ?

  then it returns the second argument , below .

  Construct the new state here , by forming a list of
  four lists representing the new stacks on each peg .
  list one peg at a time . Here , we can get away with

  For convenience , form the new stacks on peg_X and
  peg_Y first .

               (new_X (rest (nth (1- peg_X) state)))
               (new_Y (cons ring_on_X (nth (1- peg_Y) state))))

  that peg is peg_X or  , in which case use

  peg 1
                        ((equal peg_Y 1) new_Y)
                        (t (first state)))
  peg 2
                        ((equal peg_Y 2) new_Y)
                        (t (second state)))
  peg 3
                        ((equal peg_Y 3) new_Y)
                        (t (third state)))
  peg 4
                        ((equal peg_Y 4) new_Y)
                        (t (fourth state)))))))))


  Return a list of all moves .   Since four is a small number , it 's
  that packages up the general move with two peg number arguments to

(defun TH_ops (state)
   (list
      #'(lambda (state) (TH_move 1 2 state))
      #'(lambda (state) (TH_move 1 3 state))
      #'(lambda (state) (TH_move 1 4 state))
      #'(lambda (state) (TH_move 2 1 state))
      #'(lambda (state) (TH_move 2 3 state))
      #'(lambda (state) (TH_move 2 4 state))
      #'(lambda (state) (TH_move 3 1 state))
      #'(lambda (state) (TH_move 3 2 state))
      #'(lambda (state) (TH_move 3 4 state))
      #'(lambda (state) (TH_move 4 1 state))
      #'(lambda (state) (TH_move 4 2 state))
      #'(lambda (state) (TH_move 4 3 state))))



(defun TH_show_op (op)
   (funcall op -1))


(defun TH_show_state (state)
   state)

  Main program

(defun hanoi ()
   (let*
       (search-type
          (progn
  than 80 chars .   Wish I knew a way to split a quoted string
             (format t "~&Search type options are:~%")
             (format t " depth-first~% breadth-first~% iterative-deepening~%")
             (format t "Search type? ")
             (read)))
       (excl-type
          (progn
             (format t "~&Repeated state handling options are:~%")
             (format t " exclude-if-visited~% exclude-if-in-path~%")
             (format t " exclude-same-as-parent~% no-exclusion~%")
             (format t "Repeated state handling option? ")
             (read)))
       (max-depth (read (format t "~&Maximum search depth? "))))

      (blind-search
  First arg is the problem list , which contains the initial state , the
         (list
            (TH_get_initial_state)
            #'TH_goal_test
            #'TH_ops
            #'TH_show_state
            #'TH_show_op)
         :search-type search-type
         :repeated-state-handling excl-type
         :maximum-depth max-depth)))

