Permalink
Browse files

Check HOPE even further (not only on next place)

  • Loading branch information...
1 parent 6f383da commit 8fb0979c905e517d89ac5169e115dfe7c4f1ffd2 @vojtajina committed May 30, 2011
Showing with 66 additions and 4 deletions.
  1. +31 −4 src/hide-seek.lisp
  2. +35 −0 test/hide-seek.lisp
View
@@ -46,10 +46,10 @@
; can't see any person
(cond
; there is a HOPE on left, check it
- ((equal (what-is-on-left? body) 'HOPE)
+ ((hope-on-left? body)
(prog1 'TURNLEFT (set-in-action body 'BACK-RIGHT)))
; there is a HOPE on right, check it
- ((equal (what-is-on-right? body) 'HOPE)
+ ((hope-on-right? body)
(prog1 'TURNRIGHT (set-in-action body 'BACK-LEFT)))
; CLEAN - time to check left / right
((equal (jinavojt-body-in-action body) 'CLEAN)
@@ -92,9 +92,9 @@
('BACK-RIGHT (prog1 'TURNRIGHT (set-in-action body NIL)))
(otherwise (cond
; todo: local var for what-is-on-* calls
- ((equal (what-is-on-left? body) 'HOPE)
+ ((hope-on-left? body)
(prog1 'TURNLEFT (set-in-action body 'NO-TURN-RIGHT)))
- ((equal (what-is-on-right? body) 'HOPE)
+ ((hope-on-right? body)
(prog1 'TURNRIGHT (set-in-action body 'NO-TURN-LEFT)))
((equal (what-is-on-left? body) 'SEEN)
(prog1 'TURNRIGHT (set-in-action body 'NO-TURN-LEFT)))
@@ -138,18 +138,45 @@
(defun loc-on-right (location heading)
(xy-add location (rotate-heading-right heading)))
+; returns what is on NEXT place on left (HOPE/SEEN/NIL)
(defun what-is-on-left? (body)
(let ((map (jinavojt-body-map body))
(heading (jinavojt-body-heading body))
(loc (jinavojt-body-loc body)))
(what-is-on-loc? (loc-on-left loc heading) map (rotate-heading-left heading))))
+; returns what is on NEXT place on right (HOPE/SEEN/NIL)
(defun what-is-on-right? (body)
(let ((map (jinavojt-body-map body))
(heading (jinavojt-body-heading body))
(loc (jinavojt-body-loc body)))
(what-is-on-loc? (loc-on-right loc heading) map (rotate-heading-right heading))))
+; is HOPE on first known object in left direction ?
+(defun hope-on-left? (body)
+ (let ((map (jinavojt-body-map body))
+ (heading (object-heading body))
+ (loc (object-loc body)))
+ (equal 'HOPE (first-known-in-direction (loc-on-left loc heading)
+ map
+ (rotate-heading-left heading)))))
+
+; is HOPE on first known object in right direction ?
+(defun hope-on-right? (body)
+ (let ((map (jinavojt-body-map body))
+ (heading (object-heading body))
+ (loc (object-loc body)))
+ (equal 'HOPE (first-known-in-direction (loc-on-right loc heading)
+ map
+ (rotate-heading-right heading)))))
+
+; returns first known (SEEN/HOPE) in given direction
+(defun first-known-in-direction (location map heading)
+ (let ((next (what-is-on-loc? location map heading)))
+ (if (null next)
+ (first-known-in-direction (xy-add location heading) map heading)
+ next)))
+
; returns
; - NIL = unknown
; - HOPE = bush, not seen from this direction yet
View
@@ -195,6 +195,16 @@
(remove-heading-from-list NIL '(0 -1)))
)
+(define-test hope-on-*-should-check-first-known-in-direction
+ (setq body (make-jinavojt-body)
+ map (jinavojt-body-map body))
+ (setf (aref map 1 1) 'HOPE)
+ (setf (object-loc body) (@ 5 1))
+ (setf (object-heading body) (@ 0 1))
+
+ (assert-true (hope-on-left? body))
+ (assert-false (hope-on-right? body))
+)
;;; ===============================================================
;;; HIGHER LEVEL TESTS
@@ -251,6 +261,12 @@
:bspec '((at edge WALL)
(at (2 2) BUSH)
(at (4 2) BUSH)))))
+ ; env for testing HOPE on next known on left/right
+ (6 (setq env (make-hs-world :max-steps 10
+ :start (@ 4 1)
+ :bspec '((at edge WALL)
+ (at (4 2) BUSH)))))
+
)
(initialize env)
(setq agent (first (environment-agents env)))
@@ -327,3 +343,22 @@
'CLEAN)
(assert-equal 'FORW (fake-decide env)))))
+(define-test should-always-check-when-hope-on-further-right
+ ; even if hope is not on next, could be further
+ (stress 10 (lambda ()
+ (setq env (create-fake-env 6))
+ (fake-step env 'LEFT)
+ (fake-step env 'LEFT)
+ (fake-step env 'LEFT)
+ (fake-step env 'FORW)
+ (assert-equal 'TURNRIGHT (fake-decide env)))))
+
+(define-test should-always-check-when-hope-on-further-left
+ ; even if hope is not on next, could be further
+ (stress 10 (lambda ()
+ (setq env (create-fake-env 6))
+ (fake-step env 'RIGHT)
+ (fake-step env 'RIGHT)
+ (fake-step env 'RIGHT)
+ (fake-step env 'FORW)
+ (assert-equal 'TURNLEFT (fake-decide env)))))

0 comments on commit 8fb0979

Please sign in to comment.