src/players/random-ii.lisp @ fc378d24dd2f
default tip
Make zdd union a bit cleaner
author |
Steve Losh <steve@stevelosh.com> |
date |
Tue, 30 May 2017 15:13:42 +0000 |
parents |
50011302bb36 |
children |
(none) |
(in-package :scully.players.random-ii)
(defvar *data-file* nil)
(defvar *current-game* nil)
(defvar *run* 0.0)
(defvar *gc* 0.0)
;;;; Random Incomplete-Information Player -------------------------------------
(defclass random-ii-player (ggp:ggp-player)
((role :type symbol :accessor rp-role)
(reasoner :accessor rp-reasoner)
(information-set :accessor rp-information-set)
(turn :initform 0 :accessor rp-turn)
(game-number :initform 0 :accessor rp-game-number)))
(define-with-macro (random-ii-player :conc-name rp)
role reasoner information-set turn game-number)
(defun percepts-match-p (player state moves percepts)
(set-equal percepts
(percepts-for (rp-reasoner player) (rp-role player) state moves)
:test #'equal))
(defun get-possible-moves (player state move)
(let* ((reasoner (rp-reasoner player))
(our-role (rp-role player))
(other-roles (remove our-role (roles reasoner)))
(other-moves (mapcar (lambda (role)
(mapcar (curry #'cons role)
(legal-moves-for reasoner role state)))
other-roles)))
(apply #'map-product #'list
(list (cons our-role move))
other-moves)))
(defun get-next-states (player state move percepts)
(-<> (get-possible-moves player state move)
(mapcar (lambda (moves)
(when (percepts-match-p player state moves percepts)
(next-state (rp-reasoner player) state moves)))
<>)
(remove nil <>)
(remove-duplicates <> :test #'equal)))
(defun get-next-information-set (player move percepts)
(iterate (for state :in (rp-information-set player))
(unioning (get-next-states player state move percepts)
:test #'equal)))
(defun information-set-objects (iset)
(apply #'+ (mapcar #'length iset)))
(defun dump-iset (iset)
(iterate (for state :in iset)
(for i :from 1)
(format t "~%State ~D~%" i)
(iterate (for term :in state)
(format t " ~S~%" term))))
(defmethod ggp:player-start-game ((player random-ii-player) rules role timeout)
(setf *data-file* (open "data-prolog" :direction :output
:if-exists :append
:if-does-not-exist :create)
*run* 0.0
*gc* 0.0)
(sb-ext:gc :full t)
;; (format *data-file* "turn,information set size,cons/symbol count~%")
(let ((reasoner (make-prolog-reasoner)))
(incf (rp-game-number player))
(load-rules reasoner rules)
(setf (rp-role player) role
(rp-turn player) 0
(rp-reasoner player) reasoner)))
(defmethod ggp:player-stop-game ((player random-ii-player))
(finish-output *data-file*)
(close *data-file*)
(setf (rp-role player) nil
(rp-reasoner player) nil
(rp-information-set player) nil))
(defmethod ggp:player-update-game-ii ((player random-ii-player) move percepts)
(format t "~2%=====================================~%")
(with-random-ii-player (player)
(incf turn)
(setf information-set (scully.gdl:time-it
(*run* *gc*)
(if move
(get-next-information-set player move percepts)
(list (initial-state reasoner)))))
(format *data-file* "~A,~D,~D,~D,~D,~,4F,~,4F~%"
*current-game*
game-number
turn
(length information-set)
(information-set-objects information-set)
*run*
*gc*)))
(defmethod ggp:player-select-move ((player random-ii-player) timeout)
(format t "Selecting move...~%")
(with-random-ii-player (player)
(format t "Information set size: ~D~%" (length information-set))
(format t "Information set object count ~D~%"
(information-set-objects information-set))
(-<> information-set
first
(legal-moves-for reasoner role <>)
pr
scully.gdl:sort-moves
first)))
;;;; Run ----------------------------------------------------------------------
(setf hunchentoot:*default-connection-timeout* nil) ; its_fine
(defvar *player* (make-instance 'random-ii-player
:name "Scully-Random-II"
:port 5002))
(setf *current-game* 'mastermind448)
;; (ggp:start-player *player* :server :hunchentoot :use-thread t)
;; (ggp:kill-player *player*)