Successor function in LISP

AceKnocks · 04-06-2008, 07:06 PM

Hi all,
I am working on a successor function which given the current state (and state value) and the overall configuration space of the puzzle, gives all valid possible moves from the current state.

The puzzle is as following -

First configuration space (a 5x2 array, starting from {0,0} element i.e. the Start state)

S...G
.*...

According to the rules for the puzzle, we start with a 6 sided standard dice with 1 facing top and 3 facing right. The dice can be slided onto any of four sides i.e. north, south, east and west. But any such move is invalid if after sliding the dice on to any of its sides results a 6 facing top.

Lets say that we start from S (with a 1 on top, 3 on right). If we move to {0,1} cell i.e. to its right, it'll result in a state with (4 on top, 1 on right) and its a valid state. But if we try to move again right, we happen to have 6 on top that is an invalid move. Okay, from our current position at {0,1} if we try to move south then we land into a "*" which also is an invalid move.

Like wise we have to keep on rolling the dice, until we reach to G(goal) from S (start).

Following is another configuration space

S.......*
...**..G.

Our Successor function thus, will return all valid moves given a position on the space and the space itself. I am thinking to represent the current state as (x co-ord, y co-ord, and the value of the position i.e. a "S", ".","*" or a "G".

Please help.

indienick · 04-07-2008, 08:07 AM

Don't scream at me for this remark, but this sounds a little bit like homework to me. However, I'm not going to say that and leave you completely high and dry; some guidance is nice.

1. Every scenario is going to be a predefined map; since, in Lisp, you can load S- and M-expressions on the fly a simple data structure may be:

Code:

;; N is a number.
;;
(defconstant +map-N+ '((cons character-form (cons number-form  number-form))
                              ...))

