I'm designing a new challenge, I'll publish a website in some days. For
a GUI and interactive testing I've written a small Java program, but for
developing solutions Lisp would be better and I want to provide some
useful classes and/or functions for this.
Below is my first attempt for such a framework (just paste it in your
REPL and try the run-solution-map-list demo call), but before publishing
the website, it would be good to make it more Lisp-like, because
currently it is mostly a straightforward translation of the Java code.
For example to initialize the map array a general function would be
good, with a higher order function for reading the actual content.
And the run-solution could be parametrized with a higher order
function, too, for example to use it for displaying the solution like
I've done or to drive a GUI. And some methods, for example update-robot,
look a bit ugly.
;;; program for testing a solution
;;; call it like this:
;;; (run-solution-map-list *demo-map* "2644664000000002222220222022222001131003222222202222000000000000")
(defclass mars-map ()
((filename :initarg :filename :initform nil)
(map-list :initarg :map-list :initform nil)
(map)
(width :accessor width)
(height :accessor height)
(target-reached :initarg :target-reached :accessor target-reached)
(won :initarg :won :accessor won)
(start-x :initarg :start-x :accessor start-x)
(start-y :initarg :start-y :accessor start-y)
(robot-x :initarg :robot-x :accessor robot-x)
(robot-y :initarg :robot-y :accessor robot-y)
(speed-x :initarg :speed-x :accessor speed-x)
(speed-y :initarg :speed-y :accessor speed-y)))
(defun char-to-stone-symbol (char)
(case char
(#\O 'start)
(#\+ 'target)
(#\Space 'empty)
(otherwise 'stone)))
(defmethod init-by-list ((this mars-map) map-list)
(with-slots (map width height start-x start-y) this
(setf width (length (car map-list)))
(setf height (length map-list))
(setf map (make-array (list width height) :initial-element 'empty))
(loop for y from 0 below height do
(let ((line (car map-list)))
(format t "~A~%" line)
(loop for x from 0 below width do
(let ((char (elt line x)))
(when (eql 'start (setf (aref map x y)
(char-to-stone-symbol char)))
(setf start-x (* 10 x))
(setf start-y (* 10 y)))))
(setf map-list (cdr map-list)))))
(reset this))
(defmethod init-by-stream ((this mars-map) s)
(with-slots (map width height start-x start-y) this
(setf width (parse-integer (read-line s)))
(setf height (parse-integer (read-line s)))
(setf map (make-array (list width height) :initial-element 'empty))
(loop for y from 0 below height do
(let ((line (read-line s)))
(format t "~A~%" line)
(loop for x from 0 below width do
(let ((char (elt line x)))
(when (eql 'start (setf (aref map x y)
(char-to-stone-symbol char)))
(setf start-x (* 10 x))
(setf start-y (* 10 y))))))))
(reset this))
(defmethod initialize-instance :after ((this mars-map) &key)
(with-slots (filename map-list) this
(if filename
(with-open-file (s filename)
(init-by-stream this s))
(init-by-list this map-list))))
(defmethod reset ((this mars-map))
(reinitialize-instance this
:target-reached nil
:won nil
:speed-x 0
:speed-y 0
:robot-x (start-x this)
:robot-y (start-y this)))
(defmethod hit-test-impl ((this mars-map) x y cell-type)
(with-slots (width height map) this
(if (or (< x 0)
(>= x (* width 10))
(< y 0)
(>= y (* height 10)))
t
(let ((mx (truncate (/ x 10)))
(my (truncate (/ y 10))))
(when (and (< mx width) (>= mx 0) (< my height) (>= my 0))
(eql (aref map mx my) cell-type))))))
(defmethod hit-test ((this mars-map) x y cell-type)
(let ((right (+ x 9))
(bottom (+ y 9)))
(or (hit-test-impl this x y cell-type)
(hit-test-impl this right y cell-type)
(hit-test-impl this x bottom cell-type)
(hit-test-impl this right bottom cell-type))))
(defconstant *speed-delta* 2)
(defmacro bound-10 (x)
`(progn (when (< ,x -10) (setf ,x -10))
(when (> ,x 10) (setf ,x 10))))
(defmethod update-robot ((this mars-map) left bottom right)
(with-slots (robot-x robot-y speed-x speed-y) this
(when left (decf speed-x *speed-delta*))
(when bottom (decf speed-y *speed-delta*))
(when right (incf speed-x *speed-delta*))
(incf speed-y)
(bound-10 speed-x)
(bound-10 speed-y)
(do () (nil)
(let ((new-x (+ robot-x speed-x))
(new-y (+ robot-y speed-y)))
(if (hit-test this new-x new-y 'stone)
(progn
(setf speed-x (truncate (/ speed-x 2)))
(setf speed-y (truncate (/ speed-y 2))))
(progn
(setf robot-x new-x)
(setf robot-y new-y)
(return)))
(when (and (= speed-x 0) (= speed-y 0)) (return))))))
(defmethod update ((this mars-map) left bottom right)
(with-slots (target-reached won robot-x robot-y) this
(update-robot this left bottom right)
(when (hit-test this robot-x robot-y 'target)
(setf target-reached t))
(when (and target-reached
(hit-test this robot-x robot-y 'start))
(setf won t))))
(defun run-solution (map solution)
(let ((steps 0)
(fuel 0))
(loop for i from 0 below (length solution) do
(let* ((jets (char-int (elt solution i)))
(left (logbitp 0 jets))
(bottom (logbitp 1 jets))
(right (logbitp 2 jets)))
(update map left bottom right)
(when left (incf fuel))
(when bottom (incf fuel))
(when right (incf fuel)))
(format t "step: ~A, x: ~A, y: ~A, speed-x: ~A, speed-y: ~A~%"
(1+ steps)
(robot-x map) (robot-y map)
(speed-x map) (speed-y map))
(incf steps)
(when (won map) (return)))
(if (won map)
(format t "valid solution, steps: ~A, fuel usage: ~A~%" steps fuel)
(format t "invalid solution, not won~%"))))
(defun run-solution-map-file (map-filename solution)
(run-solution (make-instance 'mars-map :filename map-filename) solution))
(defun run-solution-map-list (map-list solution)
(run-solution (make-instance 'mars-map :map-list map-list) solution))
(defparameter *demo-map*
'("#####################################"
"# #"
"# #"
"# #"
"# #"
"# O #"
"############ ##################"
"############# ###### ##"
"############# #### + ###"
"############## #####"
"################### ######"
"#####################################"))
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Surendra Singhi <·········@netscape.net> wrote:
> What is this application/program about? Is it about finding a way
> through a maze (planning)?
The challenge is to fly to the "+" and back to the start with minimum fuel
usage and/or minimum step usage. My program provides only a framework for
building and testing solutions. The demo solution looks like this:
http://www.frank-buss.de/tmp/challenge.html
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
Frank Buss wrote:
> I'm designing a new challenge, I'll publish a website in some days. For
> a GUI and interactive testing I've written a small Java program, but for
> developing solutions Lisp would be better and I want to provide some
> useful classes and/or functions for this.
>
> Below is my first attempt for such a framework (just paste it in your
> REPL and try the run-solution-map-list demo call), but before publishing
> the website, it would be good to make it more Lisp-like, because
> currently it is mostly a straightforward translation of the Java code.
>
Maybe change init-by-list and init-by-stream to this,
(defmethod init ((this mars-map) (map-list cons))
(with-slots (map width height start-x start-y) this
(setf width (length (car map-list))
height (length map-list)
map (make-array (list width height) :initial-element 'empty))
(loop for y from 0
for line in map-list
do
(format t "~A~%" line)
(loop for x from 0
for char across line
do
(when (eql 'start (setf (aref map x y)
(char-to-stone-symbol char)))
(setf start-x (* 10 x) start-y (* 10 y))))))
(reset this))
(defmethod init ((this mars-map) (filename pathname))
(with-open-file (s filename)
(init this
(progn (read-line s) (read-line s)
(loop for line = (read-line s nil nil)
while line collect line)))))
(defmethod initialize-instance :after ((this mars-map) &key)
(with-slots (filename map-list) this
(init this (if filename (probe-file filename) map-list))))
Wade
Wade Humeniuk <····································@telus.net> wrote:
> Maybe change init-by-list and init-by-stream to this,
thanks, that's nice. I didn't know that you can overload methods in CLOS
and the "across" in the loop is really better, I've changed the "run-
solution" to use the across-loop, too.
And I've changed and splitted the hit-test method. There was a bug,
because hit-test always returned true, if the coordinates was not within
the map bounds, which could be used to cheat, because then the target-
test return true, too. Ok, this never happens, because when testing for
the target cell-type the coordinates are always within the map, but I
think now it is more clear.
(defmethod in-map ((this mars-map) x y)
"Returns true, if the (x, y), interpreted as robot coordinates,"
"is within the map bounds."
(with-slots (width height) this
(flet ((in-range (x lower upper) (and (>= x lower)
(< x (* upper 10)))))
(and (in-range x 0 width)
(in-range y 0 height)))))
(defmethod hit-test-impl ((this mars-map) x y cell-type)
"Returns true, if the position (x, y), interpreted as robot"
"coordinates, hits the specified cell-type. Cells not within"
"the bounds of the map are defined as stones."
(with-slots (map) this
(if (in-map this x y)
(let ((mx (truncate (/ x 10)))
(my (truncate (/ y 10))))
(eql (aref map mx my) cell-type))
(eql cell-type 'stone))))
(defmethod hit-test ((this mars-map) x y cell-type)
"Returns true, if the position (x, y), (x+9,y), (x,y+9) or"
"(x+9,y+9) hits the specified cell-type."
(let ((right (+ x 9))
(bottom (+ y 9)))
(or (hit-test-impl this x y cell-type)
(hit-test-impl this right y cell-type)
(hit-test-impl this x bottom cell-type)
(hit-test-impl this right bottom cell-type))))
Now I want to make the update-robot more Lisp like or at least easier to
understand. Any ideas?
(defconstant *speed-delta* 2)
(defmacro bound-10 (x)
`(progn (when (< ,x -10) (setf ,x -10))
(when (> ,x 10) (setf ,x 10))))
(defmethod update-robot ((this mars-map) left bottom right)
(with-slots (robot-x robot-y speed-x speed-y) this
(when left (decf speed-x *speed-delta*))
(when bottom (decf speed-y *speed-delta*))
(when right (incf speed-x *speed-delta*))
(incf speed-y)
(bound-10 speed-x)
(bound-10 speed-y)
(do () (nil)
(let ((new-x (+ robot-x speed-x))
(new-y (+ robot-y speed-y)))
(if (hit-test this new-x new-y 'stone)
(progn
(setf speed-x (truncate (/ speed-x 2)))
(setf speed-y (truncate (/ speed-y 2))))
(progn
(setf robot-x new-x)
(setf robot-y new-y)
(return)))
(when (and (= speed-x 0) (= speed-y 0)) (return))))))
--
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de