--- 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."
--- /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 <steve@stevelosh.com>"
+ :maintainer "Steve Losh <steve@stevelosh.com>"
+
+ :license "MIT/X11"
+ :version "0.0.1"
+
+ :depends-on (:temperance
+ :cl-ggp)
+
+ :serial t
+ :components ((:file "package.reasoner")
+ (:module "src"
+ :components ((:file "reasoner")))))
+
--- /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*)
--- 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
--- /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."))
+
+
--- 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*)
-
--- 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)
--- /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)))
+