I'm working on a sokoban solver. It is currently only brute force based,
though I plan to add some optimizations later.
I have a bug somewhere in my source that makes me move my boxes beyond a
wall, and eventually, out of the array. I then obviously get an array
out of bounds error. I've already spent several hours looking through
the source, testing small bits of it, and just can't track down the problem.
Could somone please take a look at the source? I'm fairly certain that
there's no mistake in the reader functions (get-map, map-size,
find-reachable) as I've printed out the result and compared it to the
original. The problem still arises even without the move-further
function, so it isn't there either. I just really don't know what could
be going wrong in the rest of the program. Did I miss a possibility
somewhere?
Some parts of the program aren't implemented yet, notably the function
that checks if a solution has been found - but I figured that adding
that won't make my array problem go away ;).
I'm going to use a hash table to check if I'm coming back to a position
I have already visited. However, I'd have to make a hash of a list of
the array that stores the boxes and the position of sokoban (or rather
some standard reachable square - such as the top left most reachable
square). This would mean that I'd have to use equalp - which is slower.
I was therefore wondering if it would be worthwhile to come up with a
number value that would represent this array and the sokoban location,
and use this for the hash, using eql for the hash table. Or would the
calculation of that number take more time than creating a hash for the
array?
Thanks in advance to anyone willing to read my source - any comments
would be appreciated - it's my first "real" lisp program, and there's
probably many things that I could do better differently. In particular,
if there is any more elegant way of reading in the maps in the first
place, rather than using the property list, and which functions would be
better as macros.
(defconstant +map-location+
'/Derek/Programming/Lisp/Sokoban/screens/screen.)
(defconstant +drive+ #\D)
(defun map-file (current-map)
(format nil "~C~C~S~D" +drive+ #\: +map-location+ current-map))
(defun solve-map (map-number)
"The main function that sets up all the variables and calls
rec-solve to actually solve the map."
(defun map-size ();expects map-number
"Gets the dimension of the map that is to be solved. Goes
through map line by line, remembering the longest line, and the total
number of lines."
(with-open-file (in-stream (map-file map-number) :direction :input)
(let ((max-width 0)
(width 0)
(length 0))
(do ((char-to-be-processed (read-char in-stream)
(read-char in-stream nil 'the-end)))
((not (characterp char-to-be-processed)) (list
max-width length))
(cond ((eql char-to-be-processed #\newline)
(incf length)
(if (< max-width width) (setq max-width width))
(setq width 0))
(T
(incf width)))))))
(let ((map-size (map-size))
(total-nodes 0)
(move 0)
(solution 0)
(goals+walls nil)
(boxes nil)
(soko nil))
;;the symbols for the goals+walls map - trans for
"translate this symbol into machine code" (setf (get
'g+w-trans-symbol '#\ ) 0)
(setf (get 'g+w-trans-symbol ···@) 0)
(setf (get 'g+w-trans-symbol '#\.) 1)
(setf (get 'g+w-trans-symbol '#\$) 0)
(setf (get 'g+w-trans-symbol '#\*) 1)
(setf (get 'g+w-trans-symbol '#\#) 2)
;;the symbols for the boxes map
(setf (get 'box-trans-symbol '#\ ) 0)
(setf (get 'box-trans-symbol ···@) 0)
(setf (get 'box-trans-symbol '#\.) 0)
(setf (get 'box-trans-symbol '#\$) 1)
(setf (get 'box-trans-symbol '#\*) 1)
(setf (get 'box-trans-symbol '#\#) 0)
(defun get-map ();expects map-size and
map-number
"Reads the map from file and returns an array containing the
walls (as 2s), the goals (as 1s) and empty space (as 0s);
Also returns an array containing all the boxes (as 1s), and
a list of the location of the sokoban."
(with-open-file (in-stream (map-file map-number) :direction
:input)
(let ( (goals+walls (make-array map-size
:element-type '(mod 3)))
(boxes (make-array map-size
:element-type '(mod 2)))
(soko nil)
(x 0)
(y 0))
(do ((current-char (read-char in-stream) (read-char
in-stream nil 'the-end)))
((not (characterp current-char)) (values
goals+walls boxes soko))
(cond ((eql current-char #\newline)
(incf y)
(setq x 0))
(T (setf
(aref goals+walls x y) (get 'g+w-trans-symbol current-char))
(setf (aref boxes x y) (get
'box-trans-symbol current-char))
(if (eql current-char ··@) (setq soko
(list x y)))
(incf x)))))))
(multiple-value-setq (goals+walls boxes soko) (get-map))
(defun make-loc-hash ()
"Makes a hash table containing all the open spaces on the map.
Can be used later in order to make the algorithm more
efficient by storing data in an array containing only the open spaces
- not the walls or space outside of the reach of the
sokoban. It isn't yet being used."
(let ((loc-hash (make-hash-table :test #'equal))
(stack (list soko)))
(defun push-os (x y)
"Used to push this location onto the stack of
locations that should be given a hash entry."
(if (not (or (= (aref goals+walls x y) 2) (gethash
(list x y) loc-hash)))
(push (list x y) stack)))
(do ((current-loc soko (car stack))
(count 0 (1+ count)))
((null current-loc) loc-hash)
(pop stack)
(setf (gethash (list (car current-loc) (cadr
current-loc)) loc-hash) count)
(push-os (car current-loc) (1- (cadr current-loc)))
(push-os (car current-loc) (1+ (cadr current-loc)))
(push-os (1- (car current-loc)) (cadr current-loc))
(push-os (1+ (car current-loc)) (cadr current-loc)))))
(defvar loc-hash (make-loc-hash)
"A hash of all spaces that could potentially be reached by
the sokoban, ie excluding walls, in the notation of (x y).")
(defvar past-loc (make-hash-table :test #'equalp)
"Another hash table not currently being used - will be used
in futur to remember posititions that have already been visited.")
(defun rec-solver (boxes soko); expects map-size,
goals+walls, loc-hash
"The actual recursive array that goes through all the
possible locations."
(defun find-reachable ();needs map-size, soko, goals+walls,
boxes
"Returns an array containing all the locations that the
sokoban can reach,
taking into account boxes that stop his path. Reachable
locations are noted with a 1."
(let ((reachable (make-array map-size :element-type
'(mod 2)))
(stack (list soko)))
(defun declare-reachable (x y)
"Oficially declare a location as reachable by
sokoban
- and stick on stack as a location who's
neighboors should be checked for reachability."
(setf (aref reachable x y) 1)
(push (list x y) stack))
(defun push-os (x y)
"If there is no box or wall at this location,
and it isn't reachable yet,
call declare-reachable to make it such, and to
push it onto the stack."
(if (and (= (aref reachable x y) 0) (< (aref
goals+walls x y) 2) (= (aref boxes x y) 0))
(declare-reachable x y)))
(setf (aref reachable (car soko) (cadr soko)) 1)
;set location of soko to reachable
(do ((current-loc soko (car stack)))
((null current-loc) reachable)
(pop stack)
(push-os (car current-loc) (1- (cadr current-loc)))
(push-os (car current-loc) (1+ (cadr current-loc)))
(push-os (1- (car current-loc)) (cadr current-loc))
(push-os (1+ (car current-loc)) (cadr
current-loc)))))
(let ((reachable (find-reachable)))
(incf total-nodes)
(defun is-reachable (x y); expects reachable
"Check if this location is reachable; return T if it
is."
(if (= 1 (aref reachable x y)) T nil))
(defun is-free (x y);expects goals+wall
and boxes
"Check if this location contains no box or wall.
Should probably be made into a macro."
(if (or (= 2 (aref goals+walls x y))
(= 1 (aref boxes x y)))
nil
T))
(defun attempt-move (x Y)
"Try to move the box located at square x y."
(print 'attempt-move)
(defun is-movable (d-x
d-y);expects x and y
"Checks for horizontal or vertical mobility,
depending on if it is with 1 0 or 0 1 - these
denoting the direction into which we want to move.
Should probably be turned into a macro."
(print 'is-movable)
(if (and (is-free (+ x d-x) (+ y d-y))
(is-free (- x d-x) (- y d-y)))
T
nil))
(defun move-further (to-x to-y d-x
d-y); d for delta
"Recursive function that is told to move to
(to-x to-y)
and will recursively check if it can move one
further into direction (d-x d-y)."
(print 'move-further)
(print map-size)
(print (list to-x to-y))
(if (is-free (+ to-x d-x) (+ to-y d-y)) ;don't
forget that the orig. positions are the ones where the box currently is,
and that it WILL go to orig + delta.
(move-further (+ to-x d-x) (+ to-y d-y) d-x
d-y));We just want to see if it could go one further.
(print 'before-move)
(move (+ to-x) (+ to-y)))
(defun move-further (new-x
new-y);expects x and y - the current position of the box to move
"Actually move the box, and call rec-solver with
the new values of boxes."
(print 'move)
(let* ((linearization-array (make-array (* (car
map-size) (cadr map-size)) :displaced-to boxes));some fancy computation
in order to be able to
(linear-copied-array (copy-seq
linearization-array));get a true copy of the boxes array that is not a
pointer
(new-boxes (make-array map-size
:displaced-to linear-copied-array)));to the orginal
(setf (aref new-boxes x y) 0)
(setf (aref new-boxes new-x new-y) 1)
(rec-solver new-boxes (list x y))));soko,
after this move, takes the spot of the box
(if (is-movable 1 0)
(if (is-reachable (1+ x) y) (move-further (1- x)
y -1 0));because move-further is recursive,
(if (is-reachable (1- x) y) (move-further (1+ x)
y 1 0)));it cannot be written without the explicit x and y parameters
(if (is-movable 0 1)
(if (is-reachable x (1+ y)) (move-further x (1-
y) 0 -1));if soko can reach one side, the box
(if (is-reachable x (1- y)) (move-further x (1+
y) 0 1))));will obviously be pushed towards the other side
(dotimes (y
(cadr map-size))
(dotimes (x (car map-size))
(if (= (aref boxes x y) 1)
(attempt-move x y))))))
(rec-solver boxes soko)))
(solve-map 11)
and an example map (from x-sokoban).
#####
# #
#$ #
### $##
# $ $ #
### # ## # ######
# # ## ##### ..#
# $ $ ..#
##### ### ·@## ..#
# #########
#######
In article <·····················@news20.bellglobal.com>,
Derek Hans <·········@gmx.net> wrote:
>I'm working on a sokoban solver. It is currently only brute force based,
>though I plan to add some optimizations later.
>I have a bug somewhere in my source that makes me move my boxes beyond a
>wall, and eventually, out of the array. I then obviously get an array
>out of bounds error. I've already spent several hours looking through
>the source, testing small bits of it, and just can't track down the problem.
>Could somone please take a look at the source? I'm fairly certain that
>there's no mistake in the reader functions (get-map, map-size,
>find-reachable) as I've printed out the result and compared it to the
>original. The problem still arises even without the move-further
>function, so it isn't there either. I just really don't know what could
>be going wrong in the rest of the program. Did I miss a possibility
>somewhere?
I don't know Sokoban, and I can't really tell what your program is doing.
But I have a major style comment.
You shouldn't be defining functions and variables within the main function
with DEFUN and DEFVAR. These are normally for defining top-level functions
and variables. Local functions should be defined with FLET or LABELS, and
local variables with LET. To make your code easier to read, I suggest you
pull those internal functions *out* and make them standalone functions (so
you'll have to pass in parameters rather than accessing the containing
function's local variables).
This should make it easier to debug your problem. You use a divide and
conquer approach: test each component separately until you find the one
that's failing.
--
Barry Margolin, ··············@level3.com
Genuity Managed Services, a Level(3) Company, Woburn, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.
Please DON'T copy followups to me -- I'll assume it wasn't posted to the group.
> I don't know Sokoban, and I can't really tell what your program is doing.
> But I have a major style comment.
>
Sorry - though everyone knows sokoban - here's an online version.
http://www.pimpernel.com/sokoban/sokoban.html
The point of the game is - you're in a room full of boxes/walls, and you
have to push all the boxes onto goal positions. No pulling is allowed.
> You shouldn't be defining functions and variables within the main function
> with DEFUN and DEFVAR. These are normally for defining top-level functions
> and variables. Local functions should be defined with FLET or LABELS, and
> local variables with LET. To make your code easier to read, I suggest you
> pull those internal functions *out* and make them standalone functions (so
> you'll have to pass in parameters rather than accessing the containing
> function's local variables).
>
Hm - didn't realize that functions could be declared in a different
manner than defun. Thanks!
> This should make it easier to debug your problem. You use a divide and
> conquer approach: test each component separately until you find the one
> that's failing.
>
That's actually how I wrote the first few functions. However, as I
expect the program to recurse to at least 1000 nodes deep, maybe more, I
figured that efficient use of memory is really important, and didn't
want to have a seperate copy of variables that I don't expect to change
for each node. That is why I wrote the rest of the code as functions
within functions. As I might call the top function several times (once
for each map I want to solve), I can't declare these as constants either.
I think I might rewrite the functions for debugging purposes as seperate
one from the other. I'll see how it runs like that, and reintegrate the
functions later if necessary ;)
In article <·····················@news20.bellglobal.com>,
Derek Hans <·········@gmx.net> wrote:
>> This should make it easier to debug your problem. You use a divide and
>> conquer approach: test each component separately until you find the one
>> that's failing.
>>
>
>That's actually how I wrote the first few functions. However, as I
>expect the program to recurse to at least 1000 nodes deep, maybe more, I
>figured that efficient use of memory is really important, and didn't
>want to have a seperate copy of variables that I don't expect to change
>for each node.
Lisp doesn't make copies when you pass arguments. You're passing a
reference to the same object.
--
Barry Margolin, ··············@level3.com
Genuity Managed Services, a Level(3) Company, Woburn, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.
Please DON'T copy followups to me -- I'll assume it wasn't posted to the group.
>
> Lisp doesn't make copies when you pass arguments. You're passing a
> reference to the same object.
>
(setq a 10)
=> 10
(defun go (x)
(setq x (- x 5))
(print x))
=> GO
(go a)
=>5 5
a
=>10
If you're passing a reference in go, how come changing x in go doesn't
affect a then? Doesn't lisp have to create the space necessary for x,
and copy the value of a to it in order to be able to work with it?
In article <·····················@news20.bellglobal.com>,
Derek Hans <·········@gmx.net> wrote:
>
>>
>> Lisp doesn't make copies when you pass arguments. You're passing a
>> reference to the same object.
>>
>
>
>(setq a 10)
>=> 10
>
>(defun go (x)
> (setq x (- x 5))
> (print x))
>=> GO
>
>(go a)
>=>5 5
>
>a
>=>10
>
>
>If you're passing a reference in go, how come changing x in go doesn't
>affect a then? Doesn't lisp have to create the space necessary for x,
>and copy the value of a to it in order to be able to work with it?
Because the assignment changes what the local variable X refers to.
(defvar *variable* (list 1 2))
(defun go (x)
(setf (car x) 3)
(setf x (list 10 11))
(print x)
nil)
(go *variable)
prints: (10 11)
(print *variable*)
prints: (3 2)
--
Barry Margolin, ··············@level3.com
Genuity Managed Services, a Level(3) Company, Woburn, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.
Please DON'T copy followups to me -- I'll assume it wasn't posted to the group.
>
> Because the assignment changes what the local variable X refers to.
>
> (defvar *variable* (list 1 2))
>
> (defun go (x)
> (setf (car x) 3)
> (setf x (list 10 11))
> (print x)
> nil)
>
> (go *variable)
> prints: (10 11)
> (print *variable*)
> prints: (3 2)
>
Oh, thanks! That would explain some problems I had previously :)
Derek Hans wrote:
>> Lisp doesn't make copies when you pass arguments. You're passing a
>> reference to the same object.
>>
>
>
> (setq a 10)
>=> 10
>
> (defun go (x)
> (setq x (- x 5))
Incidentally, this can be written as:
(decf x 5)
> (print x))
>=> GO
Which Lisp implementation allowed you to define a function called GO ?
> (go a)
>=>5 5
>
> a
>=>10
>
>
> If you're passing a reference in go, how come changing x in go doesn't
> affect a then?
Lisp's parameter passing is more like Java's than C's. Passing a
parameter to a function establishes a new binding between the
parameter name and the value passed in the argument list. The binding
can be modified, as you've done above with SETQ, and the value
(object) itself can be changed if it's mutable. No copy of the value
is made, though:
> (defun change-car (list value)
(setf (car list) value))
CHANGE-CAR
> (defvar some-list (list 1 2 3 4 5))
SOME-LIST
> some-list
(1 2 3 4 5)
> (change-car some-list "one")
"one"
> some-list
("one" 2 3 4 5)
If a copy of the list was passed then the changes made inside the
function would not be visible to the caller.
> Doesn't lisp have to create the space necessary for x,
> and copy the value of a to it in order to be able to work with it?
No.
Jeremy.
> Which Lisp implementation allowed you to define a function called GO ?
>
>
Now that I think of it, indeed, it wasn't a very good idea to use go as
an example. Though aren't you officially aloud to redifine functions
that are part of the standard? I thought it could be done, just that it
is not "a good thing". Besides, it's not good programming practice to
use go anyhow, right? ;)
I'm using the Corman IDE/compiler. I'm quite happy with it, and the fact
that I don't yet have to learn to know allegro's interface, though I'll
eventually get there...
I rewrote the code, splitting it up into seperate functions with many
parameters each and added some testing functions. I still get the same
error (array out of bounds), and the testing functions don't tell me
anything more. Somehow, I'm moving boxes into locations that contain walls.
(defconstant +map-location+
'/Derek/Programming/Lisp/Sokoban/screens/screen.)
(defconstant +drive+ #\D)
(defun map-file (current-map)
(format nil "~C~C~S~D" +drive+ #\: +map-location+ current-map))
(defvar map-number 1)
(defvar map-size nil)
(defvar total-nodes 0)
(defvar move 0)
(defvar solution 0)
(defvar goals+walls nil)
(defvar boxes nil)
(defvar soko nil)
(defvar reachable nil)
(defun map-size (map-number);expects map-number
"Gets the dimension of the map that is to be solved.
Goes through map line by line, remembering the longest line,
and the total number of lines."
(with-open-file (in-stream (map-file map-number) :direction :input)
(let ((max-width 0)
(width 0)
(length 0))
(do ((char-to-be-processed (read-char in-stream) (read-char
in-stream nil 'the-end)))
((not (characterp char-to-be-processed)) (list
max-width length))
(cond ((eql char-to-be-processed #\newline)
(incf length)
(if (< max-width width) (setq max-width width))
(setq width 0))
(T
(incf width)))))))
(map-size 10)
;;the symbols for the goals+walls map
;;trans for "translate this symbol into machine code"
(setf (get 'g+w-trans-symbol '#\ ) 0)
(setf (get 'g+w-trans-symbol ···@) 0)
(setf (get 'g+w-trans-symbol '#\.) 1)
(setf (get 'g+w-trans-symbol '#\$) 0)
(setf (get 'g+w-trans-symbol '#\*) 1)
(setf (get 'g+w-trans-symbol '#\#) 2)
;;the symbols for the boxes map
(setf (get 'box-trans-symbol '#\ ) 0)
(setf (get 'box-trans-symbol ···@) 0)
(setf (get 'box-trans-symbol '#\.) 0)
(setf (get 'box-trans-symbol '#\$) 1)
(setf (get 'box-trans-symbol '#\*) 1)
(setf (get 'box-trans-symbol '#\#) 0)
(defun get-map (map-size map-number);expects map-size and map-number
"Reads the map from file and returns an array containing the walls
(as 2s),
the goals (as 1s) and empty space (as 0s);
Also returns an array containing all the boxes (as 1s), and a list
of the location of the sokoban."
(with-open-file (in-stream (map-file map-number) :direction :input)
(let ( (goals+walls (make-array map-size :element-type
'(mod 3) :initial-element 0))
(boxes (make-array map-size :element-type
'(mod 2) :initial-element 0))
(soko nil)
(x 0)
(y 0))
(do ((current-char (read-char in-stream) (read-char
in-stream nil 'the-end)))
((not (characterp current-char)) (values goals+walls
boxes soko))
(cond ((eql current-char #\newline)
(incf y)
(setq x 0))
(T
(setf (aref goals+walls x y) (get
'g+w-trans-symbol current-char))
(setf (aref boxes x y) (get 'box-trans-symbol
current-char))
(if (eql current-char ··@) (setq soko (list x y)))
(incf x)))))))
(defun make-loc-hash (goals+walls boxes soko)
"Makes a hash table containing all the open spaces on the map.
Can be used later in order to make the algorithm more efficient
by storing data in an array containing only the open spaces
- not the walls or space outside of the reach of the sokoban. It
isn't yet being used."
(let ((loc-hash (make-hash-table :test #'equal))
(stack (list soko)))
(flet ((push-os (x y)
(if (not (or (= (aref goals+walls x y) 2) (gethash
(list x y) loc-hash)))
(push (list x y) stack))))
(do ((current-loc soko (car stack))
(count 0 (1+ count)))
((null current-loc) loc-hash)
(pop stack)
(setf (gethash (list (car current-loc) (cadr
current-loc)) loc-hash) count)
(push-os (car current-loc) (1- (cadr current-loc)))
(push-os (car current-loc) (1+ (cadr current-loc)))
(push-os (1- (car current-loc)) (cadr current-loc))
(push-os (1+ (car current-loc)) (cadr current-loc))))))
(defun find-reachable (map-size goals+walls boxes soko);needs map-size,
soko, goals+walls, boxes
"Returns an array containing all the locations that the sokoban can
reach,
taking into account boxes that stop his path. Reachable locations
are noted with a 1."
(let ((reachable (make-array map-size :element-type '(mod 2)))
(stack (list soko)))
(labels ((declare-reachable (x y)
(setf (aref reachable x y) 1)
(push (list x y) stack))
(push-os (x y)
(if (and (= (aref reachable x y) 0) (< (aref
goals+walls x y) 2) (= (aref boxes x y) 0))
(declare-reachable x y))))
(setf (aref reachable (car soko) (cadr soko)) 1) ;set
location of soko to reachable
(do ((current-loc soko (car stack)))
((null current-loc) reachable)
(pop stack)
(push-os (car current-loc) (1- (cadr current-loc)))
(push-os (car current-loc) (1+ (cadr current-loc)))
(push-os (1- (car current-loc)) (cadr current-loc))
(push-os (1+ (car current-loc)) (cadr current-loc))))))
(defun is-reachable (x y reachable); expects reachable
"Check if this location is reachable; return T if it is."
(if (= 1 (aref reachable x y)) T nil))
(defun is-free (x y goals+walls boxes);expects goals+walls and boxes
"Check if this location contains no box or wall. Should probably be
made into a macro."
(if (or (= 2 (aref goals+walls x y))
(= 1 (aref boxes x y)))
nil
T))
(defun is-movable (x y d-x d-y goals+walls boxes);expects x and y
"Checks for horizontal or vertical mobility,
depending on if it is with 1 0 or 0 1 - these denoting the
direction into which we want to move.
Should probably be turned into a macro."
(if (and (is-free (+ x d-x) (+ y d-y) goals+walls boxes)
(is-free (- x d-x) (- y d-y) goals+walls boxes))
T
nil))
(defun move (boxes x y new-x new-y);expects x and y - the current
position of the box to move
"Actually move the box, and call rec-solver with the new values of
boxes."
(let* ((linearization-array (make-array (* (car map-size) (cadr
map-size)) :displaced-to boxes))
(linear-copied-array (copy-seq linearization-array))
(new-boxes (make-array map-size :displaced-to
linear-copied-array)))
(setf (aref new-boxes x y) 0)
(setf (aref new-boxes new-x new-y) 1)
(rec-solver map-size goals+walls new-boxes (list x y))));soko,
after this move, takes the spot of the box
(defun move-further (goals+walls boxes soko to-x to-y d-x d-y); d for delta
"Recursive function that is told to move to (to-x to-y)
and will recursively check if it can move one further into
direction (d-x d-y)."
(if (is-free (+ to-x d-x) (+ to-y d-y) goals+walls boxes)
(move-further goals+walls boxes soko (+ to-x d-x) (+ to-y d-y)
d-x d-y))
(move boxes to-x to-y (+ to-x) (+ to-y)))
(defun attempt-move (goals+walls boxes soko reachable x Y)
"Try to move the box located at square x y."
(if (is-movable x y 1 0 goals+walls boxes)
(if (is-reachable (1+ x) y reachable) (move-further goals+walls
boxes soko (1- x) y -1 0))
(if (is-reachable (1- x) y reachable) (move-further goals+walls
boxes soko (1+ x) y 1 0)))
(if (is-movable x y 0 1 goals+walls boxes)
(if (is-reachable x (1+ y) reachable) (move-further goals+walls
boxes soko x (1- y) 0 -1))
(if (is-reachable x (1- y) reachable) (move-further goals+walls
boxes soko x (1+ y) 0 1))))
(defun rec-solver (map-size goals+walls boxes soko); expects map-size,
goals+walls, loc-hash
"The actual recursive array that goes through all the possible
locations."
(let ((reachable (find-reachable map-size goals+walls boxes soko)))
(incf total-nodes)
(dotimes (y (cadr map-size))
(dotimes (x (car map-size))
(if (= (aref boxes x y) 1)
(attempt-move goals+walls boxes soko reachable x
y))))))
(defun print-orig-map (map-number map-size);expects map-size
(with-open-file (in-stream (map-file map-number) :direction :input)
(do ((char-to-be-processed (read-char in-stream) (read-char
in-stream nil 'the-end)))
((not (characterp char-to-be-processed)) )
(write-char char-to-be-processed))))
(defun print-map (map-size map);expects map-size
(dotimes (y (cadr map-size))
(dotimes (x (car map-size))
(if (< 0 (aref map x Y))
(write (aref map x y))
(write-char #\ )))
(write-char #\newline)))
(multiple-value-setq (goals+walls boxes soko) (get-map (map-size 1) 1))
(rec-solver (map-size 1) goals+walls boxes soko)
(setq reachable (find-reachable (map-size 1) goals+walls boxes soko))
(print-map (map-size 1) boxes)
(print-map (map-size 1) goals+walls)
(print-map (map-size 1) reachable)
(is-reachable 7 8 reachable)
(is-reachable 6 7 reachable)
(is-free 6 7 goals+walls boxes)
(is-movable 1 5 0 1 goals+walls boxes)
(is-movable 1 5 1 0 goals+walls boxes)
From: Kenny Tilton
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <3EB1AE79.6010103@nyc.rr.com>
Derek Hans wrote:
> (defun move-further (goals+walls boxes soko to-x to-y d-x d-y); d for delta
> "Recursive function that is told to move to (to-x to-y)
> and will recursively check if it can move one further into direction
> (d-x d-y)."
> (if (is-free (+ to-x d-x) (+ to-y d-y) goals+walls boxes)
> (move-further goals+walls boxes soko (+ to-x d-x) (+ to-y d-y)
> d-x d-y))
> (move boxes to-x to-y (+ to-x) (+ to-y)))
(+ to-x) => to-x, so move won't, well, move.
>
> (defun attempt-move (goals+walls boxes soko reachable x Y)
> "Try to move the box located at square x y."
> (if (is-movable x y 1 0 goals+walls boxes)
> (if (is-reachable (1+ x) y reachable) (move-further goals+walls
> boxes soko (1- x) y -1 0))
> (if (is-reachable (1- x) y reachable) (move-further goals+walls
> boxes soko (1+ x) y 1 0)))
> (if (is-movable x y 0 1 goals+walls boxes)
> (if (is-reachable x (1+ y) reachable) (move-further goals+walls
> boxes soko x (1- y) 0 -1))
> (if (is-reachable x (1- y) reachable) (move-further goals+walls
> boxes soko x (1+ y) 0 1))))
So you really want attempt-move to move both vertically and horizontally
in one go if possible? btw, i really cannot follow this stuff, but i
notice that it /seems/ to say in a few places something like:
if (is-reachable (1+ x)...) (move-further... (1- x)...)
Is that right?
Did you try a trivial example, or are you still running against the
level-1 game?
--
kenny tilton
clinisys, inc
http://www.tilton-technology.com/
---------------------------------------------------------------
"Everything is a cell." -- Alan Kay
Kenny Tilton wrote:
>
>
> Derek Hans wrote:
>
>> (defun move-further (goals+walls boxes soko to-x to-y d-x d-y); d for
>> delta
>> "Recursive function that is told to move to (to-x to-y)
>> and will recursively check if it can move one further into
>> direction (d-x d-y)."
>> (if (is-free (+ to-x d-x) (+ to-y d-y) goals+walls boxes)
>> (move-further goals+walls boxes soko (+ to-x d-x) (+ to-y d-y)
>> d-x d-y))
>> (move boxes to-x to-y (+ to-x) (+ to-y)))
>
>
> (+ to-x) => to-x, so move won't, well, move.
>
That was a mistake while taking out nested defun's. I now completely
took out the move-further function (which should have be an
optimisztion), and it works!!! :) Well, at least, the cpu is doing
something, and I don't get any errors. ;)
I guess now I have to figure out a way to actually report results...
Thanks for all the help!
>>
>> (defun attempt-move (goals+walls boxes soko reachable x Y)
>> "Try to move the box located at square x y."
>> (if (is-movable x y 1 0 goals+walls boxes)
>> (if (is-reachable (1+ x) y reachable) (move-further
>> goals+walls boxes soko (1- x) y -1 0))
>> (if (is-reachable (1- x) y reachable) (move-further
>> goals+walls boxes soko (1+ x) y 1 0)))
>> (if (is-movable x y 0 1 goals+walls boxes)
>> (if (is-reachable x (1+ y) reachable) (move-further
>> goals+walls boxes soko x (1- y) 0 -1))
>> (if (is-reachable x (1- y) reachable) (move-further
>> goals+walls boxes soko x (1+ y) 0 1))))
>
>
> So you really want attempt-move to move both vertically and horizontally
> in one go if possible?
Well, the way I was thinking was that the last two arguments decide in
what direction it moves - if it's 1 0, it moves to the right by one
spot, 0 1 up one, -1 0 to the left, and 0 -1 down. Indeed, if I'd give
it the arguments 1 1, it would try moving vertically ;)
Indeed not the clearest way of writing this.
btw, i really cannot follow this stuff, but i
> notice that it /seems/ to say in a few places something like:
>
> if (is-reachable (1+ x)...) (move-further... (1- x)...)
>
> Is that right?
>
Yes, that's right. If the sokoban can reach the spot to the right of the
crate that is to be moved, he will push it to the left.
Well, at least, the cpu is doing
> something, and I don't get any errors. ;)
> I guess now I have to figure out a way to actually report results...
Urg! No, I still get an error, only after a lot more time!
>>>
>>> (defun attempt-move (goals+walls boxes soko reachable x Y)
>>> "Try to move the box located at square x y."
>>> (if (is-movable x y 1 0 goals+walls boxes)
>>> (if (is-reachable (1+ x) y reachable) (move-further
>>> goals+walls boxes soko (1- x) y -1 0))
>>> (if (is-reachable (1- x) y reachable) (move-further
>>> goals+walls boxes soko (1+ x) y 1 0)))
>>> (if (is-movable x y 0 1 goals+walls boxes)
>>> (if (is-reachable x (1+ y) reachable) (move-further
>>> goals+walls boxes soko x (1- y) 0 -1))
>>> (if (is-reachable x (1- y) reachable) (move-further
>>> goals+walls boxes soko x (1+ y) 0 1))))
>>
>>
>>
Arg! I misused if! I should have been using cond - I wanted to say "if
movable horizontally, then try to move to the right AND to the left".
Here I'm saying "if movable, move to the right. Otherwise, move to the
left!!!!!
Yes, now I can start optimising - I'm getting a stack overflow ;)
Derek Hans wrote:
> Yes, now I can start optimising - I'm getting a stack overflow ;)
Hardly surprising, since you have a bottomless recursion.
Remember the old joke about a machine so fast that it
can execute an infinite loop in just 2 seconds? :-)
--
Gareth McCaughan ················@pobox.com
.sig under construc
Gareth McCaughan wrote:
> Derek Hans wrote:
>
>
>>Yes, now I can start optimising - I'm getting a stack overflow ;)
>
>
> Hardly surprising, since you have a bottomless recursion.
> Remember the old joke about a machine so fast that it
> can execute an infinite loop in just 2 seconds? :-)
>
No, actually it should exit a search branch once no more boxes can move
- though that are still way too many search branches...
Derek Hans wrote:
> >>Yes, now I can start optimising - I'm getting a stack overflow ;)
> >
> > Hardly surprising, since you have a bottomless recursion.
> > Remember the old joke about a machine so fast that it
> > can execute an infinite loop in just 2 seconds? :-)
> >
> No, actually it should exit a search branch once no more boxes can move
> - though that are still way too many search branches...
Yes, it will leave a branch when no boxes can move,
but not all branches end that way. Just like the
following function is a bottomless recursion even
though some of its branches terminate.
(defun f (n)
(if (zerop n) 1
(+ (f (- n 1))
(f (- n 2)))))
--
Gareth McCaughan ················@pobox.com
.sig under construc
Kenny Tilton wrote:
[Derek Hans's code:]
> > (defun attempt-move (goals+walls boxes soko reachable x Y)
> > "Try to move the box located at square x y."
> > (if (is-movable x y 1 0 goals+walls boxes)
> > (if (is-reachable (1+ x) y reachable) (move-further goals+walls
> > boxes soko (1- x) y -1 0))
> > (if (is-reachable (1- x) y reachable) (move-further goals+walls
> > boxes soko (1+ x) y 1 0)))
> > (if (is-movable x y 0 1 goals+walls boxes)
> > (if (is-reachable x (1+ y) reachable) (move-further goals+walls
> > boxes soko x (1- y) 0 -1))
> > (if (is-reachable x (1- y) reachable) (move-further goals+walls
> > boxes soko x (1+ y) 0 1))))
[Kenny:]
> So you really want attempt-move to move both vertically and horizontally
> in one go if possible? btw, i really cannot follow this stuff, but i
> notice that it /seems/ to say in a few places something like:
>
> if (is-reachable (1+ x)...) (move-further... (1- x)...)
>
> Is that right?
Yes, it is. If the little man can get to one side of
the box, then he can push it away from where he is.
--
Gareth McCaughan ················@pobox.com
.sig under construc
From: Kenny Tilton
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <3EB17F4C.1030908@nyc.rr.com>
I'm gonna look at the code a little just out of curiosity, and this will
not explain the coding error, but shouldn't the screen be:
#####
# #
#$ #
### $##
# $ $ #
### # ## # ######
# # ## ##### ..#
# $ $ ..#
##### ### ·@## ..#
# #########
#######
Your version has a few rows shifted left one character.
kt
Derek Hans wrote:
> I'm working on a sokoban solver. It is currently only brute force based,
> though I plan to add some optimizations later.
> I have a bug somewhere in my source that makes me move my boxes beyond a
> wall, and eventually, out of the array. I then obviously get an array
> out of bounds error. I've already spent several hours looking through
> the source, testing small bits of it, and just can't track down the
> problem.
> Could somone please take a look at the source? I'm fairly certain that
> there's no mistake in the reader functions (get-map, map-size,
> find-reachable) as I've printed out the result and compared it to the
> original. The problem still arises even without the move-further
> function, so it isn't there either. I just really don't know what could
> be going wrong in the rest of the program. Did I miss a possibility
> somewhere?
>
> Some parts of the program aren't implemented yet, notably the function
> that checks if a solution has been found - but I figured that adding
> that won't make my array problem go away ;).
>
> I'm going to use a hash table to check if I'm coming back to a position
> I have already visited. However, I'd have to make a hash of a list of
> the array that stores the boxes and the position of sokoban (or rather
> some standard reachable square - such as the top left most reachable
> square). This would mean that I'd have to use equalp - which is slower.
> I was therefore wondering if it would be worthwhile to come up with a
> number value that would represent this array and the sokoban location,
> and use this for the hash, using eql for the hash table. Or would the
> calculation of that number take more time than creating a hash for the
> array?
>
> Thanks in advance to anyone willing to read my source - any comments
> would be appreciated - it's my first "real" lisp program, and there's
> probably many things that I could do better differently. In particular,
> if there is any more elegant way of reading in the maps in the first
> place, rather than using the property list, and which functions would be
> better as macros.
>
>
>
>
> (defconstant +map-location+
> '/Derek/Programming/Lisp/Sokoban/screens/screen.)
> (defconstant +drive+ #\D)
> (defun map-file (current-map)
> (format nil "~C~C~S~D" +drive+ #\: +map-location+ current-map))
>
> (defun solve-map (map-number)
> "The main function that sets up all the variables and calls rec-solve
> to actually solve the map."
> (defun map-size ();expects map-number
> "Gets the dimension of the map that is to be solved. Goes through
> map line by line, remembering the longest line, and the total number of
> lines."
> (with-open-file (in-stream (map-file map-number) :direction :input)
> (let ((max-width 0)
> (width 0)
> (length 0))
> (do ((char-to-be-processed (read-char in-stream)
> (read-char in-stream nil 'the-end)))
> ((not (characterp char-to-be-processed)) (list
> max-width length))
> (cond ((eql char-to-be-processed #\newline)
> (incf length)
> (if (< max-width width) (setq max-width width))
> (setq width 0))
> (T
> (incf width)))))))
> (let ((map-size (map-size))
> (total-nodes 0)
> (move 0)
> (solution 0)
> (goals+walls nil)
> (boxes nil)
> (soko nil))
> ;;the symbols for the goals+walls map - trans for
> "translate this symbol into machine code" (setf (get
> 'g+w-trans-symbol '#\ ) 0)
> (setf (get 'g+w-trans-symbol ···@) 0)
> (setf (get 'g+w-trans-symbol '#\.) 1)
> (setf (get 'g+w-trans-symbol '#\$) 0)
> (setf (get 'g+w-trans-symbol '#\*) 1)
> (setf (get 'g+w-trans-symbol '#\#) 2)
> ;;the symbols for the boxes map
> (setf (get 'box-trans-symbol '#\ ) 0)
> (setf (get 'box-trans-symbol ···@) 0)
> (setf (get 'box-trans-symbol '#\.) 0)
> (setf (get 'box-trans-symbol '#\$) 1)
> (setf (get 'box-trans-symbol '#\*) 1)
> (setf (get 'box-trans-symbol '#\#) 0)
> (defun get-map ();expects map-size and
> map-number
> "Reads the map from file and returns an array containing the
> walls (as 2s), the goals (as 1s) and empty space (as 0s);
> Also returns an array containing all the boxes (as 1s), and a
> list of the location of the sokoban."
> (with-open-file (in-stream (map-file map-number) :direction
> :input)
> (let ( (goals+walls (make-array map-size
> :element-type '(mod 3)))
> (boxes (make-array map-size
> :element-type '(mod 2)))
> (soko nil)
> (x 0)
> (y 0))
> (do ((current-char (read-char in-stream) (read-char
> in-stream nil 'the-end)))
> ((not (characterp current-char)) (values
> goals+walls boxes soko))
> (cond ((eql current-char #\newline)
> (incf y)
> (setq x 0))
> (T (setf (aref
> goals+walls x y) (get 'g+w-trans-symbol current-char))
> (setf (aref boxes x y) (get
> 'box-trans-symbol current-char))
> (if (eql current-char ··@) (setq soko
> (list x y)))
> (incf x)))))))
> (multiple-value-setq (goals+walls boxes soko) (get-map))
> (defun make-loc-hash ()
> "Makes a hash table containing all the open spaces on the map.
> Can be used later in order to make the algorithm more
> efficient by storing data in an array containing only the open spaces
> - not the walls or space outside of the reach of the sokoban.
> It isn't yet being used."
> (let ((loc-hash (make-hash-table :test #'equal))
> (stack (list soko)))
> (defun push-os (x y)
> "Used to push this location onto the stack of
> locations that should be given a hash entry."
> (if (not (or (= (aref goals+walls x y) 2) (gethash
> (list x y) loc-hash)))
> (push (list x y) stack)))
> (do ((current-loc soko (car stack))
> (count 0 (1+ count)))
> ((null current-loc) loc-hash)
> (pop stack)
> (setf (gethash (list (car current-loc) (cadr
> current-loc)) loc-hash) count)
> (push-os (car current-loc) (1- (cadr current-loc)))
> (push-os (car current-loc) (1+ (cadr current-loc)))
> (push-os (1- (car current-loc)) (cadr current-loc))
> (push-os (1+ (car current-loc)) (cadr current-loc)))))
> (defvar loc-hash (make-loc-hash)
> "A hash of all spaces that could potentially be reached by
> the sokoban, ie excluding walls, in the notation of (x y).")
> (defvar past-loc (make-hash-table :test #'equalp)
> "Another hash table not currently being used - will be used
> in futur to remember posititions that have already been visited.")
> (defun rec-solver (boxes soko); expects map-size,
> goals+walls, loc-hash
> "The actual recursive array that goes through all the
> possible locations."
>
> (defun find-reachable ();needs map-size, soko, goals+walls,
> boxes
> "Returns an array containing all the locations that the
> sokoban can reach,
> taking into account boxes that stop his path. Reachable
> locations are noted with a 1."
> (let ((reachable (make-array map-size :element-type '(mod
> 2)))
> (stack (list soko)))
> (defun declare-reachable (x y)
> "Oficially declare a location as reachable by
> sokoban
> - and stick on stack as a location who's
> neighboors should be checked for reachability."
> (setf (aref reachable x y) 1)
> (push (list x y) stack))
> (defun push-os (x y)
> "If there is no box or wall at this location, and
> it isn't reachable yet,
> call declare-reachable to make it such, and to
> push it onto the stack."
> (if (and (= (aref reachable x y) 0) (< (aref
> goals+walls x y) 2) (= (aref boxes x y) 0))
> (declare-reachable x y)))
> (setf (aref reachable (car soko) (cadr soko)) 1) ;set
> location of soko to reachable
> (do ((current-loc soko (car stack)))
> ((null current-loc) reachable)
> (pop stack)
> (push-os (car current-loc) (1- (cadr current-loc)))
> (push-os (car current-loc) (1+ (cadr current-loc)))
> (push-os (1- (car current-loc)) (cadr current-loc))
> (push-os (1+ (car current-loc)) (cadr
> current-loc)))))
> (let ((reachable (find-reachable)))
> (incf total-nodes)
> (defun is-reachable (x y); expects reachable
> "Check if this location is reachable; return T if it
> is."
> (if (= 1 (aref reachable x y)) T nil))
> (defun is-free (x y);expects goals+wall and
> boxes
> "Check if this location contains no box or wall.
> Should probably be made into a macro."
> (if (or (= 2 (aref goals+walls x y))
> (= 1 (aref boxes x y)))
> nil
> T))
> (defun attempt-move (x Y)
> "Try to move the box located at square x y."
> (print 'attempt-move)
> (defun is-movable (d-x d-y);expects
> x and y
> "Checks for horizontal or vertical mobility,
> depending on if it is with 1 0 or 0 1 - these
> denoting the direction into which we want to move.
> Should probably be turned into a macro."
> (print 'is-movable)
> (if (and (is-free (+ x d-x) (+ y d-y))
> (is-free (- x d-x) (- y d-y)))
> T
> nil))
> (defun move-further (to-x to-y d-x
> d-y); d for delta
> "Recursive function that is told to move to (to-x
> to-y)
> and will recursively check if it can move one
> further into direction (d-x d-y)."
> (print 'move-further)
> (print map-size)
> (print (list to-x to-y))
> (if (is-free (+ to-x d-x) (+ to-y d-y)) ;don't
> forget that the orig. positions are the ones where the box currently is,
> and that it WILL go to orig + delta.
> (move-further (+ to-x d-x) (+ to-y d-y) d-x
> d-y));We just want to see if it could go one further.
> (print 'before-move)
> (move (+ to-x) (+ to-y)))
> (defun move-further (new-x
> new-y);expects x and y - the current position of the box to move
> "Actually move the box, and call rec-solver with
> the new values of boxes."
> (print 'move)
> (let* ((linearization-array (make-array (* (car
> map-size) (cadr map-size)) :displaced-to boxes));some fancy computation
> in order to be able to
> (linear-copied-array (copy-seq
> linearization-array));get a true copy of the boxes array that is not a
> pointer
> (new-boxes (make-array map-size
> :displaced-to linear-copied-array)));to the orginal
> (setf (aref new-boxes x y) 0)
> (setf (aref new-boxes new-x new-y) 1)
> (rec-solver new-boxes (list x y))));soko,
> after this move, takes the spot of the box
> (if (is-movable 1 0)
> (if (is-reachable (1+ x) y) (move-further (1- x)
> y -1 0));because move-further is recursive,
> (if (is-reachable (1- x) y) (move-further (1+ x)
> y 1 0)));it cannot be written without the explicit x and y parameters
> (if (is-movable 0 1)
> (if (is-reachable x (1+ y)) (move-further x (1-
> y) 0 -1));if soko can reach one side, the box
> (if (is-reachable x (1- y)) (move-further x (1+
> y) 0 1))));will obviously be pushed towards the other side
> (dotimes (y
> (cadr map-size))
> (dotimes (x (car map-size))
> (if (= (aref boxes x y) 1)
> (attempt-move x y))))))
> (rec-solver boxes soko)))
>
>
> (solve-map 11)
>
>
>
>
>
> and an example map (from x-sokoban).
>
>
>
> #####
> # #
> #$ #
> ### $##
> # $ $ #
> ### # ## # ######
> # # ## ##### ..#
> # $ $ ..#
> ##### ### ·@## ..#
> # #########
> #######
>
--
kenny tilton
clinisys, inc
http://www.tilton-technology.com/
---------------------------------------------------------------
"Everything is a cell." -- Alan Kay
Kenny Tilton wrote:
> I'm gonna look at the code a little just out of curiosity, and this will
> not explain the coding error, but shouldn't the screen be:
>
> #####
> # #
> #$ #
> ### $##
> # $ $ #
> ### # ## # ######
> # # ## ##### ..#
> # $ $ ..#
> ##### ### ·@## ..#
> # #########
> #######
>
Indeed - something went wrong during pasting :)
From: Kenny Tilton
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <3EB18F5B.5010104@nyc.rr.com>
Derek Hans wrote:
> Kenny Tilton wrote:
>
>> I'm gonna look at the code a little just out of curiosity, and this
>> will not explain the coding error, but shouldn't the screen be:
>>
>> #####
>> # #
>> #$ #
>> ### $##
>> # $ $ #
>> ### # ## # ######
>> # # ## ##### ..#
>> # $ $ ..#
>> ##### ### ·@## ..#
>> # #########
>> #######
>>
> Indeed - something went wrong during pasting :)
>
>
I wonder how that could affect only certain lines. Anyway, the output of
get-map looked pretty bad until I added ":initial-element 0" to the
make-arrays. your algorithm may have been processing garbage.
--
kenny tilton
clinisys, inc
http://www.tilton-technology.com/
---------------------------------------------------------------
"Everything is a cell." -- Alan Kay
From: Kenny Tilton
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <3EB182D7.3090200@nyc.rr.com>
If your screen file, like mine, ended without a newline on the last line
of tokens, that line never gets processed by map-size. fwiw.
kt
Derek Hans wrote:
> I'm working on a sokoban solver. It is currently only brute force based,
> though I plan to add some optimizations later.
> I have a bug somewhere in my source that makes me move my boxes beyond a
> wall, and eventually, out of the array. I then obviously get an array
> out of bounds error. I've already spent several hours looking through
> the source, testing small bits of it, and just can't track down the
> problem.
> Could somone please take a look at the source? I'm fairly certain that
> there's no mistake in the reader functions (get-map, map-size,
> find-reachable) as I've printed out the result and compared it to the
> original. The problem still arises even without the move-further
> function, so it isn't there either. I just really don't know what could
> be going wrong in the rest of the program. Did I miss a possibility
> somewhere?
>
> Some parts of the program aren't implemented yet, notably the function
> that checks if a solution has been found - but I figured that adding
> that won't make my array problem go away ;).
>
> I'm going to use a hash table to check if I'm coming back to a position
> I have already visited. However, I'd have to make a hash of a list of
> the array that stores the boxes and the position of sokoban (or rather
> some standard reachable square - such as the top left most reachable
> square). This would mean that I'd have to use equalp - which is slower.
> I was therefore wondering if it would be worthwhile to come up with a
> number value that would represent this array and the sokoban location,
> and use this for the hash, using eql for the hash table. Or would the
> calculation of that number take more time than creating a hash for the
> array?
>
> Thanks in advance to anyone willing to read my source - any comments
> would be appreciated - it's my first "real" lisp program, and there's
> probably many things that I could do better differently. In particular,
> if there is any more elegant way of reading in the maps in the first
> place, rather than using the property list, and which functions would be
> better as macros.
>
>
>
>
> (defconstant +map-location+
> '/Derek/Programming/Lisp/Sokoban/screens/screen.)
> (defconstant +drive+ #\D)
> (defun map-file (current-map)
> (format nil "~C~C~S~D" +drive+ #\: +map-location+ current-map))
>
> (defun solve-map (map-number)
> "The main function that sets up all the variables and calls rec-solve
> to actually solve the map."
> (defun map-size ();expects map-number
> "Gets the dimension of the map that is to be solved. Goes through
> map line by line, remembering the longest line, and the total number of
> lines."
> (with-open-file (in-stream (map-file map-number) :direction :input)
> (let ((max-width 0)
> (width 0)
> (length 0))
> (do ((char-to-be-processed (read-char in-stream)
> (read-char in-stream nil 'the-end)))
> ((not (characterp char-to-be-processed)) (list
> max-width length))
> (cond ((eql char-to-be-processed #\newline)
> (incf length)
> (if (< max-width width) (setq max-width width))
> (setq width 0))
> (T
> (incf width)))))))
> (let ((map-size (map-size))
> (total-nodes 0)
> (move 0)
> (solution 0)
> (goals+walls nil)
> (boxes nil)
> (soko nil))
> ;;the symbols for the goals+walls map - trans for
> "translate this symbol into machine code" (setf (get
> 'g+w-trans-symbol '#\ ) 0)
> (setf (get 'g+w-trans-symbol ···@) 0)
> (setf (get 'g+w-trans-symbol '#\.) 1)
> (setf (get 'g+w-trans-symbol '#\$) 0)
> (setf (get 'g+w-trans-symbol '#\*) 1)
> (setf (get 'g+w-trans-symbol '#\#) 2)
> ;;the symbols for the boxes map
> (setf (get 'box-trans-symbol '#\ ) 0)
> (setf (get 'box-trans-symbol ···@) 0)
> (setf (get 'box-trans-symbol '#\.) 0)
> (setf (get 'box-trans-symbol '#\$) 1)
> (setf (get 'box-trans-symbol '#\*) 1)
> (setf (get 'box-trans-symbol '#\#) 0)
> (defun get-map ();expects map-size and
> map-number
> "Reads the map from file and returns an array containing the
> walls (as 2s), the goals (as 1s) and empty space (as 0s);
> Also returns an array containing all the boxes (as 1s), and a
> list of the location of the sokoban."
> (with-open-file (in-stream (map-file map-number) :direction
> :input)
> (let ( (goals+walls (make-array map-size
> :element-type '(mod 3)))
> (boxes (make-array map-size
> :element-type '(mod 2)))
> (soko nil)
> (x 0)
> (y 0))
> (do ((current-char (read-char in-stream) (read-char
> in-stream nil 'the-end)))
> ((not (characterp current-char)) (values
> goals+walls boxes soko))
> (cond ((eql current-char #\newline)
> (incf y)
> (setq x 0))
> (T (setf (aref
> goals+walls x y) (get 'g+w-trans-symbol current-char))
> (setf (aref boxes x y) (get
> 'box-trans-symbol current-char))
> (if (eql current-char ··@) (setq soko
> (list x y)))
> (incf x)))))))
> (multiple-value-setq (goals+walls boxes soko) (get-map))
> (defun make-loc-hash ()
> "Makes a hash table containing all the open spaces on the map.
> Can be used later in order to make the algorithm more
> efficient by storing data in an array containing only the open spaces
> - not the walls or space outside of the reach of the sokoban.
> It isn't yet being used."
> (let ((loc-hash (make-hash-table :test #'equal))
> (stack (list soko)))
> (defun push-os (x y)
> "Used to push this location onto the stack of
> locations that should be given a hash entry."
> (if (not (or (= (aref goals+walls x y) 2) (gethash
> (list x y) loc-hash)))
> (push (list x y) stack)))
> (do ((current-loc soko (car stack))
> (count 0 (1+ count)))
> ((null current-loc) loc-hash)
> (pop stack)
> (setf (gethash (list (car current-loc) (cadr
> current-loc)) loc-hash) count)
> (push-os (car current-loc) (1- (cadr current-loc)))
> (push-os (car current-loc) (1+ (cadr current-loc)))
> (push-os (1- (car current-loc)) (cadr current-loc))
> (push-os (1+ (car current-loc)) (cadr current-loc)))))
> (defvar loc-hash (make-loc-hash)
> "A hash of all spaces that could potentially be reached by
> the sokoban, ie excluding walls, in the notation of (x y).")
> (defvar past-loc (make-hash-table :test #'equalp)
> "Another hash table not currently being used - will be used
> in futur to remember posititions that have already been visited.")
> (defun rec-solver (boxes soko); expects map-size,
> goals+walls, loc-hash
> "The actual recursive array that goes through all the
> possible locations."
>
> (defun find-reachable ();needs map-size, soko, goals+walls,
> boxes
> "Returns an array containing all the locations that the
> sokoban can reach,
> taking into account boxes that stop his path. Reachable
> locations are noted with a 1."
> (let ((reachable (make-array map-size :element-type '(mod
> 2)))
> (stack (list soko)))
> (defun declare-reachable (x y)
> "Oficially declare a location as reachable by
> sokoban
> - and stick on stack as a location who's
> neighboors should be checked for reachability."
> (setf (aref reachable x y) 1)
> (push (list x y) stack))
> (defun push-os (x y)
> "If there is no box or wall at this location, and
> it isn't reachable yet,
> call declare-reachable to make it such, and to
> push it onto the stack."
> (if (and (= (aref reachable x y) 0) (< (aref
> goals+walls x y) 2) (= (aref boxes x y) 0))
> (declare-reachable x y)))
> (setf (aref reachable (car soko) (cadr soko)) 1) ;set
> location of soko to reachable
> (do ((current-loc soko (car stack)))
> ((null current-loc) reachable)
> (pop stack)
> (push-os (car current-loc) (1- (cadr current-loc)))
> (push-os (car current-loc) (1+ (cadr current-loc)))
> (push-os (1- (car current-loc)) (cadr current-loc))
> (push-os (1+ (car current-loc)) (cadr
> current-loc)))))
> (let ((reachable (find-reachable)))
> (incf total-nodes)
> (defun is-reachable (x y); expects reachable
> "Check if this location is reachable; return T if it
> is."
> (if (= 1 (aref reachable x y)) T nil))
> (defun is-free (x y);expects goals+wall and
> boxes
> "Check if this location contains no box or wall.
> Should probably be made into a macro."
> (if (or (= 2 (aref goals+walls x y))
> (= 1 (aref boxes x y)))
> nil
> T))
> (defun attempt-move (x Y)
> "Try to move the box located at square x y."
> (print 'attempt-move)
> (defun is-movable (d-x d-y);expects
> x and y
> "Checks for horizontal or vertical mobility,
> depending on if it is with 1 0 or 0 1 - these
> denoting the direction into which we want to move.
> Should probably be turned into a macro."
> (print 'is-movable)
> (if (and (is-free (+ x d-x) (+ y d-y))
> (is-free (- x d-x) (- y d-y)))
> T
> nil))
> (defun move-further (to-x to-y d-x
> d-y); d for delta
> "Recursive function that is told to move to (to-x
> to-y)
> and will recursively check if it can move one
> further into direction (d-x d-y)."
> (print 'move-further)
> (print map-size)
> (print (list to-x to-y))
> (if (is-free (+ to-x d-x) (+ to-y d-y)) ;don't
> forget that the orig. positions are the ones where the box currently is,
> and that it WILL go to orig + delta.
> (move-further (+ to-x d-x) (+ to-y d-y) d-x
> d-y));We just want to see if it could go one further.
> (print 'before-move)
> (move (+ to-x) (+ to-y)))
> (defun move-further (new-x
> new-y);expects x and y - the current position of the box to move
> "Actually move the box, and call rec-solver with
> the new values of boxes."
> (print 'move)
> (let* ((linearization-array (make-array (* (car
> map-size) (cadr map-size)) :displaced-to boxes));some fancy computation
> in order to be able to
> (linear-copied-array (copy-seq
> linearization-array));get a true copy of the boxes array that is not a
> pointer
> (new-boxes (make-array map-size
> :displaced-to linear-copied-array)));to the orginal
> (setf (aref new-boxes x y) 0)
> (setf (aref new-boxes new-x new-y) 1)
> (rec-solver new-boxes (list x y))));soko,
> after this move, takes the spot of the box
> (if (is-movable 1 0)
> (if (is-reachable (1+ x) y) (move-further (1- x)
> y -1 0));because move-further is recursive,
> (if (is-reachable (1- x) y) (move-further (1+ x)
> y 1 0)));it cannot be written without the explicit x and y parameters
> (if (is-movable 0 1)
> (if (is-reachable x (1+ y)) (move-further x (1-
> y) 0 -1));if soko can reach one side, the box
> (if (is-reachable x (1- y)) (move-further x (1+
> y) 0 1))));will obviously be pushed towards the other side
> (dotimes (y
> (cadr map-size))
> (dotimes (x (car map-size))
> (if (= (aref boxes x y) 1)
> (attempt-move x y))))))
> (rec-solver boxes soko)))
>
>
> (solve-map 11)
>
>
>
>
>
> and an example map (from x-sokoban).
>
>
>
> #####
> # #
> #$ #
> ### $##
> # $ $ #
> ### # ## # ######
> # # ## ##### ..#
> # $ $ ..#
> ##### ### ·@## ..#
> # #########
> #######
>
--
kenny tilton
clinisys, inc
http://www.tilton-technology.com/
---------------------------------------------------------------
"Everything is a cell." -- Alan Kay
From: Kenny Tilton
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <3EB190F4.8040502@nyc.rr.com>
> (setf (get 'g+w-trans-symbol ···@) 0)
> (setf (get 'g+w-trans-symbol '#\.) 1)
> (setf (get 'g+w-trans-symbol '#\$) 0)
> (setf (get 'g+w-trans-symbol '#\*) 1)
> (setf (get 'g+w-trans-symbol '#\#) 2)
Above needs an entry for #\Space (a little more readable than #\ , btw).
Without it ACL whines about me trying to store a nil in a '(mod 3) typed
array.
btw, you are treating the major index as the column and the minor index
as the row. i guess it does not matter, but that's hard for me to
visualize. any chance you tripped up on that in your indexing?
kt
--
kenny tilton
clinisys, inc
http://www.tilton-technology.com/
---------------------------------------------------------------
"Everything is a cell." -- Alan Kay
> Thanks in advance to anyone willing to read my source - any comments
> would be appreciated - it's my first "real" lisp program, and there's
> probably many things that I could do better differently.
Well, a boring observation to begin with: your lines are too long,
especially if you're going to be posting your code to Usenet :-).
I've attempted to undo the worst of the line-wrapping damage below.
The indentation seems to be rather messed up too; I've tried to
fix it a bit.
> (defconstant +map-location+
> '/Derek/Programming/Lisp/Sokoban/screens/screen.)
> (defconstant +drive+ #\D)
> (defun map-file (current-map)
> (format nil "~C~C~S~D" +drive+ #\: +map-location+ current-map))
(defconstant +map-base+ "D:/Derek/Programming/Lisp/Sokoban/Screens/screen")
(defun map-file (number)
(format nil "~A.~A" +map-base+ number))
seems nicer to me. When you want a string, use a string,
not a symbol or a character. (It's possible that what you
actually want is a *pathname*, but pathnames are a bit
hairy and you may prefer to avoid them for now.) And the
trailing "." on your +map-location+ is, um, a bit icky.
I'd also advise finding a name other than MAP-FILE, which
sounds a little like a counterpart of MAPCAR for files.
Perhaps use "board" or "problem" or "layout" instead of
"map"?
> (defun solve-map (map-number)
> "The main function that sets up all the variables and calls
> rec-solve to actually solve the map."
As a stylistic note, I think functions' docstrings should
say what the function does, not what it is. Thus:
(defun solve-map (map-number)
"Solve a Sokoban problem by setting up some variables
and calling REC-SOLVE."
> (defun map-size ();expects map-number
> "Gets the dimension of the map that is to be solved. Goes
> through map line by line, remembering the longest line, and the total
> number of lines."
Barry Margolin already suggested that these internal definitions
are bad style, and so they are. Most of them should be taken out
to top level, and things they need to be able to see should be
passed in as parameters or made global variables. (Possibly the
board, for instance, should be a global variable.) Some of them
might want to stay internal, and be defined locally using LABELS
or FLET.
The docstring should say exactly what the function returns.
(defun map-size ()
"Read the map file and return a list (COLUMNS LINES)
giving its size."
> (with-open-file (in-stream (map-file map-number) :direction :input)
> (let ((max-width 0)
> (width 0)
> (length 0))
> (do ((char-to-be-processed (read-char in-stream) (read-char in-stream nil 'the-end)))
> ((not (characterp char-to-be-processed)) (list max-width length))
> (cond ((eql char-to-be-processed #\newline)
> (incf length)
> (if (< max-width width) (setq max-width width))
> (setq width 0))
> (T
> (incf width)))))))
(defun read-map (map-number)
"Read the lines from a map file, and return them in a list."
(with-open-file (stream (map-file map-number) :direction :input)
(let ((eof-object (list)))
(loop for line = (read-line stream nil eof-object)
until (eq line eof-object)
collect line))))
(defun map-size (map-lines)
(list (loop for line in lines maximize (length line))
(length lines))))
> (let ((map-size (map-size))
> (total-nodes 0)
> (move 0)
> (solution 0)
> (goals+walls nil)
> (boxes nil)
> (soko nil))
> ;;the symbols for the goals+walls map - trans for "translate this symbol into machine code"
> (setf (get 'g+w-trans-symbol '#\ ) 0)
> (setf (get 'g+w-trans-symbol ···@) 0)
> (setf (get 'g+w-trans-symbol '#\.) 1)
> (setf (get 'g+w-trans-symbol '#\$) 0)
> (setf (get 'g+w-trans-symbol '#\*) 1)
> (setf (get 'g+w-trans-symbol '#\#) 2)
> ;;the symbols for the boxes map
> (setf (get 'box-trans-symbol '#\ ) 0)
> (setf (get 'box-trans-symbol ···@) 0)
> (setf (get 'box-trans-symbol '#\.) 0)
> (setf (get 'box-trans-symbol '#\$) 1)
> (setf (get 'box-trans-symbol '#\*) 1)
> (setf (get 'box-trans-symbol '#\#) 0)
Property lists are on the whole best avoided. Especially when
all the properties are on one or two symbols! Further, there's
a really subtle trap you've fallen into: character objects
are a particularly bad choice of indicator for property lists,
because two instances of the same character are *not guaranteed
to be identical* (i.e., not guaranteed to compare equal using
EQ). So using them as indicators in a property list is unsafe.
Uh-oh. :-)
I also think it's bad style to have all these magic
numbers flying around. I'd prefer to see something along
the following lines:
(defvar *symbol-props*
'((#\ nil nil nil)
(··@ nil nil nil)
(#\. t nil nil)
(#\$ nil nil t)
(#\* t nil t)
(#\# nil t nil))
"List of (char goal? wall? box?).")
(defun char-goalp (c) (second (assoc c *symbol-props*)))
(defun char-wallp (c) (third (assoc c *symbol-props*)))
(defun char-boxp (c) (fourth (assoc c *symbol-props*)))
I don't like any of the names I've used, but it's not
completely clear to me what these things are for. You
can probably come up with better names. All this ASSOC
and FOURTH stuff is somewhat less than optimally efficient,
but I conjecture that this doesn't matter at all.
> (defun get-map ();expects map-size and map-number
> "Reads the map from file and returns an array containing the walls (as 2s),
> the goals (as 1s) and empty space (as 0s);
> Also returns an array containing all the boxes (as 1s), and
> a list of the location of the sokoban."
> (with-open-file (in-stream (map-file map-number) :direction :input)
> (let ( (goals+walls (make-array map-size :element-type '(mod 3)))
> (boxes (make-array map-size :element-type '(mod 2)))
> (soko nil)
> (x 0)
> (y 0))
> (do ((current-char (read-char in-stream) (read-char in-stream nil 'the-end)))
> ((not (characterp current-char)) (values goals+walls boxes soko))
> (cond ((eql current-char #\newline)
> (incf y)
> (setq x 0))
> (T
> (setf (aref goals+walls x y) (get 'g+w-trans-symbol current-char))
> (setf (aref boxes x y) (get 'box-trans-symbol current-char))
> (if (eql current-char ··@) (setq soko (list x y)))
> (incf x)))))))
Looping over characters is such a very C-ish thing to do.
Here's another place where you'd rather have a list of lines,
as conveniently provided by the READ-MAP function I defined
earlier, and use nested loops. This also lets us avoid
reading the file twice. (You'll notice that my version
of MAP-SIZE takes a list of lines, not something that
specifies a file to read.)
I think it's better to have a single array containing all the
information about each square. And, rather than using magic numbers
to contain that information, do something like this:
(defstruct square
goalp wallp boxp)
(defun get-map (map-number)
"Read a map file. Return three values: a 2-dimensional array
containing SQUARE objects indexed as (column, row), and a
list (column row) giving the player's initial position."
(let* ((map-lines (read-map map-number))
(size (map-size map-lines))
(result (make-array size))
(position nil))
(loop for line-number upfrom 0 for line in map-lines do
(loop for column-number below (first size) do
(let ((c (if (< column-number (length line))
(char line column-number)
#\ )))
(setf (aref result column-number line-number)
(make-square :goalp (char-goalp c)
:wallp (char-wallp c)
:boxp (char-boxp c)))
(when (char= c ··@)
(setq position (list column-number line-number))))))
(values result position)))
I also happen to find DO unreadable, which is another reason why
I prefer those nested LOOPs. Opinions vary on this. :-)
> (multiple-value-setq (goals+walls boxes soko) (get-map))
> (defun make-loc-hash ()
> "Makes a hash table containing all the open spaces on the map.
> Can be used later in order to make the algorithm more efficient by storing data in an array containing only the open spaces
> - not the walls or space outside of the reach of the sokoban. It isn't yet being used."
> (let ((loc-hash (make-hash-table :test #'equal))
> (stack (list soko)))
> (defun push-os (x y)
> "Used to push this location onto the stack of locations that should be given a hash entry."
> (if (not (or (= (aref goals+walls x y) 2) (gethash (list x y) loc-hash)))
> (push (list x y) stack)))
> (do ((current-loc soko (car stack))
> (count 0 (1+ count)))
> ((null current-loc) loc-hash)
> (pop stack)
> (setf (gethash (list (car current-loc) (cadr current-loc)) loc-hash) count)
> (push-os (car current-loc) (1- (cadr current-loc)))
> (push-os (car current-loc) (1+ (cadr current-loc)))
> (push-os (1- (car current-loc)) (cadr current-loc))
> (push-os (1+ (car current-loc)) (cadr current-loc)))))
This looks like repeated work, since you'll be needing to do the same
sort of recursive exploration later. So let's factor some of that work
out now.
(defun left (position) (list (1- (first position)) (second position)))
(defun right (position) (list (1+ (first position)) (second position)))
(defun up (position) (list (first position) (1- (second position))))
(defun down (position) (list (first position) (1+ (second position))))
(defun neighbours (position)
(list (left position) (right position) (up position) (down position)))
The next couple of functions I've made a bit more general so that we
can reuse them later; and I've used a hash table rather than an array
for the set of reachable locations. If it's really useful, we can
easily enough extract a list of them.
(defun accessible (position board &optional (blocker-predicate #'square-wallp))
(let ((x (first position))
(y (second position)))
(and (<= 0 x (1- (array-dimension board 0)))
(<= 0 y (1- (array-dimension board 1)))
(not (funcall blocker-predicate (aref board x y))))))
(defun find-reachable-squares (board initial-position
&optional (blocker-predicate #'square-wallp))
"Given a board and starting place, as returned from GET-MAP,
return an array the same size as the board, where reachable
positions are indicated by non-NIL entries. Reachability is
defined recursively, starting at INITIAL-POSITION and being
blocked by squares satisfying the BLOCKER-PREDICATE. Reachable
locations are numbered up from 0, in order of being reached."
(let ((h (make-array (array-dimensions board) :initial-element nil))
(n 0))
(labels ((explore (position)
(setf (gethash position h) n)
(incf n)
(loop for new-pos in (neighbours position) do
(when (and (not (gethash position h))
(accessible position board blocker-predicate))
(explore position)))))
(explore initial-position))
h))
> (defvar loc-hash (make-loc-hash)
> "A hash of all spaces that could potentially be reached by the sokoban, ie excluding walls, in the notation of (x y).")
> (defvar past-loc (make-hash-table :test #'equalp)
> "Another hash table not currently being used - will be used in future to remember posititions that have already been visited.")
> (defun rec-solver (boxes soko); expects map-size, goals+walls, loc-hash
> "The actual recursive array that goes through all the possible locations."
>
> (defun find-reachable ();needs map-size, soko, goals+walls, boxes
> "Returns an array containing all the locations that the sokoban can reach,
> taking into account boxes that stop his path. Reachable locations are noted with a 1."
> (let ((reachable (make-array map-size :element-type '(mod 2)))
> (stack (list soko)))
> (defun declare-reachable (x y)
> "Oficially declare a location as reachable by sokoban
> - and stick on stack as a location who's neighboors should be checked for reachability."
> (setf (aref reachable x y) 1)
> (push (list x y) stack))
> (defun push-os (x y)
> "If there is no box or wall at this location, and it isn't reachable yet,
> call declare-reachable to make it such, and to push it onto the stack."
> (if (and (= (aref reachable x y) 0) (< (aref goals+walls x y) 2) (= (aref boxes x y) 0))
> (declare-reachable x y)))
> (setf (aref reachable (car soko) (cadr soko)) 1) ;set location of soko to reachable
> (do ((current-loc soko (car stack)))
> ((null current-loc) reachable)
> (pop stack)
> (push-os (car current-loc) (1- (cadr current-loc)))
> (push-os (car current-loc) (1+ (cadr current-loc)))
> (push-os (1- (car current-loc)) (cadr current-loc))
> (push-os (1+ (car current-loc)) (cadr current-loc)))))
Instead of FIND-REACHABLE, we can use FIND-REACHABLE-SQUARES,
defined above, with blocker-predicate
(lambda (square) (or (square-wallp square) (square-boxp square)))
which you may in fact want to give a name -- OBSTRUCTED or
something.
A couple of other things: you're using CAR and CADR everywhere;
FIRST and SECOND are easier on the eyes. As a general rule:
when you're working with lists as lists, use FIRST etc; when
you're working with them as general tree structures, use CAR etc.
> (let ((reachable (find-reachable)))
> (incf total-nodes)
> (defun is-reachable (x y); expects reachable
> "Check if this location is reachable; return T if it is."
> (if (= 1 (aref reachable x y)) T nil))
Instead of (if <foo> t nil), you should always just write <foo>.
And if you adopt my suggestion above of using NIL elements in
the array to indicate non-reachability, the definition collapses
to
(defun is-reachable (x y)
(aref reachable x y))
which may not even be worth defining :-).
> (defun is-free (x y);expects goals+wall and boxes
> "Check if this location contains no box or wall. Should probably be made into a macro."
> (if (or (= 2 (aref goals+walls x y))
> (= 1 (aref boxes x y)))
> nil
> T))
No, it shouldn't be made a macro. Don't use macros for efficiency;
use them for expressivity and clarity. If you want an inline function,
define an inline function. (Unfortunately some implementations
don't honour inline declarations; if you are using one of those,
complain to your vendor.)
I notice that neither IS-REACHABLE nor IS-FREE checks that
the arguments aren't off the board. This is probably OK, since
I expect the presence of walls will make sure we never feed
these functions out-of-range values, but I'd be happier with
some checks in there. Locations off the board should presumably
be treated as walls. The ACCESSIBLE function I defined earlier
is basically a wrapper that does this.
> (defun attempt-move (x Y)
> "Try to move the box located at square x y."
> (print 'attempt-move)
> (defun is-movable (d-x d-y);expects x and y
> "Checks for horizontal or vertical mobility,
> depending on if it is with 1 0 or 0 1 - these denoting the direction into which we want to move.
> Should probably be turned into a macro."
> (print 'is-movable)
> (if (and (is-free (+ x d-x) (+ y d-y))
> (is-free (- x d-x) (- y d-y)))
> T
> nil))
This also shouldn't be turned into a macro :-).
I also think -- this is a very minor matter -- that
IS-PUSHABLE would be a better name, because that
reminds the reader of why you have to check both
sides of the box (because to push it, the sokoban
needs to get on one side and have a space on the
other).
> (defun move-further (to-x to-y d-x d-y); d for delta
> "Recursive function that is told to move to (to-x to-y)
> and will recursively check if it can move one further into direction (d-x d-y)."
> (print 'move-further)
> (print map-size)
> (print (list to-x to-y))
> (if (is-free (+ to-x d-x) (+ to-y d-y)) ;don't forget that the orig. positions are the ones where the box currently is, and that it WILL go to orig + delta.
> (move-further (+ to-x d-x) (+ to-y d-y) d-x d-y));We just want to see if it could go one further.
> (print 'before-move)
> (move (+ to-x) (+ to-y)))
There seem to be a couple of things wrong here.
- There isn't a function called MOVE. I suspect that the
immediately following function, currently called MOVE-FURTHER,
is meant to be called MOVE.
- (+ to-x) and (+ to-y) seem like odd things to say.
Presumably you mean *either* just to-x and to-y
*or* (+ to-x d-x) and (+ to-y d-y); I think the
latter.
MOVE-FURTHER is a rather unhelpful name. I'm not sure how
to improve it; maybe something like SLIDE would convey the
idea of moving as far as necessary in a particular direction?
> (defun move-further (new-x new-y);expects x and y - the current position of the box to move
This is presumably really called MOVE, as mentioned above.
> "Actually move the box, and call rec-solver with the new values of boxes."
> (print 'move)
> (let* ((linearization-array (make-array (* (car map-size) (cadr map-size)) :displaced-to boxes));some fancy computation in order to be able to
> (linear-copied-array (copy-seq linearization-array));get a true copy of the boxes array that is not a pointer
> (new-boxes (make-array map-size displaced-to linear-copied-array)));to the orginal
Isn't it *horrible* that there's no really straightforward way
to make a copy of a multidimensional array? :-|
Now, when I got to this point reading your code I thought
"Bother. It was a terrible mistake to combine the walls array
and the boxes array. I should have trusted Derek better."
But, on reflection, I don't think it *was* a mistake. Instead
of copying the whole boxes array, why not just leave a
record on the call stack of what you've been doing and alter
it in place?
So: Don't bother copying the boxes. Instead, make the old and
new positions both arguments to MOVE, and then do
;; move the box from old position to new position
;; and the sokoban to old position
;; call REC-SOLVER
;; move the box from new position to old position
;; and the sokoban to the place behind old position
Sorted!
Something I'm puzzled not to see: there doesn't seem to be anything
checking whether you've found a solution or not. So the thing is
just going to recurse deeper and deeper and deeper until it
runs out of stack space. Unless I've missed the point somewhere.
I suppose it's possible that this explains the errors you've been
seeing; some implementations might do very odd things if the
stack overflows. (They shouldn't.)
The easiest way to report a solution is probably to use
THROW.
Even if you do this, you need to be careful. Can you prove
that the program won't go round and round in circles, pushing
the same block backwards and forwards? Perhaps you can (the
fact that MOVE-FURTHER always moves as far as possible might
be helpful here), but it doesn't seem obvious to me. You can
prevent that sort of behaviour, at the cost of a great deal
of memory, by keeping a hash table that records what board
configurations you've seen and never moving to a position
you've already explored. (Caution: two positions might not
be "the same" even if they have boxes in the same places,
if the sokoban's two positions aren't mutually reachable.)
> (setf (aref new-boxes x y) 0)
> (setf (aref new-boxes new-x new-y) 1)
> (rec-solver new-boxes (list x y))));soko, after this move, takes the spot of the box
If you keep all the hairy internal function definitions,
then you should have a comment here alerting the reader to
the fact that we're now back in REC-SOLVER.
> (if (is-movable 1 0)
> (if (is-reachable (1+ x) y) (move-further (1- x) y -1 0));because move-further is recursive,
> (if (is-reachable (1- x) y) (move-further (1+ x) y 1 0)));it cannot be written without the explicit x and y parameters
> (if (is-movable 0 1)
> (if (is-reachable x (1+ y)) (move-further x (1- y) 0 -1));if soko can reach one side, the box
> (if (is-reachable x (1- y)) (move-further x (1+ y) 0 1))));will obviously be pushed towards the other side
> (dotimes (y (cadr map-size))
> (dotimes (x (car map-size))
> (if (= (aref boxes x y) 1)
> (attempt-move x y))))))
> (rec-solver boxes soko)))
That all looks OK. It might be helpful to store the positions of all the
boxes in some separate data structure, though as long as you're doing
a recursive search on every call to REC-SOLVER to find reachable squares
the improvement that brings is likely to be lost in the noise :-).
Hmm. I haven't found your out-of-bounds bug, though there are
a few leads there. I have, on the other hand, gone on at excessive
length and rewritten far more of your code than is polite. Sorry.
I'll stop now :-).
--
Gareth McCaughan ················@pobox.com
.sig under construc
From: Kenny Tilton
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <3EB19C5C.5030907@nyc.rr.com>
Gareth McCaughan wrote:
> Derek wrote:
>> (if (is-movable 1 0)
>> (if (is-reachable (1+ x) y) (move-further (1- x) y -1 0));because move-further is recursive,
>> (if (is-reachable (1- x) y) (move-further (1+ x) y 1 0)));it cannot be written without the explicit x and y parameters
>> (if (is-movable 0 1)
>> (if (is-reachable x (1+ y)) (move-further x (1- y) 0 -1));if soko can reach one side, the box
>> (if (is-reachable x (1- y)) (move-further x (1+ y) 0 1))));will obviously be pushed towards the other side
..snip..
>
> That all looks OK.
Well, I think it means that attempt-move (the above code) where possible
will all in one go first move vertically and then move horizontally, at
which point I concluded...
> Hmm. I haven't found your out-of-bounds bug, though there are
> a few leads there.
... the OP should follow your leads and see what shakes out. The bug
will likely just go away.
btw, a couple of test files like:
#######
·@ $ .#
#######
...would not hurt. the OP could have quite a few print statements and
the output would still be manageable.
--
kenny tilton
clinisys, inc
http://www.tilton-technology.com/
---------------------------------------------------------------
"Everything is a cell." -- Alan Kay
From: Lieven Marchand
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <87znm6b8az.fsf@wyrd.be>
Derek Hans <·········@gmx.net> writes:
> I'm working on a sokoban solver. It is currently only brute force
> based, though I plan to add some optimizations later.
You might start thinking about optimizations. Sokoban is
PSPACE-complete so even notorious stuff like Traveling Salesman is far
easier.
--
Jane - Daria? Come on, the neighbors are starting to talk.
Daria - Um... good. Soon they'll progress to cave drawings and civilization
will be on its way.
Lieven Marchand wrote:
> Derek Hans <·········@gmx.net> writes:
>
>
>>I'm working on a sokoban solver. It is currently only brute force
>>based, though I plan to add some optimizations later.
>
>
> You might start thinking about optimizations. Sokoban is
> PSPACE-complete so even notorious stuff like Traveling Salesman is far
> easier.
>
Indeed :) I already have some ideas.
Though I won't start with that until the basic code works.
In article <··············@wyrd.be>, Lieven Marchand <···@wyrd.be> wrote:
>Derek Hans <·········@gmx.net> writes:
>
>> I'm working on a sokoban solver. It is currently only brute force
>> based, though I plan to add some optimizations later.
>
>You might start thinking about optimizations.
What??? He still has array-bounds problems. And he barely understands
Lisp semantics. Optimization is the *last* thing he should be thinking
about.
--
Barry Margolin, ··············@level3.com
Genuity Managed Services, a Level(3) Company, Woburn, MA
*** DON'T SEND TECHNICAL QUESTIONS DIRECTLY TO ME, post them to newsgroups.
Please DON'T copy followups to me -- I'll assume it wasn't posted to the group.
From: Kenny Tilton
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <3EB1BCBD.1040305@nyc.rr.com>
Barry Margolin wrote:
> In article <··············@wyrd.be>, Lieven Marchand <···@wyrd.be> wrote:
>
>>Derek Hans <·········@gmx.net> writes:
>>
>>
>>>I'm working on a sokoban solver. It is currently only brute force
>>>based, though I plan to add some optimizations later.
>>
>>You might start thinking about optimizations.
>
>
> What??? He still has array-bounds problems. And he barely understands
> Lisp semantics. Optimization is the *last* thing he should be thinking
> about.
>
Lisp semantics?? <g> The OP does not understand debugging. Think about
it. He is running the code. It is breaking. He cannot use print
statements to find out why, instead we end up analyzing horrific code.
The Real Problem here is that the OP does not know how to debug. I went
ahead and changed the test case to:
#######
·@ $ .#
#######
I do not know if the OP took that hint, but it quickly manifests a
simple problem in this code:
> (defun attempt-move (goals+walls boxes soko reachable x Y)
> "Try to move the box located at square x y."
> (if (is-movable x y 1 0 goals+walls boxes)
> (if (is-reachable (1+ x) y reachable) (move-further goals+walls boxes soko (1- x) y -1 0))
> (if (is-reachable (1- x) y reachable) (move-further goals+walls boxes soko (1+ x) y 1 0)))
> (if (is-movable x y 0 1 goals+walls boxes)
> (if (is-reachable x (1+ y) reachable) (move-further goals+walls boxes soko x (1- y) 0 -1))
> (if (is-reachable x (1- y) reachable) (move-further goals+walls boxes soko x (1+ y) 0 1))))
Tracing a little (array output truncated):
0: (ATTEMPT-MOVE #2A((2 2 2) (2 0 2) (2 0 2) (2 0 2) (2 0 2) (2 1 2)
#2A((0 0 0) (0 0 0) (0 0 0) (0 1 0) (0 0 0) (0 0 0)
#2A((1 0 1) (0 1 0) (0 1 0) (0 0 0) (0 0 0) (0 0 0)
1: (IS-MOVABLE 3 1 1 0 #2A((2 2 2) (2 0 2) (2 0 2) (2 0 2) (2 0 2)
#2A((0 0 0) (0 0 0) (0 0 0) (0 1 0) (0 0 0) (0 0 0)
1: returned T
yes, the box at (x y)=(3 1) can move left or right (that's all we learn
from it, and in this case it happens it can move both left and right).
so far so fuzzy. The true branch then asks (mistakenly) only if the soko
can get to the right of the box to push it to the left.
1: (IS-REACHABLE 4 1 #2A((1 0 1) (0 1 0) (0 1 0) (0 0 0) (0 0 0) (
1: returned NIL
Nope. (is-reachable 2 1) would succeed, but that is asked (illogically)
by the false branch. ie, if the box cannot be moved horizontally, let's
see if we can get to the left of it so we can push it to the right!
Now that might well be the case, so an illegal move might be made. I say
"might" because the move code makes no sense:
> (defun move-further (goals+walls boxes soko to-x to-y d-x d-y); d for delta
> "Recursive function that is told to move to (to-x to-y)
> and will recursively check if it can move one further into direction (d-x d-y)."
> (if (is-free (+ to-x d-x) (+ to-y d-y) goals+walls boxes)
> (move-further goals+walls boxes soko (+ to-x d-x) (+ to-y d-y) d-x d-y))
> (move boxes to-x to-y (+ to-x) (+ to-y)))
The last line above calls move and passes as the "from" arguments the
"to" arguments it was passed, I guess because move-further is not told
the "from" x and y. They might be derived perversely by subtracting the
delta, but that does not happen.
Going back to attempt-move, I wonder if the OP is a pythonista, or is
porting some python code. This version makes more sense:
> (defun attempt-move (goals+walls boxes soko reachable x Y)
> "Try to move the box located at square x y."
> (when (is-movable x y 1 0 goals+walls boxes)
> (if (is-reachable (1+ x) y reachable) (move-further goals+walls boxes soko (1- x) y -1 0))
> (if (is-reachable (1- x) y reachable) (move-further goals+walls boxes soko (1+ x) y 1 0)))
> (when (is-movable x y 0 1 goals+walls boxes)
> (if (is-reachable x (1+ y) reachable) (move-further goals+walls boxes soko x (1- y) 0 -1))
> (if (is-reachable x (1- y) reachable) (move-further goals+walls boxes soko x (1+ y) 0 1))))
And in Python the two if-reachables would both have executed because of
their like indentation.
This is fun, but really the OP just needs to learn how to debug code, the
first step being to try it on an exceedingly simple case.
--
kenny tilton
clinisys, inc
http://www.tilton-technology.com/
---------------------------------------------------------------
"Everything is a cell." -- Alan Kay
> Lisp semantics?? <g> The OP does not understand debugging. Think about
> it. He is running the code. It is breaking. He cannot use print
> statements to find out why, instead we end up analyzing horrific code.
>
Well, I'd be happy to take suggestions as to how to make it less
horrific :)!
> The Real Problem here is that the OP does not know how to debug. I went
> ahead and changed the test case to:
>
Indeed, I don't know how to debug - I haven't programmed all that much
before (a little in c and java, but nothing serious). Any good guides to
learning how to? Or is that something I'll have to learn over time?
> Going back to attempt-move, I wonder if the OP is a pythonista, or is
> porting some python code. This version makes more sense:
>
Actually, no, just wrote it rather late at night, and didn't realize
what I was doing - should have used cond instead of if so as to get both
statements to execute if it's true - not one if it's true and another if
it's false.
From: Tim Daly, Jr.
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <87ade6m5lc.fsf@tenkan.org>
Derek Hans <·········@gmx.net> writes:
...
> Indeed, I don't know how to debug - I haven't programmed all that much
> before (a little in c and java, but nothing serious). Any good guides
> to learning how to? Or is that something I'll have to learn over time?
...
Yup, you're going to have to learn it over time. Practice makes
better.
I think it's really cool that you're kind of starting with Lisp. Good
choice! The best way to get started is probably to read one of the
many good Lisp books out there, and do some of the exercises. Lisp
offers so much freedom it can be confusing at first. A good book can
really help make sense of it.
Probably the easiest to digest, and most clearly written, is Paul
Graham's "ANSI Common Lisp". It shouldn't be your last Lisp book, but
I recommend it as a good first.
I know you asked about learning to debug, not program, but I think
it's really the same thing in many cases. The best way to debug is to
stop writing them.
-Tim
--
From: Kenny Tilton
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <3EB27C6A.9040105@nyc.rr.com>
Derek Hans wrote:
>
>> Lisp semantics?? <g> The OP does not understand debugging. Think about
>> it. He is running the code. It is breaking. He cannot use print
>> statements to find out why, instead we end up analyzing horrific code.
>>
> Well, I'd be happy to take suggestions as to how to make it less
> horrific :)!
Nah, don't worry about that yet. My point was that we should be helping
you with debugging -- not writing -- your code. It is fine that your
code is horrific -- everyone starts there. Your code will improve as
long as you keep on trying to make your own code more understandable to
yourself. But something like Kernighan & Pike's "The Practice of
Programming" would accelerate the process. Or "The Pragmatic Programmer"
by Hunt et al, which I just noticed/ordered from Amazon while
researching this Q.
>
>> The Real Problem here is that the OP does not know how to debug. I
>> went ahead and changed the test case to:
>>
>
> Indeed, I don't know how to debug - I haven't programmed all that much
> before (a little in c and java, but nothing serious). Any good guides to
> learning how to? Or is that something I'll have to learn over time?
It's just common sense. You told us a box is moving into a wall and then
outside the wall and into a bounds error. Tilton's Law: Fix the first
bug, moving into a wall. You have a move function which IIRC handles all
moving. Add a couple of lines of code which first check whether the
destination is a wall. If so, add a break statement:
(break "can't move from (~a ~a) into wall at (~a ~a)"
from-x from-y to-x to-y)
...and then inspect the stack. (or you could use TRACE on the
interesting functions and look at that output to see how you arrived at
a bad move.) What function is calling move with a bad destination? Add
print statements there to reveal the caller's reasoning. etc etc
But I have also suggested a couple of dozen times that you work first on
a trivial example and I see no sign that you have done so, so there may
be no hope for you. :)
--
kenny tilton
clinisys, inc
http://www.tilton-technology.com/
---------------------------------------------------------------
"Everything is a cell." -- Alan Kay
It is fine that your
> code is horrific -- everyone starts there. Your code will improve as
> long as you keep on trying to make your own code more understandable to
> yourself.
That's very relieving to hear! :)
It's just common sense. You told us a box is moving into a wall and then
> outside the wall and into a bounds error. Tilton's Law: Fix the first
> bug, moving into a wall. You have a move function which IIRC handles all
> moving. Add a couple of lines of code which first check whether the
> destination is a wall. If so, add a break statement:
>
> (break "can't move from (~a ~a) into wall at (~a ~a)"
> from-x from-y to-x to-y)
>
> ...and then inspect the stack. (or you could use TRACE on the
> interesting functions and look at that output to see how you arrived at
> a bad move.) What function is calling move with a bad destination? Add
> print statements there to reveal the caller's reasoning. etc etc
>
I think part of the problem is that I'm using a compiler (corman) with a
very reduced feature set - which has the advantage of making it very
easy to use, but lacks some pretty important debugging capabilities. I
haven't found a way to set the saftely level higher. Trace only
sometimes gave intelligible responses. I think I'll go over to some
other compiler - such as allegro, though I found allegro a little
overwhelming the last time I tried using it. I guess I'll just have to
read the (very long) documentation that comes with it ;)
Any recommendations in terms of compilers/IDE?
I could potentially use Linux for this, but the Linux computer is
considerably slower than my windows computer :(
> But I have also suggested a couple of dozen times that you work first on
> a trivial example and I see no sign that you have done so, so there may
> be no hope for you. :)
>
Actually, I changed my first map to a simpler version at some point,
with only two boxes, within a 4x4 area. Maybe still wasn't simple enough.
Meantime, I've added some optimisations, in particular, remembering
positions I've already visited, with the help of a hash table, and
dropping any search that goes back to them. Obviously, I've added new
bugs ;) but I'll try to debug on my own for the next little while...
we'll see if I've learned something ;)
From: Thien-Thi Nguyen
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <7g1xzg98y1.fsf@gnufans.net>
Derek Hans <·········@gmx.net> writes:
> I could potentially use Linux for this, but the Linux computer is
> considerably slower than my windows computer :(
which is easier to catch, the butterfly or the bee?
even toothless tyson still dreams of ali...
thi
From: Matthew Danish
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <20030502215815.E25716@mapcar.org>
Schemer Alert!!
On Fri, May 02, 2003 at 07:59:14PM -0400, Derek Hans wrote:
> I think part of the problem is that I'm using a compiler (corman) with a
> very reduced feature set - which has the advantage of making it very
> easy to use,
This above part contradicts with the next part... (How can it be easier to use
if it lacks features? This is the Schemer attitude: "Fewer operators, so it
must be easier." Unless you actually want to do something...)
> but lacks some pretty important debugging capabilities. I
> haven't found a way to set the saftely level higher. Trace only
> sometimes gave intelligible responses. I think I'll go over to some
> other compiler - such as allegro, though I found allegro a little
> overwhelming the last time I tried using it. I guess I'll just have to
> read the (very long) documentation that comes with it ;)
It's really not that hard. Close the silly form windows. Use the Listener and
the editor windows. You should know how they work already.
> Any recommendations in terms of compilers/IDE?
LispWorks/Windows has a pretty nice IDE.
--
; Matthew Danish <·······@andrew.cmu.edu>
; OpenPGP public key: C24B6010 on keyring.debian.org
; Signed or encrypted mail welcome.
; "There is no dark side of the moon really; matter of fact, it's all dark."
From: Kenny Tilton
Subject: Re: Array out of bounds in Sokoban solver and hash of arrays
Date:
Message-ID: <3EB31887.6020703@nyc.rr.com>
Derek Hans wrote:
> I think part of the problem is that I'm using a compiler (corman) with a
> very reduced feature set - which has the advantage of making it very
> easy to use, but lacks some pretty important debugging capabilities.
Welllll... I happen to know ACL best, used to know MCL best... I have
used Corman enough to get my pet project Cells working there, but even I
(with lots of experience with IDEs for Lisp and C) would hesitate to put
Corman down without spending a lot of time on the Corman mailing list
asking for guidance. You might be pleasantly surprised. I happen at this
point to like ACL best, but that is the one I know best.
> Any recommendations in terms of compilers/IDE?
If you grab ACL and ask me via email I could fill you in on the basic
tools. no need to read any doc. TRACE is a bit of a no-brainer, as is
(format t ....). Backtraces, the inspector... that about does it. i can
tell you how to get along with the project manager. The good news is
that rudimentary debugging skills will keep you busy for weeks; at this
stage, every bug you find will cause substantial re-writing (unless you
go for the quick fix like most programmers).
btw, I have been feeling bad about talking about print statements and
assertions when you could just /read/ your code and identify problems
(as long as you remember IF is not COND). Try hand-executing the
ultimate trivial example:
#####
·@$.#
#####
> Actually, I changed my first map to a simpler version at some point,
> with only two boxes, within a 4x4 area. Maybe still wasn't simple enough.
OK, glad to hear it. Until your code can solve the above UTE -- the
HelloWorld of Soko -- you do not have to worry about anything else.
That's actually kinda liberating. Then introduce new challenges one at a
time, and save/re-test all of them after you get each new case working.
>
> Meantime, I've added some optimisations....Obviously, I've added new
> bugs ;) ....
<heh-heh> sure, knock yourself out. it's all learning.
--
kenny tilton
clinisys, inc
http://www.tilton-technology.com/
---------------------------------------------------------------
"Everything is a cell." -- Alan Kay
On Fri, 02 May 2003 19:59:14 -0400, Derek Hans <·········@gmx.net>
wrote:
>>
>I think part of the problem is that I'm using a compiler (corman) with a
>very reduced feature set - which has the advantage of making it very
>easy to use, but lacks some pretty important debugging capabilities. I
>haven't found a way to set the saftely level higher. Trace only
>sometimes gave intelligible responses.
You can use
(declare (optimize ...))
to control safety level in a function.
Trace can be tricky as it doesn't necessarily trace recursive calls.
Also if you redefine the function the TRACE loses effect; you must
execute the TRACE statement again.
For more detailed help or questions you should ask on the Corman
mailing list (which you can subscribe to by visiting the Corman web
site)
Derek Hans wrote:
> I'm working on a sokoban solver. It is currently only brute force based,
> though I plan to add some optimizations later.
For the theoretical minded, here is a paper that proves that Sokoboban
is PSPACE-complete:
<http://www.cs.ualberta.ca/~joe/Preprints/Sokoban/paper.html>
--
Jens Axel S�gaard