結果

問題 No.5015 Escape from Labyrinth
ユーザー motoshiramotoshira
提出日時 2023-04-16 18:25:15
言語 Common Lisp
(sbcl 2.3.8)
結果
RE  
実行時間 -
コード長 59,812 bytes
コンパイル時間 1,007 ms
コンパイル使用メモリ 116,196 KB
実行使用メモリ 340,932 KB
スコア 20,580
最終ジャッジ日時 2023-04-16 18:30:07
合計ジャッジ時間 287,734 ms
ジャッジサーバーID
(参考情報)
judge12 / judge14
このコードへのチャレンジ
(要ログイン)

テストケース

テストケース表示
入力 結果 実行時間
実行使用メモリ
testcase_00 AC 2,872 ms
226,112 KB
testcase_01 AC 2,932 ms
191,528 KB
testcase_02 AC 2,990 ms
295,920 KB
testcase_03 AC 2,855 ms
265,276 KB
testcase_04 RE -
testcase_05 AC 2,901 ms
304,092 KB
testcase_06 AC 2,862 ms
167,504 KB
testcase_07 AC 2,859 ms
277,448 KB
testcase_08 AC 2,983 ms
263,160 KB
testcase_09 AC 2,922 ms
203,544 KB
testcase_10 AC 2,856 ms
261,004 KB
testcase_11 AC 2,858 ms
295,808 KB
testcase_12 RE -
testcase_13 RE -
testcase_14 RE -
testcase_15 RE -
testcase_16 TLE -
testcase_17 AC 2,860 ms
223,892 KB
testcase_18 AC 2,854 ms
314,208 KB
testcase_19 AC 2,903 ms
246,688 KB
testcase_20 AC 2,860 ms
210,576 KB
testcase_21 TLE -
testcase_22 AC 2,909 ms
293,600 KB
testcase_23 AC 2,857 ms
173,024 KB
testcase_24 RE -
testcase_25 AC 2,863 ms
218,100 KB
testcase_26 AC 2,858 ms
207,868 KB
testcase_27 AC 2,890 ms
209,880 KB
testcase_28 RE -
testcase_29 RE -
testcase_30 AC 2,969 ms
265,240 KB
testcase_31 RE -
testcase_32 AC 2,899 ms
242,524 KB
testcase_33 AC 2,855 ms
275,404 KB
testcase_34 AC 2,907 ms
204,384 KB
testcase_35 AC 2,946 ms
228,356 KB
testcase_36 RE -
testcase_37 AC 2,862 ms
191,552 KB
testcase_38 AC 2,859 ms
263,084 KB
testcase_39 AC 2,989 ms
277,564 KB
testcase_40 AC 2,862 ms
340,932 KB
testcase_41 RE -
testcase_42 AC 2,871 ms
257,024 KB
testcase_43 RE -
testcase_44 RE -
testcase_45 AC 2,858 ms
211,872 KB
testcase_46 AC 2,939 ms
246,588 KB
testcase_47 RE -
testcase_48 RE -
testcase_49 RE -
testcase_50 AC 2,888 ms
191,480 KB
testcase_51 AC 2,866 ms
277,480 KB
testcase_52 AC 2,953 ms
207,844 KB
testcase_53 TLE -
testcase_54 AC 2,905 ms
220,032 KB
testcase_55 AC 2,980 ms
214,636 KB
testcase_56 TLE -
testcase_57 AC 2,871 ms
193,420 KB
testcase_58 AC 2,901 ms
187,196 KB
testcase_59 AC 2,947 ms
279,468 KB
testcase_60 AC 2,892 ms
315,232 KB
testcase_61 AC 2,857 ms
320,420 KB
testcase_62 AC 2,859 ms
211,752 KB
testcase_63 AC 2,891 ms
262,960 KB
testcase_64 AC 2,854 ms
168,888 KB
testcase_65 AC 2,864 ms
272,348 KB
testcase_66 AC 2,856 ms
277,504 KB
testcase_67 TLE -
testcase_68 AC 2,861 ms
211,852 KB
testcase_69 TLE -
testcase_70 AC 2,858 ms
289,836 KB
testcase_71 RE -
testcase_72 AC 2,857 ms
254,920 KB
testcase_73 AC 2,855 ms
298,008 KB
testcase_74 TLE -
testcase_75 AC 2,857 ms
250,760 KB
testcase_76 AC 2,869 ms
218,076 KB
testcase_77 AC 2,932 ms
316,440 KB
testcase_78 AC 2,925 ms
265,092 KB
testcase_79 AC 2,956 ms
273,264 KB
testcase_80 AC 2,958 ms
220,056 KB
testcase_81 AC 2,892 ms
271,260 KB
testcase_82 AC 2,961 ms
257,024 KB
testcase_83 AC 2,895 ms
278,400 KB
testcase_84 AC 2,896 ms
258,936 KB
testcase_85 RE -
testcase_86 TLE -
testcase_87 AC 2,998 ms
277,476 KB
testcase_88 AC 2,900 ms
316,260 KB
testcase_89 AC 2,870 ms
234,408 KB
testcase_90 AC 2,954 ms
283,400 KB
testcase_91 AC 2,854 ms
167,504 KB
testcase_92 AC 2,860 ms
198,216 KB
testcase_93 AC 2,956 ms
298,052 KB
testcase_94 AC 2,861 ms
271,388 KB
testcase_95 AC 2,855 ms
273,284 KB
testcase_96 AC 2,858 ms
297,944 KB
testcase_97 AC 2,961 ms
293,856 KB
testcase_98 AC 2,941 ms
256,668 KB
testcase_99 RE -
権限があれば一括ダウンロードができます
コンパイルメッセージ
; compiling file "/home/judge/data/code/Main.lisp" (written 16 APR 2023 06:25:15 PM):
; processing (IN-PACKAGE #:CL-USER)
; processing (DECLAIM (OPTIMIZE # ...))
; processing (DECLAIM (MUFFLE-CONDITIONS COMPILER-NOTE))
; processing (DISABLE-DEBUGGER)
; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...)
; processing (SET-DISPATCH-MACRO-CHARACTER #\# ...)
; processing (DEFPACKAGE CP-LIBRARY/AVL-TREE ...)
; processing (IN-PACKAGE AVL)
; processing (DECLAIM (INLINE %%MAKE-NODE))
; processing (DEFSTRUCT (NODE # ...) ...)
; processing (DEFMACRO DEFINE-ACCESSOR-FOR-NULLABLE-NODE ...)
; processing (DEFINE-ACCESSOR-FOR-NULLABLE-NODE %VALUE ...)
; processing (DEFINE-ACCESSOR-FOR-NULLABLE-NODE %KEY ...)
; processing (DEFINE-ACCESSOR-FOR-NULLABLE-NODE %CNT ...)
; processing (DEFINE-ACCESSOR-FOR-NULLABLE-NODE %HEIGHT ...)
; processing (DEFINE-ACCESSOR-FOR-NULLABLE-NODE %L ...)
; processing (DEFINE-ACCESSOR-FOR-NULLABLE-NODE %R ...)
; processing (DEFUN DUMP-TO-LIST ...)
; processing (DEFMETHOD PRINT-OBJECT ...)
; processing (DEFUN DUMP-TO-TREE ...)
; processing (DECLAIM (INLINE %MAKE-NODE))
; processing (DEFUN %MAKE-NODE ...)
; processing (DEFUN MAKE-AVL-TREE ...)
; processing (DECLAIM (INLINE %UPDATE-NODE))
; processing (DEFUN %UPDATE-NODE ...)
; processing (DECLAIM (INLINE %ROTATE-LEFT))
; processing (DEFUN %ROTATE-LEFT ...)
; processing (DECLAIM (INLINE %ROTATE-RIGHT))
; processing (DEFUN %ROTATE-RIGHT ...)
; processing (DECLAIM (INLINE %ROTATE-LR))
; processing (DEFUN %ROTATE-LR ...)
; processing (DECLAIM (INLINE %ROTATE-RL))
; processing (DEFUN %ROTATE-RL ...)
; processing (DEFCONSTANT +TOO-LEFT+ ...)
; processing (DEFCONSTANT +LEFT+ ...)
; processing (DEFCONSTANT +EVEN+ ...)
; processing (DEFCONSTANT +RIGHT+ ...)
; processing (DEFCONSTANT +TOO-RIGHT+ ...)
; processing (DECLAIM (INLINE %BIAS))
; processing (DEFUN %BIAS ...)
; processing (DECLAIM (INLINE %LEFT-RIGHT-CASE-P))
; processing (DEFUN %LEFT-RIGHT-CASE-P ...)
; processing (DECLAIM (INLINE %RIGHT-LEFT-CASE-P))
; proces

ソースコード

diff #

(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)
           (optimize (speed 3) (safety 0)))
  (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))))

(deftype moves () `(member ,@'#.+moves+))

(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)
  (declare ((unsigned-byte 4) int)
           (optimize (speed 3) (safety 0)))
  (int->char-ecase int))

(defun dir->char (dir)
  (declare (moves dir)
           (optimize (speed 3) (safety 0)))
  (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)
  (declare (optimize (speed 3) (safety 0))
           (fixnum 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)
  (has-key (error "Need to specify value") :type boolean)
  ;; avl-tree of coord (shared with other boards)
  ;; TODO 削除操作がなければbloom filterで保持できるとうれしそう
  (visited nil :type t :read-only t)
  (destroyed-finders nil :type t :read-only t)
  (blocks nil :type t :read-only t)
  ;; positive fixnum
  (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)
  (avl:ref (%visited state) coord))

(defun %get-next-visited (state coord)
  (avl:insert (%visited state) coord t))

(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+))
  (declare (optimize (speed 3) (safety 0))
           (function block-exist-p finder-destroyed-p)
           (fixnum pos))
  (let ((res nil))
    (loop for (dy . dx) of-type (fixnum . fixnum) in directions do
      (let ((c pos))
        (declare ((or null fixnum) c))
        (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 new-pos))
             (nfa (if (char= nobj #\F)
                      (1+ fa)
                      fa))
             (nja (if (and (char= nobj #\J)
                           (not (visitedp state new-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)))
        ;; #>(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* (;; 空のマスでないといけない
           (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)))
      (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* ((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)))
      (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 (avl:make-avl-tree-from-list #'identity (constantly t) (list 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 必要そうなものを適宜足す
  (unless (reachablep state game-info (%pos state))
    (error "~a is not unreachable" (%pos state)))
  (unless (visitedp state (%pos state))
    (error "Player is at ~a, but visited is not marked" (%pos state)))
  (awhen (loop for c in (avl:keys (%destroyed-finders state))
               for obj = (obj-at game-info c)
               when (char/= obj
                            #\E)
                 return (cons c obj))
    (error "~a is contained in destroyed-finders, but is actually ~a" (car it) (cdr it)))
  (awhen (loop for c in (avl:keys (%blocks state))
               for obj = (obj-at game-info c)
               when (char/= obj #\.)
                 return (cons c obj))
    (error "~a is contained in blocks, so supposed to be empty block, but is actually ~a" (car it) (cdr it))))

(defconstant +dist-penalty-factor+ -1.0)
(defconstant +est-cost-factor+ 5.0d0)

(defun %eval-dist-to-goal (state game-info)
  (- (round (estimated-cost-to-goal game-info (%pos state)))))

(defun %eval-dist-to-key (state game-info)
  (let ((est-cost-from-here-to-key (round (estimated-cost-to-key game-info (%pos state)))))
    ;; 最短で取りに行きたい
    (if (zerop est-cost-from-here-to-key)
        (%elapsed-vital state)
        (- est-cost-from-here-to-key))))

(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 +heap-size-threshold+ 200)

(defun chokudai-search (game-info eval-state goal-state-p
                        &key
                          init-states
                          time-limit
                          elapsed-vital-min
                          elapsed-vital-max)
  (declare (function eval-state goal-state-p))
  (let* ((n (- elapsed-vital-max elapsed-vital-min))
         (states (make-array (1+ n)))
         (start (get-internal-real-time))
         (goal-candidates (rh:make-randomized-heap #'> #'%score)))
    (dotimes (elapsed (1+ n))
      (setf (aref states elapsed)
            (rh:make-randomized-heap #'> #'%score)))
    (dolist (init-state init-states)
      (rh:push! (aref states (- (%elapsed-vital init-state)
                                elapsed-vital-min))
                (make-node :state init-state
                           :score (funcall eval-state init-state game-info))))
    ;; 時間いっぱいchokudaiサーチ
    (loop named search for turn from 1 do
      (loop for elapsed-vital from elapsed-vital-min below elapsed-vital-max for e-index = (- elapsed-vital elapsed-vital-min) do
        ;; #>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 e-index))
          (let ((node (rh:pop! #1#)))
            (labels ((%treat-next (next-state action)
                       #+(and swank) (validate-state next-state game-info)
                       (let* ((next-node (make-node :parent node
                                                    :state next-state
                                                    :score (funcall eval-state next-state game-info)
                                                    :last-action action))
                              (nev (%elapsed-vital next-state)))
                         (when (<= nev elapsed-vital-max)
                           ;; #>(nev elapsed-vital-min elapsed-vital-max)
                           (cond
                             ((funcall goal-state-p next-state game-info)
                              (rh:push! goal-candidates next-node))
                             (t
                              (rh:push! (aref states (- nev elapsed-vital-min))
                                        next-node)
                              (when (= (rh:count (aref states (- nev elapsed-vital-min)))
                                       +heap-size-threshold+)
                                (rh:prune! (aref states (- nev elapsed-vital-min))
                                           (ash +heap-size-threshold+ -1)))))))))
              (declare (inline %treat-next))
              (%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)))
                    ;; ブロックを配置
                    (when (block-placeable-p (%state node) game-info nc)
                      (%treat-next (place-block (%state node)
                                                game-info
                                                nc)
                                   (cons :place-block dir)))
                    ;; ブロックを破壊
                    (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を復元してリストとして返す
    #>((rh:count goal-candidates))
    (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)))
      res)))

(defun print-res (res)
  (princ
   (with-output-to-string (*standard-output*)
     (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)))))))))

(defun apply-action (state game-info action dir)
  (ecase action
    (:wait (do-nothing state game-info))
    (:move (move state game-info dir))
    (:place-block
     (destructuring-bind (dy . dx) (move->dy-dx dir)
       (place-block state game-info (next-coord (%pos state) dy dx))))
    (:destroy-block
     (destructuring-bind (dy . dx) (move->dy-dx dir)
       (destroy-block state game-info (next-coord (%pos state) dy dx))))
    (:fire
     (destroy-finders-by-fire state game-info dir))))

(defun apply-actions (state game-info actions)
  (reduce (lambda (acc act)
            (destructuring-bind (act-type . dir) act
              (apply-action acc game-info act-type dir)))
          actions
          :initial-value state))

(defconstant +find-key-time-limit+ 0.3)
(defconstant +earn-coin-time-limit+ 2.0)
(defconstant +find-goal-time-limit+ 0.5)

#+nil
(defun eval-state (state game-info)
  ;; TODO ゴールに辿りつくのが難しい場合ほど大きなペナルティ
  ;; TODO 残り体力が少なくなるほど傾斜を強くする?
  (cond
    ((not (%has-key state))
     (- (%eval-for-dist-to-key state game-info)
        100000))
    ;; 残り100ターンを切ったらゴールを最優先して目指す
    ((< (- +player-vital+ (%elapsed-vital state))
        400)
     (+ (%eval-for-dist-to-goal state game-info)
        (* 100000 (%jewel-amount state))))
    (t
     (%jewel-amount state))))

(declaim (notinline main))
(defun main ()
  (let* ((game-info (read-game-info))
         (init-state (make-init-state game-info))
         (best-moves-to-key (chokudai-search
                             game-info
                             #'%eval-dist-to-key
                             (lambda (state game-info)
                               (declare (ignore game-info))
                               (%has-key state))
                             :init-states (list init-state)
                             :time-limit +find-key-time-limit+
                             :elapsed-vital-min 0
                             :elapsed-vital-max (round (* (estimated-cost-to-key game-info (%pos init-state))
                                                          10))))
         (next-init-state (apply-actions init-state game-info best-moves-to-key))
         (elapsed-vital-to-key (%elapsed-vital next-init-state))
         (earn-end (max (1+ elapsed-vital-to-key)
                        (round (- +player-vital+
                                  (* (estimated-cost-to-goal game-info (%key-pos game-info))
                                     10)))))
         (best-earn-moves (chokudai-search
                           game-info
                           (lambda (state game-info)
                             (declare (ignore game-info))
                             (%jewel-amount state))
                           (lambda (state game-info)
                             (declare (ignore game-info))
                             (<= (abs (- (%elapsed-vital state)
                                         earn-end))
                                 30))
                           :init-states (list next-init-state)
                           :time-limit +earn-coin-time-limit+
                           :elapsed-vital-min (%elapsed-vital next-init-state)
                           :elapsed-vital-max earn-end))
         (next-init-state (apply-actions next-init-state game-info best-earn-moves))
         (_ #>next-init-state)
         (best-back-moves (chokudai-search
                           game-info
                           #'%eval-dist-to-goal
                           #'goal-state-p
                           :init-states (list next-init-state)
                           :time-limit +find-goal-time-limit+
                           :elapsed-vital-min (%elapsed-vital next-init-state)
                           :elapsed-vital-max +player-vital+))
         (res (concatenate 'list
                           best-moves-to-key
                           best-earn-moves
                           best-back-moves)))
    #>(elapsed-vital-to-key earn-end)
    (print-res res)))















#-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)))
0