# HG changeset patch # User Steve Losh # Date 1468594981 0 # Node ID 1411666a60f8998375966b6380a7c736592688bf # Parent c547c69d5405ee3f3ce47865df60b7a4cd46c4d8 Clean up the examples a bit, still needs a lot of work diff -r c547c69d5405 -r 1411666a60f8 examples/ggp-wam-hanoi.lisp --- a/examples/ggp-wam-hanoi.lisp Fri Jul 15 02:23:07 2016 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,272 +0,0 @@ -(in-package #:bones.wam) - -(declaim (optimize (speed 3) (debug 0) (safety 0))) - -(defparameter *d* (make-database)) - -(with-database *d* - (rules ((member :thing (list* :thing :rest))) - ((member :thing (list* :other :rest)) - (member :thing :rest))) - - (rule (true :state :thing) - (member :thing :state)) - - (rule (does :performed :role :move) - (member (does :role :move) :performed)) - - (rules ((not :x) (call :x) ! fail) - ((not :x))) - - (fact (role player)) - - (facts (init (on disc7 pillar1)) - (init (on disc6 disc7)) - (init (on disc5 disc6)) - (init (on disc4 disc5)) - (init (on disc3 disc4)) - (init (on disc2 disc3)) - (init (on disc1 disc2)) - (init (clear disc1)) - (init (clear pillar2)) - (init (clear pillar3)) - (init (step s0))) - - (rule (legal :state player (puton :x :y)) - (true :state (clear :x)) - (true :state (clear :y)) - (smallerdisc :x :y)) - - (rules ((next :state :performed (step :y)) - (true :state (step :x)) - (successor :x :y)) - ((next :state :performed (on :x :y)) - (does :performed player (puton :x :y))) - ((next :state :performed (on :x :y)) - (true :state (on :x :y)) - (not (put_on_any :performed :x))) - ((next :state :performed (clear :y)) - (true :state (on :x :y)) - (put_on_any :performed :x)) - ((next :state :performed (clear :y)) - (true :state (clear :y)) - (not (put_any_on :performed :y)))) - - (rule (put_on_any :performed :x) - (does :performed player (puton :x :y))) - - (rule (put_any_on :performed :y) - (does :performed player (puton :x :y))) - - (rules ((goal :state player num100) - (tower :state pillar3 s7)) - ((goal :state player num80) - (tower :state pillar3 s6)) - ((goal :state player num60) - (tower :state pillar3 s5)) - ((goal :state player num40) - (tower :state pillar3 s4)) - ((goal :state player num0) - (tower :state pillar3 :height) - (smaller :height s4))) - - (rule (terminal :state) - (true :state (step s127))) - - (rules ((tower :state :x s0) - (true :state (clear :x))) - ((tower :state :x :height) - (true :state (on :y :x)) - (disc_or_pillar :y) - (tower :state :y :height1) - (successor :height1 :height))) - - (facts (pillar pillar1) - (pillar pillar2) - (pillar pillar3)) - - (rules ((nextsize disc1 disc2)) - ((nextsize disc2 disc3)) - ((nextsize disc3 disc4)) - ((nextsize disc4 disc5)) - ((nextsize disc5 disc6)) - ((nextsize disc6 disc7)) - ((nextsize disc7 :pillar) - (pillar :pillar))) - - (rules ((disc_or_pillar :p) (pillar :p)) - ((disc_or_pillar disc1)) - ((disc_or_pillar disc2)) - ((disc_or_pillar disc3)) - ((disc_or_pillar disc4)) - ((disc_or_pillar disc5)) - ((disc_or_pillar disc6)) - ((disc_or_pillar disc7))) - - (rules ((smallerdisc :a :b) - (nextsize :a :b)) - ((smallerdisc :a :b) - (nextsize :a :c) - (smallerdisc :c :b))) - - (facts (successor s0 s1) (successor s1 s2) (successor s2 s3) - (successor s3 s4) (successor s4 s5) (successor s5 s6) - (successor s6 s7) (successor s7 s8) (successor s8 s9) - (successor s9 s10) (successor s10 s11) (successor s11 s12) - (successor s12 s13) (successor s13 s14) (successor s14 s15) - (successor s15 s16) (successor s16 s17) (successor s17 s18) - (successor s18 s19) (successor s19 s20) (successor s20 s21) - (successor s21 s22) (successor s22 s23) (successor s23 s24) - (successor s24 s25) (successor s25 s26) (successor s26 s27) - (successor s27 s28) (successor s28 s29) (successor s29 s30) - (successor s30 s31) (successor s31 s32) (successor s32 s33) - (successor s33 s34) (successor s34 s35) (successor s35 s36) - (successor s36 s37) (successor s37 s38) (successor s38 s39) - (successor s39 s40) (successor s40 s41) (successor s41 s42) - (successor s42 s43) (successor s43 s44) (successor s44 s45) - (successor s45 s46) (successor s46 s47) (successor s47 s48) - (successor s48 s49) (successor s49 s50) (successor s50 s51) - (successor s51 s52) (successor s52 s53) (successor s53 s54) - (successor s54 s55) (successor s55 s56) (successor s56 s57) - (successor s57 s58) (successor s58 s59) (successor s59 s60) - (successor s60 s61) (successor s61 s62) (successor s62 s63) - (successor s63 s64) (successor s64 s65) (successor s65 s66) - (successor s66 s67) (successor s67 s68) (successor s68 s69) - (successor s69 s70) (successor s70 s71) (successor s71 s72) - (successor s72 s73) (successor s73 s74) (successor s74 s75) - (successor s75 s76) (successor s76 s77) (successor s77 s78) - (successor s78 s79) (successor s79 s80) (successor s80 s81) - (successor s81 s82) (successor s82 s83) (successor s83 s84) - (successor s84 s85) (successor s85 s86) (successor s86 s87) - (successor s87 s88) (successor s88 s89) (successor s89 s90) - (successor s90 s91) (successor s91 s92) (successor s92 s93) - (successor s93 s94) (successor s94 s95) (successor s95 s96) - (successor s96 s97) (successor s97 s98) (successor s98 s99) - (successor s99 s100) (successor s100 s101) (successor s101 s102) - (successor s102 s103) (successor s103 s104) (successor s104 s105) - (successor s105 s106) (successor s106 s107) (successor s107 s108) - (successor s108 s109) (successor s109 s110) (successor s110 s111) - (successor s111 s112) (successor s112 s113) (successor s113 s114) - (successor s114 s115) (successor s115 s116) (successor s116 s117) - (successor s117 s118) (successor s118 s119) (successor s119 s120) - (successor s120 s121) (successor s121 s122) (successor s122 s123) - (successor s123 s124) (successor s124 s125) (successor s125 s126) - (successor s126 s127)) - - (rules ((smaller :x :y) - (successor :x :y)) - ((smaller :x :y) - (successor :x :z) - (smaller :z :y)))) - - -(defun extract (key results) - (mapcar (lambda (result) (getf result key)) results)) - -(defun to-prolog-list (l) - (if (null l) - nil - (list* 'list l))) - -(defun initial-state () - (to-prolog-list - (with-database *d* - (extract :what (return-all (init :what)))))) - -(defun terminalp (state) - (with-database *d* - (perform-prove `((terminal ,state))))) - -(defun legal-moves (state) - (with-database *d* - (perform-return `((legal ,state :role :move)) :all))) - -(defun roles () - (with-database *d* - (extract :role (return-all (role :role))))) - -(defun goal-value (state role) - (with-database *d* - (getf (perform-return `((goal ,state ,role :goal)) :one) :goal))) - -(defun goal-values (state) - (with-database *d* - (perform-return `((goal ,state :role :goal)) :all))) - -(defun next-state (current-state move) - (let ((does `(list (does - ,(getf move :role) - ,(getf move :move))))) - (with-database *d* - (to-prolog-list - (extract :what - (perform-return `((next ,current-state ,does :what)) :all)))))) - - - -(defvar *count* 0) - -(defstruct search-path state (path nil) (previous nil)) - -(defun tree-search (states goal-p children combine) - (labels - ((recur (states) - (if (null states) - nil - (destructuring-bind (state . remaining) states - (incf *count*) - (when (zerop (rem *count* 1000)) - (format t "~D...~%" *count*)) - ; (format t "Searching: ~S (~D remaining)~%" - ; state - ; (length remaining)) - (if (funcall goal-p state) - state - (recur (funcall combine - (funcall children state) - remaining))))))) - (let ((result (recur states))) - (when result - (reverse (search-path-path result)))))) - - -(defun game-goal-p (search-path) - (let ((state (search-path-state search-path))) - (and (terminalp state) - (eql (goal-value state 'player) 'num100)))) - -(defun game-children (search-path) - (let ((state (search-path-state search-path)) - (path (search-path-path search-path))) - (when (not (terminalp state)) - (loop :for move :in (legal-moves state) - :collect (make-search-path :state (next-state state move) - :path (cons move path) - :previous search-path))))) - -(defun never (&rest args) - (declare (ignore args)) - nil) - -(defun dfs () - (let ((*count* 0)) - (tree-search (list (make-search-path :state (initial-state))) - #'game-goal-p - #'game-children - #'append))) - -(defun dfs-exhaust () - (let ((*count* 0)) - (prog1 - (tree-search (list (make-search-path :state (initial-state))) - #'never - #'game-children - #'append) - (format t "Searched ~D nodes.~%" *count*)))) - -(defun bfs () - (tree-search (list (make-search-path :state (initial-state))) - #'game-goal-p - #'game-children - (lambda (x y) - (append y x)))) diff -r c547c69d5405 -r 1411666a60f8 examples/ggp-wam-rover.lisp --- a/examples/ggp-wam-rover.lisp Fri Jul 15 02:23:07 2016 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,630 +0,0 @@ -(in-package #:bones.wam) - -(declaim (optimize (speed 3) (debug 0) (safety 0))) - -(defparameter *d* (make-database)) - -(with-database *d* - (rules ((member :thing (list* :thing :rest))) - ((member :thing (list* :other :rest)) - (member :thing :rest))) - - (rule (true :state :thing) - (member :thing :state)) - - (rule (does :performed :role :move) - (member (does :role :move) :performed)) - - (rules ((not :x) (call :x) ! fail) - ((not :x))) - - (fact (role solver)) - - (facts (init (thing empty_rover0store)) - (init (thing available_rover0)) - (init (thing at_rover0_waypoint3)) - (init (thing channel_free_general)) - (init (thing at_rock_sample_waypoint3)) - (init (thing at_soil_sample_waypoint3)) - (init (thing at_rock_sample_waypoint2)) - (init (thing at_soil_sample_waypoint2)) - (init (thing at_rock_sample_waypoint1)) - (init (thing at_soil_sample_waypoint0)) - (init (step num1))) - - (rule (solved :state) - (true :state (thing communicated_image_data_objective1_high_res)) - (true :state (thing communicated_rock_data_waypoint3)) - (true :state (thing communicated_soil_data_waypoint2))) - - (rules ((terminal :state) - (true :state (thing communicated_image_data_objective1_high_res)) - (true :state (thing communicated_rock_data_waypoint3)) - (true :state (thing communicated_soil_data_waypoint2))) - ((terminal :state) - (true :state (step num30)))) - - (rules - ((goal :state solver num100) - (true :state (thing communicated_image_data_objective1_high_res)) - (true :state (thing communicated_rock_data_waypoint3)) - (true :state (thing communicated_soil_data_waypoint2))) - ((goal :state solver num0) - (not (solved :state)))) - - (rules ((legal :state solver navigate_rover0_waypoint0_waypoint3) - (true :state (thing at_rover0_waypoint0)) - (true :state (thing available_rover0))) - ((legal :state solver navigate_rover0_waypoint1_waypoint3) - (true :state (thing at_rover0_waypoint1)) - (true :state (thing available_rover0))) - ((legal :state solver communicate_image_data_rover0_general_objective1_high_res_waypoint1_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective1_high_res)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver communicate_image_data_rover0_general_objective1_colour_waypoint1_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective1_colour)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver communicate_image_data_rover0_general_objective0_high_res_waypoint1_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective0_high_res)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver communicate_image_data_rover0_general_objective0_colour_waypoint1_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective0_colour)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver communicate_image_data_rover0_general_objective1_high_res_waypoint2_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective1_high_res)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver communicate_image_data_rover0_general_objective1_colour_waypoint2_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective1_colour)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver communicate_image_data_rover0_general_objective0_high_res_waypoint2_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective0_high_res)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver communicate_image_data_rover0_general_objective0_colour_waypoint2_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective0_colour)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver communicate_image_data_rover0_general_objective1_high_res_waypoint3_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective1_high_res)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver communicate_image_data_rover0_general_objective1_colour_waypoint3_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective1_colour)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver communicate_image_data_rover0_general_objective0_high_res_waypoint3_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective0_high_res)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver communicate_image_data_rover0_general_objective0_colour_waypoint3_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_image_rover0_objective0_colour)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver communicate_rock_data_rover0_general_waypoint3_waypoint1_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_rock_analysis_rover0_waypoint3)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver communicate_rock_data_rover0_general_waypoint2_waypoint1_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_rock_analysis_rover0_waypoint2)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver communicate_rock_data_rover0_general_waypoint1_waypoint1_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_rock_analysis_rover0_waypoint1)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver communicate_rock_data_rover0_general_waypoint3_waypoint2_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_rock_analysis_rover0_waypoint3)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver communicate_rock_data_rover0_general_waypoint2_waypoint2_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_rock_analysis_rover0_waypoint2)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver communicate_rock_data_rover0_general_waypoint1_waypoint2_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_rock_analysis_rover0_waypoint1)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver communicate_rock_data_rover0_general_waypoint3_waypoint3_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_rock_analysis_rover0_waypoint3)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver communicate_rock_data_rover0_general_waypoint2_waypoint3_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_rock_analysis_rover0_waypoint2)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver communicate_rock_data_rover0_general_waypoint1_waypoint3_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_rock_analysis_rover0_waypoint1)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver communicate_soil_data_rover0_general_waypoint3_waypoint1_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_soil_analysis_rover0_waypoint3)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver communicate_soil_data_rover0_general_waypoint2_waypoint1_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_soil_analysis_rover0_waypoint2)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver communicate_soil_data_rover0_general_waypoint0_waypoint1_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_soil_analysis_rover0_waypoint0)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver communicate_soil_data_rover0_general_waypoint3_waypoint2_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_soil_analysis_rover0_waypoint3)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver communicate_soil_data_rover0_general_waypoint2_waypoint2_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_soil_analysis_rover0_waypoint2)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver communicate_soil_data_rover0_general_waypoint0_waypoint2_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_soil_analysis_rover0_waypoint0)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver communicate_soil_data_rover0_general_waypoint3_waypoint3_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_soil_analysis_rover0_waypoint3)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver communicate_soil_data_rover0_general_waypoint2_waypoint3_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_soil_analysis_rover0_waypoint2)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver communicate_soil_data_rover0_general_waypoint0_waypoint3_waypoint0) - (true :state (thing channel_free_general)) - (true :state (thing available_rover0)) - (true :state (thing have_soil_analysis_rover0_waypoint0)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver take_image_rover0_waypoint0_objective0_camera0_colour) - (true :state (thing at_rover0_waypoint0)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint0_objective0_camera0_high_res) - (true :state (thing at_rover0_waypoint0)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint1_objective0_camera0_colour) - (true :state (thing at_rover0_waypoint1)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint1_objective0_camera0_high_res) - (true :state (thing at_rover0_waypoint1)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint2_objective0_camera0_colour) - (true :state (thing at_rover0_waypoint2)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint2_objective0_camera0_high_res) - (true :state (thing at_rover0_waypoint2)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint3_objective0_camera0_colour) - (true :state (thing at_rover0_waypoint3)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint3_objective0_camera0_high_res) - (true :state (thing at_rover0_waypoint3)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint0_objective1_camera0_colour) - (true :state (thing at_rover0_waypoint0)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint0_objective1_camera0_high_res) - (true :state (thing at_rover0_waypoint0)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint1_objective1_camera0_colour) - (true :state (thing at_rover0_waypoint1)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint1_objective1_camera0_high_res) - (true :state (thing at_rover0_waypoint1)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint2_objective1_camera0_colour) - (true :state (thing at_rover0_waypoint2)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint2_objective1_camera0_high_res) - (true :state (thing at_rover0_waypoint2)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint3_objective1_camera0_colour) - (true :state (thing at_rover0_waypoint3)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver take_image_rover0_waypoint3_objective1_camera0_high_res) - (true :state (thing at_rover0_waypoint3)) - (true :state (thing calibrated_camera0_rover0))) - ((legal :state solver calibrate_rover0_camera0_objective1_waypoint0) - (true :state (thing at_rover0_waypoint0))) - ((legal :state solver calibrate_rover0_camera0_objective1_waypoint1) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver calibrate_rover0_camera0_objective1_waypoint2) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver calibrate_rover0_camera0_objective1_waypoint3) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver drop_rover0_rover0store) - (true :state (thing full_rover0store))) - ((legal :state solver sample_rock_rover0_rover0store_waypoint3) - (true :state (thing empty_rover0store)) - (true :state (thing at_rock_sample_waypoint3)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver sample_rock_rover0_rover0store_waypoint2) - (true :state (thing empty_rover0store)) - (true :state (thing at_rock_sample_waypoint2)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver sample_rock_rover0_rover0store_waypoint1) - (true :state (thing empty_rover0store)) - (true :state (thing at_rock_sample_waypoint1)) - (true :state (thing at_rover0_waypoint1))) - ((legal :state solver sample_soil_rover0_rover0store_waypoint3) - (true :state (thing empty_rover0store)) - (true :state (thing at_soil_sample_waypoint3)) - (true :state (thing at_rover0_waypoint3))) - ((legal :state solver sample_soil_rover0_rover0store_waypoint2) - (true :state (thing empty_rover0store)) - (true :state (thing at_soil_sample_waypoint2)) - (true :state (thing at_rover0_waypoint2))) - ((legal :state solver sample_soil_rover0_rover0store_waypoint0) - (true :state (thing empty_rover0store)) - (true :state (thing at_soil_sample_waypoint0)) - (true :state (thing at_rover0_waypoint0))) - ((legal :state solver navigate_rover0_waypoint2_waypoint1) - (true :state (thing at_rover0_waypoint2)) - (true :state (thing available_rover0))) - ((legal :state solver navigate_rover0_waypoint1_waypoint2) - (true :state (thing at_rover0_waypoint1)) - (true :state (thing available_rover0))) - ((legal :state solver navigate_rover0_waypoint3_waypoint0) - (true :state (thing at_rover0_waypoint3)) - (true :state (thing available_rover0))) - ((legal :state solver navigate_rover0_waypoint3_waypoint1) - (true :state (thing at_rover0_waypoint3)) - (true :state (thing available_rover0))) - ((legal :state solver noop))) - - - (facts (addeffect calibrate_rover0_camera0_objective1_waypoint0 (thing calibrated_camera0_rover0)) - (addeffect calibrate_rover0_camera0_objective1_waypoint1 (thing calibrated_camera0_rover0)) - (addeffect calibrate_rover0_camera0_objective1_waypoint2 (thing calibrated_camera0_rover0)) - (addeffect calibrate_rover0_camera0_objective1_waypoint3 (thing calibrated_camera0_rover0)) - (addeffect communicate_image_data_rover0_general_objective0_colour_waypoint1_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective0_colour_waypoint1_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective0_colour_waypoint1_waypoint0 (thing communicated_image_data_objective0_colour)) - (addeffect communicate_image_data_rover0_general_objective0_colour_waypoint2_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective0_colour_waypoint2_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective0_colour_waypoint2_waypoint0 (thing communicated_image_data_objective0_colour)) - (addeffect communicate_image_data_rover0_general_objective0_colour_waypoint3_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective0_colour_waypoint3_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective0_colour_waypoint3_waypoint0 (thing communicated_image_data_objective0_colour)) - (addeffect communicate_image_data_rover0_general_objective0_high_res_waypoint1_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective0_high_res_waypoint1_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective0_high_res_waypoint1_waypoint0 (thing communicated_image_data_objective0_high_res)) - (addeffect communicate_image_data_rover0_general_objective0_high_res_waypoint2_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective0_high_res_waypoint2_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective0_high_res_waypoint2_waypoint0 (thing communicated_image_data_objective0_high_res)) - (addeffect communicate_image_data_rover0_general_objective0_high_res_waypoint3_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective0_high_res_waypoint3_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective0_high_res_waypoint3_waypoint0 (thing communicated_image_data_objective0_high_res)) - (addeffect communicate_image_data_rover0_general_objective1_colour_waypoint1_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective1_colour_waypoint1_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective1_colour_waypoint1_waypoint0 (thing communicated_image_data_objective1_colour)) - (addeffect communicate_image_data_rover0_general_objective1_colour_waypoint2_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective1_colour_waypoint2_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective1_colour_waypoint2_waypoint0 (thing communicated_image_data_objective1_colour)) - (addeffect communicate_image_data_rover0_general_objective1_colour_waypoint3_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective1_colour_waypoint3_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective1_colour_waypoint3_waypoint0 (thing communicated_image_data_objective1_colour)) - (addeffect communicate_image_data_rover0_general_objective1_high_res_waypoint1_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective1_high_res_waypoint1_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective1_high_res_waypoint1_waypoint0 (thing communicated_image_data_objective1_high_res)) - (addeffect communicate_image_data_rover0_general_objective1_high_res_waypoint2_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective1_high_res_waypoint2_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective1_high_res_waypoint2_waypoint0 (thing communicated_image_data_objective1_high_res)) - (addeffect communicate_image_data_rover0_general_objective1_high_res_waypoint3_waypoint0 (thing available_rover0)) - (addeffect communicate_image_data_rover0_general_objective1_high_res_waypoint3_waypoint0 (thing channel_free_general)) - (addeffect communicate_image_data_rover0_general_objective1_high_res_waypoint3_waypoint0 (thing communicated_image_data_objective1_high_res)) - (addeffect communicate_rock_data_rover0_general_waypoint1_waypoint1_waypoint0 (thing available_rover0)) - (addeffect communicate_rock_data_rover0_general_waypoint1_waypoint1_waypoint0 (thing channel_free_general)) - (addeffect communicate_rock_data_rover0_general_waypoint1_waypoint1_waypoint0 (thing communicated_rock_data_waypoint1)) - (addeffect communicate_rock_data_rover0_general_waypoint1_waypoint2_waypoint0 (thing available_rover0)) - (addeffect communicate_rock_data_rover0_general_waypoint1_waypoint2_waypoint0 (thing channel_free_general)) - (addeffect communicate_rock_data_rover0_general_waypoint1_waypoint2_waypoint0 (thing communicated_rock_data_waypoint1)) - (addeffect communicate_rock_data_rover0_general_waypoint1_waypoint3_waypoint0 (thing available_rover0)) - (addeffect communicate_rock_data_rover0_general_waypoint1_waypoint3_waypoint0 (thing channel_free_general)) - (addeffect communicate_rock_data_rover0_general_waypoint1_waypoint3_waypoint0 (thing communicated_rock_data_waypoint1)) - (addeffect communicate_rock_data_rover0_general_waypoint2_waypoint1_waypoint0 (thing available_rover0)) - (addeffect communicate_rock_data_rover0_general_waypoint2_waypoint1_waypoint0 (thing channel_free_general)) - (addeffect communicate_rock_data_rover0_general_waypoint2_waypoint1_waypoint0 (thing communicated_rock_data_waypoint2)) - (addeffect communicate_rock_data_rover0_general_waypoint2_waypoint2_waypoint0 (thing available_rover0)) - (addeffect communicate_rock_data_rover0_general_waypoint2_waypoint2_waypoint0 (thing channel_free_general)) - (addeffect communicate_rock_data_rover0_general_waypoint2_waypoint2_waypoint0 (thing communicated_rock_data_waypoint2)) - (addeffect communicate_rock_data_rover0_general_waypoint2_waypoint3_waypoint0 (thing available_rover0)) - (addeffect communicate_rock_data_rover0_general_waypoint2_waypoint3_waypoint0 (thing channel_free_general)) - (addeffect communicate_rock_data_rover0_general_waypoint2_waypoint3_waypoint0 (thing communicated_rock_data_waypoint2)) - (addeffect communicate_rock_data_rover0_general_waypoint3_waypoint1_waypoint0 (thing available_rover0)) - (addeffect communicate_rock_data_rover0_general_waypoint3_waypoint1_waypoint0 (thing channel_free_general)) - (addeffect communicate_rock_data_rover0_general_waypoint3_waypoint1_waypoint0 (thing communicated_rock_data_waypoint3)) - (addeffect communicate_rock_data_rover0_general_waypoint3_waypoint2_waypoint0 (thing available_rover0)) - (addeffect communicate_rock_data_rover0_general_waypoint3_waypoint2_waypoint0 (thing channel_free_general)) - (addeffect communicate_rock_data_rover0_general_waypoint3_waypoint2_waypoint0 (thing communicated_rock_data_waypoint3)) - (addeffect communicate_rock_data_rover0_general_waypoint3_waypoint3_waypoint0 (thing available_rover0)) - (addeffect communicate_rock_data_rover0_general_waypoint3_waypoint3_waypoint0 (thing channel_free_general)) - (addeffect communicate_rock_data_rover0_general_waypoint3_waypoint3_waypoint0 (thing communicated_rock_data_waypoint3)) - (addeffect communicate_soil_data_rover0_general_waypoint0_waypoint1_waypoint0 (thing available_rover0)) - (addeffect communicate_soil_data_rover0_general_waypoint0_waypoint1_waypoint0 (thing channel_free_general)) - (addeffect communicate_soil_data_rover0_general_waypoint0_waypoint1_waypoint0 (thing communicated_soil_data_waypoint0)) - (addeffect communicate_soil_data_rover0_general_waypoint0_waypoint2_waypoint0 (thing available_rover0)) - (addeffect communicate_soil_data_rover0_general_waypoint0_waypoint2_waypoint0 (thing channel_free_general)) - (addeffect communicate_soil_data_rover0_general_waypoint0_waypoint2_waypoint0 (thing communicated_soil_data_waypoint0)) - (addeffect communicate_soil_data_rover0_general_waypoint0_waypoint3_waypoint0 (thing available_rover0)) - (addeffect communicate_soil_data_rover0_general_waypoint0_waypoint3_waypoint0 (thing channel_free_general)) - (addeffect communicate_soil_data_rover0_general_waypoint0_waypoint3_waypoint0 (thing communicated_soil_data_waypoint0)) - (addeffect communicate_soil_data_rover0_general_waypoint2_waypoint1_waypoint0 (thing available_rover0)) - (addeffect communicate_soil_data_rover0_general_waypoint2_waypoint1_waypoint0 (thing channel_free_general)) - (addeffect communicate_soil_data_rover0_general_waypoint2_waypoint1_waypoint0 (thing communicated_soil_data_waypoint2)) - (addeffect communicate_soil_data_rover0_general_waypoint2_waypoint2_waypoint0 (thing available_rover0)) - (addeffect communicate_soil_data_rover0_general_waypoint2_waypoint2_waypoint0 (thing channel_free_general)) - (addeffect communicate_soil_data_rover0_general_waypoint2_waypoint2_waypoint0 (thing communicated_soil_data_waypoint2)) - (addeffect communicate_soil_data_rover0_general_waypoint2_waypoint3_waypoint0 (thing available_rover0)) - (addeffect communicate_soil_data_rover0_general_waypoint2_waypoint3_waypoint0 (thing channel_free_general)) - (addeffect communicate_soil_data_rover0_general_waypoint2_waypoint3_waypoint0 (thing communicated_soil_data_waypoint2)) - (addeffect communicate_soil_data_rover0_general_waypoint3_waypoint1_waypoint0 (thing available_rover0)) - (addeffect communicate_soil_data_rover0_general_waypoint3_waypoint1_waypoint0 (thing channel_free_general)) - (addeffect communicate_soil_data_rover0_general_waypoint3_waypoint1_waypoint0 (thing communicated_soil_data_waypoint3)) - (addeffect communicate_soil_data_rover0_general_waypoint3_waypoint2_waypoint0 (thing available_rover0)) - (addeffect communicate_soil_data_rover0_general_waypoint3_waypoint2_waypoint0 (thing channel_free_general)) - (addeffect communicate_soil_data_rover0_general_waypoint3_waypoint2_waypoint0 (thing communicated_soil_data_waypoint3)) - (addeffect communicate_soil_data_rover0_general_waypoint3_waypoint3_waypoint0 (thing available_rover0)) - (addeffect communicate_soil_data_rover0_general_waypoint3_waypoint3_waypoint0 (thing channel_free_general)) - (addeffect communicate_soil_data_rover0_general_waypoint3_waypoint3_waypoint0 (thing communicated_soil_data_waypoint3)) - (addeffect drop_rover0_rover0store (thing empty_rover0store)) - (addeffect navigate_rover0_waypoint0_waypoint3 (thing at_rover0_waypoint3)) - (addeffect navigate_rover0_waypoint1_waypoint2 (thing at_rover0_waypoint2)) - (addeffect navigate_rover0_waypoint1_waypoint3 (thing at_rover0_waypoint3)) - (addeffect navigate_rover0_waypoint2_waypoint1 (thing at_rover0_waypoint1)) - (addeffect navigate_rover0_waypoint3_waypoint0 (thing at_rover0_waypoint0)) - (addeffect navigate_rover0_waypoint3_waypoint1 (thing at_rover0_waypoint1)) - (addeffect sample_rock_rover0_rover0store_waypoint1 (thing full_rover0store)) - (addeffect sample_rock_rover0_rover0store_waypoint1 (thing have_rock_analysis_rover0_waypoint1)) - (addeffect sample_rock_rover0_rover0store_waypoint2 (thing full_rover0store)) - (addeffect sample_rock_rover0_rover0store_waypoint2 (thing have_rock_analysis_rover0_waypoint2)) - (addeffect sample_rock_rover0_rover0store_waypoint3 (thing full_rover0store)) - (addeffect sample_rock_rover0_rover0store_waypoint3 (thing have_rock_analysis_rover0_waypoint3)) - (addeffect sample_soil_rover0_rover0store_waypoint0 (thing full_rover0store)) - (addeffect sample_soil_rover0_rover0store_waypoint0 (thing have_soil_analysis_rover0_waypoint0)) - (addeffect sample_soil_rover0_rover0store_waypoint2 (thing full_rover0store)) - (addeffect sample_soil_rover0_rover0store_waypoint2 (thing have_soil_analysis_rover0_waypoint2)) - (addeffect sample_soil_rover0_rover0store_waypoint3 (thing full_rover0store)) - (addeffect sample_soil_rover0_rover0store_waypoint3 (thing have_soil_analysis_rover0_waypoint3)) - (addeffect take_image_rover0_waypoint0_objective0_camera0_colour (thing have_image_rover0_objective0_colour)) - (addeffect take_image_rover0_waypoint0_objective0_camera0_high_res (thing have_image_rover0_objective0_high_res)) - (addeffect take_image_rover0_waypoint0_objective1_camera0_colour (thing have_image_rover0_objective1_colour)) - (addeffect take_image_rover0_waypoint0_objective1_camera0_high_res (thing have_image_rover0_objective1_high_res)) - (addeffect take_image_rover0_waypoint1_objective0_camera0_colour (thing have_image_rover0_objective0_colour)) - (addeffect take_image_rover0_waypoint1_objective0_camera0_high_res (thing have_image_rover0_objective0_high_res)) - (addeffect take_image_rover0_waypoint1_objective1_camera0_colour (thing have_image_rover0_objective1_colour)) - (addeffect take_image_rover0_waypoint1_objective1_camera0_high_res (thing have_image_rover0_objective1_high_res)) - (addeffect take_image_rover0_waypoint2_objective0_camera0_colour (thing have_image_rover0_objective0_colour)) - (addeffect take_image_rover0_waypoint2_objective0_camera0_high_res (thing have_image_rover0_objective0_high_res)) - (addeffect take_image_rover0_waypoint2_objective1_camera0_colour (thing have_image_rover0_objective1_colour)) - (addeffect take_image_rover0_waypoint2_objective1_camera0_high_res (thing have_image_rover0_objective1_high_res)) - (addeffect take_image_rover0_waypoint3_objective0_camera0_colour (thing have_image_rover0_objective0_colour)) - (addeffect take_image_rover0_waypoint3_objective0_camera0_high_res (thing have_image_rover0_objective0_high_res)) - (addeffect take_image_rover0_waypoint3_objective1_camera0_colour (thing have_image_rover0_objective1_colour)) - (addeffect take_image_rover0_waypoint3_objective1_camera0_high_res (thing have_image_rover0_objective1_high_res))) - - (facts (deleteeffect drop_rover0_rover0store (thing full_rover0store)) - (deleteeffect navigate_rover0_waypoint0_waypoint3 (thing at_rover0_waypoint0)) - (deleteeffect navigate_rover0_waypoint1_waypoint2 (thing at_rover0_waypoint1)) - (deleteeffect navigate_rover0_waypoint1_waypoint3 (thing at_rover0_waypoint1)) - (deleteeffect navigate_rover0_waypoint2_waypoint1 (thing at_rover0_waypoint2)) - (deleteeffect navigate_rover0_waypoint3_waypoint0 (thing at_rover0_waypoint3)) - (deleteeffect navigate_rover0_waypoint3_waypoint1 (thing at_rover0_waypoint3)) - (deleteeffect sample_rock_rover0_rover0store_waypoint1 (thing at_rock_sample_waypoint1)) - (deleteeffect sample_rock_rover0_rover0store_waypoint1 (thing empty_rover0store)) - (deleteeffect sample_rock_rover0_rover0store_waypoint2 (thing at_rock_sample_waypoint2)) - (deleteeffect sample_rock_rover0_rover0store_waypoint2 (thing empty_rover0store)) - (deleteeffect sample_rock_rover0_rover0store_waypoint3 (thing at_rock_sample_waypoint3)) - (deleteeffect sample_rock_rover0_rover0store_waypoint3 (thing empty_rover0store)) - (deleteeffect sample_soil_rover0_rover0store_waypoint0 (thing at_soil_sample_waypoint0)) - (deleteeffect sample_soil_rover0_rover0store_waypoint0 (thing empty_rover0store)) - (deleteeffect sample_soil_rover0_rover0store_waypoint2 (thing at_soil_sample_waypoint2)) - (deleteeffect sample_soil_rover0_rover0store_waypoint2 (thing empty_rover0store)) - (deleteeffect sample_soil_rover0_rover0store_waypoint3 (thing at_soil_sample_waypoint3)) - (deleteeffect sample_soil_rover0_rover0store_waypoint3 (thing empty_rover0store)) - (deleteeffect take_image_rover0_waypoint0_objective0_camera0_colour (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint0_objective0_camera0_high_res (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint0_objective1_camera0_colour (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint0_objective1_camera0_high_res (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint1_objective0_camera0_colour (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint1_objective0_camera0_high_res (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint1_objective1_camera0_colour (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint1_objective1_camera0_high_res (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint2_objective0_camera0_colour (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint2_objective0_camera0_high_res (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint2_objective1_camera0_colour (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint2_objective1_camera0_high_res (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint3_objective0_camera0_colour (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint3_objective0_camera0_high_res (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint3_objective1_camera0_colour (thing calibrated_camera0_rover0)) - (deleteeffect take_image_rover0_waypoint3_objective1_camera0_high_res (thing calibrated_camera0_rover0))) - - (rules - ((next :state :performed (thing :pred)) - (does :performed solver :action) - (true :state (thing :pred)) - (not (deleteeffect :action (thing :pred)))) - - ((next :state :performed (thing :pred)) - (does :performed solver :action) - (addeffect :action (thing :pred))) - - ((next :state :performed (step :y)) - (true :state (step :x)) - (succ :x :y))) - - (facts (succ num1 num2) - (succ num2 num3) - (succ num3 num4) - (succ num4 num5) - (succ num5 num6) - (succ num6 num7) - (succ num7 num8) - (succ num8 num9) - (succ num9 num10) - (succ num10 num11) - (succ num11 num12) - (succ num12 num13) - (succ num13 num14) - (succ num14 num15) - (succ num15 num16) - (succ num16 num17) - (succ num17 num18) - (succ num18 num19) - (succ num19 num20) - (succ num20 num21) - (succ num21 num22) - (succ num22 num23) - (succ num23 num24) - (succ num24 num25) - (succ num25 num26) - (succ num26 num27) - (succ num27 num28) - (succ num28 num29) - (succ num29 num30) - (succ num30 num31)) - ) - - -(defun extract (key results) - (mapcar (lambda (result) (getf result key)) results)) - -(defun to-prolog-list (l) - (if (null l) - nil - (list* 'list l))) - -(defun initial-state () - (to-prolog-list - (with-database *d* - (extract :what (return-all (init :what)))))) - -(defun terminalp (state) - (with-database *d* - (perform-prove `((terminal ,state))))) - -(defun legal-moves (state) - (with-database *d* - (perform-return `((legal ,state :role :move)) :all))) - -(defun roles () - (with-database *d* - (extract :role (return-all (role :role))))) - -(defun goal-value (state role) - (with-database *d* - (getf (perform-return `((goal ,state ,role :goal)) :one) :goal))) - -(defun goal-values (state) - (with-database *d* - (perform-return `((goal ,state :role :goal)) :all))) - -(defun next-state (current-state move) - (let ((does `(list (does - ,(getf move :role) - ,(getf move :move))))) - (with-database *d* - (to-prolog-list - (extract :what - (perform-return `((next ,current-state ,does :what)) :all)))))) - - - -(defvar *count* 0) - -(defstruct search-path state (path nil) (previous nil)) - -(defun tree-search (states goal-p children combine) - (labels - ((recur (states) - (if (null states) - nil - (destructuring-bind (state . remaining) states - (incf *count*) - (when (zerop (rem *count* 1000)) - (format t "~D...~%" *count*)) - ; (format t "Searching: ~S (~D remaining)~%" - ; state - ; (length remaining)) - (if (funcall goal-p state) - state - (recur (funcall combine - (funcall children state) - remaining))))))) - (let ((result (recur states))) - (when result - (reverse (search-path-path result)))))) - - -(defun game-goal-p (search-path) - (let ((state (search-path-state search-path))) - (and (terminalp state) - (eql (goal-value state 'player) 'num100)))) - -(defun game-children (search-path) - (let ((state (search-path-state search-path)) - (path (search-path-path search-path))) - (when (not (terminalp state)) - (loop :for move :in (legal-moves state) - :collect (make-search-path :state (next-state state move) - :path (cons move path) - :previous search-path))))) - -(defun never (&rest args) - (declare (ignore args)) - nil) - -(defun dfs () - (let ((*count* 0)) - (tree-search (list (make-search-path :state (initial-state))) - #'game-goal-p - #'game-children - #'append))) - -(defun dfs-exhaust () - (let ((*count* 0)) - (prog1 - (tree-search (list (make-search-path :state (initial-state))) - #'never - #'game-children - #'append) - (format t "Searched ~D nodes.~%" *count*)))) - -(defun bfs () - (tree-search (list (make-search-path :state (initial-state))) - #'game-goal-p - #'game-children - (lambda (x y) - (append y x)))) diff -r c547c69d5405 -r 1411666a60f8 examples/zebra-wam.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/zebra-wam.lisp Fri Jul 15 15:03:01 2016 +0000 @@ -0,0 +1,57 @@ +(in-package #:bones.wam) + +(reset-database) +(push-logic-frame) + +(fact (member ?item (list* ?item ?))) +(rule (member ?item (list* ? ?rest)) + (member ?item ?rest)) + +(rule (next-to ?x ?y ?list) + (in-order ?x ?y ?list)) + +(rule (next-to ?x ?y ?list) + (in-order ?y ?x ?list)) + +(fact (in-order ?x ?y (list* ?x ?y ?))) +(rule (in-order ?x ?y (list* ? ?rest)) + (in-order ?x ?y ?rest)) + +(rule (= ?x ?x)) + +(rule + (zebra ?houses ?water-drinker ?zebra-owner) + ;; Houses are of the form: + ;; (HOUSE ?country ?pet ?cigarette ?drink ?color) + + (= ?houses + (list (house norway ? ? ? ?) + ? + (house ? ? ? milk ?) + ? + ?)) + + (member (house england ? ? ? red ) ?houses) + (member (house spain dog ? ? ? ) ?houses) + (member (house ? ? ? coffee green ) ?houses) + (member (house ukraine ? ? tea ? ) ?houses) + (member (house ? snails winston ? ? ) ?houses) + (member (house ? ? kools ? yellow) ?houses) + (member (house ? ? lucky-strike orange-juice ? ) ?houses) + (member (house japan ? parliaments ? ? ) ?houses) + (in-order (house ? ? ? ? ivory ) + (house ? ? ? ? green ) ?houses) + (next-to (house ? ? chesterfield ? ? ) + (house ? fox ? ? ? ) ?houses) + (next-to (house ? ? kools ? ? ) + (house ? horse ? ? ? ) ?houses) + (next-to (house norway ? ? ? ? ) + (house ? ? ? ? blue ) ?houses) + + (member (house ?water-drinker ? ? water ?) ?houses) + (member (house ?zebra-owner zebra ? ? ?) ?houses)) + +(finalize-logic-frame) + +(time (query-all (zebra ?houses ?water ?zebra))) +; (declaim (optimize (speed 3) (safety 0))) diff -r c547c69d5405 -r 1411666a60f8 package.lisp --- a/package.lisp Fri Jul 15 02:23:07 2016 +0000 +++ b/package.lisp Fri Jul 15 15:03:01 2016 +0000 @@ -74,6 +74,7 @@ #:bones.utils) (:export #:make-database + #:reset-database #:with-database #:with-fresh-database diff -r c547c69d5405 -r 1411666a60f8 src/wam/ui.lisp --- a/src/wam/ui.lisp Fri Jul 15 02:23:07 2016 +0000 +++ b/src/wam/ui.lisp Fri Jul 15 15:03:01 2016 +0000 @@ -8,6 +8,10 @@ (defun make-database () (make-wam)) +(defun reset-database () + (setf *database* (make-database))) + + (defmacro with-database (database &body body) `(let ((*database* ,database)) ,@body))