--- a/examples/bench.lisp Sun May 15 00:06:53 2016 +0000
+++ b/examples/bench.lisp Thu May 19 14:13:37 2016 +0000
@@ -1,4 +1,5 @@
(ql:quickload 'bones)
+(ql:quickload 'paiprolog)
(load "examples/ggp-paip.lisp")
(load "examples/ggp.lisp")
@@ -10,13 +11,16 @@
(*debug-io* (make-broadcast-stream))
(*terminal-io* (make-broadcast-stream))
(*error-output* (make-broadcast-stream)))
- (asdf:load-system 'bones :force t)))
+ (asdf:load-system 'bones :force t)
+ (asdf:load-system 'paiprolog :force t)
+ (load "examples/ggp-paip.lisp")
+ (load "examples/ggp.lisp")))
(defun run-test ()
(reload)
(format t "PAIP ------------------------------~%")
- (time (bones.paip::dfs-exhaust))
+ (time (paiprolog-test::dfs-exhaust))
(format t "WAM -------------------------------~%")
(time (bones.wam::dfs-exhaust)))
@@ -26,15 +30,15 @@
; (declaim (optimize (speed 0) (safety 3) (debug 3)))
; (run-test)
-; (format t "~%~%====================================~%")
-; (format t "(speed 3) (safety 1) (debug 1)~%")
-; (declaim (optimize (speed 3) (safety 1) (debug 1)))
-; (run-test)
+(format t "~%~%====================================~%")
+(format t "(speed 3) (safety 1) (debug 1)~%")
+(declaim (optimize (speed 3) (safety 1) (debug 1)))
+(run-test)
-(format t "~%~%====================================~%")
-(format t "(speed 3) (safety 1) (debug 0)~%")
-(declaim (optimize (speed 3) (safety 1) (debug 0)))
-(run-test)
+; (format t "~%~%====================================~%")
+; (format t "(speed 3) (safety 1) (debug 0)~%")
+; (declaim (optimize (speed 3) (safety 1) (debug 0)))
+; (run-test)
(format t "~%~%====================================~%")
(format t "(speed 3) (safety 0) (debug 0)~%")
--- a/examples/ggp-paip.lisp Sun May 15 00:06:53 2016 +0000
+++ b/examples/ggp-paip.lisp Thu May 19 14:13:37 2016 +0000
@@ -1,209 +1,209 @@
-(in-package #:bones.paip)
+(defpackage #:paiprolog-test
+ (:use #:cl #:paiprolog))
-(clear-db)
+(in-package #:paiprolog-test)
+
-(rule (member ?thing (cons ?thing ?rest)))
+(defvar *state* nil)
+(defvar *actions* nil)
-(rule (member ?thing (cons ?other ?rest))
- (member ?thing ?rest))
+(defun paiprolog::true/1 (?thing cont)
+ (loop :with tr = (fill-pointer paiprolog::*trail*)
+ :for item :in *state*
+ :when (paiprolog::unify! ?thing item)
+ :do
+ (funcall cont)
+ (paiprolog::undo-bindings! tr)))
-(rule (true ?state ?thing)
- (member ?thing ?state))
-
-(rule (does ?performed ?role ?move)
- (member (does ?role ?move) ?performed))
+(defun paiprolog::does/1 (?action cont)
+ (loop :with tr = (fill-pointer paiprolog::*trail*)
+ :for action :in *actions*
+ :when (paiprolog::unify! ?action action)
+ :do
+ (funcall cont)
+ (paiprolog::undo-bindings! tr)))
-(rule (role robot))
+(<-- (member ?x (?x . ?)))
+(<- (member ?x (?y . ?rest))
+ (member ?x ?rest))
+
+(<-- (role robot))
-(rule (init (off p)))
-(rule (init (off q)))
-(rule (init (off r)))
-(rule (init (off s)))
-(rule (init (step num1)))
+(<-- (init (off p)))
+(<- (init (off q)))
+(<- (init (off r)))
+(<- (init (off s)))
+(<- (init (step num1)))
-(rule (next ?state ?performed (on p))
- (does ?performed robot a)
- (true ?state (off p)))
-(rule (next ?state ?performed (on q))
- (does ?performed robot a)
- (true ?state (on q)))
-(rule (next ?state ?performed (on r))
- (does ?performed robot a)
- (true ?state (on r)))
-(rule (next ?state ?performed (off p))
- (does ?performed robot a)
- (true ?state (on p)))
-(rule (next ?state ?performed (off q))
- (does ?performed robot a)
- (true ?state (off q)))
-(rule (next ?state ?performed (off r))
- (does ?performed robot a)
- (true ?state (off r)))
+(<-- (next (on p))
+ (does (robot a))
+ (true (off p)))
+(<- (next (on q))
+ (does (robot a))
+ (true (on q)))
+(<- (next (on r))
+ (does (robot a))
+ (true (on r)))
+(<- (next (off p))
+ (does (robot a))
+ (true (on p)))
+(<- (next (off q))
+ (does (robot a))
+ (true (off q)))
+(<- (next (off r))
+ (does (robot a))
+ (true (off r)))
-(rule (next ?state ?performed (on p))
- (does ?performed robot b)
- (true ?state (on q)))
-(rule (next ?state ?performed (on q))
- (does ?performed robot b)
- (true ?state (on p)))
-(rule (next ?state ?performed (on r))
- (does ?performed robot b)
- (true ?state (on r)))
-(rule (next ?state ?performed (off p))
- (does ?performed robot b)
- (true ?state (off q)))
-(rule (next ?state ?performed (off q))
- (does ?performed robot b)
- (true ?state (off p)))
-(rule (next ?state ?performed (off r))
- (does ?performed robot b)
- (true ?state (off r)))
-
-(rule (next ?state ?performed (on p))
- (does ?performed robot c)
- (true ?state (on p)))
-(rule (next ?state ?performed (on q))
- (does ?performed robot c)
- (true ?state (on r)))
-(rule (next ?state ?performed (on r))
- (does ?performed robot c)
- (true ?state (on q)))
-(rule (next ?state ?performed (off p))
- (does ?performed robot c)
- (true ?state (off p)))
-(rule (next ?state ?performed (off q))
- (does ?performed robot c)
- (true ?state (off r)))
-(rule (next ?state ?performed (off r))
- (does ?performed robot c)
- (true ?state (off q)))
+(<- (next (on p))
+ (does (robot b))
+ (true (on q)))
+(<- (next (on q))
+ (does (robot b))
+ (true (on p)))
+(<- (next (on r))
+ (does (robot b))
+ (true (on r)))
+(<- (next (off p))
+ (does (robot b))
+ (true (off q)))
+(<- (next (off q))
+ (does (robot b))
+ (true (off p)))
+(<- (next (off r))
+ (does (robot b))
+ (true (off r)))
-(rule (next ?state ?performed (off s))
- (does ?performed robot a)
- (true ?state (off s)))
-(rule (next ?state ?performed (off s))
- (does ?performed robot b)
- (true ?state (off s)))
-(rule (next ?state ?performed (off s))
- (does ?performed robot c)
- (true ?state (off s)))
-(rule (next ?state ?performed (on s))
- (does ?performed robot a)
- (true ?state (on s)))
-(rule (next ?state ?performed (on s))
- (does ?performed robot b)
- (true ?state (on s)))
-(rule (next ?state ?performed (on s))
- (does ?performed robot c)
- (true ?state (on s)))
-(rule (next ?state ?performed (off s))
- (does ?performed robot d)
- (true ?state (on s)))
-(rule (next ?state ?performed (on s))
- (does ?performed robot d)
- (true ?state (off s)))
+(<- (next (on p))
+ (does (robot c))
+ (true (on p)))
+(<- (next (on q))
+ (does (robot c))
+ (true (on r)))
+(<- (next (on r))
+ (does (robot c))
+ (true (on q)))
+(<- (next (off p))
+ (does (robot c))
+ (true (off p)))
+(<- (next (off q))
+ (does (robot c))
+ (true (off r)))
+(<- (next (off r))
+ (does (robot c))
+ (true (off q)))
-(rule (next ?state ?performed (on p))
- (does ?performed robot d)
- (true ?state (on p)))
-(rule (next ?state ?performed (off p))
- (does ?performed robot d)
- (true ?state (off p)))
+(<- (next (off s))
+ (does (robot a))
+ (true (off s)))
+(<- (next (off s))
+ (does (robot b))
+ (true (off s)))
+(<- (next (off s))
+ (does (robot c))
+ (true (off s)))
+(<- (next (on s))
+ (does (robot a))
+ (true (on s)))
+(<- (next (on s))
+ (does (robot b))
+ (true (on s)))
+(<- (next (on s))
+ (does (robot c))
+ (true (on s)))
+(<- (next (off s))
+ (does (robot d))
+ (true (on s)))
+(<- (next (on s))
+ (does (robot d))
+ (true (off s)))
-(rule (next ?state ?performed (on q))
- (does ?performed robot d)
- (true ?state (on q)))
-(rule (next ?state ?performed (off q))
- (does ?performed robot d)
- (true ?state (off q)))
+(<- (next (on p))
+ (does (robot d))
+ (true (on p)))
+(<- (next (off p))
+ (does (robot d))
+ (true (off p)))
-(rule (next ?state ?performed (on r))
- (does ?performed robot d)
- (true ?state (on r)))
-(rule (next ?state ?performed (off r))
- (does ?performed robot d)
- (true ?state (off r)))
+(<- (next (on q))
+ (does (robot d))
+ (true (on q)))
+(<- (next (off q))
+ (does (robot d))
+ (true (off q)))
-(rule (next ?state ?performed (step ?y))
- (true ?state (step ?x))
- (succ ?x ?y))
+(<- (next (on r))
+ (does (robot d))
+ (true (on r)))
+(<- (next (off r))
+ (does (robot d))
+ (true (off r)))
-(rule (succ num1 num2))
-(rule (succ num2 num3))
-(rule (succ num3 num4))
-(rule (succ num4 num5))
-(rule (succ num5 num6))
-(rule (succ num6 num7))
-(rule (succ num7 num8))
+(<- (next (step ?y))
+ (true (step ?x))
+ (succ ?x ?y))
+
+(<-- (succ num1 num2))
+(<- (succ num2 num3))
+(<- (succ num3 num4))
+(<- (succ num4 num5))
+(<- (succ num5 num6))
+(<- (succ num6 num7))
+(<- (succ num7 num8))
-(rule (legal robot a))
-(rule (legal robot b))
-(rule (legal robot c))
-(rule (legal robot d))
+(<-- (legal robot a))
+(<- (legal robot b))
+(<- (legal robot c))
+(<- (legal robot d))
-(rule (goal ?state robot num100)
- (true ?state (on p))
- (true ?state (on q))
- (true ?state (on r))
- (true ?state (on s)))
-(rule (goal ?state robot num0)
- (true ?state (off p)))
-(rule (goal ?state robot num0)
- (true ?state (off q)))
-(rule (goal ?state robot num0)
- (true ?state (off r)))
-(rule (goal ?state robot num0)
- (true ?state (off s)))
+(<-- (goal robot num100)
+ (true (on p))
+ (true (on q))
+ (true (on r))
+ (true (on s)))
+(<- (goal robot num0)
+ (true (off p)))
+(<- (goal robot num0)
+ (true (off q)))
+(<- (goal robot num0)
+ (true (off r)))
+(<- (goal robot num0)
+ (true (off s)))
-(rule (terminal ?state)
- (true ?state (step num8)))
-(rule (terminal ?state)
- (true ?state (on p))
- (true ?state (on q))
- (true ?state (on r))
- (true ?state (on s)))
+(<-- (terminal)
+ (true (step num8)))
+(<- (terminal)
+ (true (on p))
+ (true (on q))
+ (true (on r))
+ (true (on s)))
+
+(<-- (lol 1))
(defvar *count* 0)
-(defun extract (key results)
- (mapcar (lambda (result) (cdr (assoc key result))) results))
-
-(defun to-fake-list (l)
- (if (null l)
- 'nil
- `(cons ,(car l) ,(to-fake-list (cdr l)))))
+(defun initial-state ()
+ (prolog-collect (?what) (init ?what)))
-(defun initial-state ()
- (to-fake-list
- (extract '?what (return-all (init ?what)))))
-
-(defun terminalp (state)
- (raw-provable-p `(terminal ,state)))
+(defun terminalp ()
+ (not (null (prolog-first (?lol)
+ (terminal)
+ (lol ?lol)))))
(defun legal-moves (state)
(declare (ignore state))
- (return-all (legal ?role ?move)))
+ (prolog-collect (?role ?move) (legal ?role ?move)))
(defun roles ()
- (extract '?role (return-all (role ?role))))
-
-(defun goal-value (state role)
- (cdr (assoc '?goal
- (raw-return-one `(goal ,state ,role ?goal)))))
-
-(defun goal-values (state)
- (raw-return-all `(goal ,state ?role ?goal)))
+ (prolog-collect (?role) (role ?role)))
-(defun next-state (current-state move)
- (let ((does (to-fake-list `((does
- ,(cdr (assoc '?role move))
- ,(cdr (assoc '?move move)))))))
- (to-fake-list
- (extract
- '?what
- (raw-return-all `(next ,current-state ,does ?what))))))
+(defun goal-value ()
+ (prolog-first (?goal) (goal robot ?goal)))
+
+(defun next-state (move)
+ (setf *actions* (list move))
+ (prolog-collect (?what) (next ?what)))
(defstruct search-path state (path nil) (previous nil))
@@ -227,16 +227,17 @@
(defun buttons-goal-p (search-path)
- (let ((state (search-path-state search-path)))
- (and (terminalp state)
- (eql (goal-value state 'robot) 'num100))))
+ (setf *state* (search-path-state search-path))
+ (and (terminalp)
+ (eql (goal-value) 'num100)))
(defun buttons-children (search-path)
(let ((state (search-path-state search-path))
(path (search-path-path search-path)))
- (when (not (terminalp state))
+ (setf *state* state)
+ (when (not (terminalp))
(loop :for move :in (legal-moves state)
- :collect (make-search-path :state (next-state state move)
+ :collect (make-search-path :state (next-state move)
:path (cons move path)
:previous search-path)))))
@@ -257,7 +258,7 @@
#'never
#'buttons-children
#'append)
- (format t "Searched ~D nodes.~%" *count*))))
+ (format t "Searched ~D nodes.~%" *count*))))
(defun bfs ()
(tree-search (list (make-search-path :state (initial-state)))
@@ -266,9 +267,15 @@
(lambda (x y)
(append y x))))
-; (sb-sprof:with-profiling
-; (:report :flat
-; :sample-interval 0.001
-; :loop nil)
-; (dfs-exhaust)
-; )
+
+(declaim (sb-ext:muffle-conditions sb-ext:compiler-note))
+
+#+no
+(progn
+ (require :sb-sprof)
+ (sb-sprof:with-profiling (:max-samples 10000
+ :sample-interval 0.01
+ :loop nil)
+ (dfs-exhaust))
+
+ (sb-sprof:report :type :flat :max 100))