(in-package #:cl-user) ;;; ;;; Init ;;; (eval-when (:compile-toplevel :load-toplevel :execute) ;; #+swank (declaim (optimize (speed 3) (safety 2))) #+swank (declaim (optimize (speed 0) (safety 3) (debug 3))) #-swank (declaim (optimize (speed 3) (safety 0) (debug 0))) #-swank (declaim (sb-ext:muffle-conditions sb-ext:compiler-note)) #-swank (sb-ext:disable-debugger)) ;;; ;;; Reader Macros ;;; (eval-when (:compile-toplevel :load-toplevel :execute) (set-dispatch-macro-character #\# #\f #'(lambda (stream c2 n) (declare (ignore c2 n)) (let ((form (read stream t nil t))) `(lambda (&optional %) (declare (ignorable %)) ,form)))) (set-dispatch-macro-character #\# #\> #'(lambda (stream c2 n) (declare (ignore c2 n)) (let ((form (read stream t nil t))) (declare (ignorable form)) #-swank nil #+swank (if (atom form) `(format *error-output* "~a => ~a~&" ',form ,form) `(format *error-output* "~a => ~a~&" ',form `(,,@form))))))) ;;; ;;; Libraries ;;; ;;; ;;; BOF ;;; (defpackage cp-library/avl-tree (:use #:cl) (:nicknames #:avl) (:shadow #:remove #:count) (:export #:make-avl-tree #:insert #:remove #:insert! #:remove! #:count #:dump-to-list #:dump-to-tree #:keys #:vals #:predecessor #:successor #:nth-element #:compare-default #:compare-keyword #:ref #:update #:update! #:make-avl-tree-from-list #:rand-nth)) (in-package avl) (declaim (inline %%make-node)) (defstruct (node (:constructor %%make-node) (:conc-name %%)) (key nil :type t) (value nil :type t) (cnt nil :type fixnum) (height nil :type fixnum) (l nil :type (or null node)) (r nil :type (or null node))) (defmacro define-accessor-for-nullable-node (name accessor default) `(progn (declaim (inline ,name)) (defun ,name (node) (if node (,accessor node) ,default)))) (define-accessor-for-nullable-node %value %%value nil) (define-accessor-for-nullable-node %key %%key nil) (define-accessor-for-nullable-node %cnt %%cnt 0) (define-accessor-for-nullable-node %height %%height 0) (define-accessor-for-nullable-node %l %%l nil) (define-accessor-for-nullable-node %r %%r nil) (defun dump-to-list (node) (let ((res nil)) (labels ((rec (node) (when node (rec (%%l node)) (push (cons (%%key node) (%%value node)) res) (rec (%%r node))))) (rec node) (reverse res)))) (defmethod print-object ((node node) s) (print-unreadable-object (node s :type t) (dolist (kv (dump-to-list node)) (fresh-line s) (princ kv s)) (terpri s))) (defun dump-to-tree (node) (labels ((rec (node) (when node (cl:remove nil (list (rec (%%l node)) (when node (cons (%%key node) (%%value node))) (rec (%%r node))))))) (rec node))) (declaim (inline %make-node)) (defun %make-node (&key key value l r) (declare ((or null node) l r)) (let ((height (1+ (max (%height l) (%height r)))) (cnt (1+ (the fixnum (+ (%cnt l) (%cnt r)))))) (declare (fixnum height cnt)) (%%make-node :key key :value value :height height :cnt cnt :l l :r r))) (defun make-avl-tree () "Create an empty avl-tree." nil) ;; helper functions (declaim (inline %update-node)) (defun %update-node (node &key (key nil k-p) (value nil v-p) (l nil l-p) (r nil r-p)) (%make-node :key (if k-p key (%key node)) :value (if v-p value (%value node)) :l (if l-p l (%l node)) :r (if r-p r (%r node)))) (declaim (inline %rotate-left)) (defun %rotate-left (node) (declare (node node) #+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note)) (let* ((r (%%r node)) (rl (%l r))) (%update-node r :l (%update-node node :r rl)))) (declaim (inline %rotate-right)) (defun %rotate-right (node) (declare (node node) #+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note)) (let* ((l (%%l node)) (lr (%r l))) (%update-node l :r (%update-node node :l lr)))) (declaim (inline %rotate-lr)) (defun %rotate-lr (node) (%rotate-right (%update-node node :l (%rotate-left (%%l node))))) (declaim (inline %rotate-rl)) (defun %rotate-rl (node) (%rotate-left (%update-node node :r (%rotate-right (%%r node))))) (defconstant +too-left+ -2) (defconstant +left+ -1) (defconstant +even+ 0) (defconstant +right+ 1) (defconstant +too-right+ 2) (declaim (inline %bias)) (defun %bias (node) (if (null node) 0 (- (%height (%%r node)) (%height (%%l node))))) (declaim (inline %left-right-case-p)) (defun %left-right-case-p (node) (= (%bias (%%l node)) +right+)) (declaim (inline %right-left-case-p)) (defun %right-left-case-p (node) (= (%bias (%%r node)) +left+)) (declaim (inline %balance)) (defun %balance (node) (let ((b (%bias node))) (cond ((= b +even+) (values node t)) ((or (= b +left+) (= b +right+)) (values node nil)) ((<= b +too-left+) (values (if (%left-right-case-p node) (%rotate-lr node) (%rotate-right node)) t)) (t (values (if (%right-left-case-p node) (%rotate-rl node) (%rotate-left node)) t))))) (defun compare-default (key node-key) (declare (fixnum node-key key)) (cond ((= key node-key) :eq) ((< key node-key) :less) (t :greater))) (defun compare-keyword (k1 k2) (declare (keyword k1 k2)) (let ((k1 (sb-impl::eq-hash k1)) (k2 (sb-impl::eq-hash k2))) (cond ((< k1 k2) :less) ((= k1 k2) :eq) (t :greater)))) (defun insert (node key value &optional (compare #'compare-default)) ;; (values balanced-node need-to-balance-parents) (declare (optimize (speed 3) (safety 0)) (function compare)) (labels ((%rec (node) (unless node (return-from %rec (values (%make-node :key key :value value) nil))) (ecase (funcall compare key (%%key node)) (:eq ;; 書き換えだけなのでbalanceしなくていい (values (%update-node node :value value) t)) (:less (multiple-value-bind (l balanced) (%rec (%%l node)) (let ((new-node (%update-node node :l l))) (if balanced (values new-node t) (%balance new-node))))) (:greater (multiple-value-bind (r balanced) (%rec (%%r node)) (let ((new-node (%update-node node :r r))) (if balanced (values new-node t) (%balance new-node)))))))) (%rec node))) (defun %remove-rightest (node) ;; (values new-node removed-node balanced) (declare (optimize (speed 3) (safety 0))) (let ((r (%%r node))) (if (null r) ;; node = rightest (let ((l (%%l node)) (removed (%update-node node :l nil))) (values l removed nil)) (multiple-value-bind (new-r removed balanced) (%remove-rightest r) (let ((new (%update-node node :r new-r))) (if balanced (values new removed t) (multiple-value-bind (new balanced) (%balance new) (values new removed balanced)))))))) (defun remove (node key &optional (compare #'compare-default)) (declare (optimize (speed 3) (safety 0)) (function compare)) (labels ((%rec (node) (unless node (return-from %rec (values nil nil))) (ecase (funcall compare key (%%key node)) (:eq (let ((l (%%l node)) (r (%%r node))) (unless (and l r) (return-from %rec (if #1=(or l r) (values #1# nil) (values nil t)))) (multiple-value-bind (new-l removed balanced) (%remove-rightest l) (if (null removed) ;; 変更なし (values node t) (let ((new-node (%make-node :key (%%key removed) :value (%%value removed) :l new-l :r (%%r node)))) (if balanced (values new-node t) (%balance new-node))))))) (:less (multiple-value-bind (l balanced) (%rec (%%l node)) (let ((new-node (%update-node node :l l))) (if balanced (values new-node t) (%balance new-node))))) (:greater (multiple-value-bind (r balanced) (%rec (%%r node)) (let ((new-node (%update-node node :r r))) (if balanced (values new-node t) (%balance new-node)))))))) (%rec node))) (define-modify-macro insert! (key value &optional (compare '(function compare-default))) insert) (define-modify-macro remove! (key &optional (compare '(function compare-default))) remove) (defun keys (node) (mapcar #'car (dump-to-list node))) (defun vals (node) (mapcar #'cdr (dump-to-list node))) (defun count (node) (%cnt node)) (defun predecessor (node key &optional (compare #'compare-default)) (declare (optimize (speed 3) (safety 0)) (function compare)) (labels ((%rec (node) (when node (ecase (funcall compare key (%%key node)) (:greater (or (%rec (%%r node)) node)) ((:eq :less) (%rec (%%l node))))))) (let ((res (%rec node))) (if res (values (%%key res) (%%value res) t) (values nil nil nil))))) (defun successor (node key &optional (compare #'compare-default)) (declare (optimize (speed 3) (safety 0)) (function compare)) (labels ((%rec (node) (when node (ecase (funcall compare key (%%key node)) (:less (or (%rec (%%l node)) node)) ((:eq :greater) (%rec (%%r node))))))) (let ((res (%rec node))) (if res (values (%%key res) (%%value res) t) (values nil nil nil))))) (defun nth-element (node n) (declare (optimize (speed 3) (safety 0)) (fixnum n)) (labels ((%rec (node k) (declare (fixnum k)) (let ((l-cnt (%cnt (%%l node)))) (declare (fixnum l-cnt)) (cond ((< k l-cnt) (%rec (%%l node) k)) ((= k l-cnt) node) (t (%rec (%%r node) (- k l-cnt 1))))))) (if (<= 0 n (the fixnum (1- (the fixnum (%cnt node))))) (let ((res (%rec node n))) (declare (node node)) (values (%%key res) (%%value res) t)) (values nil nil nil)))) (defun rand-nth (node) (when node (nth-element node (random (count node))))) (defun ref (node key &optional (compare #'compare-default)) (declare (optimize (speed 3) (safety 0)) (function compare)) (labels ((%rec (node) (when node (ecase (funcall compare key (%%key node)) (:eq node) (:less (%rec (%%l node))) (:greater (%rec (%%r node))))))) (let ((res (%rec node))) (if res (values (%%key node) (%%value node) t) (values nil nil nil))))) (defun update (node key fn &optional (compare #'compare-default)) (let ((current (ref node key compare))) (insert node key (funcall fn current) compare))) (defun make-avl-tree-from-list (key-fn value-fn list &optional (compare #'compare-default)) (let ((res nil)) (dolist (x list res) (avl:insert! res (funcall key-fn x) (funcall value-fn x) compare)))) (define-modify-macro update! (key fn &optional (compare '(function compare-default))) update) ;;; ;;; EOF ;;; ;;; ;;; BOF ;;; (defpackage randomized-heap (:use #:cl) (:nicknames #:rh) (:shadow #:count) (:export #:make-randomized-heap #:empty-p #:push! #:pop! #:peak #:count #:do-all-kvs #:prune!)) (in-package #:randomized-heap) (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *OPT* #+swank '(optimize (speed 3) (safety 2)) #-swank '(optimize (speed 3) (safety 0) (debug 0)))) (declaim (inline %make-node make-randomized-heap)) (defstruct (node (:constructor %make-node) (:conc-name %n-)) (key nil :type fixnum) (value nil :type t) (children (make-array 2 :element-type '(or null node) :initial-element nil) :type (simple-array (or null node) (2)))) (defstruct (randomized-heap (:constructor make-randomized-heap (&optional (compare #'sb-impl::two-arg-<) (key-fn #'identity)))) (root nil :type (or null node)) (count 0 :type (integer 0 #.most-positive-fixnum)) (comparator compare :type (function (fixnum fixnum) boolean)) (key-fn key-fn :type (function (t) fixnum))) (defun count (heap) (randomized-heap-count heap)) (declaim (inline %direction)) (defun %direction () (declare #.*OPT*) (random 2)) (defun meld (l r comparator) (declare #.*OPT* ((or null node) l r) ((function (fixnum fixnum) boolean) comparator)) (cond ((or (null l) (null r)) (or l r)) ((funcall comparator (%n-key l) (%n-key r)) ;; l is root (let ((dir (%direction))) (setf (aref (%n-children l) dir) (meld (aref (%n-children l) dir) r comparator)) l)) (t ;; r is root (let ((dir (%direction))) (setf (aref (%n-children r) dir) (meld l (aref (%n-children r) dir) comparator)) r)))) (declaim (inline peak)) (defun peak (heap) (declare #.*OPT*) (let ((root (randomized-heap-root heap))) (values (%n-value root) (%n-key root)))) (defun empty-p (heap) (null (randomized-heap-root heap))) (declaim (inline pop! push!)) (defun pop! (heap) (declare #.*OPT*) (when (empty-p heap) (error "heap is empty")) (decf (randomized-heap-count heap)) (multiple-value-bind (value key) (peak heap) (let* ((children (%n-children (randomized-heap-root heap))) (l (aref children 0)) (r (aref children 1))) (setf (randomized-heap-root heap) (meld l r (randomized-heap-comparator heap))) (values value key)))) (defun push! (heap value) (declare #.*OPT*) (let ((key (funcall (randomized-heap-key-fn heap) value))) (incf (randomized-heap-count heap)) (setf (randomized-heap-root heap) (meld (randomized-heap-root heap) (%make-node :key key :value value) (randomized-heap-comparator heap)))) heap) (defmacro do-all-kvs ((key value heap) &body body &environment env) (let ((temp (gensym))) (multiple-value-bind (args argvs res setter accessor) (get-setf-expansion heap env) `(let ((,temp (make-randomized-heap (randomized-heap-comparator ,accessor) (randomized-heap-key-fn ,accessor)))) (loop :until (empty-p ,accessor) :do (multiple-value-bind (,value ,key) (pop! ,accessor) (progn ,@body) (push! ,temp ,value))) (let* (,@(mapcar #'list args argvs) (,(car res) ,temp)) ,setter nil))))) (defun prune! (heap cnt) (let ((new-root nil) (comparator (randomized-heap-comparator heap))) (dotimes (_ cnt) (multiple-value-bind (v k) (pop! heap) (setf new-root (meld new-root (%make-node :key k :value v) comparator)))) (setf (randomized-heap-root heap) new-root))) ;;; ;;; EOF ;;; ;;; ;;; Macros ;;; (in-package #:cl-user) (defmacro do-iota ((var count &optional (start 0) (step 1)) &body body) (check-type step integer) (let* ((last (gensym)) (terminate (if (plusp step) `(>= ,var ,last) `(<= ,var ,last)))) `(let ((,last (+ ,start (the fixnum (* ,step ,count))))) (declare (fixnum ,last)) (do ((,var ,start (+ ,var ,step))) (,terminate (progn ,@body)))))) (defmacro awhen (test &body forms) `(let ((it ,test)) (when it ,@forms))) (defmacro while (test &body body) `(loop while ,test do (progn ,@body))) (defmacro eval-always (&body body) `(eval-when (:compile-toplevel :load-toplevel :execute) ,@body)) ;;; ;;; I/O ;;; (in-package #:cl-user) (declaim (inline println)) (defun println (obj &optional (stream *standard-output*)) #+sbcl (declare (sb-kernel:ansi-stream stream)) (let ((*read-default-float-format* 'double-float)) (prog1 obj (princ obj stream) (terpri stream)))) (declaim (inline %read-byte)) (defun %read-byte (&optional (stream *standard-input*)) (declare (inline read-byte) #+(and sbcl (not swank)) (sb-kernel:ansi-stream stream)) (the fixnum #+swank (char-code (read-char stream nil #\Nul)) #-swank (read-byte stream nil #.(char-code #\Nul)))) (declaim (inline read-fixnum)) (defun read-fixnum (&optional (in *standard-input*) (byte-reader #'%read-byte)) ;; Ref: https://competitive12.blogspot.com/2020/03/common-lisp.html ;; partially modified (declare ((function (stream) (unsigned-byte 8)) byte-reader) (optimize (speed 3) (safety 0) (debug 0))) (let ((minus nil) (res 0)) (declare (boolean minus) (fixnum res)) (labels ((%byte->num (b) (the fixnum (- (the fixnum b) #.(char-code #\0)))) (%digit-p (byte) (<= #.(char-code #\0) (the fixnum byte) #.(char-code #\9))) (%first-proc! () (loop for byte of-type fixnum = (funcall byte-reader in) do (cond ((%digit-p byte) (setf (the fixnum res) (%byte->num byte)) (return)) ((= byte #.(char-code #\Nul)) (error "EOF")) ((= byte #.(char-code #\-)) (setf minus t))))) (%rest-proc! () (loop for byte of-type fixnum = (funcall byte-reader in) do (cond ((%digit-p byte) (setf (the fixnum res) (the fixnum (+ (the fixnum (* res 10)) (%byte->num byte))))) (t (return)))))) (declare (inline %byte->num %digit-p %first-proc! %rest-proc!)) (%first-proc!) (%rest-proc!) (the fixnum (if minus (- res) res))))) (declaim (inline read-base-char)) (defun read-base-char (&optional (stream *standard-input*)) (code-char (%read-byte stream))) (defun read-line-fast (&optional (stream *standard-input*)) #+(and (not swank) sbcl) (declare (sb-kernel:ansi-stream stream)) (loop with buffer of-type base-string = (make-array 0 :element-type 'base-char :fill-pointer 0) for c of-type base-char = (read-base-char stream) until (or (eql c #\Newline) (eql c #\Nul)) do (vector-push-extend c buffer) finally (return buffer))) (defun split (string &optional (separator #\space)) (declare (base-char separator)) (let ((pos (position separator string))) (if pos (cons (subseq string 0 pos) (split (subseq string (1+ pos)) separator)) (list string)))) (declaim (inline parse-fixnum)) (defun parse-fixnum (string) (with-input-from-string (in string) (read-fixnum in #f(the (unsigned-byte 8) (char-code (read-char % nil #\Nul nil)))))) (declaim (inline read-times)) (defun read-times (count &key (result-type 'list) (reader #'read-fixnum)) (coerce (loop repeat count collect (funcall reader)) result-type)) (defun unwrap (sequence) ;; e.g. (unwrap (list 1 2 3 4 5)) => "1 2 3 4 5" (let ((*standard-output* (make-string-output-stream :element-type 'base-char))) (let ((init nil)) (declare (boolean init)) (map nil (lambda (x) (when init (princ #\space)) (setq init t) (princ x)) sequence)) (coerce (get-output-stream-string *standard-output*) 'simple-base-string))) ;;; ;;; Body ;;; (in-package #:cl-user) (defmacro %expander-body (form cases) `(ecase ,form ,@(loop for (from . to) in cases collect `(,from ,to)))) (defmacro define-ecase-expander (name assoc-list) `(defmacro ,name (form) `(%expander-body ,form ,',assoc-list))) (eval-always ;; TODO wait (defconstant +grid-size+ 60) (defconstant +player-vital+ 1500) (sb-int:defconstant-eqx +char-int-assoc+ '((#\. . 0) (#\# . 1) (#\S . 2) (#\G . 3) (#\K . 4) (#\J . 5) (#\F . 6) (#\E . 7)) #'equalp) (sb-int:defconstant-eqx +move-dy-dx-assoc+ '((:down . (1 . 0)) (:up . (-1 . 0)) (:left . (0 . -1)) (:right . (0 . 1)) #+nil (:wait . (0 . 0))) #'equalp) (sb-int:defconstant-eqx +dir-char-assoc+ '((:down . #\D) (:up . #\U) (:left . #\L) (:right . #\R)) #'equal) (sb-int:defconstant-eqx +moves+ (mapcar #'car +move-dy-dx-assoc+) #'equal) (sb-int:defconstant-eqx +dy-dx+ (mapcar #'cdr +move-dy-dx-assoc+) #'equalp) (defun swap-cons (xs) (cons (cdr xs) (car xs)))) (define-ecase-expander char->int-ecase #.+char-int-assoc+) (define-ecase-expander int->char-ecase #.(mapcar #'swap-cons +char-int-assoc+)) (define-ecase-expander dir->char-ecase #.+dir-char-assoc+) (defun char->int (c) (char->int-ecase c)) (defun int->char (int) (int->char-ecase int)) (defun dir->char (dir) (dir->char-ecase dir)) (defun move->dy-dx (move) "Returns (cons dy dx)" (cdr (assoc move +move-dy-dx-assoc+))) ;; Coord (eval-always (defconstant +each-coord-word-size+ 8)) (eval-always (deftype coord () '(unsigned-byte #.(* +each-coord-word-size+ 2)))) (declaim (inline y x)) (defun y (c) (ldb (byte #.+each-coord-word-size+ 0) c)) (defun x (c) (ldb (byte #.+each-coord-word-size+ #.+each-coord-word-size+) c)) #+nil (defun valid-coord-p (c) (and (<= 0 (y c) (1- +grid-size+)) (<= 0 (x c) (1- +grid-size+)))) (declaim (inline make-coord)) (defun make-coord (&key y x) (when (and (<= 0 y (1- +grid-size+)) (<= 0 x (1- +grid-size+))) (dpb x (byte +each-coord-word-size+ +each-coord-word-size+) y))) #+nil (let ((c (make-coord :y 3 :x 1))) (values c (y c) (x c))) (declaim (inline next-coord)) (defun next-coord (c dy dx) (make-coord :y (the fixnum (+ (y c) dy)) :x (the fixnum (+ (x c) dx)))) (deftype costs () '(simple-array single-float (#.+grid-size+ #.+grid-size+))) (deftype objs () '(simple-array (unsigned-byte 4) (#.+grid-size+ #.+grid-size+))) (defstruct (game-info (:conc-name %)) "ゲーム中に変化しない情報をまとめる" (estimated-cost-to-goal nil :type costs) (estimated-cost-to-key nil :type costs) (key-pos nil :type coord) (objs nil :type objs :read-only t) ;; TODO use vector (finder-cycle-by-coord (make-hash-table) :type hash-table :read-only t) (finder-penalty nil :type fixnum)) (defun estimated-cost-to-goal (game-info c) (aref (%estimated-cost-to-goal game-info) (y c) (x c))) (defun estimated-cost-to-key (game-info c) (aref (%estimated-cost-to-key game-info) (y c) (x c))) (defun obj-at (game-info c) (int->char (aref (%objs game-info) (y c) (x c)))) (defun finder-active-p (game-info pos turn) ;; MEMO turnは1からスタートする (let ((finder-cycle (gethash pos (%finder-cycle-by-coord game-info)))) (zerop (rem turn finder-cycle)))) (defstruct (state (:conc-name %)) (pos nil :type coord) (visited nil :type integer) (has-key (error "Need to specify value") :type boolean) ;; TODO bloom filterで保持できるとうれしそう ;; avl-tree of coord (shared with other boards) (destroyed-finders nil :type t :read-only t) ;; avl-tree of coord (shared with other boards) (blocks nil :type t :read-only t) (fire-amount 0 :type (integer 0 #.most-positive-fixnum)) (jewel-amount 0 :type (integer 0 #.most-positive-fixnum)) (elapsed-turn 0 :type (integer 0 #.most-positive-fixnum)) (elapsed-vital 0 :type (integer 0 #.most-positive-fixnum))) (defun visitedp (state coord) (logbitp (+ (* (y coord) +grid-size+) (x coord)) (%visited state))) (defun %get-next-visited (state coord) (logior (%visited state) (ash 1 (+ (* (y coord) +grid-size+) (x coord))))) (defun reachablep (state game-info coord) ;; coordのマスへ移動できる ;; TODO moveを引数に取りたい (let ((c (obj-at game-info coord))) (and (not (avl:ref (%blocks state) coord)) (or (find c ".SGKJF") (and (char= c #\E) (avl:ref (%destroyed-finders state) coord)))))) (defun block-placeable-p (state game-info coord) ;; coordのマスにブロックを配置できる ;; finder破壊後のマスにも置ける? (let ((c (obj-at game-info coord))) (and (char= c #\.) (null (avl:ref (%blocks state) coord))))) (defun block-removable-p (state game-info coord) ;; coordのマスのブロックを削除 (declare (ignore game-info)) (avl:ref (%blocks state) coord)) (defun %find-obj (get-obj-at obj) (loop for y below +grid-size+ for c = (loop for x below +grid-size+ for c = (make-coord :y y :x x) for i = (funcall get-obj-at c) when (char= i obj) return c) when c return it)) (defun %make-est-cost-from-obj (objs start-obj finder-cycle-by-coord) (flet ((obj-at (c) (int->char (aref objs (y c) (x c))))) (let ((sc (%find-obj #'obj-at start-obj)) (costs (make-array (list +grid-size+ +grid-size+) :element-type 'single-float :initial-element most-positive-single-float)) (heap (rh:make-randomized-heap #'< #'first))) (assert sc) (rh:push! heap (list 0.0 sc)) (while (not (rh:empty-p heap)) (destructuring-bind (cost c) (rh:pop! heap) (when (<= cost (aref costs (y c) (x c))) (setf (aref costs (y c) (x c)) cost) (loop for (dy . dx) in +dy-dx+ for ny = (+ (y c) dy) for nx = (+ (x c) dx) for nc = (make-coord :y ny :x nx) when (and nc (not (find (obj-at nc) "#E"))) do (let ((penalty 0)) (loop for (dy . dx) in +dy-dx+ unless (= dy dx 0) do ;; ncは即値 (let ((c nc)) (while c (cond ((char= (obj-at c) #\W) (return)) ((char= (obj-at c) #\E) ;; 一番近くの探知機で止まる (let ((cycle (gethash c finder-cycle-by-coord))) (assert cycle) ;; TODO いい感じの係数をかける (incf penalty (float (/ cycle))) (return))) (t (setf c (next-coord c dy dx))))))) (let ((new-cost (+ cost penalty))) (when (< new-cost (aref costs (y nc) (x nc))) (setf (aref costs (y nc) (x nc)) new-cost) (rh:push! heap (list new-cost nc))))))))) ;; (break) costs))) (defun read-game-info () (destructuring-bind (n d h) (mapcar #'parse-fixnum (split (read-line))) (declare (ignore n h)) (let ((objs (make-array '(#.+grid-size+ #.+grid-size+) :element-type '(unsigned-byte 4)))) (dotimes (y +grid-size+) (let ((s (read-line))) (dotimes (x +grid-size+) (setf (aref objs y x) (char->int (char s x)))))) (let ((m (read)) (finder-cycle-by-coord (make-hash-table))) (dotimes (_ m) (destructuring-bind (y x dd) (mapcar #'parse-fixnum (split (read-line))) (setf (gethash (make-coord :y y :x x) finder-cycle-by-coord) dd))) (make-game-info :estimated-cost-to-goal (%make-est-cost-from-obj objs #\G finder-cycle-by-coord) :estimated-cost-to-key (%make-est-cost-from-obj objs #\K finder-cycle-by-coord) :key-pos (%find-obj #f(int->char (aref objs (y %) (x %))) #\K) :objs objs :finder-cycle-by-coord finder-cycle-by-coord :finder-penalty d))))) (defun %find-nearest-finders (game-info block-exist-p finder-destroyed-p pos &optional (directions +dy-dx+)) (let ((res nil)) (loop for (dy . dx) in directions do (let ((c pos)) (while c (cond ((char= (obj-at game-info c) #\W) (return)) ((funcall block-exist-p c) (return)) ((and (char= (obj-at game-info c) #\E) (not (funcall finder-destroyed-p c))) ;; 一番近くの探知機で止まる (push c res) (return)) (t (setf c (next-coord c dy dx))))))) (nreverse res))) ;; TODO 他のアクションと共通の部分は切り出すとよさそう?→バグらせそうなのでやめたほうがいい ;; TODO 体力消費、ターン消費?(アイテム取得は移動時だけ) (defun do-nothing (state game-info) (with-accessors ((pos %pos) (visited %visited) (has-key %has-key) (dfs %destroyed-finders) (bs %blocks) (fa %fire-amount) (ja %jewel-amount) (ev %elapsed-vital) (et %elapsed-turn)) state (let* ((nearest-finders (%find-nearest-finders game-info ;; block-exist-p (lambda (c) (avl:ref bs c)) ;; finder-destroyed-p (lambda (c) (avl:ref dfs c)) pos)) (nev (+ ev (* (length (remove-if-not #f(finder-active-p game-info % (1+ et)) nearest-finders)) (%finder-penalty game-info)) 1))) ;; #>(pos new-pos) (make-state :pos pos :has-key has-key :visited visited :destroyed-finders dfs :blocks bs :fire-amount fa :jewel-amount ja :elapsed-vital nev :elapsed-turn (1+ et))))) (defun move (state game-info move) (with-accessors ((pos %pos) (visited %visited) (has-key %has-key) (dfs %destroyed-finders) (bs %blocks) (fa %fire-amount) (ja %jewel-amount) (ev %elapsed-vital) (et %elapsed-turn)) state (destructuring-bind (dy . dx) (move->dy-dx move) (let* ((ny (+ (y pos) dy)) (nx (+ (x pos) dx)) (new-pos (make-coord :y ny :x nx)) (nobj (obj-at game-info new-pos)) (new-visited (%get-next-visited state pos)) (nfa (if (char= nobj #\F) (1+ fa) fa)) (nja (if (and (char= nobj #\J) (not (visitedp state pos))) (1+ ja) ja)) (nearest-finders (%find-nearest-finders game-info ;; block-exist-p (lambda (c) (avl:ref bs c)) ;; finder-destroyed-p (lambda (c) (avl:ref dfs c)) new-pos)) (nev (+ ev (* (length (remove-if-not #f(finder-active-p game-info % (1+ et)) nearest-finders)) (%finder-penalty game-info)) 1))) (declare (ignore _)) ;; #>(pos new-pos) (make-state :pos new-pos :has-key (or has-key (char= (obj-at game-info new-pos) #\K)) :visited new-visited :destroyed-finders dfs :blocks bs :fire-amount nfa :jewel-amount nja :elapsed-vital nev :elapsed-turn (1+ et)))))) (defun place-block (state game-info place-pos) (with-accessors ((pos %pos) (visited %visited) (hk %has-key) (dfs %destroyed-finders) (bs %blocks) (fa %fire-amount) (ja %jewel-amount) (ev %elapsed-vital) (et %elapsed-turn)) state (let* (;; 空のマスでないといけない (_ (assert (char= (obj-at game-info place-pos) #\.))) (_ (assert (eql (avl:ref bs place-pos) nil))) (nbs (avl:insert bs place-pos t)) (nearest-finders (%find-nearest-finders game-info ;; block-exist-p (lambda (c) (avl:ref nbs c)) ;; finder-destroyed-p (lambda (c) (avl:ref dfs c)) pos)) (nev (+ ev (* (length nearest-finders) (%finder-penalty game-info)) 1))) (declare (ignore _)) (make-state :pos pos :visited visited :has-key hk :destroyed-finders dfs :blocks nbs :fire-amount fa :jewel-amount ja :elapsed-vital nev :elapsed-turn (1+ et))))) (defun destroy-block (state game-info place-pos) (with-accessors ((pos %pos) (visited %visited) (has-key %has-key) (dfs %destroyed-finders) (bs %blocks) (fa %fire-amount) (ja %jewel-amount) (ev %elapsed-vital) (et %elapsed-turn)) state (let* (;; 空のマスのはず (_ (assert (char= (obj-at game-info place-pos) #\.))) ;; いま置いているはず (_ (assert (avl:ref bs place-pos))) (nbs (avl:remove bs place-pos)) (nearest-finders (%find-nearest-finders game-info ;; block-exist-p (lambda (c) (avl:ref nbs c)) ;; finder-destroyed-p (lambda (c) (avl:ref dfs c)) pos)) (nev (+ ev (* (length (remove-if-not #f(finder-active-p game-info % (1+ et)) nearest-finders)) (%finder-penalty game-info)) 1))) (declare (ignore _)) (make-state :pos pos :visited visited :has-key has-key :destroyed-finders dfs :blocks nbs :fire-amount fa :jewel-amount ja :elapsed-vital nev :elapsed-turn (1+ et))))) (defun destroy-finders-by-fire (state game-info dir) (with-accessors ((pos %pos) (has-key %has-key) (visited %visited) (dfs %destroyed-finders) (bs %blocks) (fa %fire-amount) (ja %jewel-amount) (ev %elapsed-vital) (et %elapsed-turn)) state (let* ((destroyed-finders (%find-nearest-finders game-info ;; block-exist-p (lambda (c) (avl:ref bs c)) ;; finder-destroyed-p (lambda (c) (avl:ref dfs c)) pos (list (move->dy-dx dir)))) (ndfs (reduce (lambda (dfs c) (avl:insert dfs c t)) destroyed-finders :initial-value dfs)) (nearest-finders (%find-nearest-finders game-info ;; block-exist-p (lambda (c) (avl:ref bs c)) ;; finder-destroyed-p (lambda (c) (avl:ref ndfs c)) pos)) (nfa (1- fa)) (nev (+ ev (* (length (remove-if-not #f(finder-active-p game-info % (1+ et)) nearest-finders)) (%finder-penalty game-info)) 1))) (assert (>= nfa 0)) (make-state :pos pos :visited visited :destroyed-finders ndfs :has-key has-key :blocks bs :fire-amount nfa :jewel-amount ja :elapsed-vital nev :elapsed-turn (1+ et))))) (defun make-init-state (game-info) (let* ((sp (%find-obj #f(obj-at game-info %) #\S)) (visited (ash 1 (+ (* (y sp) +grid-size+) (x sp))))) (make-state :pos sp :has-key nil :visited visited :destroyed-finders nil :blocks nil))) (defun goal-state-p (state game-info) (and (%has-key state) (char= (obj-at game-info (%pos state)) #\G))) (defun validate-state (state game-info) ;; TODO ;; 到達可能な場所にいる ;; visitedに現在の場所が入っている ;; 破壊された探索機の場所 ;; ブロックを空マス以外に置いていない ;; jewel-amountがvisitedで探索済みの点と一致 ;; elapsed-turn <= elapsed-vital nil) (defconstant +dist-penalty-factor+ -1.0) (defconstant +est-cost-factor+ 10d0) (defun %eval-penalty-for-dist-to-goal (state game-info) (let* ((rest-vital (- +player-vital+ (%elapsed-vital state))) (est-cost (estimated-cost-to-goal game-info (%pos state)))) ;; 不足が大きいほど強いペナルティ (max (round (* (float (max 0.0 (- (* est-cost +est-cost-factor+) rest-vital)) 0d0) +dist-penalty-factor+)) most-negative-fixnum))) (defun %eval-for-dist-to-key (state game-info) (let* ((est-cost-from-here-to-key (estimated-cost-to-key game-info (%pos state))) (est-cost-from-key-to-goal (estimated-cost-to-goal game-info (%key-pos game-info))) (est-cost (+ est-cost-from-here-to-key est-cost-from-key-to-goal))) ;; 最短で取りに行きたい (+ (- (round est-cost)) -100000))) (defun eval-state (state game-info) ;; TODO 辿りつけなさそうだとペナルティ ;; TODO 最後が近づくほど傾斜を強くする ;; TODO keyを所持しているかどうかも考慮する(スコアリングでやってしまうほうが楽かも) (if (%has-key state) (+ (%jewel-amount state) (%eval-penalty-for-dist-to-goal state game-info)) (%eval-for-dist-to-key state game-info))) (defstruct (node (:conc-name %)) ;; TODO hash (parent nil :type (or null node)) (state nil :type state) (score nil :type fixnum) (last-action nil :type (or null cons))) (defconstant +time-limit+ 2.5) (defconstant +heap-size-threshold+ 100) (declaim (notinline main)) (defun main () (let* ((game-info (read-game-info)) (init-state (make-init-state game-info)) (states (make-array (1+ +player-vital+))) (start (get-internal-real-time)) (goal-candidates (rh:make-randomized-heap #'> #'%score))) (dotimes (elapsed (1+ +player-vital+)) (setf (aref states elapsed) (rh:make-randomized-heap #'> #'%score))) (rh:push! (aref states 0) (make-node :state init-state :score (eval-state init-state game-info))) ;; 時間いっぱいchokudaiサーチ (loop named search for turn from 1 do (dotimes (elapsed-vital +player-vital+) ;; #>elapsed-vital (when (> (/ (float (- (get-internal-real-time) start)) internal-time-units-per-second) +time-limit+) #>turn (return-from search)) (unless (rh:empty-p #1=(aref states elapsed-vital)) (let ((node (rh:pop! #1#))) (labels ((%treat-next (next-state action) (let* ((next-node (make-node :parent node :state next-state :score (eval-state next-state game-info) :last-action action)) (nev (%elapsed-vital next-state))) ;; #>(elapsed-vital nev) (when (<= nev +player-vital+) (cond ((goal-state-p next-state game-info) (rh:push! goal-candidates next-node)) (t (rh:push! (aref states nev) next-node) (when (= (rh:count (aref states nev)) +heap-size-threshold+) (rh:prune! (aref states nev) (ash +heap-size-threshold+ -1))))))))) (%treat-next (do-nothing (%state node) game-info) (cons :wait nil)) (loop for (dir . (dy . dx)) in +move-dy-dx-assoc+ do (let ((nc (next-coord (%pos (%state node)) dy dx))) (when nc ;; 移動(「何もしない」も含む) (when (reachablep (%state node) game-info nc) (%treat-next (move (%state node) game-info dir) (cons :move dir))) ;; ブロックを配置 #+nil (when (block-placeable-p (%state node) game-info nc) (%treat-next (place-block (%state node) game-info nc) (cons :place-block dir))) ;; ブロックを破壊 #+nil (when (block-removable-p (%state node) game-info nc) (%treat-next (destroy-block (%state node) game-info nc) (cons :destroy-block dir))) ;; ファイヤー #+nil (when (plusp (%fire-amount (%state node))) (%treat-next (destroy-finders-by-fire (%state node) game-info dir) (cons :fire dir))))))))))) ;; moveを復元して出力 (let ((best-node (unless (rh:empty-p goal-candidates) (rh:pop! goal-candidates))) (res nil)) (assert best-node) #>((%score best-node)) (while (%parent best-node) (push (%last-action best-node) res) (setf best-node (%parent best-node))) (loop for (act . dir) in res do (println (ecase act (:wait "S") (:move (format nil "M ~a" (dir->char dir))) ((:place-block :destroy-block) (format nil "B ~a" (dir->char dir))) (:fire (format nil "F ~a" (dir->char dir))))))))) #-swank (main) ;;; ;;; Debug ;;; #+swank (defun run () (let ((*standard-input* (make-string-input-stream (with-output-to-string (*standard-output*) (run-program (truename "~/.roswell/bin/copy-or-paste") '() :output *standard-output*))))) (main))) ;; Raise error on warning at compile time #+(and sbcl (not swank)) (eval-when (:compile-toplevel) (when (or (plusp sb-c::*compiler-warning-count*) sb-c::*undefined-warnings*) (error "compiler-error-count:~a, undefined warnings:~a" sb-c::*compiler-warning-count* sb-c::*undefined-warnings*))) #+swank (defun run-sample (infile outfile &optional (out *standard-output*)) (with-open-file (*standard-input* infile :direction :input) (with-open-file (*standard-output* outfile :direction :output :if-exists :supersede) (main)) (sb-ext:run-program "/usr/bin/java" (list "Judge" infile outfile) :output out :error *error-output*))) #+swank (declaim (notinline run-sample-zero)) #+swank (defun run-sample-zero () (gc :full t) (with-input-from-string (*standard-input* "60 3 1500 .......JJ....J#..#E#....EE.J..E...E#J.....#.#EE......#..J.J# #E#.....##J..JE....E..#....J.........#......#..#J.........#. .J.J.#.#....J.#..#........J#...#J#.KJE.J.E.#J.#....#......J. J..E..#.E#.......E........JEJ.....F..##..............#...J.J ..J.......JE...#......J.#.#..#J#JFJ.......E..#..#....E.....J #..J.....EE....J........E............##.E#.E.#JJ..........E. ...#......J.J..J#...#...#.#..JE#....##E...#F.#....E....#E#.. .JJ.....###.J.EE...J...#E#E#...E.E.....#E......J..#...#....# E.E.......#JF.J.J.E.##E#...EE..J....F..#.#J#..E#J..E..J...#F ##....F.#F#.E.#.EJ...J#E..#..#.J.......E...J....#..#..#....S .E...E...J..J#........#...E.E.......#.....J..J.....E..E....# .................#J#.....F...JE.#......##.........JJ.J....#. E..J...E##..#.J...#...#.E....##...#.....EEJJJ.##.#.E.....E#. E#.F.#.......JF..#..E#......EJ.....#.#.E.##..JJ.......E.J..E JE..#E....E..E.J#.E...E...J...#J#J.#.E.....E..#E#.E..EF###.. E....J.#..J#....#..EE#.E...E.J.J...E#E#.J..J...E..........J# .....#..J.#JF.#....E..#EE..E..#.......E.........#..J..#..J.F #.EF.......E.J.E............#.........#...........E...#.#J.. F.....JJ...E#..E.#....#.E#...#...F.J.#.E.F.#.....J.....#EJ.E ###......#.E.J.E...#E..#..E...#.....#..#.#......F#.E.J..#.#E ....JEEE..EE.#.E#..#JJ............#J.E.#E..J........E....#.E ..E....EJ...J........#..J..J.#E#.#...#.E....#E.#E.#.#E..#..# ...#E#.E.....#J.E.#.#.J.J...E.JJ#J...#.J...##....J.J.......# .....F....#..J#J..#....#.E...EJ#..#...#.#F#F.EE#..#.....#E.E J#..#....#.#E..#.J.#.#......EJ..J.............#...#....#.E.. ..##EEEE.....JJ..J.#..#..#.E....#J#E#E...E......#JJ#.E..E.#J #E..##..JJ.#.JE.....E.##.E....E#.....#E.#J..#....JJ..#.#.... .E.#.E....#E..E..JEJ..JE..#F#..#.#.#..E#J#......#.E.EJ#..F.E .J....#....J.JE.J#...JF.E..JE.J..#....F.F#..E.##JJE....#F.EE ..F.EJF...E...EE#..J.#F.F#....JE#J.......E#F.....E.....J...# #E##EJ#.E....E......JJ..F##J..E...J..JE..J.EJ..E.....E.EE.#E E#...E...JE.#.#..E..#.J....E..#.#.J#.E.E.#.#E.##.#...#...E.J ...G##..EF.J#J.J....E.F.......E#.J...#..E...##........#.E.#. .....J.#..J...E..EJ..E......J....E...#.#.F#E.EE..#J.E......E ........E.E..#FJ.E#.F..E#.#...........F....J..#.##.##..EFJ.E ....E.#....##.JE...EE.E.#E#..JJEF....#J.#....J.JE..J.....J.. #E...........JJ....###....J#................J..#J.JJ#JE.EJ.. JE.#EJE..#..E..J..#.J.#.....J.J.....#EJJ.E#.E..#E.......E..# #.#J......#....#...#....J.J.E#J.E##.J....EE.#..E..##J..E.... E..E.F.#E....E.....J.#.#.EJ.#.#.J.#...JJ##..#J.....#J.EJ.... .#J.E#......#..E..#..#...J#J....#.E.J......#F.#.E.EJ..E...#. ....J.E..#.#......J...#.JE.#.E...#..E..E.J.E..#.E...#....#EJ ...##.J..J.J...JEJEJ...#.##.#.EE.F...F#.......E.E...#.....J. ...#F..JJ....J##.......F...#..#E....#JJJE.E.J##.E..J...F#J#. #....J..#......EJ.#....EE.#...E....E...#.E.J.E...JEE.E..J..# ...#...#.#....#...E.#.E..E.E..F.E.FEE...............F..#.E#. E.JJ.....E#EJE#....##....#.#.F..#J..#E...#...E.#..##EJ#.#... F....#....#..........E.E.FE.#E......#..#EE..#...#EE....FE..# ..JJ#J..EE...J........J#.E..E..J..E.#...##......J..J........ ..##...#...JJF#J....F....#.....#E.......EJ.........J.#...... ....J.#J.....J....##J..#..JJ.#..#.#.#...J.JE##E.JJ....E#.#.E ...#......EE.....JE..........J.J..J#...#.#..#F..#..J..E...#. E...E..E.F.E#....J....E.#.E.JJ..J.J.J.#.##.....J.E..J....... ##E.....E#EJJ.##.......E.##....EE......E...FE.#.....E.J##..J ..#E#J#......J#......#.#.J....E.#..E..#E.##.#.###......#.... #E#.#J...E.#.JE.#.J...#.....#....J..EE.##EE#..##.......##E.. #.#......#.J.J...E#.E...JE#......#..J.....J#JF..#E.EJ.J..... J....#...JJ...E......#E.J..##.....#.J.#..#E.E..#.....##..J.. E#E.......J#.....EE.J..##...F.....J.FJ#.E........E........#. J.E....J.E.J...E.#..E........##..E....#J..#.#..J...#...E#E.. 374 0 18 5 0 24 5 0 25 2 0 30 3 0 34 2 0 45 3 0 46 4 1 1 3 1 14 5 1 19 2 2 37 5 2 41 5 3 3 3 3 8 4 3 17 3 3 27 3 4 11 2 4 42 4 4 53 2 5 9 4 5 10 2 5 24 3 5 40 5 5 43 2 5 58 5 6 30 2 6 38 5 6 50 5 6 56 5 7 14 2 7 15 5 7 24 5 7 26 4 7 31 5 7 33 4 7 40 3 8 0 5 8 2 5 8 18 5 8 22 3 8 27 3 8 28 5 8 46 2 8 51 5 9 12 3 9 16 3 9 23 5 9 39 4 10 1 5 10 5 2 10 26 5 10 28 3 10 51 4 10 54 3 11 30 2 12 0 4 12 7 4 12 24 4 12 40 5 12 41 4 12 51 5 12 57 4 13 0 4 13 20 2 13 28 2 13 39 4 13 54 2 13 59 5 14 1 5 14 5 4 14 10 4 14 13 5 14 18 2 14 22 4 14 37 2 14 43 4 14 47 4 14 50 2 14 53 3 15 0 3 15 19 3 15 20 4 15 23 2 15 27 3 15 35 2 15 37 3 15 47 5 16 19 4 16 23 2 16 24 5 16 27 2 16 38 5 17 2 5 17 11 4 17 15 5 17 50 3 18 11 5 18 15 3 18 24 3 18 39 5 18 56 4 18 59 5 19 11 5 19 15 5 19 20 2 19 26 4 19 51 4 19 59 4 20 5 4 20 6 4 20 7 4 20 10 3 20 11 4 20 15 4 20 37 5 20 40 4 20 52 2 20 59 3 21 2 2 21 7 3 21 30 5 21 39 3 21 45 3 21 48 2 21 53 4 22 4 4 22 7 2 22 16 4 22 28 2 23 25 3 23 29 2 23 45 4 23 46 5 23 57 4 23 59 4 24 12 3 24 28 5 24 57 2 25 4 2 25 5 3 25 6 4 25 7 2 25 27 4 25 35 5 25 37 3 25 41 3 25 53 3 25 56 4 26 1 5 26 14 2 26 20 3 26 25 3 26 30 3 26 38 5 27 1 2 27 5 4 27 11 2 27 14 3 27 18 2 27 23 2 27 38 3 27 50 2 27 52 2 27 59 5 28 14 2 28 24 5 28 28 2 28 44 3 28 50 3 28 58 4 28 59 3 29 4 2 29 10 5 29 14 4 29 15 2 29 31 3 29 41 3 29 49 4 30 1 4 30 4 3 30 8 2 30 13 5 30 30 3 30 38 4 30 43 3 30 47 3 30 53 3 30 55 3 30 56 2 30 59 2 31 0 5 31 5 3 31 10 2 31 17 5 31 27 4 31 37 2 31 39 3 31 44 4 31 57 4 32 8 3 32 20 3 32 30 5 32 40 2 32 56 5 33 14 3 33 17 4 33 21 3 33 33 3 33 43 4 33 45 3 33 46 4 33 52 5 33 59 5 34 8 4 34 10 4 34 17 2 34 23 5 34 55 5 34 59 5 35 4 2 35 15 3 35 19 5 35 20 2 35 22 5 35 25 2 35 31 5 35 48 2 36 1 4 36 54 3 36 56 2 37 1 5 37 4 2 37 6 3 37 12 4 37 37 5 37 41 5 37 44 2 37 48 2 37 56 2 38 28 2 38 32 3 38 41 5 38 42 5 38 47 5 38 55 2 39 0 4 39 3 2 39 8 2 39 13 5 39 25 3 39 54 3 40 4 2 40 15 3 40 34 4 40 48 5 40 50 4 40 54 4 41 6 4 41 25 4 41 29 4 41 36 5 41 39 4 41 43 4 41 48 4 41 58 4 42 16 2 42 18 3 42 30 5 42 31 4 42 46 2 42 48 2 43 31 2 43 40 2 43 42 2 43 48 5 44 15 4 44 23 3 44 24 5 44 30 2 44 35 2 44 41 5 44 45 4 44 50 2 44 51 3 44 53 3 45 18 3 45 22 5 45 25 5 45 27 2 45 32 3 45 35 4 45 36 2 45 57 4 46 0 4 46 9 5 46 11 2 46 13 4 46 37 3 46 45 3 46 52 2 47 21 2 47 23 4 47 26 2 47 29 5 47 40 2 47 41 3 47 49 3 47 50 4 47 56 5 48 8 3 48 9 2 48 25 5 48 28 4 48 34 2 49 32 5 49 40 5 50 43 2 50 46 5 50 54 5 50 59 3 51 10 4 51 11 3 51 18 2 51 54 4 52 0 4 52 4 4 52 7 3 52 11 2 52 22 2 52 26 2 52 49 3 53 2 3 53 8 4 53 10 2 53 23 4 53 31 3 53 32 3 53 39 4 53 44 2 53 52 2 54 3 3 54 30 4 54 35 4 54 39 4 55 1 3 55 9 5 55 14 4 55 36 2 55 37 5 55 41 4 55 42 2 55 57 3 56 17 5 56 20 3 56 25 3 56 49 4 56 51 4 57 14 2 57 22 2 57 42 5 57 44 3 58 0 2 58 2 4 58 17 2 58 18 4 58 40 2 58 49 4 59 2 4 59 9 4 59 15 3 59 20 3 59 33 2 59 55 5 59 57 2 ") (main)))