# HG changeset patch # User Steve Losh # Date 1472068645 0 # Node ID 1f0a36161f174adb0b7ff25d30f88ef2af3b8505 # Parent 45622a0c4e96eb774ed302a0642201ee8b1dcf08 Implement the rest of the GDL benchmarking diff -r 45622a0c4e96 -r 1f0a36161f17 contrib/gdl-benchmark/README.markdown --- a/contrib/gdl-benchmark/README.markdown Wed Aug 24 15:43:20 2016 +0000 +++ b/contrib/gdl-benchmark/README.markdown Wed Aug 24 19:57:25 2016 +0000 @@ -43,3 +43,22 @@ [Roswell]: https://github.com/roswell/roswell [SBCL]: http://www.sbcl.org/ + +Performance +----------- + +The benchmark script ensures that Temperance will be compiled with sane +optimization settings: `(debug 1) (safety 1) (speed 3)`. + +If you want to throw caution to the wind and see how fast it can get, you can +set the `PLEASE_SEGFAULT` environment variable to `YES` **when building**: + + cd ~/.roswell/local-projects/temperance/contrib/gdl-benchmark/ + + ros use sbcl + PLEASE_SEGFAULT=YES ros build run-temperance.ros + +This must be done when *building*. The variable has no effect when running the +binary. + +In practice this results in a speed increase of around 20%. diff -r 45622a0c4e96 -r 1f0a36161f17 contrib/gdl-benchmark/run-temperance.ros --- a/contrib/gdl-benchmark/run-temperance.ros Wed Aug 24 15:43:20 2016 +0000 +++ b/contrib/gdl-benchmark/run-temperance.ros Wed Aug 24 19:57:25 2016 +0000 @@ -9,7 +9,23 @@ (ql:quickload :unix-opts :silent t) (ql:quickload :split-sequence :silent t) (ql:quickload :losh :silent t) -(ql:quickload :temperance :silent t) + +(defmacro shut-up (&body body) + `(let ((*standard-output* (make-broadcast-stream)) + (*error-output* (make-broadcast-stream))) + ,@body)) + + +(defun load-temperance () + (if (string= "YES" (uiop:getenv "PLEASE_SEGFAULT")) + (declaim (optimize (debug 0) (safety 0) (speed 3))) + (declaim (optimize (debug 1) (safety 1) (speed 3)))) + (shut-up + (asdf:load-system :temperance :force t)) + (declaim (optimize (debug 3) (safety 1) (speed 1)))) + +(load-temperance) + ;;;; Package ------------------------------------------------------------------ (defpackage #:temperance.contrib.gdl-benchmark @@ -140,17 +156,193 @@ :collect (cons role move)))) +(defvar *update-count* 0) +(defvar *legal-move-count* 0) +(defvar *goal-state-count* 0) + +(defvar *deadline* nil) + +(defun calculate-deadline (seconds) + (setf *deadline* (+ (get-internal-real-time) + (* internal-time-units-per-second seconds)))) + +(defun time-exceeded-p () + (and *deadline* (> (get-internal-real-time) *deadline*))) + + +(defun evaluate-goals () + (goal-values) + (incf *goal-state-count*)) + + +(defun run-random-simulation (state) + (apply-state state) + (if (terminalp) + (progn + (evaluate-goals) + (clear-state)) + (let ((move (random-elt (legal-moves)))) + (incf *legal-move-count*) + (apply-moves move) + (let ((next (next-state))) + (incf *update-count*) + (clear-moves) + (clear-state) + (run-random-simulation next))))) + + +(defun run-monte-carlo (limit state) + (format t "Searching with Monte-Carlo search for ~D seconds.~%" limit) + (calculate-deadline limit) + (loop :for simulation-count :from 0 + :until (time-exceeded-p) + :do (progn + (when (dividesp simulation-count 1000) + (format t "#simulations: ~D~%" simulation-count)) + (run-random-simulation state)) + :finally (format t "#simulations: ~D~%" simulation-count))) + + +; def minimax(state, depth): +; global nb_legals, nb_updates +; if checkTimeout(): return False + +; # check for termination condition +; if state.isTerminal(): +; if checkTimeout(): return False +; # compute goal values +; evalgoals(state) +; return True +; if depth <= 0: +; return False + +; isTerminal = True + +; # compute all possible joint moves (combinations of legal moves of all players) +; moves = state.getMoves() +; nb_legals+=1 +; if checkTimeout(): return False + +; # for each joint move +; for move in moves: +; # go to the successor state +; successor = state.getSuccessor(move) +; nb_updates+=1 +; # search the successor state (recursively) +; isTerminal = minimax(successor, depth-1) and isTerminal # order matters here +; if checkTimeout(): return False +; return isTerminal + +(defun minimax (state depth) + ;; I know this is horrible, but I wanted to do as straight a port of the other + ;; benchmarks as possible to minimize differences between benchmarks. + (block nil + (when (time-exceeded-p) (return)) + + (apply-state state) + + (when (terminalp) + (when (time-exceeded-p) (clear-state) (return)) + (evaluate-goals) + (clear-state) + (return t)) + + (when (<= depth 0) + (clear-state) + (return)) + + (loop + :with terminal = t + :with moves = (prog1 (legal-moves) + (incf *legal-move-count*) + (when (time-exceeded-p) (clear-state) (return))) + :for move :in moves + :for successor = (prog2 (apply-moves move) + (next-state) + (clear-moves) + (incf *update-count*)) + :do (setf terminal (and (prog2 + (clear-state) + (minimax successor (1- depth)) + (apply-state state)) + terminal)) + :do (when (time-exceeded-p) (clear-state) (return)) + :finally (progn + (clear-state) + (return terminal))))) + + +(defun run-dfs (limit state) + (format t "Searching with DFS for at most ~D seconds.~%" limit) + (loop + :with finished = nil + :with deadline = (calculate-deadline limit) + :for depth :from 0 + :until (or (> (get-internal-real-time) deadline) + finished) + :do (setf finished (minimax state depth)))) + + +(defun fixed-depth-dfs (limit state) + (setf *deadline* nil) + (loop + :with finished = nil + :for depth :from 0 :to limit + :until finished + :do (setf finished (minimax state depth)))) + +(defun run-trace (trace algorithm) + (setf *update-count* 0 + *legal-move-count* 0 + *goal-state-count* 0) + (let ((start (get-internal-real-time))) + (recursively ((state (initial-state)) + (trace trace) + (step 1)) + (flet + ((handle-terminal () + (clear-state) + (if trace + (progn + (format t "ERROR: Terminal state with trace of ~S remaining.~%" + trace) + (format t "Offending state:~%~{ ~S~%~}~%" state)) + (evaluate-goals))) + (handle-non-terminal () + (when (null trace) + (format t "ERROR: Non-terminal state with no trace remaining.~%") + (clear-state) + (return-from run-trace)) + (format t "Step ~D~%" step) + (apply-moves (first trace)) + (let ((next (next-state))) + (clear-moves) + (clear-state) + (funcall algorithm state) + (incf *update-count*) + (format t "MOVE ~D #legals: ~D, #updates: ~D, #goals: ~D~%" + step *legal-move-count* *update-count* *goal-state-count*) + (recur next + (rest trace) + (1+ step))))) + (apply-state state) + (if (terminalp) + (handle-terminal) + (handle-non-terminal)))) + + (format t "FINAL #legals: ~D, #updates: ~D, #goals: ~D, seconds: ~F~%" + *legal-move-count* *update-count* *goal-state-count* + (/ (- (get-internal-real-time) start) + internal-time-units-per-second)))) + (defun run (modes limit gdl-file trace-file) - (declare (ignore modes limit)) (build-database (read-gdl gdl-file)) - (build-traces ()) - (print (roles)) - (print (build-traces (read-trace trace-file))) - (print (initial-state)) - (print (terminalp)) - (apply-state (initial-state)) - (print (legal-moves)) - ) + (dolist (mode modes) + (run-trace (build-traces (read-trace trace-file)) + (ecase mode + (:mc (curry #'run-monte-carlo limit)) + (:dfs (curry #'run-dfs limit)) + (:fdfs (curry #'fixed-depth-dfs limit)))))) ;;;; CLI ---------------------------------------------------------------------- @@ -236,6 +428,7 @@ (usage) (die "ERROR: All arguments are required.~%")) + (in-package :temperance.contrib.gdl-benchmark) (destructuring-bind (modes limit gdl-file trace-file) arguments (run (parse-modes modes) (parse-limit limit)