;;; program for testing a solution ;;; call it like this: ;;; (run-solution-map-list *demo-map* "2644664000000002222220222022222001131003222222202222000000000000") ;;; or if you have a map-file "demo.txt": ;;; (run-solution-map-list (pathname "c:/tmp/demo.txt") "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 ((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)))) (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 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)))) (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) (setf speed-x (truncate (/ speed-x 2)) speed-y (truncate (/ speed-y 2))) (progn (setf robot-x new-x 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 jets-char across solution do (let* ((jets (char-int jets-char)) (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 #" "############ ##################" "############# ###### ##" "############# #### + ###" "############## #####" "################### ######" "#####################################"))