a07961309f28

Add the reasoner
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sun, 29 Jan 2017 12:53:28 +0000
parents d819a1f69da9
children 1a4608813a73
branches/tags (none)
files cl-ggp.asd cl-ggp.reasoner.asd examples/random-player.lisp package.lisp package.reasoner.lisp src/example.lisp src/ggp.lisp src/reasoner.lisp

Changes

--- 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)))
+