(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

(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)

;; BEGIN_INSERTED_CONTENTS
;;;
;;; Sort multiple vectors
;;;

;; TODO: throw an error if there are two ore more identical vectors in the given
;; vectors

(declaim (inline %median3))
(defun %median3 (x y z)
  (if (> x y)
      (if (> y z)
          y
          (if (> z x)
              x
              z))
      (if (> z y)
          y
          (if (> x z)
              x
              z))))

(defun parallel-sort! (vector vector1 vector2 end)
  (declare #.OPT
           ((simple-array int32 (*)) vector)
           ((simple-array t (*)) vector1 vector2)
           ((integer 0 #.array-total-size-limit) end))
  (labels
      ((recur (left right)
         (declare ((integer -1 #.array-total-size-limit) left right))
         (when (< left right)
           (let* ((l left)
                  (r right)
                  (pivot (%median3 (aref vector l)
                                   (aref vector (ash (+ l r) -1))
                                   (aref vector r))))
             (declare ((integer 0 #.most-positive-fixnum) l r))
             (loop (loop while (> (aref vector l) pivot)
                         do (incf l 1))
                   (loop while (> pivot (aref vector r))
                         do (decf r 1))
                   (when (>= l r)
                     (return))
                   (rotatef (aref vector l) (aref vector r))
                   (rotatef (aref vector1 l) (aref vector1 r))
                   (rotatef (aref vector2 l) (aref vector2 r))
                   (incf l 1)
                   (decf r 1))
             (recur left (- l 1))
             (recur (+ r 1) right)))))
    (recur 0 (- end 1))
    vector))

(declaim (inline bisect-left))
(defun bisect-left (target value &key (start 0) end (order #'<))
  (declare (function 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 (,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 (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  "NOTE: cannot read -2^62"
  (declare #.OPT)
  (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)))

(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 (365 26)))
  (schedule nil :type (simple-array uint8 (*)))
  (history-table nil :type (simple-array (simple-array int16 (*)) (26)))
  (ends nil :type (simple-array uint16 (*)))
  (score 0 :type fixnum))

(defun make-state-from (d cs ss schedule)
  (declare #.OPT
           (uint32 d)
           ((simple-array uint8 (*)) cs schedule)
           ((simple-array uint32 (* *)) ss))
  (let ((history-table (make-array 26 :element-type '(simple-array int16 (*))))
        (ends (make-array 26 :element-type 'uint16 :initial-element 1)))
    (dotimes (i 26)
      (let ((history (make-array (+ d 2) :element-type 'int16)))
        (setf (aref history 0) -1)
        (setf (aref history-table i) history)))
    (dotimes (i d)
      (let ((type (aref schedule i)))
        (setf (aref (aref history-table type) (aref ends type)) i)
        (incf (aref ends type))))
    (dotimes (i 26)
      (setf (aref (aref history-table i) (aref ends i)) d)
      (incf (aref ends 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
                  :ends ends
                  :score score))))

(defun state-update! (state day new-type)
  (declare #.OPT
           (uint16 day new-type))
  (symbol-macrolet ((score (state-score state))
                    (cs (state-cs state))
                    (ss (the (simple-array uint32 (365 26)) (state-ss state)))
                    (history-table (state-history-table state))
                    (ends (state-ends 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 :end (aref ends old-type)))
             (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)))
        (loop for i from pos below (aref ends old-type)
              do (rotatef (aref old-history i) (aref old-history (+ i 1))))
        (decf (aref ends old-type)))
      ;; add new type
      (incf score (aref ss day new-type))
      (let* ((pos (bisect-left new-history day :end (aref ends new-type)))
             (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)))
        (setf (aref new-history (aref ends new-type)) day)
        (loop for i from (aref ends new-type) above pos
              do (rotatef (aref new-history i) (aref new-history (- i 1))))
        (incf (aref ends new-type)))
      (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)
  (declare (int32 prev-score new-score)
           (double-float temp))
  (if (>= new-score prev-score)
      1d0
      (exp (/ (- new-score prev-score) temp))))

(defun anneal (state &optional (time 0.8d0))
  (declare #.OPT
           (double-float time))
  (let* ((opt-schedule (copy-seq (state-schedule state)))
         (opt-score (state-score state))
         (start-temp 1000d0)
         (end-temp 10d0)
         (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))
          (if (zerop (random 4))
              (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))
                    (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)))))
              (let* ((width (+ 1 (random 16)))
                     (day (random (- (state-d state) width)))
                     (type1 (aref (state-schedule state) day))
                     (type2 (aref (state-schedule state) (+ day width)))
                     (old-score (state-score state)))
                (unless (= type1 type2)
                  (state-update! state day type2)
                  (state-update! state (+ day width) type1)
                  (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))
                    ;; (dbg day type1 type2 old-score new-score)
                    (when (> new-score opt-score)
                      ;; (dbg new-score)
                      (setq opt-schedule (copy-seq (state-schedule state))
                            opt-score new-score))
                    (when (> (random 1.0) prob)
                      ;; rollback
                      (state-update! state day type1)
                      (state-update! state (+ day width) type2)))))))))
    #>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))))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defconstant +beam-width+ 1000))

(defun make-initial-schedule (d cs ss)
  (declare #.OPT
           (uint16 d)
           ((simple-array uint8 (*)) cs)
           ((simple-array uint32 (365 26)) ss))
  (let* (;; score schedule prevs
         (que1 (make-array #.(* +beam-width+ 26) :element-type 'int32))
         (que2 (make-array #.(* +beam-width+ 26) :element-type t))
         (que3 (make-array #.(* +beam-width+ 26) :element-type t))
         (new-que1 (make-array #.(* +beam-width+ 26) :element-type 'int32))
         (new-que2 (make-array #.(* +beam-width+ 26) :element-type t))
         (new-que3 (make-array #.(* +beam-width+ 26) :element-type t))
         (end 0)
         (new-end 0))
    (declare ((simple-array int32 (*)) que1 new-que1)
             ((simple-array t (*)) que2 new-que2 que3 new-que3)
             (uint31 end new-end))
    (setf (aref que1 0) 0
          (aref que2 0) nil
          (aref que3 0) (make-array 26 :element-type 'int16 :initial-element -1))
    (incf end)
    (dotimes (i d)
      (loop for j below (min +beam-width+ end)
            for base-score of-type int32 = (aref que1 j)
            for schedule of-type list = (aref que2 j)
            for prevs of-type (simple-array int16 (*)) = (aref que3 j)
            do (dotimes (type 26)
                 (decf base-score (* (aref cs type) (- i (aref prevs type)))))
               (dotimes (type 26)
                 (let ((new-score (+ base-score
                                     (aref ss i type)
                                     (* (aref cs type) (- i (aref prevs type)))))
                       (new-prevs (copy-seq prevs)))
                   (setf (aref new-prevs type) i)
                   (setf (aref new-que1 new-end) new-score
                         (aref new-que2 new-end) (cons type schedule)
                         (aref new-que3 new-end) new-prevs)
                   (incf new-end))))
      (parallel-sort! new-que1 new-que2 new-que3 new-end)
      (rotatef que1 new-que1)
      (rotatef que2 new-que2)
      (rotatef que3 new-que3)
      (setq end new-end
            new-end 0))
    (coerce (reverse (aref que2 0)) '(simple-array uint8 (*)))))

(defun main ()
  (declare #.OPT)
  (let* ((d (read))
         (cs #-swank (sb-int:make-static-vector 26)
             #+swank (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)))
      ;; #>init-state
      ;; #>(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))))

;; #+linux
;; (eval-when (:compile-toplevel :load-toplevel :execute)
;;   (require :sb-sprof))
;; #+linux
;; (sb-sprof:start-profiling)

#-swank (main)

;; #+linux
;; (progn
;;   (sb-sprof:stop-profiling)
;;   (sb-sprof:report))

;;;
;;; 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 10
          do (gen-dat i)
          sum #>(run *dat-pathname*))))


(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

(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)

;; BEGIN_INSERTED_CONTENTS
;;;
;;; Sort multiple vectors
;;;

;; TODO: throw an error if there are two ore more identical vectors in the given
;; vectors

(declaim (inline %median3))
(defun %median3 (x y z)
  (if (> x y)
      (if (> y z)
          y
          (if (> z x)
              x
              z))
      (if (> z y)
          y
          (if (> x z)
              x
              z))))

(defun parallel-sort! (vector vector1 vector2 end)
  (declare #.OPT
           ((simple-array int32 (*)) vector)
           ((simple-array t (*)) vector1 vector2)
           ((integer 0 #.array-total-size-limit) end))
  (labels
      ((recur (left right)
         (declare ((integer -1 #.array-total-size-limit) left right))
         (when (< left right)
           (let* ((l left)
                  (r right)
                  (pivot (%median3 (aref vector l)
                                   (aref vector (ash (+ l r) -1))
                                   (aref vector r))))
             (declare ((integer 0 #.most-positive-fixnum) l r))
             (loop (loop while (> (aref vector l) pivot)
                         do (incf l 1))
                   (loop while (> pivot (aref vector r))
                         do (decf r 1))
                   (when (>= l r)
                     (return))
                   (rotatef (aref vector l) (aref vector r))
                   (rotatef (aref vector1 l) (aref vector1 r))
                   (rotatef (aref vector2 l) (aref vector2 r))
                   (incf l 1)
                   (decf r 1))
             (recur left (- l 1))
             (recur (+ r 1) right)))))
    (recur 0 (- end 1))
    vector))

(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 (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  "NOTE: cannot read -2^62"
  (declare #.OPT)
  (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)))

(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 (365 26)))
  (schedule nil :type (simple-array uint8 (*)))
  (history-table nil :type (simple-array (simple-array int16 (*)) (26)))
  (ends nil :type (simple-array uint16 (*)))
  (score 0 :type fixnum))

(defun make-state-from (d cs ss schedule)
  (declare #.OPT
           (uint32 d)
           ((simple-array uint8 (*)) cs schedule)
           ((simple-array uint32 (* *)) ss))
  (let ((history-table (make-array 26 :element-type '(simple-array int16 (*))))
        (ends (make-array 26 :element-type 'uint16 :initial-element 1)))
    (dotimes (i 26)
      (let ((history (make-array (+ d 2) :element-type 'int16)))
        (setf (aref history 0) -1)
        (setf (aref history-table i) history)))
    (dotimes (i d)
      (let ((type (aref schedule i)))
        (setf (aref (aref history-table type) (aref ends type)) i)
        (incf (aref ends type))))
    (dotimes (i 26)
      (setf (aref (aref history-table i) (aref ends i)) d)
      (incf (aref ends 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
                  :ends ends
                  :score score))))

(defun state-update! (state day new-type)
  (declare #.OPT
           (uint16 day new-type))
  (symbol-macrolet ((score (state-score state))
                    (cs (state-cs state))
                    (ss (the (simple-array uint32 (365 26)) (state-ss state)))
                    (history-table (state-history-table state))
                    (ends (state-ends 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 :end (aref ends old-type)))
             (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)))
        (loop for i from pos below (aref ends old-type)
              do (rotatef (aref old-history i) (aref old-history (+ i 1))))
        (decf (aref ends old-type)))
      ;; add new type
      (incf score (aref ss day new-type))
      (let* ((pos (bisect-left new-history day :end (aref ends new-type)))
             (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)))
        (setf (aref new-history (aref ends new-type)) day)
        (loop for i from (aref ends new-type) above pos
              do (rotatef (aref new-history i) (aref new-history (- i 1))))
        (incf (aref ends new-type)))
      (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)
  (declare (int32 prev-score new-score)
           (double-float temp))
  (if (>= new-score prev-score)
      1d0
      (exp (/ (- new-score prev-score) temp))))

(defun anneal (state &optional (time 1.5d0))
  (declare #.OPT
           (double-float time))
  (let* ((opt-schedule (copy-seq (state-schedule state)))
         (opt-score (state-score state))
         (start-temp 1000d0)
         (end-temp 10d0)
         (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))
          (if (zerop (random 4))
              (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))
                    (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)))))
              (let* ((width (+ 1 (random 16)))
                     (day (random (- (state-d state) width)))
                     (type1 (aref (state-schedule state) day))
                     (type2 (aref (state-schedule state) (+ day width)))
                     (old-score (state-score state)))
                (unless (= type1 type2)
                  (state-update! state day type2)
                  (state-update! state (+ day width) type1)
                  (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))
                    ;; (dbg day type1 type2 old-score new-score)
                    (when (> new-score opt-score)
                      ;; (dbg new-score)
                      (setq opt-schedule (copy-seq (state-schedule state))
                            opt-score new-score))
                    (when (> (random 1.0) prob)
                      ;; rollback
                      (state-update! state day type1)
                      (state-update! state (+ day width) type2)))))))))
    #>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))))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defconstant +beam-width+ 400))

(defun make-initial-schedule (d cs ss)
  (declare #.OPT
           (uint16 d)
           ((simple-array uint8 (*)) cs)
           ((simple-array uint32 (365 26)) ss))
  (let* (;; score schedule prevs
         (que1 (make-array #.(* +beam-width+ 26) :element-type 'int32))
         (que2 (make-array #.(* +beam-width+ 26) :element-type t))
         (que3 (make-array #.(* +beam-width+ 26) :element-type t))
         (new-que1 (make-array #.(* +beam-width+ 26) :element-type 'int32))
         (new-que2 (make-array #.(* +beam-width+ 26) :element-type t))
         (new-que3 (make-array #.(* +beam-width+ 26) :element-type t))
         (end 0)
         (new-end 0))
    (declare ((simple-array int32 (*)) que1 new-que1)
             ((simple-array t (*)) que2 new-que2 que3 new-que3)
             (uint31 end new-end))
    (setf (aref que1 0) 0
          (aref que2 0) nil
          (aref que3 0) (make-array 26 :element-type 'int16 :initial-element -1))
    (incf end)
    (dotimes (i d)
      (loop for j below (min +beam-width+ end)
            for base-score of-type int32 = (aref que1 j)
            for schedule of-type list = (aref que2 j)
            for prevs of-type (simple-array int16 (*)) = (aref que3 j)
            do (dotimes (type 26)
                 (decf base-score (* (aref cs type) (- i (aref prevs type)))))
               (dotimes (type 26)
                 (let ((new-score (+ base-score
                                     (aref ss i type)
                                     (* (aref cs type) (- i (aref prevs type)))))
                       (new-prevs (copy-seq prevs)))
                   (setf (aref new-prevs type) i)
                   (setf (aref new-que1 new-end) new-score
                         (aref new-que2 new-end) (cons type schedule)
                         (aref new-que3 new-end) new-prevs)
                   (incf new-end))))
      (parallel-sort! new-que1 new-que2 new-que3 new-end)
      (rotatef que1 new-que1)
      (rotatef que2 new-que2)
      (rotatef que3 new-que3)
      (setq end new-end
            new-end 0))
    (coerce (reverse (aref que2 0)) '(simple-array uint8 (*)))))

(defun main ()
  (declare #.OPT)
  (let* ((d (read))
         (cs #-swank (sb-int:make-static-vector 26)
             #+swank (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)))
      ;; #>init-state
      ;; #>(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))))

;; #+linux
;; (eval-when (:compile-toplevel :load-toplevel :execute)
;;   (require :sb-sprof))
;; #+linux
;; (sb-sprof:start-profiling)

#-swank (main)

;; #+linux
;; (progn
;;   (sb-sprof:stop-profiling)
;;   (sb-sprof:report))

;;;
;;; 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 10
          do (gen-dat i)
          sum #>(run *dat-pathname*))))

Global OOD problem IDs are disjoint from train, validation, and in-distribution test problem IDs.

Problem Statement

AtCoder currently hosts three types of contests: ABC, ARC, and AGC. As the number of users has grown, in order to meet the needs of more users, AtCoder has decided to increase the number of contests to 26 types, from AAC to AZC. For convenience, we number these 26 types as type 1 through type 26. AtCoder wants to schedule contests for D days so that user satisfaction is as high as possible. For every day, AtCoder will hold exactly one contest, and each contest will end on that day. The satisfaction is calculated as follows.

The satisfaction at the beginning of day 1 is 0. Satisfaction can be negative.

Holding contests increases satisfaction. The amount of increase will vary depending on a variety of factors. Specifically, we know in advance that holding a contest of type i on day d will increase the satisfaction by s_{d,i}.

If a particular type of contest is not held for a while, the satisfaction decreases. Each contest type i has an integer c_i, and at the end of each day d=1,2,...,D, the satisfaction decreases as follows. Let \mathrm{last}(d,i) be the last day before day d (including d) on which a contest of type i was held. If contests of type i have never been held yet, we define \mathrm{last}(d,i)=0. At the end of day d, the satisfaction decreases by \sum _{i=1}^{26}c_i \times (d-\mathrm{last}(d,i)).

Please schedule contests on behalf of AtCoder.
If the satisfaction at the end of day D is S, you will get a score of \max(10^6 + S, 0).
There are 50 test cases, and the score of a submission is the total scores for each test case.
You can make submissions multiple times, and the highest score among your submissions will be your score.

Constraints

D = 365

Each c_i is an integer satisfying 0\leq c_i \leq 100.

Each s_{d,i} is an integer satisfying 0\leq s_{d,i} \leq 20000.

Input

Input is given from Standard Input in the following format:

D
c_1 c_2 \cdots c_{26}
s_{1,1} s_{1,2} \cdots s_{1,26}
\vdots
s_{D,1} s_{D,2} \cdots s_{D,26}

Output

Let t_d (1\leq t_d \leq 26) be the type of the contest that will be held at day d.
Print D integers t_d to Standard Output in the following format:

t_1
t_2
\vdots
t_D

Any output that does not follow the above format may result in 0 pointsWA for that test case.

Input Generation

Each integer c_i and s_{d,i} is generated independently and uniformly at random from the integers in the range described in the problem statement.

Sample Input 1

5
86 90 69 51 2 96 71 47 88 34 45 46 89 34 31 38 97 84 41 80 14 4 50 83 7 82
19771 12979 18912 10432 10544 12928 13403 3047 10527 9740 8100 92 2856 14730 1396 15905 6534 4650 11469 3628 8433 2994 10899 16396 18355 11424
6674 17707 13855 16407 12232 2886 11908 1705 5000 1537 10440 10711 4917 10770 17272 15364 19277 18094 3929 3705 7169 6159 18683 15410 9092 4570
6878 4239 19925 1799 375 9563 3445 5658 19857 11401 6997 6498 19933 3848 2426 2146 19745 16880 17773 18359 3921 14172 16730 11157 5439 256
8633 15862 15303 10749 18499 7792 10317 5901 9395 11433 3514 3959 5202 19850 19469 9790 5653 784 18500 10552 17975 16615 7852 197 8471 7452
19855 17918 7990 10572 4333 438 9140 9104 12622 4985 12319 4028 19922 12132 16259 17476 2976 547 19195 19830 16285 4806 4471 9457 2864 2192

Sample Output 1

1
17
13
14
13

Note that this example is a small one for checking the problem specification. It does not satisfy the constraint D=365 and is never actually given as a test case. The final satisfaction with this output is 79325, so the score is 1079325.

Input generator, score calculator, and visualizer

Beginner's Guide

If you don't know what to do, proceed to problem B or C.

Submitted source-code file size, in bytes.

Execution CPU time reported by official Project CodeNet metadata, in milliseconds.

Peak memory usage reported by official Project CodeNet metadata, in kilobytes.


(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

(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)

;; BEGIN_INSERTED_CONTENTS
;;;
;;; Quicksort (deterministic median-of-three partitioning)
;;;

;; NOTE: This quicksort is NOT randomized. You should shuffle an input when you
;; need to avoid getting hacked.

;; Reference:
;; Hannu Erkio, The worst case permutation for median-of-three quicksort

(declaim (inline %median3))
(defun %median3 (x y z order)
  (if (funcall order x y)
      (if (funcall order y z)
          y
          (if (funcall order z x)
              x
              z))
      (if (funcall order z y)
          y
          (if (funcall order x z)
              x
              z))))

(defun quicksort! (vector end)
  "Destructively sorts VECTOR w.r.t. ORDER."
  (declare #.OPT
           ((simple-array list (*)) vector)
           (uint32 end))
  (labels
      ((order (x y)
         (> (the int32 (car x)) (the int32 (car y))))
       (recur (left right)
         (when (< left right)
           (let* ((l left)
                  (r right)
                  (pivot (%median3 (aref vector l)
                                   (aref vector (ash (+ l r) -1))
                                   (aref vector r)
                                   #'order)))
             (declare ((integer 0 #.most-positive-fixnum) l r))
             (loop (loop while (order (aref vector l) pivot)
                         do (incf l))
                   (loop while (order pivot (aref vector r))
                         do (decf r))
                   (when (>= l r)
                     (return))
                   (rotatef (aref vector l) (aref vector r))
                   (incf l 1)
                   (decf r 1))
             (recur left (- l 1))
             (recur (+ r 1) right)))))
    (declare (inline order))
    (recur 0 (- end 1))
    vector))

(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 (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  "NOTE: cannot read -2^62"
  (declare #.OPT)
  (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)))

(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 (365 26)))
  (schedule nil :type (simple-array uint8 (*)))
  (history-table nil :type (simple-array (simple-array int16 (*)) (26)))
  (ends nil :type (simple-array uint16 (*)))
  (score 0 :type fixnum))

(defun make-state-from (d cs ss schedule)
  (declare #.OPT
           (uint32 d)
           ((simple-array uint8 (*)) cs schedule)
           ((simple-array uint32 (* *)) ss))
  (let ((history-table (make-array 26 :element-type '(simple-array int16 (*))))
        (ends (make-array 26 :element-type 'uint16 :initial-element 1)))
    (dotimes (i 26)
      (let ((history (make-array (+ d 2) :element-type 'int16)))
        (setf (aref history 0) -1)
        (setf (aref history-table i) history)))
    (dotimes (i d)
      (let ((type (aref schedule i)))
        (setf (aref (aref history-table type) (aref ends type)) i)
        (incf (aref ends type))))
    (dotimes (i 26)
      (setf (aref (aref history-table i) (aref ends i)) d)
      (incf (aref ends 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
                  :ends ends
                  :score score))))

(defun state-update! (state day new-type)
  (declare #.OPT
           (uint16 day new-type))
  (symbol-macrolet ((score (state-score state))
                    (cs (state-cs state))
                    (ss (the (simple-array uint32 (365 26)) (state-ss state)))
                    (history-table (state-history-table state))
                    (ends (state-ends 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 :end (aref ends old-type)))
             (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)))
        (loop for i from pos below (aref ends old-type)
              do (rotatef (aref old-history i) (aref old-history (+ i 1))))
        (decf (aref ends old-type)))
      ;; add new type
      (incf score (aref ss day new-type))
      (let* ((pos (bisect-left new-history day :end (aref ends new-type)))
             (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)))
        (setf (aref new-history (aref ends new-type)) day)
        (loop for i from (aref ends new-type) above pos
              do (rotatef (aref new-history i) (aref new-history (- i 1))))
        (incf (aref ends new-type)))
      (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)
  (declare (int32 prev-score new-score)
           (double-float temp))
  (if (>= new-score prev-score)
      1d0
      (exp (/ (- new-score prev-score) temp))))

(defun anneal (state &optional (time 1.5d0))
  (declare #.OPT
           (double-float time))
  (let* ((opt-schedule (copy-seq (state-schedule state)))
         (opt-score (state-score state))
         (start-temp 1000d0)
         (end-temp 10d0)
         (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))
          (if (zerop (random 4))
              (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))
                    (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)))))
              (let* ((width (+ 1 (random 16)))
                     (day (random (- (state-d state) width)))
                     (type1 (aref (state-schedule state) day))
                     (type2 (aref (state-schedule state) (+ day width)))
                     (old-score (state-score state)))
                (unless (= type1 type2)
                  (state-update! state day type2)
                  (state-update! state (+ day width) type1)
                  (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))
                    ;; (dbg day type1 type2 old-score new-score)
                    (when (> new-score opt-score)
                      ;; (dbg new-score)
                      (setq opt-schedule (copy-seq (state-schedule state))
                            opt-score new-score))
                    (when (> (random 1.0) prob)
                      ;; rollback
                      (state-update! state day type1)
                      (state-update! state (+ day width) type2)))))))))
    #>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))))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defconstant +beam-width+ 350))

(defun make-initial-schedule (d cs ss)
  (declare #.OPT
           (uint16 d)
           ((simple-array uint8 (*)) cs)
           ((simple-array uint32 (365 26)) ss)
           ;; (inline sort sb-impl::stable-sort-list)
           )
  (let* (;; score schedule prevs
         (que (make-array #.(* +beam-width+ 26) :element-type 'list))
         (new-que (make-array #.(* +beam-width+ 26) :element-type 'list))
         (end 0)
         (new-end 0))
    (declare ((simple-array list (*)) que new-que)
             (uint31 end new-end))
    (setf (aref que 0)
          (list* 0 nil (make-array 26 :element-type 'int16 :initial-element -1)))
    (incf end)
    (dotimes (i d)
      (loop for j below (min +beam-width+ end)
            for (score schedule . prevs)
            of-type (int32 list . (simple-array int16 (*))) = (aref que j)
            for base-score of-type int32 = score
            do (dotimes (type 26)
                 (decf base-score (* (aref cs type) (- i (aref prevs type)))))
               (dotimes (type 26)
                 (let ((new-score (+ base-score
                                     (aref ss i type)
                                     (* (aref cs type) (- i (aref prevs type)))))
                       (new-prevs (copy-seq prevs)))
                   (setf (aref new-prevs type) i)
                   (setf (aref new-que new-end)
                         (list* new-score (cons type schedule) new-prevs))
                   (incf new-end))))
      (quicksort! new-que new-end)
      (rotatef que new-que)
      (setq end new-end
            new-end 0))
    (coerce (reverse (second (aref que 0))) '(simple-array uint8 (*)))))

(defun main ()
  (declare #.OPT)
  (let* ((d (read))
         (cs #-swank (sb-int:make-static-vector 26)
             #+swank (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)))
      ;; #>init-state
      ;; #>(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))))

;; #+linux
;; (eval-when (:compile-toplevel :load-toplevel :execute)
;;   (require :sb-sprof))
;; #+linux
;; (sb-sprof:start-profiling)

#-swank (main)

;; #+linux
;; (progn
;;   (sb-sprof:stop-profiling)
;;   (sb-sprof:report))

;;;
;;; 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 10
          do (gen-dat i)
          sum #>(run *dat-pathname*))))


(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 (ftype (function * (values fixnum &optional)) read-fixnum))
(defun read-fixnum (&optional (in *standard-input*))
  "NOTE: cannot read -2^62"
  (declare #.OPT)
  (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 (simple-array int16 (*)) (26)))
  (ends nil :type (simple-array uint16 (*)))
  (score 0 :type fixnum))

(defun make-state-from (d cs ss schedule)
  (declare #.OPT
           (uint32 d)
           ((simple-array uint8 (*)) cs schedule)
           ((simple-array uint32 (* *)) ss))
  (let ((history-table (make-array 26 :element-type '(simple-array int16 (*))))
        (ends (make-array 26 :element-type 'uint16 :initial-element 1)))
    (dotimes (i 26)
      (let ((history (make-array (+ d 2) :element-type 'int16)))
        (setf (aref history 0) -1)
        (setf (aref history-table i) history)))
    (dotimes (i d)
      (let ((type (aref schedule i)))
        (setf (aref (aref history-table type) (aref ends type)) i)
        (incf (aref ends type))))
    (dotimes (i 26)
      (setf (aref (aref history-table i) (aref ends i)) d)
      (incf (aref ends 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
                  :ends ends
                  :score score))))

(defun state-update! (state day new-type)
  (declare #.OPT
           (uint16 day new-type))
  (symbol-macrolet ((score (state-score state))
                    (cs (state-cs state))
                    (ss (state-ss state))
                    (history-table (state-history-table state))
                    (ends (state-ends 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 :end (aref ends old-type)))
             (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)))
        (loop for i from pos below (aref ends old-type)
              do (rotatef (aref old-history i) (aref old-history (+ i 1))))
        (decf (aref ends old-type)))
      ;; add new type
      (incf score (aref ss day new-type))
      (let* ((pos (bisect-left new-history day :end (aref ends new-type)))
             (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)))
        (setf (aref new-history (aref ends new-type)) day)
        (loop for i from (aref ends new-type) above pos
              do (rotatef (aref new-history i) (aref new-history (- i 1))))
        (incf (aref ends new-type)))
      (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 anneal (state &optional (time 1.5d0))
  (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))
          (if (zerop (random 1))
              (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))
                    (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)))))
              (let* ((day (random (- (state-d state) 1)))
                     (type1 (aref (state-schedule state) day))
                     (type2 (aref (state-schedule state) (+ day 1)))
                     (old-score (state-score state)))
                (unless (= type1 type2)
                  (state-update! state day type2)
                  (state-update! state (+ day 1) type1)
                  (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))
                    (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 type1)
                      (state-update! state (+ day 1) type2)))))))))
    #>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
           (uint16 d)
           ((simple-array uint8 (*)) cs)
           ((simple-array uint32 (365 26)) ss)
           (inline sort sb-impl::stable-sort-list))
  (let* (;; score schedule prevs
         que)
    (push (list* 0 nil (make-array 26 :element-type 'int16 :initial-element -1)) que)
    (dotimes (i d)
      (let (new-que)
        (loop repeat 200
              for (score schedule . prevs)
              of-type (int32 list . (simple-array int16 (*))) in que
              for base-score of-type int32 = score
              do (dotimes (type 26)
                   (decf base-score (* (aref cs type) (- i (aref prevs type)))))
                 (dotimes (type 26)
                   (let ((new-score (+ base-score
                                       (aref ss i type)
                                       (* (aref cs type) (- i (aref prevs type)))))
                         (new-prevs (copy-seq prevs)))
                     (setf (aref new-prevs type) i)
                     (push (list* new-score (cons type schedule) new-prevs) new-que))))
        (setq que (sort new-que #'> :key (lambda (x) (the int32 (car x)))))))
    (coerce (reverse (second (first que))) '(simple-array uint8 (*)))))

(defun main ()
  (declare #.OPT)
  (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)))
      ;; #>init-state
      ;; #>(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 10
          do (gen-dat i)
          sum #>(run *dat-pathname*))))


(let* ((d-read (read))
    (c (make-array 27))
    (s (make-array '(366 27)))
    (score 0)
    (max_ 0)
    (max_contest 0)
    (last (make-array 27 :initial-element -1)))

    (loop for i from 1 to 26 do
        (setf (aref c i) (read))
    )
    (loop for i from 1 to d-read do
        (loop for j from 1 to 26 do
            (setf (aref s i j) (read))
        )
    )

    (loop for d from 1 to d-read do
        (loop for contest from 1 to 26 do
            (setq score (aref s d contest))
            (loop for i from 1 to 26 do
                (if (not (= i contest))
                (decf score (* (aref c i) (- d (aref last i)))))
            )
            (if (or (= contest 1) (> score max_))
                (progn
                (setq max_ score)
                (setq max_contest contest)
                )
            )
        )
    (setf (aref last max_contest) d)
    (format t "~D~%" max_contest)
    )
)


(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"
  (declare #.OPT)
  (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 #.OPT
           (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 (365 26)) ss))
  (let* ((prevs (make-array 26 :element-type 'int16 :initial-element -1))
         (schedule (make-array d :element-type 'uint8 :initial-element 0)))
    (dotimes (i (- d 2))
      (labels ((%eval (day type)
                 (declare (uint16 day type))
                 (let ((value (aref ss day type)))
                   (declare (fixnum value))
                   (dotimes (j 26)
                     (decf value (* (aref cs j) (- day (aref prevs j)))))
                   value))
               (%eval-after (day type offset)
                 (declare (uint16 day type offset))
                 (let* ((value (aref ss day type))
                        (end (min d (+ day offset))) ; exclusive
                        (factor (+ day end -1)))
                   (declare (uint16 factor)
                            (int32 value))
                   (dotimes (j 26)
                     (let ((l+r (* (aref cs j) (- factor (ash (aref prevs j) 1)))))
                       (decf value (ash (* l+r (- end day)) -1))))
                   value)))
        (let ((max-type1 0)
              (max-type2 0)
              (max-type3 0)
              (max-value most-negative-fixnum))
          (declare (fixnum max-value))
          (dotimes (type1 26)
            (let ((store-i1 (aref prevs type1)))
              (setf (aref prevs type1) i)
              (let ((value1 (%eval i type1)))
                (declare (int32 value1))
                (dotimes (type2 26)
                  (let ((store-i2 (aref prevs type2)))
                    (setf (aref prevs type2) (+ i 1))
                    (let ((value2 (%eval (+ i 1) type2)))
                      (declare (int32 value2))
                      (dotimes (type3 26)
                        (let ((store-i3 (aref prevs type3)))
                          (setf (aref prevs type3) (+ i 2))
                          (let* ((value3 (%eval-after (+ i 2) type3 2)))
                            (declare (int32 value3))
                            (let ((value (+ value1 value2 value3)))
                              (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 ()
  (declare #.OPT)
  (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 10
          do (gen-dat i)
          sum #>(run *dat-pathname*))))

;; 13132566