(eval-when (:compile-toplevel :load-toplevel :execute)
  (sb-int:defconstant-eqx opt
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0))
    #'equal)
  #+swank (ql:quickload '(:cl-debug-print :fiveam) :silent t)
  #-swank (set-dispatch-macro-character
           #\# #\> (lambda (s c p) (declare (ignore c p)) `(values ,(read s nil nil t)))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)
#-swank (disable-debugger) ; for CS Academy

;; BEGIN_INSERTED_CONTENTS
(declaim (inline bisect-left))
(defun bisect-left (target value &key (start 0) end (order #'<) (key #'identity))
  "TARGET := vector | function (taking an integer argument)
ORDER := strict order

Analogue of lower_bound() of C++ or bisect_left() of Python: Returns the
smallest index (or input) i that fulfills TARGET[i] >= VALUE, where '>=' is the
complement of ORDER. In other words, this function returns the leftmost index at
which VALUE can be inserted with keeping the order. Therefore, TARGET must be
monotonically non-decreasing with respect to ORDER.

- This function returns END if VALUE exceeds TARGET[END-1]. 
- The range [START, END) is half-open.
- END must be explicitly specified if TARGET is function.
- KEY is applied to each element of TARGET before comparison."
  (declare (function key order)
           (integer start)
           ((or null integer) end))
  (macrolet
      ((frob (accessor &optional declaration)
         `(labels
              ((%bisect-left (ng ok)
                 ;; TARGET[OK] >= VALUE always holds (assuming
                 ;; TARGET[END] = +infinity)
                 ,@(when declaration (list declaration))
                 (if (<= (- ok ng) 1)
                     ok
                     (let ((mid (ash (+ ng ok) -1)))
                       (if (funcall order (funcall key (,accessor target mid)) value)
                           (%bisect-left mid ok)
                           (%bisect-left ng mid))))))
            (assert (<= start end))
            (%bisect-left (- start 1) end))))
    (etypecase target
      (vector
       (let ((end (or end (length target))))
         (frob aref (declare ((integer -1 (#.most-positive-fixnum)) ng ok)))))
      (function
       (assert end () "Requires END argument if TARGET is a function.")
       (frob funcall)))))

(declaim (inline bisect-right))
(defun bisect-right (target value &key (start 0) end (order #'<) (key #'identity))
  "TARGET := vector | function (taking an integer argument)
ORDER := strict order

Analogue of upper_bound() of C++ or bisect_right() of Python: Returns the
smallest index (or input) i that fulfills TARGET[i] > VALUE. In other words,
this function returns the rightmost index at which VALUE can be inserted with
keeping the order. Therefore, TARGET must be monotonically non-decreasing with
respect to ORDER.

- This function returns END if VALUE >= TARGET[END-1].
- The range [START, END) is half-open.
- END must be explicitly specified if TARGET is function.
- KEY is applied to each element of TARGET before comparison."
  (declare (function key order)
           (integer start)
           ((or null integer) end))
  (macrolet
      ((frob (accessor &optional declaration)
         `(labels
              ((%bisect-right (ng ok)
                 ;; TARGET[OK] > VALUE always holds (assuming
                 ;; TARGET[END] = +infinity)
                 ,@(when declaration (list declaration))
                 (if (<= (- ok ng) 1)
                     ok
                     (let ((mid (ash (+ ng ok) -1)))
                       (if (funcall order value (funcall key (,accessor target mid)))
                           (%bisect-right ng mid)
                           (%bisect-right mid ok))))))
            (assert (<= start end))
            (%bisect-right (- start 1) end))))
    (etypecase target
      (vector
       (let ((end (or end (length target))))
         (frob aref (declare ((integer -1 (#.array-total-size-limit)) ng ok)))))
      (function
       (assert end () "Requires END argument if TARGET is a function.")
       (frob funcall)))))

(declaim (inline vector-insert))
(defun vector-insert (vector new-element index)
  (let ((n (length vector)))
    (vector-push new-element vector)
    (loop for i from n above index
          do (rotatef (aref vector i) (aref vector (- i 1)))))
  vector)

(declaim (inline vector-delete))
(defun vector-delete (vector index)
  (loop for i from index below (- (length vector) 1)
        do (rotatef (aref vector i) (aref vector (+ i 1))))
  (vector-pop vector)
  vector)

(declaim (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  "NOTE: cannot read -2^62"
  (macrolet ((%read-byte ()
               `(the (unsigned-byte 8)
                     #+swank (char-code (read-char in nil #\Nul))
                     #-swank (sb-impl::ansi-stream-read-byte in nil #.(char-code #\Nul) nil))))
    (let* ((minus nil)
           (result (loop (let ((byte (%read-byte)))
                           (cond ((<= 48 byte 57)
                                  (return (- byte 48)))
                                 ((zerop byte) ; #\Nul
                                  (error "Read EOF or #\Nul."))
                                 ((= byte #.(char-code #\-))
                                  (setq minus t)))))))
      (declare ((integer 0 #.most-positive-fixnum) result))
      (loop
        (let* ((byte (%read-byte)))
          (if (<= 48 byte 57)
              (setq result (+ (- byte 48)
                              (* 10 (the (integer 0 #.(floor most-positive-fixnum 10))
                                         result))))
              (return (if minus (- result) result))))))))

(in-package :cl-user)

(defmacro dbg (&rest forms)
  #+swank
  (if (= (length forms) 1)
      `(format *error-output* "~A => ~A~%" ',(car forms) ,(car forms))
      `(format *error-output* "~A => ~A~%" ',forms `(,,@forms)))
  #-swank (declare (ignore forms)))

(defmacro define-int-types (&rest bits)
  `(progn
     ,@(mapcar (lambda (b) `(deftype ,(intern (format nil "UINT~A" b)) () '(unsigned-byte ,b))) bits)
     ,@(mapcar (lambda (b) `(deftype ,(intern (format nil "INT~A" b)) () '(signed-byte ,b))) bits)))
(define-int-types 2 4 7 8 15 16 31 32 62 63 64)

(declaim (inline println))
(defun println (obj &optional (stream *standard-output*))
  (let ((*read-default-float-format* 'double-float))
    (prog1 (princ obj stream) (terpri stream))))

(defconstant +mod+ 1000000007)

;;;
;;; Body
;;;


(defstruct state
  (d 0 :type uint16)
  (cs nil :type (simple-array uint8 (*)))
  (ss nil :type (simple-array uint32 (* *)))
  (schedule nil :type (simple-array uint8 (*)))
  (history-table nil :type (simple-array (array int16 (*)) (26)))
  (score 0 :type fixnum))

(defun make-state-from (d cs ss schedule)
  (declare (uint32 d)
           ((simple-array uint8 (*)) cs schedule)
           ((simple-array uint32 (* *)) ss))
  (let ((history-table (make-array 26 :element-type '(array uint32 (*)))))
    (dotimes (i 26)
      (let ((history (make-array (+ d 2) :element-type 'int16 :fill-pointer 0)))
        (vector-push -1 history)
        (setf (aref history-table i) history)))
    (dotimes (i d)
      (let ((type (aref schedule i)))
        (vector-push i (aref history-table type))))
    (dotimes (i 26)
      (vector-push d (aref history-table i)))
    (let* ((prevs (make-array 26 :element-type 'int32 :initial-element -1))
           (score 0))
      (declare (fixnum score))
      (dotimes (i d)
        (let ((type (aref schedule i)))
          (incf score (aref ss i type))
          (setf (aref prevs type) i)
          (dotimes (j 26)
            (decf score (* (aref cs j) (- i (aref prevs j)))))))
      (make-state :d d
                  :cs cs
                  :ss ss
                  :schedule schedule
                  :history-table history-table
                  :score score))))

(defun state-update! (state day new-type)
  (declare #.OPT
           (uint32 day new-type))
  (symbol-macrolet ((score (state-score state))
                    (cs (state-cs state))
                    (ss (state-ss state))
                    (history-table (state-history-table state)))
    (let* ((old-type (aref (state-schedule state) day))
           (old-history (aref history-table old-type))
           (new-history (aref history-table new-type)))
      (declare ((array int16 (*)) old-history new-history))
      ;; delete old type
      (decf score (aref ss day old-type))
      (let* ((pos (bisect-left old-history day))
             (prev-day (aref old-history (- pos 1)))
             (next-day (aref old-history (+ pos 1))))
        ;; (assert (= day (aref old-history pos)))
        (decf score (* (aref cs old-type) (- day prev-day) (- next-day day)))
        (vector-delete old-history pos))
      ;; add new type 
      (incf score (aref ss day new-type))
      (let* ((pos (bisect-left new-history day))
             (next-day (aref new-history pos))
             (prev-day (aref new-history (- pos 1))))
        ;; (assert (< day (aref new-history pos)))
        (incf score (* (aref cs new-type) (- day prev-day) (- next-day day)))
        (vector-insert new-history day pos))
      (setf (state-score state) score)
      (setf (aref (state-schedule state) day) new-type)
      state)))

(declaim (inline calc-prob))
(defun calc-prob (prev-score new-score temp)
  (handler-bind ((floating-point-overflow (lambda (c) #>c (dbg prev-score new-score temp) (return-from calc-prob 1d0))))
    (exp (/ (- new-score prev-score) temp))))

;; (defun initialize-scores (d cs ss state)
;;   (declare (fixnum d)
;;            ((simple-array uint8 (*)) cs state)
;;            ((simple-array uint32 (* *)) ss))
;;   (let* ((prevs (make-array 26 :element-type 'int32 :initial-element -1))
;;          (res (make-array 26 :element-type 'int32 :initial-element 0)))
;;     (dotimes (i d)
;;       (let ((type (aref state i)))
;;         (incf (aref res type) (aref ss i type))
;;         (setf (aref prevs type) i)
;;         (dotimes (j 26)
;;           (decf (aref res j) (* (aref cs j) (- i (aref prevs j)))))))
;;     res))

(defun anneal (state &optional (time 1.6d0))
  (declare #.OPT
           (double-float time))
  (let* ((opt-schedule (copy-seq (state-schedule state)))
         (opt-score (state-score state))
         (start-temp 1000d0)
         (end-temp 1d0)
         (loop-count 0))
    (declare (fixnum loop-count opt-score)
             (double-float start-temp end-temp))
    (sb-int:with-progressive-timeout (rem-time :seconds time)
      (loop
        (incf loop-count)
        (let ((rem-time (float (rem-time) 1d0)))
          (when (zerop rem-time)
            (return))
          (let* ((day (random (state-d state)))
                 (old-type (aref (state-schedule state) day))
                 (new-type (random 26))
                 (old-score (state-score state)))
            (unless (= old-type new-type)
              ;; tmp. update
              (state-update! state day new-type)
              (let* ((new-score (state-score state))
                     (temp (+ end-temp (/ (* rem-time (- start-temp end-temp)) time)))
                     (prob (calc-prob old-score new-score temp)))
                (declare (double-float temp))
                ;; rollback
                (when (> new-score opt-score)
                  (setq opt-schedule (copy-seq (state-schedule state))
                        opt-score new-score))
                (when (>= (random 1.0) prob)
                  ;; rollback
                  (state-update! state day old-type))))))))
    #>loop-count
    (values opt-schedule opt-score)))

(defun print* (state)
  (write-string
   (with-output-to-string (*standard-output* nil :element-type 'base-char)
     (loop for x across state
           do (println (+ x 1))))))

(defun make-initial-schedule (d cs ss)
  (declare #.OPT
           (uint32 d)
           ((simple-array uint8 (*)) cs)
           ((simple-array uint32 (* *)) ss))
  (let* ((prevs (make-array 26 :element-type 'int32 :initial-element -1))
         (schedule (make-array d :element-type 'uint8 :initial-element 0)))
    (dotimes (i (- d 2))
      (labels ((%eval (day type)
                 (declare (uint31 day type))
                 (let ((value (aref ss day type)))
                   (declare (fixnum value))
                   (dotimes (j 26)
                     (unless (= j type)
                       (decf value (* (aref cs j) (- day (aref prevs j))))))
                   value))
               ;; (%eval-after (day offset)
               ;;   (let ((value 0)
               ;;         (start day)
               ;;         (end (min (+ day offset -1) (- d 1)))) ;; inclusive
               ;;     (declare (fixnum value))
               ;;     (if (> start end)
               ;;         0
               ;;         (dotimes (j 26 value)
               ;;           (let ((l (* (aref cs j) (- start (aref prevs j))))
               ;;                 (r (* (aref cs j) (- end (aref prevs j)))))
               ;;             (declare (int32 l r))
               ;;             (decf value (floor (the uint32 (* (+ l r) (+ 1 (- end start))))
               ;;                                2)))))))
               )
        (let ((max-type1 0)
              (max-type2 0)
              (max-type3 0)
              (max-value most-negative-fixnum))
          (declare (fixnum max-value))
          (dotimes (type1 26)
            (let ((value1 (%eval i type1))
                  (store-i1 (aref prevs type1)))
              (declare (int32 value1))
              (setf (aref prevs type1) i)
              (dotimes (type2 26)
                (let ((value2 (%eval (+ i 1) type2))
                      (store-i2 (aref prevs type2)))
                  (declare (int32 value2))
                  (setf (aref prevs type2) (+ i 1))
                  (dotimes (type3 26)
                    (let* ((value3 (%eval (+ i 2) type3))
                           ;; (store-i3 (aref prevs type3))
                           )
                      (declare (int32 value3))
                      ;; (setf (aref prevs type3) (+ i 2))
                      (let ((value (+ value1 value2 value3 ;; (%eval-after (+ i 3) 4)
                                      )))
                        (when (> value max-value)
                          (setq max-type1 type1
                                max-type2 type2
                                max-type3 type3
                                max-value value)))
                      ;; (setf (aref prevs type3) store-i3)
                      ))
                  (setf (aref prevs type2) store-i2)))
              (setf (aref prevs type1) store-i1)))
          (setf (aref prevs max-type1) i
                (aref schedule i) max-type1)
          (when (= i (- d 3))
            (setf (aref prevs max-type2) (+ i 1)
                  (aref schedule (+ i 1)) max-type2
                  (aref prevs max-type3) (+ i 2)
                  (aref schedule (+ i 2)) max-type3)))))
    schedule))

(defun main ()
  (let* ((d (read))
         (cs (make-array 26 :element-type 'uint8 :initial-element 0))
         (ss (make-array (list d 26) :element-type 'uint32 :initial-element 0)))
    (dotimes (i 26)
      (setf (aref cs i) (read-fixnum)))
    (dotimes (i d)
      (dotimes (j 26)
        (setf (aref ss i j) (read-fixnum))))
    ;; #>ss
    (let* ((init-schedule (make-initial-schedule d cs ss))
           (init-state (make-state-from d cs ss init-schedule)))
      #>(state-score init-state)
      ;; (print* init-state)
      ;; (loop for x across (initialize-scores d cs ss init-state) sum x)
      (multiple-value-bind (schedule score) (anneal init-state)
        ;; (let ((result-state (make-state-from d cs ss schedule)))
        ;;   (assert (= score (state-score result-state))))
        (print* schedule)
        score))))

#-swank (main)

;;;
;;; Test and benchmark
;;;

#+swank
(defun io-equal (in-string out-string &key (function #'main) (test #'equal))
  "Passes IN-STRING to *STANDARD-INPUT*, executes FUNCTION, and returns true if
the string output to *STANDARD-OUTPUT* is equal to OUT-STRING."
  (labels ((ensure-last-lf (s)
             (if (eql (uiop:last-char s) #\Linefeed)
                 s
                 (uiop:strcat s uiop:+lf+))))
    (funcall test
             (ensure-last-lf out-string)
             (with-output-to-string (out)
               (let ((*standard-output* out))
                 (with-input-from-string (*standard-input* (ensure-last-lf in-string))
                   (funcall function)))))))

#+swank
(defun get-clipbrd ()
  (with-output-to-string (out)
    (run-program "powershell.exe" '("-Command" "Get-Clipboard") :output out :search t)))

#+swank (defparameter *this-pathname* (uiop:current-lisp-file-pathname))
#+swank (defparameter *dat-pathname* (uiop:merge-pathnames* "test.dat" *this-pathname*))

#+swank
(defun run (&optional thing (out *standard-output*))
  "THING := null | string | symbol | pathname

null: run #'MAIN using the text on clipboard as input.
string: run #'MAIN using the string as input.
symbol: alias of FIVEAM:RUN!.
pathname: run #'MAIN using the text file as input."
  (let ((*standard-output* out))
    (etypecase thing
      (null
       (with-input-from-string (*standard-input* (delete #\Return (get-clipbrd)))
         (main)))
      (string
       (with-input-from-string (*standard-input* (delete #\Return thing))
         (main)))
      (symbol (5am:run! thing))
      (pathname
       (with-open-file (*standard-input* thing)
         (main))))))

#+swank
(defun gen-dat (seed)
  (uiop:with-output-file (out *dat-pathname* :if-exists :supersede)
    (let ((state (seed-random-state seed)))
      (format out "365~%")
      (dotimes (i 26)
        (println (random 101 state) out))
      (dotimes (i 365)
        (dotimes (j 26)
          (println (random 20001 state) out))))))

#+swank
(defun bench ()
  (let ((*random-state* (seed-random-state 0)))
    (loop for i below 5
          ;; do (gen-dat i)
          sum #>(run *dat-pathname*))))


Measured memory_bytes: 49852