diff --git a/missions/lisp/IeeeJOE2018PaperBasicExample/IeeeJOE2018HumanDirectedAllPathsSearch.cl b/missions/lisp/IeeeJOE2018PaperBasicExample/IeeeJOE2018HumanDirectedAllPathsSearch.cl index 6535f67200ffc2f90b5d138013c4a08bc9f4a4fa..3daa7bb5f612d92544d42798d3f2a3cdf883b38a 100644 --- a/missions/lisp/IeeeJOE2018PaperBasicExample/IeeeJOE2018HumanDirectedAllPathsSearch.cl +++ b/missions/lisp/IeeeJOE2018PaperBasicExample/IeeeJOE2018HumanDirectedAllPathsSearch.cl @@ -1,6 +1,7 @@ + ;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 diff --git a/missions/lisp/IeeeJOE2018PaperBasicExample/IeeeJOE2018HumanDirectedAllPathsSearch.output.txt b/missions/lisp/IeeeJOE2018PaperBasicExample/IeeeJOE2018HumanDirectedAllPathsSearch.output.txt index 611c0eda99d282734df18dd8ab45e57254aec358..382659a5a6721316f3d883024f0df75986f23af7 100644 --- a/missions/lisp/IeeeJOE2018PaperBasicExample/IeeeJOE2018HumanDirectedAllPathsSearch.output.txt +++ b/missions/lisp/IeeeJOE2018PaperBasicExample/IeeeJOE2018HumanDirectedAllPathsSearch.output.txt @@ -1,3 +1,6 @@ + +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)) + +