;; In application:
;;
(defconstant +map-3+ '((cons #\S (cons 0 0))
                       (cons #\. (cons 0 1))
                       ...
                       (cons #\G (cons 1 4))))

The basic, nested CONS cells representing the value of the location, and then in the second CONS set, the X and Y coordinates.

As the die gets rolled, you'll need to run through a COND form to figure out if the move is valid, and throw it all inside of a loop with a nice prompt, and that's taken care of.

Code:

(defun get-user-input ()
  (format *query-io* "~&>> ")
  (force-output *query-io*)
  (read-line *query-io*))

(loop for input = (get-user-input) while (not (char= input #\q))
  do
    ...
    ...)

I'm going to leave you with that; figuring out how to decode the validity of the next die roll is up to you.

AceKnocks · 04-07-2008, 08:47 AM

Sure indienick, that sure is my homework assignment. The only missing information is I was totally unaware of the amount of Lisp usage in my AI course beforehand.

Had I known that was the case and we will not be learning Lisp at all, I would have re-considered taking this course but now that I am in the course and did almost 3 assignments already (of course not in Lisp, but in Java) I want to go ahead with some struggling and complete this assignment. Most of the undergrad (and grad) students had taken Lisp/Scheme programming course in their freshmen year but I have never studied (nor worked) on these two.

Thanks for your suggestion and last night I worked out my dice in this form.

Code:

(defstruct (die (:type vector))
  top right bottom left front back x y c) 

(defvar *die* (make-die :top 1 :right 3 :bottom 6 :left 4 :front 2  :back 5 :x 0 :y 0 :c "S"))

where c is the S(start) position' value i.e. co-ord {0,0}

I have also thought about some of the valid move checking functionality but at this time, it isn't working.

Code:

(let ((new-die (move-die *die* direction)))
   (cond
      ((and (/= 6 (die-top new-die))
            (valid-position *box* (die-x new-die) (die-y new-die)))
        ;; a valid move
        (setf *die* new-die))
      (t
        ;; not a valid move
        )))

but I am not able to come up with my representation of a direction-move concept. It should sure be an array but I am not able to think of any.

indienick · 04-07-2008, 11:40 AM

Lisp is a marvelous language (IMHO), although it received much scorn for being different.

To make this a trillion times easier on yourself, try making a class to represent a die, and supply functions with it (like, ROTATE-DIE direction-form) to manage all of the number shifting.

A nice handbook to keep close for any stint of Lisp hacking, the Common Lisp Coobook.

Here's the section on DEFCLASS and DEFSTRUCT: CLOS-Tutorial: Section 3.

AceKnocks · 04-07-2008, 01:50 PM

Here is something that I have thought of.. showing my abstract representation..

Now, let's say I represent a die using a list itself in the following way
(list :top 1 :right 3 :front 2 :left 4 :back 5 :down 6 :x 0 :y 0)

I can readily retrieve the value of top and right by
(getf (list :top 1 :right 3 :front 2 :left 4 :back 5 :down 6 :x 0 :y 0) :top)
(getf (list :top 1 :right 3 :front 2 :left 4 :back 5 :down 6 :x 0 :y 0) :right)

Our 6 sided die can only move to four directions (right, left, front, back) and therefore for a given number on top (let's say a 1), there
can be four different number(s) in its right (3, 2, 4, 5) and in the same way for a 2 on top, there could be (3, 4, 6, 1) on its right.

If we have the top and right position for a certain dice we already know the certain representation of the dice at that instant. For e.g.
if there's a 5 on top and a 4 on right, there can be only one distinct combination existing for the given top and right and that is
(list :top 5 :right 4 :front 6 :left 3 :back 1 :down 2)

Thus we can make a 24 x 6 sized static array, valid-die-combinations, which will have all of the valid possible die-states. i.e. 4 for each (1, 2, 3, 4, 5, 6)

The following array considers the same order
(:top :right :front :left :back :down)
starting from ((1, 3, 2, 4, 5, 6), (1, 2, 4, 5, 3, 6), (1, 4, 5, 3, 2, 6) and the last one for 1 is (1, 5, 3, 2, 4, 6)..... and so on for 2, 3, 4, 5, 6....each

We will also have to make another puzzle-space array that will represent the given puzzle in the row, column form such as
[S . . . G
. . . . .]

Where S can be retrieved using aref on puzzle-space array with the help of row and column and therefore we can determine a IN-valid "LEFT" move standing on (0, 0) position already.

Now let's start some wishful thinking for making a validate move function

Code:

(defun validate-move (die direction)
        "Make sure incrementing x by one when moving in x direction remains lesser than or equal to max-x, where max-x can be retrieved from puzzle-space array"
        (cond  ((not (eq (1+ (getf die :x)) max-x))
                "Make sure that the new x and y in puzzle space is not an "*"
                 (not (eq (aref puzzle space x y) "*"))
                 (t
                                "We are allowed to move right"))

Making a generate-move function

Code:

(defun generate-move(die direction)
       (setf vdc-top (getf die :top))
       (setf vdc-right (getf die :right))
       (setf newdie (using aref and two pointers vdc-top, vdc-right bring on the correct row, where vdc is the valid-die-combination array
and we have the information about a distinct row that has a unique combination of top and right element)

Here's the mean n mighty successor function .. which will generate the moves and return it to my search algorithm.

Code:

(defun successor (die)
        "We will be executing the same validate-move code for all four directions one by one to generate at most four next valid states to
move from the current position in the puzzle" 
        "First for right"
        (if (not (eq (validate-move die right) nil))
             "Call generate-move function and generate a single state moving
right"
                (if (not (eq (getf generate-move (die right) :top) 6))
                     (setf right-move generate-move (die right))

        "second for front" and so on..

        "At the end we will combine all generated right-move, front-move, left-move and back-move, into a list and return it as a return value
)

Please suggest me some keywords that I must use to make my life easier to implement the above structural representation. I would have surely liked the idea of going through each topic in the book one by one myself, but as I have only a day left - I cant really enjoy
that leisure.

AceKnocks · 04-07-2008, 05:59 PM

If we have following array
(setf *possible-die-combinations* (make-array '(20 6)
:initial-contents
'((1 3 2 4 5 6)
(1 2 4 5 3 6)
(1 4 5 3 2 6)
(1 5 3 2 4 6)
(2 3 6 4 1 5)
(2 6 4 1 3 5)
(2 4 1 3 6 5)
(2 1 3 6 4 5)
(3 5 6 2 1 4)
(3 6 2 1 5 4)
(3 2 1 5 6 4)
(3 1 5 6 2 4)
(4 6 5 1 2 3)
(4 5 1 2 6 3)
(4 1 2 6 5 3)
(4 2 6 5 1 3)
(5 3 1 4 6 2)
(5 1 4 6 3 2)
(5 4 6 3 1 2)
(5 6 3 1 4 2))))

If you would notice, in every row the set of first and second elements
together is unique. For e.g. the first row has (1, 3) and the second
row has (1, 2).
Now I want to retrieve a specific row based on this given combination
of first and second element. How do I do it?

indienick · 04-07-2008, 09:19 PM

Here's the first thing that popped into my head:

Code:

(defun get-set-if (set a b)
  (if (and (= (first set) a)
           (= (second set) b))
      set
      nil))

(defun get-set-if* (a b)
  (let ((x a) (y b))
    (dolist (idx *possible-die-combinations*)
      (if (and (= (first idx) x)
               (= (second idx) y))
          set nil))))

;; Call GET-SET-WHERE like so:
;; 
;; (get-set-where *possible-die-combinations* 1 3 #'=)
;;
;; I just thought of giving you this as an easily expandable option. :)
;;
(defmacro get-set-where (set a b op)
  `(dolist (idx ,set)
     (if (and (,op (first idx) a)
              (,op (second idx) b))
         ,idx nil)))

There are a billion other ways to do this (one such way that came across, involving macros).

AceKnocks · 04-07-2008, 09:29 PM

Thanks indienick. I am almost finishing my complete successor function but the thing which is troubling me is I cant list'up a global variable in a loop

Code:

(defvar *successor-states* ())

(defun give-me-next-move(die)
  (setf *successor-states* ())
  (dolist (x '(right left up down))
    (when (validate-constraints die x)
      (when (not (eq (getf (generate-move die x) :top) 6))
            (setf *successor-states* (cons *successor-states* (generate-move die x)))))))

Is there tiny little thing that I am missing here. validate-constraints function just tell me if I can move in a specific direction or not, generate-move function generates the dice state specific to an already validated move.

I have thoroughly tested the validate-constraints and generate-move functions and I am pasting the output here.

For a given die like the one below
(setq die (list :top 1 :right 3 :front 2 :left 4 :back 5 :bottom 6 :x 0 :y 0))

> (validate-constraints die 'right)
T
> (validate-constraints die 'left)
NIL

> (generate-move die 'right)
(:TOP 4 :RIGHT 1 :FRONT 2 :LEFT 6 :BACK 5 :BOTTOM 3 :X 1 :Y 0)
> (generate-move die 'down)
(:TOP 2 :RIGHT 3 :FRONT 6 :LEFT 4 :BACK 1 :BOTTOM 5 :X 0 :Y 1)

Is there anything that I am missing here with successor-states variable?

indienick · 04-07-2008, 09:37 PM

If I've understood it correctly, you're trying to append the output of *SUCCESSOR-STATES* onto the end of itself.

Declare *SUCCESSOR-STATES* as a list:

Code:

(defvar *successor-states* '())

...
(setf *successor-states* '())
...
...
...
(when ...
  (push (generate-move die x) *successor-states*))

AceKnocks · 04-07-2008, 09:59 PM

I am attaching the debug runout after adding a print statement after every critical step.

Here's the changed code

Code:

(defun successor(die)
  (print die)
  (setf *successor-states* ())
  (print *successor-states*)
  (dolist (x '(right left up down))
    (print x)
       (and (validate-constraints die x)
           (not (eq (getf (generate-move die x) :top) 6))
         (print (generate-move die x))
         (push (generate-move die x) *successor-states*)
         (print '-------------------------------------) ))))

Here's the output

Code:

> (successor die)

(:TOP 1 :RIGHT 3 :FRONT 2 :LEFT 4 :BACK 5 :BOTTOM 6 :X 0 :Y 0)
NIL
RIGHT
(:TOP 4 :RIGHT 1 :FRONT 2 :LEFT 6 :BACK 5 :BOTTOM 3 :X 1 :Y 0)
-------------------------------------
LEFT
UP
DOWN
(:TOP 2 :RIGHT 3 :FRONT 6 :LEFT 4 :BACK 1 :BOTTOM 5 :X 0 :Y 1)
-------------------------------------
NIL

I must be really doing something silly and it is hard to point out..

indienick · 04-08-2008, 07:41 AM

What you had:

Code:

(defun successor(die)
  (print die)
  (setf *successor-states* ())
  (print *successor-states*)
  (dolist (x '(right left up down))
    (print x)
       (and (validate-constraints die x)
           (not (eq (getf (generate-move die x) :top) 6))
         (print (generate-move die x))
         (push (generate-move die x) *successor-states*)
         (print '-------------------------------------) ))))

Some proposed changes:

Code:

(defun successor(die)
  (print die)
  (setf *successor-states* '())
  (print *successor-states*)
  (dolist (x '(right left up down))
    (print x)
       (and (validate-constraints die x)
           (not (= (getf (generate-move die x) :top) 6))
         (print (generate-move die x))
         (push (generate-move die x) *successor-states*)
         (print '-------------------------------------) ))))

1. EQ is for testing symbolic equality (if memory serves me correctly). For numerical comparisons, use =.

2. *SUCCESSOR-STATES* was still being set to a CONS set at the third line of the function - the SETF line.

3. For the DOLIST macro, are RIGHT LEFT UP and DOWN initialized? If you're looking to use them as symbol names, put a ' in front of the name:

Code:

...
  (dolist (x '('right 'left 'up 'down))
    ...

That's all I could see for now.

ntubski · 04-08-2008, 11:46 AM

Quote:

Originally Posted by indienick

3. For the DOLIST macro, are RIGHT LEFT UP and DOWN initialized? If you're looking to use them as symbol names, put a ' in front of the name:

Code:

...
  (dolist (x '('right 'left 'up 'down))
    ...

The original was correct:

Code:

[1]> '(up down left right)
(UP DOWN LEFT RIGHT)
[2]> '('up 'down 'left 'right)
('UP 'DOWN 'LEFT 'RIGHT)
[3]> (first '('up 'down 'left 'right))
'UP
[4]> (first (first '('up 'down 'left 'right)))
QUOTE
[5]> (second (first '('up 'down 'left 'right)))
UP
[6]> (first '(up down left right))
UP

indienick · 04-08-2008, 12:00 PM

Whoops - my mistake. Sorry.