Add `abort` support, tweak examples for ELS
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))