results from 9 JUN 2020 session

missions/lisp/IeeeJOE2018PaperBasicExample/IeeeJOE2018HumanDirectedAllPathsSearch.cl

+
 ;This code written in ANSI Common Lisp, Allegro 10.1 enhancement, from Franz, Inc., by
 ;Prof. Robert B. McGhee (robertbmcghee@gmail.com) at the Naval Postgraduate School,
-;Monterey, CA 93943. Date of latest update: 1 June 2020.
+; , CA 93943. Date of latest update: 9 June 2020.
 
 ;The mission coded below is taken from Fig. 7, pg. 434, in "Ethical Mission Definition
 ;and Execution for Maritime Robots Under Human Supervision", IEEE Journal of Oceanic
@@ -46,8 +47,9 @@
 ;reduce the number of phases in top level mission orders.
 
 (defvar *current-paths-to-goal* nil)
-(defvar *path-to-goal* nil)
+(defvar *path-to-goal* '(s s s s))
 (defvar agent1)
+(defvar agent2)
 (defvar phase1)
 (defvar phase2)
 (defvar phase3)
@@ -94,8 +96,10 @@
 
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Human Mission Testing and Validation;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;Human Mission Testing and Validation;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 
+;The system function "eval", as used below, obtains pointer (address) for a global object.
 
 (defmethod issue-command ((agent human-search-agent))
   (let* ((phase (current-execution-phase agent))
@@ -133,14 +137,18 @@
 
 (defun list-execute-phase ()
   (issue-command agent1)
-  (ask-list-result agent1)
-  (set-successor-list-index agent1)
+  (ask-list-result agent1)             ;Note that "ask-list-result" accesses outcome sequence
+  (set-successor-list-index agent1)    ;list rather than human single digit keyboard entry.
   (set-next-phase agent1))
 
 (defun create-2018-JOE-orders ()
   (setf 2018-JOE-orders (create-5-mission-phases))
   (initialize-2018-mission-phases))
 
+(defun start1 ()
+  (create-2018-JOE-orders)
+  (setf agent1 (make-instance 'human-search-agent)))
+
 (defun issue-order (command)
   (format t "~A" command)
   (terpri))
@@ -169,93 +177,145 @@
 
 (defun start ()
   (setf *current-paths-to-goal* nil)
-  (create-2018-JOE-orders)
-  (setf agent1 (make-instance 'human-search-agent)))
+  (start1))
 
-(defun new-outcome-sequence ()
+(defun run1 ()
+  (start1)
   (execute-mission)
   (reverse (current-outcome-sequence agent1)))
 
-(defun list-new-outcome-sequence ()
-  (create-2018-JOE-orders)
-  (setf agent1 (make-instance 'human-search-agent))
+(defun list-run1 ()
+  (start1)
   (list-execute-mission)
   (reverse (current-outcome-sequence agent1)))
 
 (defun run ()
   (pprint (increment-paths-to-goal)))
 
+(defun list-run (outcome-list)
+  (setf *path-to-goal* outcome-list)
+  (pprint (list-increment-paths-to-goal)))
+
 (defun run-all ()
   (terpri)
   (list-run (pop *current-paths-to-goal*))
-  (pop *current-paths-to-goal*) ;Infinite loop with out this line even though it seems redundant.
+  (pop *current-paths-to-goal*)
   (if (not (equal *current-paths-to-goal* nil)) (run-all) 'done))
 
 (defun increment-paths-to-goal ()
-  (setf (current-outcome-sequence agent1) (new-outcome-sequence))
+  (setf (current-outcome-sequence agent1) (run1))
   (push (reverse (current-outcome-sequence agent1)) *current-paths-to-goal*))
 
 (defun list-increment-paths-to-goal ()
-  (setf (current-outcome-sequence agent1) (list-new-outcome-sequence))
+  (setf (current-outcome-sequence agent1) (list-run1))
   (push (reverse (current-outcome-sequence agent1)) *current-paths-to-goal*))
 
-(defun list-run (outcome-list)
-  (setf *path-to-goal* outcome-list)
-  (pprint (list-increment-paths-to-goal)))  
-
 (defun convert-outcome-to-index (x)
   (cond ((equal x 's) 0)
         ((equal x 'f) 1)
         ((equal x 'x) 2)))
 
+(defun cycle-left (x) (append (rest x) (list (first x))))
+
 
 
-;;;;;;;;;;;;;;;;;;;;;;; Algorithmic Proof of Correctness by Exhaustive Search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;Algorithmic Proof of Correctness by Breadth First Exhaustive Search;;;;;;;;;;;;;;;;;;;;;
 
 
-(defvar *integer-quotient* 0)
-(defvar *integer-remainder* 0)
-(defvar *next-path-element* 0)
-(defvar *trial-path-to-goal* nil)
-(defvar *max-serial-number* 80)
-(defvar *next-path-serial-number*)
-(defvar *max-path-length* 4)
-(defvar *all-trial-paths* nil)
+(defclass DAG-find-all-paths-agent ()
+  ((current-search-phase :accessor current-search-phase :initform 'phase1)
+   (successor-list :accessor successor-list :initform nil)
+   (successor-list-index :accessor successor-list-index :initform 0)
+   (all-paths-to-frontier :accessor all-paths-to-frontier :initform nil)
+   (all-paths-to-goal :accessor all-paths-to-goal :initform nil)
+   (new-paths-list-length :accessor new-paths-list-length :initform nil)
+   (new-paths-list :accessor new-paths-list :initform nil)
+   (new-path-segments-list :accessor new-path-segments-list :initform nil)))
+
+;DAG means "Directed Acyclic Graph".
+
+(defun update-successor-list-index (index modulus) (mod (1+ index) modulus))
+   
+(defmethod get-new-path-segment ((agent DAG-find-all-paths-agent))
+  (let* ((phase (current-search-phase agent))
+         (command (command (eval phase)))
+         (successor-list (successor-list (eval phase)))
+         (index (successor-list-index agent))
+         (outcome (first (nth index successor-list)))
+         (next-phase (second (nth index successor-list)))
+         (path-segment (list phase command outcome next-phase)))
+    (setf (successor-list-index agent) (update-successor-list-index index 3))
+    (push path-segment (new-path-segments-list agent))))
+
+(defmethod update-new-path-segments-list ((agent DAG-find-all-paths-agent))
+  (setf (new-path-segments-list agent) nil)
+  (dotimes (i 3) (get-new-path-segment agent))
+  (new-path-segments-list agent))  
+ 
+(defmethod extend-path ((agent DAG-find-all-paths-agent))
+  (let* ((all-paths (all-paths-to-frontier agent))
+         (new-segment (pop (new-path-segments-list agent)))
+         (path (first all-paths)))
+    (push (connect path new-segment) (new-paths-list agent))))
+
+(defmethod start-mission-execution-tree ((agent DAG-find-all-paths-agent))
+  (setf (new-paths-list agent) (update-new-path-segments-list agent))
+  (dotimes (i 3) (store-new-path agent))
+  (setf (current-search-phase agent) (flf (all-paths-to-frontier agent)))
+  (all-paths-to-frontier agent))  
+
+(defmethod expand-frontier-node ((agent DAG-find-all-paths-agent))
+  (update-new-path-segments-list agent)
+  (dotimes (i 3) (extend-path agent))
+  (pop (all-paths-to-frontier agent))
+  (setf (current-search-phase agent) (flf (all-paths-to-frontier agent)))
+  (new-paths-list agent))
+
+(defmethod store-new-path ((agent DAG-find-all-paths-agent))
+  (let* ((new-path (pop (new-paths-list agent))))
+    (if new-path (if (not (equal 'phase5 (fl new-path)))
+                     (push new-path (all-paths-to-frontier agent))
+                     (push new-path (all-paths-to-goal agent))))))
+ 
+(defmethod extend-all-paths-to-frontier ((agent DAG-find-all-paths-agent))
+  (let* ((n (length (all-paths-to-frontier agent))))
+    (progn (dotimes (i n) (expand-frontier-node agent))
+           (setf (new-paths-list-length agent) (length (new-paths-list agent)))
+           (all-paths-to-frontier agent))))
+
+(defmethod advance-execution-tree-frontier ((agent DAG-find-all-paths-agent))
+  (extend-all-paths-to-frontier agent)
+  (store-all-new-paths agent)
+  (setf (current-search-phase agent) (flf (all-paths-to-frontier agent))))
+
+(defmethod store-all-new-paths ((agent DAG-find-all-paths-agent))
+  (dotimes (i (new-paths-list-length agent)) (store-new-path agent)))
+ 
+(defun create-agent2 ()
+  (setf agent2 (make-instance 'DAG-find-all-paths-agent)))
+
+(defun start-all ()
+  (create-2018-JOE-orders)
+  (create-agent2)
+  (start-mission-execution-tree agent2))
 
-(defun start-trial-paths ()
-  (setf *next-path-serial-number* 0 *integer-quotient* 0  *trial-path-to-goal* nil
-    *all-trial-paths* '((s s s s))))
+(defun connect (list1 list2)
+  (if (equal (first (last list1)) (first list2))
+      (append list1 (rest list2))
+      list1))
 
-(defun new-trial-path ()
-  (setf *next-path-serial-number* (1+ *next-path-serial-number*)
-        *integer-quotient* *next-path-serial-number* *trial-path-to-goal* nil)
-  (find-trial-path)
-  (pprint *trial-path-to-goal*))
+(defun flf (list) (first (last (first list))))
 
-(defun integral-ternary-remainder (decimal-integer)
-  (rem decimal-integer 3))
+(defun fl (list) (first (last list)))
 
-(defun integral-ternary-quotient (decimal-integer)
-  (let ((x (truncate decimal-integer 3))) x))
+(defun find-all-paths-to-goal ()
+  (start)
+  (dotimes (i 3) (advance-execution-tree-frontier agent2)) 'done)
 
-(defun convert-integer-to-outcome (x)
-  (cond ((equal x 0) 's)
-        ((equal x 1) 'f)
-        ((equal x 2) 'x)))          
+(defun all-paths ()
+  (find-all-paths-to-goal))
 
-(defun advance-toward-goal ()
-  (setf *integer-remainder* (integral-ternary-remainder *integer-quotient*)
-        *integer-quotient* (integral-ternary-quotient *integer-quotient*)))
-       
-(defun find-trial-path ()
-  (when (not (equal (length *trial-path-to-goal*) *max-path-length*))
-    (advance-toward-goal)
-    (setf *trial-path-to-goal* (cons (convert-integer-to-outcome *integer-remainder*) *trial-path-to-goal*))
-  (find-trial-path)))
+(defun results ()  
+  (pprint (all-paths-to-goal agent2)))
 
-(defun shazzam () (push *trial-path-to-goal* *all-trial-paths*) 'shazzam)
 
-(defun find-all-trial-paths ()
-  (new-trial-path)
-  (if (not (equal *trial-path-to-goal* '(s s f s)))
-      (progn (shazzam) (find-all-trial-paths)) 'done))
\ No newline at end of file

missions/lisp/IeeeJOE2018PaperBasicExample/IeeeJOE2018HumanDirectedAllPathsSearch.output.txt

+
+RESULTS
+
 International Allegro CL Free Express Edition
 10.1 [32-bit Windows] (Jan 9, 2019 10:44)
 Copyright (C) 1985-2019, Franz Inc., Oakland, CA, USA.  All Rights Reserved.
@@ -19,11 +22,19 @@ CG-USER(1):
 ;   Foreign loading libeay32.dll.
 ;   Foreign loading ssleay32.dll.
 ;   Foreign loading sys:aclissl.dll.
-; Fast loading C:\acl10.1express-new\2020 Code\Lisp 2018 Mission All Paths\New Depth All Paths Search 2018 JOE Mission.fasl
+; Fast loading C:\acl10.1express-new\2020 Code\Lisp 2018 Mission All Paths\New All Paths Search 2018 JOE Mission.fasl
 CG-USER(1): (start)
-#<HUMAN-SEARCH-AGENT @ #x217fb65a>
+#<HUMAN-SEARCH-AGENT @ #x217f85c2>
 CG-USER(2): (run)
 Search Area A!
+Is execution outcome success (s), failure (f), or exception (x)?:x
+Rendezvous with Vehicle2!
+Is execution outcome success (s), failure (f), or exception (x)?:f
+Proceed to recovery!
+
+((X F))
+CG-USER(3): (run)
+Search Area A!
 Is execution outcome success (s), failure (f), or exception (x)?:s
 Sample environment!
 Is execution outcome success (s), failure (f), or exception (x)?:s
@@ -33,45 +44,149 @@ Rendezvous with Vehicle2!
 Is execution outcome success (s), failure (f), or exception (x)?:s
 Proceed to recovery!
 
-((S S S S))
-CG-USER(3): (list-run '(s s s f))
+((S S S S) (X F))
+CG-USER(4): (run)
+Search Area A!
+Is execution outcome success (s), failure (f), or exception (x)?:s
+Sample environment!
+Is execution outcome success (s), failure (f), or exception (x)?:x
+Rendezvous with Vehicle2!
+Is execution outcome success (s), failure (f), or exception (x)?:f
+Proceed to recovery!
+
+((S X F) (S S S S) (X F))
+CG-USER(5): (list-run '(s s s f))
+
+Search Area A!
+Sample environment!
+Search Area B!
+Rendezvous with Vehicle2!
+Proceed to recovery!
+
+((S S S F) (S X F) (S S S S) (X F))
+CG-USER(6):
+CG-USER(6): (list-run '(s s s x))
+                       
+Search Area A!
+Sample environment!
+Search Area B!
+Rendezvous with Vehicle2!
+Proceed to recovery!
+
+((S S S X) (S S S F) (S X F) (S S S S) (X F))
+CG-USER(7):
+CG-USER(7): (list-run (s s x f))
+Error: attempt to call `S' which is an undefined function.
+[condition type: UNDEFINED-FUNCTION]
+CG-USER(8): (list-run '(s s x f))
+
+Search Area A!
+Sample environment!
+Search Area B!
+Rendezvous with Vehicle2!
+Proceed to recovery!
+
+((S S X F) (S S S X) (S S S F) (S X F) (S S S S) (X F))
+CG-USER(9):
+CG-USER(9): (list-run '(x f s s))
+Search Area A!
+Rendezvous with Vehicle2!
+Proceed to recovery!
+
+((X F) (S S X F) (S S S X) (S S S F) (S X F) (S S S S) (X F))
+CG-USER(10): (run-all)
+
+Search Area A!
+Rendezvous with Vehicle2!
+Proceed to recovery!
+
+((X F) (S S X F) (S S S X) (S S S F) (S X F) (S S S S) (X F))
 Search Area A!
 Sample environment!
 Search Area B!
 Rendezvous with Vehicle2!
 Proceed to recovery!
 
-((S S S F) (S S S S))
-CG-USER(4): (run-all)
+((S S X F) (S S S X) (S S S F) (S X F) (S S S S) (X F))
+Search Area A!
+Sample environment!
+Search Area B!
+Rendezvous with Vehicle2!
+Proceed to recovery!
 
+((S S S X) (S S S F) (S X F) (S S S S) (X F))
 Search Area A!
 Sample environment!
 Search Area B!
 Rendezvous with Vehicle2!
 Proceed to recovery!
 
-((S S S F) (S S S S))
+((S S S F) (S X F) (S S S S) (X F))
+Search Area A!
+Sample environment!
+Rendezvous with Vehicle2!
+Proceed to recovery!
+
+((S X F) (S S S S) (X F))
 Search Area A!
 Sample environment!
 Search Area B!
 Rendezvous with Vehicle2!
 Proceed to recovery!
 
-((S S S S))
+((S S S S) (X F))
+Search Area A!
+Rendezvous with Vehicle2!
+Proceed to recovery!
+
+((X F))
 DONE
-CG-USER(5): (start-trial-paths)
-((S S S S))
-CG-USER(6): (new-trial-path)
-
-(S S S F)
-CG-USER(7): (start-trial-paths)
-((S S S S))
-CG-USER(8): (find-all-trial-paths)
- 
-(S S S F)  ;Work in progress. This gratauitous output will soon be eliminated.
-(S S S X)
-(S S F S)
+CG-USER(11): (start-all)
+((PHASE1 "Search Area A!" "Success." PHASE2) (PHASE1 "Search Area A!" "Failure." PHASE3)
+ (PHASE1 "Search Area A!" "Exception." PHASE4))
+CG-USER(12): (all-paths)
 DONE
-CG-USER(9): *all-trial-paths* ;Path below deliberately truncated for development purposes. Final version will be
-((S S S X) (S S S F) (S S S S)) ;of length 81. Near term work will be to develop "run-all-trial-paths" to "consume"
-CG-USER(10):                    *all-trial-paths* and return "all-paths-to-goal" without duplicates. 
\ No newline at end of file
+CG-USER(13): (rseults)
+Error: attempt to call `RSEULTS' which is an undefined function.
+[condition type: UNDEFINED-FUNCTION]
+CG-USER(14): (results)
+
+((PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Success." PHASE3 "Search Area B!" "Exception." PHASE4
+  "Rendezvous with Vehicle2!" "Exception." PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Success." PHASE3 "Search Area B!" "Exception." PHASE4
+  "Rendezvous with Vehicle2!" "Failure." PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Success." PHASE3 "Search Area B!" "Exception." PHASE4
+  "Rendezvous with Vehicle2!" "Success." PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Success." PHASE3 "Search Area B!" "Failure." PHASE4
+  "Rendezvous with Vehicle2!" "Exception." PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Success." PHASE3 "Search Area B!" "Failure." PHASE4
+  "Rendezvous with Vehicle2!" "Failure." PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Success." PHASE3 "Search Area B!" "Failure." PHASE4
+  "Rendezvous with Vehicle2!" "Success." PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Success." PHASE3 "Search Area B!" "Success." PHASE4
+  "Rendezvous with Vehicle2!" "Exception." PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Success." PHASE3 "Search Area B!" "Success." PHASE4
+  "Rendezvous with Vehicle2!" "Failure." PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Success." PHASE3 "Search Area B!" "Success." PHASE4
+  "Rendezvous with Vehicle2!" "Success." PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Exception." PHASE4 "Rendezvous with Vehicle2!" "Exception."
+  PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Exception." PHASE4 "Rendezvous with Vehicle2!" "Failure."
+  PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Exception." PHASE4 "Rendezvous with Vehicle2!" "Success."
+  PHASE5)
+ (PHASE1 "Search Area A!" "Failure." PHASE3 "Search Area B!" "Exception." PHASE4 "Rendezvous with Vehicle2!" "Exception." PHASE5)
+ (PHASE1 "Search Area A!" "Failure." PHASE3 "Search Area B!" "Exception." PHASE4 "Rendezvous with Vehicle2!" "Failure." PHASE5)
+ (PHASE1 "Search Area A!" "Failure." PHASE3 "Search Area B!" "Exception." PHASE4 "Rendezvous with Vehicle2!" "Success." PHASE5)
+ (PHASE1 "Search Area A!" "Failure." PHASE3 "Search Area B!" "Failure." PHASE4 "Rendezvous with Vehicle2!" "Exception." PHASE5)
+ (PHASE1 "Search Area A!" "Failure." PHASE3 "Search Area B!" "Failure." PHASE4 "Rendezvous with Vehicle2!" "Failure." PHASE5)
+ (PHASE1 "Search Area A!" "Failure." PHASE3 "Search Area B!" "Failure." PHASE4 "Rendezvous with Vehicle2!" "Success." PHASE5)
+ (PHASE1 "Search Area A!" "Failure." PHASE3 "Search Area B!" "Success." PHASE4 "Rendezvous with Vehicle2!" "Exception." PHASE5)
+ (PHASE1 "Search Area A!" "Failure." PHASE3 "Search Area B!" "Success." PHASE4 "Rendezvous with Vehicle2!" "Failure." PHASE5)
+ (PHASE1 "Search Area A!" "Failure." PHASE3 "Search Area B!" "Success." PHASE4 "Rendezvous with Vehicle2!" "Success." PHASE5)
+ (PHASE1 "Search Area A!" "Success." PHASE2 "Sample environment!" "Failure." PHASE5)
+ (PHASE1 "Search Area A!" "Exception." PHASE4 "Rendezvous with Vehicle2!" "Exception." PHASE5)
+ (PHASE1 "Search Area A!" "Exception." PHASE4 "Rendezvous with Vehicle2!" "Failure." PHASE5)
+ (PHASE1 "Search Area A!" "Exception." PHASE4 "Rendezvous with Vehicle2!" "Success." PHASE5))
+
+