# HG changeset patch # User Steve Losh # Date 1485694408 0 # Node ID a07961309f28eede631a7fffebbf059667c6f4be # Parent d819a1f69da93f6621c44ca4af32fa5b45b45565 Add the reasoner diff -r d819a1f69da9 -r a07961309f28 cl-ggp.asd --- a/cl-ggp.asd Fri Jan 13 16:43:52 2017 +0000 +++ b/cl-ggp.asd Sun Jan 29 12:53:28 2017 +0000 @@ -1,4 +1,4 @@ -(asdf:defsystem #:cl-ggp +(asdf:defsystem :cl-ggp :name "ggp" :description "A framework for writing General Game Playing clients." diff -r d819a1f69da9 -r a07961309f28 cl-ggp.reasoner.asd --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/cl-ggp.reasoner.asd Sun Jan 29 12:53:28 2017 +0000 @@ -0,0 +1,19 @@ +(asdf:defsystem :cl-ggp.reasoner + :name "ggp.reasoner" + + :description "A reasoner to use as a starting point for General Game Playing clients." + + :author "Steve Losh " + :maintainer "Steve Losh " + + :license "MIT/X11" + :version "0.0.1" + + :depends-on (:temperance + :cl-ggp) + + :serial t + :components ((:file "package.reasoner") + (:module "src" + :components ((:file "reasoner"))))) + diff -r d819a1f69da9 -r a07961309f28 examples/random-player.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/examples/random-player.lisp Sun Jan 29 12:53:28 2017 +0000 @@ -0,0 +1,50 @@ +(in-package :cl-user) + + +(defclass random-player (ggp:ggp-player) + ((role :accessor p-role) + (current-state :accessor p-current-state) + (reasoner :accessor p-reasoner))) + +(defmethod ggp:player-start-game + ((player random-player) rules role deadline) + (setf (p-role player) role + (p-reasoner player) (ggp.reasoner:make-reasoner rules))) + +(defmethod ggp:player-update-game + ((player random-player) moves) + (setf (p-current-state player) + (if (null moves) + (ggp.reasoner:initial-state (p-reasoner player)) + (ggp.reasoner:next-state (p-reasoner player) + (p-current-state player) + moves)))) + +(defmethod ggp:player-select-move + ((player random-player) deadline) + (let ((moves (ggp.reasoner:legal-moves-for + (p-reasoner player) + (p-current-state player) + (p-role player)))) + (nth (random (length moves)) moves))) + +(defmethod ggp:player-stop-game + ((player random-player)) + (setf (p-current-state player) nil + (p-reasoner player) nil + (p-role player) nil)) + +(defvar *random-player* + (make-instance 'random-player + :name "RandomPlayer" + :port 4000)) + +(defvar *random-player-2* + (make-instance 'random-player + :name "AnotherRandomPlayer" + :port 5000)) + +; (ggp:start-player *random-player*) +; (ggp:start-player *random-player-2*) +; (ggp:kill-player *random-player*) +; (ggp:kill-player *random-player-2*) diff -r d819a1f69da9 -r a07961309f28 package.lisp --- a/package.lisp Fri Jan 13 16:43:52 2017 +0000 +++ b/package.lisp Sun Jan 29 12:53:28 2017 +0000 @@ -18,8 +18,7 @@ :read-gdl-from-file ) - (:documentation "The main GGP package.") - ) + (:documentation "The main GGP package.")) (defpackage :ggp-rules (:import-from :cl :nil) ; fuckin lol diff -r d819a1f69da9 -r a07961309f28 package.reasoner.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/package.reasoner.lisp Sun Jan 29 12:53:28 2017 +0000 @@ -0,0 +1,12 @@ +(defpackage :ggp.reasoner + (:use :cl :temperance) + (:export + :make-reasoner + :initial-state + :next-state + :terminalp + :legal-moves-for + :goal-value-for) + (:documentation "The package containing a simple GGP reasoner.")) + + diff -r d819a1f69da9 -r a07961309f28 src/example.lisp --- a/src/example.lisp Fri Jan 13 16:43:52 2017 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -(in-package #:cl-user) - -(defclass simple-player (ggp:ggp-player) - ()) - -(defmethod ggp:player-select-move ((player simple-player) timeout) - (format t "Selecting move (timeout ~A)~%" timeout) - 'ggp-rules::wait) - - -(defvar *player* nil) - -(setf *player* (make-instance 'simple-player - :name "SimplePlayer" - :port 5000)) - - -(ggp:start-player *player*) -(ggp:kill-player *player*) - diff -r d819a1f69da9 -r a07961309f28 src/ggp.lisp --- a/src/ggp.lisp Fri Jan 13 16:43:52 2017 +0000 +++ b/src/ggp.lisp Sun Jan 29 12:53:28 2017 +0000 @@ -1,4 +1,4 @@ -(in-package #:ggp) +(in-package :ggp) (named-readtables:in-readtable :fare-quasiquote) diff -r d819a1f69da9 -r a07961309f28 src/reasoner.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/reasoner.lisp Sun Jan 29 12:53:28 2017 +0000 @@ -0,0 +1,118 @@ +(in-package :ggp.reasoner) + +;;;; Utilities ---------------------------------------------------------------- +(defun gdl-rule-p (form) + (and (consp form) + (eq (car form) 'ggp-rules::<=))) + +(defun normalize-state (state) + (remove-duplicates state :test #'equal)) + + +;;;; Reasoner ----------------------------------------------------------------- +(defun load-gdl-preamble (db) + (push-logic-frame-with db + (rule db (ggp-rules::not ?x) (call ?x) ! fail) + (fact db (ggp-rules::not ?x)) + + (rule db (ggp-rules::or ?x ?y) (call ?x)) + (rule db (ggp-rules::or ?x ?y) (call ?y)) + + (rule db (ggp-rules::and ?x ?y) (call ?x) (call ?y)) + + (rule db (ggp-rules::distinct ?x ?x) ! fail) + (fact db (ggp-rules::distinct ?x ?y)))) + +(defun make-reasoner-database () + (let ((db (temperance:make-database))) + (load-gdl-preamble db) + db)) + + +(defclass reasoner () + ((database :initform (make-reasoner-database) :reader reasoner-database) + (current-state :initform nil :accessor reasoner-state) + (current-moves :initform nil :accessor reasoner-moves))) + + +(defun clean-gdl (rules) + ;; todo this + rules) + +(defun load-rule (rule) + (if (gdl-rule-p rule) + (apply #'invoke-rule t (rest rule)) + (invoke-fact t rule))) + +(defun load-rules-into-reasoner (reasoner rules) + (with-database (reasoner-database reasoner) + (push-logic-frame-with t + (map nil #'load-rule rules)))) + + +(defun make-reasoner (rules) + (let ((reasoner (make-instance 'reasoner))) + (load-rules-into-reasoner reasoner rules) + reasoner)) + + +(defun apply-state (reasoner state) + (push-logic-frame-with t + (loop :for fact :in state + :do (invoke-fact t `(ggp-rules::true ,fact)))) + (setf (reasoner-state reasoner) state)) + +(defun apply-moves (reasoner moves) + (push-logic-frame-with t + (loop :for (role . action) :in moves + :do (invoke-fact t `(ggp-rules::does ,role ,action)))) + (setf (reasoner-moves reasoner) moves)) + + +(defun clear-state (reasoner) + (pop-logic-frame (reasoner-database reasoner)) + (setf (reasoner-state reasoner) nil)) + +(defun clear-moves (reasoner) + (pop-logic-frame (reasoner-database reasoner)) + (setf (reasoner-moves reasoner) nil)) + + +(defun ensure-state (reasoner state) + (when (not (eql state (reasoner-state reasoner))) + (when (not (null (reasoner-moves reasoner))) + (clear-moves reasoner)) + (when (not (null (reasoner-state reasoner))) + (clear-state reasoner)) + (apply-state reasoner state))) + +(defun ensure-moves (reasoner moves) + (when (not (eql moves (reasoner-moves reasoner))) + (when (not (null (reasoner-moves reasoner))) + (clear-moves reasoner)) + (apply-moves reasoner moves))) + + +(defun initial-state (reasoner) + (normalize-state + (query-for (reasoner-database reasoner) ?what + (ggp-rules::init ?what)))) + +(defun next-state (reasoner state moves) + (with-database (reasoner-database reasoner) + (ensure-state reasoner state) + (ensure-moves reasoner moves) + (normalize-state + (query-for t ?what (ggp-rules::next ?what))))) + + +(defun legal-moves (reasoner state) + (with-database (reasoner-database reasoner) + (ensure-state reasoner state) + (query-all t (ggp-rules::legal ?role ?action)))) + +(defun legal-moves-for (reasoner state role) + (loop :for move :in (legal-moves reasoner state) + :when (eq (getf move '?role) role) + :collect (getf move '?action))) +