4ce62327f4bd

Add `abort` support, tweak examples for ELS
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Mon, 03 Apr 2017 23:52:37 +0200
parents fc6ac5c922d6
children 90c855f298b8
branches/tags (none)
files examples/monte-carlo-player.lisp examples/random-player.lisp src/ggp.lisp

Changes

--- a/examples/monte-carlo-player.lisp	Thu Mar 23 18:55:04 2017 +0000
+++ b/examples/monte-carlo-player.lisp	Mon Apr 03 23:52:37 2017 +0200
@@ -6,9 +6,7 @@
 (defun random-elt (sequence)
   (elt sequence (random (length sequence))))
 
-
-;;;; Simulations --------------------------------------------------------------
-(defun random-move (reasoner state)
+(defun random-joint-move (reasoner state)
   (mapcar (lambda (role)
             (cons role (random-elt
                          (ggp.reasoner:legal-moves-for reasoner state role))))
@@ -17,11 +15,13 @@
 (defun random-playout-value (reasoner role state &optional our-move)
   (if (ggp.reasoner:terminalp reasoner state)
     (ggp.reasoner:goal-value-for reasoner state role)
-    (let ((move (random-move reasoner state)))
+    (let ((joint-move (random-joint-move reasoner state)))
       (when our-move
-        (setf (cdr (assoc role move)) our-move))
-      (random-playout-value reasoner role
-                            (ggp.reasoner:next-state reasoner state move)))))
+        (setf (cdr (assoc role joint-move)) our-move))
+      (random-playout-value
+        reasoner
+        role
+        (ggp.reasoner:next-state reasoner state joint-move)))))
 
 
 ;;;; Player -------------------------------------------------------------------
@@ -32,6 +32,7 @@
 
 (defmethod ggp:player-start-game
     ((player monte-carlo-player) rules role deadline)
+  (declare (ignore deadline))
   (setf (p-role player) role
         (p-reasoner player) (ggp.reasoner:make-reasoner rules)))
 
@@ -45,13 +46,34 @@
                                    moves))))
 
 
-(defun conservative-deadline (deadline &optional (seconds-of-breathing-room 1))
-  (- deadline (* seconds-of-breathing-room internal-time-units-per-second)))
+(defun conservative-deadline (deadline seconds-of-breathing-room)
+  (- deadline (* seconds-of-breathing-room
+                 internal-time-units-per-second)))
 
 (defmethod ggp:player-select-move
     ((player monte-carlo-player) deadline)
   (loop
-    :with conservative-deadline = (conservative-deadline deadline)
+    :with conservative-deadline = (conservative-deadline deadline 2)
+    :with reasoner = (p-reasoner player)
+    :with state = (p-current-state player)
+    :with role = (p-role player)
+    :with our-moves = (ggp.reasoner:legal-moves-for reasoner state role)
+    :with scores = (mapcar (lambda (move) (cons move 0))
+                           our-moves)
+    ; '(((mark 1 1) . 0)
+    ;   ((mark 1 2) . 0)
+    ;   ...)
+    :until (>= (get-internal-real-time) conservative-deadline)
+    :do (dolist (move our-moves)
+          (incf (cdr (assoc move scores))
+                (random-playout-value reasoner role state move)))
+    :finally (return (car (first (sort scores #'> :key #'cdr))))))
+
+
+(defmethod ggp:player-select-move
+    ((player monte-carlo-player) deadline)
+  (loop
+    :with conservative-deadline = (conservative-deadline deadline 2)
     :with reasoner = (p-reasoner player)
     :with state = (p-current-state player)
     :with role = (p-role player)
@@ -60,6 +82,7 @@
                            our-moves)
     :for count :from 1
     :until (>= (get-internal-real-time) conservative-deadline)
+    :when (= 1 (length our-moves)) :do (return (first our-moves))
     :do (dolist (move our-moves)
           (incf (cdr (assoc move scores))
                 (random-playout-value reasoner role state move)))
@@ -73,6 +96,7 @@
                (finish-output)
                (return (car (first (sort scores #'> :key #'cdr)))))))
 
+
 (defmethod ggp:player-stop-game
     ((player monte-carlo-player))
   (setf (p-current-state player) nil
@@ -83,7 +107,7 @@
 ;;;; Scratch ------------------------------------------------------------------
 (defvar *monte-carlo-player*
   (make-instance 'monte-carlo-player
-    :name "MonteCarloPlayer"
+    :name "ELSMonteCarloPlayer"
     :port 4000))
 
 ;; (ggp:start-player *monte-carlo-player*)
--- a/examples/random-player.lisp	Thu Mar 23 18:55:04 2017 +0000
+++ b/examples/random-player.lisp	Mon Apr 03 23:52:37 2017 +0200
@@ -1,13 +1,16 @@
 (in-package :cl-user)
 
+(ql:quickload '(:cl-ggp :cl-ggp.reasoner))
 
 (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)
+  (declare (ignore deadline))
   (setf (p-role player) role
         (p-reasoner player) (ggp.reasoner:make-reasoner rules)))
 
@@ -22,6 +25,7 @@
 
 (defmethod ggp:player-select-move
     ((player random-player) deadline)
+  (declare (ignore deadline))
   (let ((moves (ggp.reasoner:legal-moves-for
                  (p-reasoner player)
                  (p-current-state player)
@@ -34,17 +38,12 @@
         (p-reasoner player) nil
         (p-role player) nil))
 
+
 (defvar *random-player*
   (make-instance 'random-player
-                 :name "RandomPlayer"
+                 :name "ELSRandomPlayer"
                  :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*)
+;; (ggp:start-player *random-player*)
+;; (ggp:kill-player *random-player*)
--- a/src/ggp.lisp	Thu Mar 23 18:55:04 2017 +0000
+++ b/src/ggp.lisp	Mon Apr 03 23:52:37 2017 +0200
@@ -14,6 +14,7 @@
     ggp-rules::play
     ggp-rules::stop
     ggp-rules::start
+    ggp-rules::abort
 
     ggp-rules::name
     ggp-rules::status
@@ -273,6 +274,12 @@
   'ggp-rules::done)
 
 
+(defun handle-abort (player match-id)
+  (l "Handling abort request for ~S~%" match-id)
+  (cleanup-game player)
+  'ggp-rules::done)
+
+
 (defun route (player request)
   "Route the request to the appropriate player function."
   (match request
@@ -288,6 +295,9 @@
     (`(ggp-rules::stop ,match-id ,moves)
      (handle-stop player match-id moves))
 
+    (`(ggp-rules::abort ,match-id)
+     (handle-abort player match-id))
+
     (`(ggp-rules::stop ,match-id ,turn ,move ,percepts)
      (handle-stop-ii player match-id turn move percepts))