Submission #6761370

---

Source Code Expand

;; -*- coding: utf-8 -*-
(eval-when (:compile-toplevel :load-toplevel :execute)
  (defparameter OPT
    #+swank '(optimize (speed 3) (safety 2))
    #-swank '(optimize (speed 3) (safety 0) (debug 0)))
  #+swank (ql:quickload '(:cl-debug-print :fiveam))
  #-swank (set-dispatch-macro-character #\# #\> (lambda (s c p) (declare (ignore c p)) (read s nil (values) t))))
#+swank (cl-syntax:use-syntax cl-debug-print:debug-print-syntax)
#-swank (disable-debugger) ; for CS Academy

;; BEGIN_INSERTED_CONTENTS
;; from alexandria
(declaim (inline hash-table-to-alist))
(defun hash-table-to-alist (hash-table)
  (let ((alist nil))
    (maphash (lambda (k v)
               (push (cons k v) alist))
             hash-table)
    alist))

;;;
;;; Minimum cost flow (O(FElogV))
;;;

(setf *print-circle* t)

(defconstant +inf-distance+ (expt 51 60))
(deftype cost-type () 'integer)

(defstruct (edge (:constructor %make-edge))
  (to nil :type (integer 0 #.most-positive-fixnum))
  (capacity 0 :type (integer 0 #.most-positive-fixnum))
  (cost 0 :type cost-type)
  (reversed nil :type (or null edge)))

(defun push-edge (from-idx to-idx capacity cost graph)
  "FROM-IDX, TO-IDX := index of vertex
GRAPH := vector of list of all the edges that goes from the vertex"
  (declare ((simple-array list (*)) graph)
           (cost-type cost))
  (let* ((dep (%make-edge :to to-idx :capacity capacity :cost cost))
         (ret (%make-edge :to from-idx :capacity 0 :cost (- cost) :reversed dep)))
    (setf (edge-reversed dep) ret)
    (push dep (aref graph from-idx))
    (push ret (aref graph to-idx))))

;; binary heap for Dijkstra's algorithm
(defstruct (fheap (:constructor make-fheap
                          (size
                           &aux (costs (make-array (1+ size) :element-type 'cost-type))
                                (vertices (make-array (1+ size) :element-type 'fixnum)))))
  (costs nil :type (simple-array cost-type (*)) :read-only t)
  (vertices nil :type (simple-array fixnum (*)) :read-only t)
  (next-position 1 :type (integer 1 #.most-positive-fixnum)))

(defun fheap-push (cost vertex fheap)
  (declare #.OPT)
  (symbol-macrolet ((next-position (fheap-next-position fheap)))
    (let ((costs (fheap-costs fheap))
          (vertices (fheap-vertices fheap)))
      (labels ((update (pos)
                 (unless (= pos 1)
                   (let ((parent-pos (ash pos -1)))
                     (when (< (aref costs pos) (aref costs parent-pos))
                       (rotatef (aref costs pos) (aref costs parent-pos))
                       (rotatef (aref vertices pos) (aref vertices parent-pos))
                       (update parent-pos))))))
        (setf (aref costs next-position) cost
              (aref vertices next-position) vertex)
        (update next-position)
        (incf next-position)
        fheap))))

(defun fheap-pop (fheap)
  (declare #.OPT)
  (symbol-macrolet ((next-position (fheap-next-position fheap)))
    (let ((costs (fheap-costs fheap))
          (vertices (fheap-vertices fheap)))
      (labels ((update (pos)
                 (declare (optimize (safety 0))
                          ((integer 1 #.most-positive-fixnum) pos))
                 (let* ((child-pos1 (+ pos pos))
                        (child-pos2 (1+ child-pos1)))
                   (when (<= child-pos1 next-position)
                     (if (<= child-pos2 next-position)
                         (if (< (aref costs child-pos1) (aref costs child-pos2))
                             (unless (< (aref costs pos) (aref costs child-pos1))
                               (rotatef (aref costs pos) (aref costs child-pos1))
                               (rotatef (aref vertices pos) (aref vertices child-pos1))
                               (update child-pos1))
                             (unless (< (aref costs pos) (aref costs child-pos2))
                               (rotatef (aref costs pos) (aref costs child-pos2))
                               (rotatef (aref vertices pos) (aref vertices child-pos2))
                               (update child-pos2)))
                         (unless (< (aref costs pos) (aref costs child-pos1))
                           (rotatef (aref costs pos) (aref costs child-pos1))
                           (rotatef (aref vertices pos) (aref vertices child-pos1))))))))
        (if (= next-position 1)
            (error "No element in heap.")
            (multiple-value-prog1 (values (aref costs 1) (aref vertices 1))
              (decf next-position)
              (setf (aref costs 1) (aref costs next-position)
                    (aref vertices 1) (aref vertices next-position))
              (update 1)))))))

(declaim (inline fheap-empty-p))
(defun fheap-empty-p (fheap)
  (= (fheap-next-position fheap) 1))

(declaim (inline fheap-reinitialize))
(defun fheap-reinitialize (heap)
  (setf (fheap-next-position heap) 1)
  heap)

(define-condition not-enough-capacity-error (simple-error)
  ((graph :initarg :graph :reader not-enough-capacity-error-graph)
   (flow :initarg :flow :reader not-enough-capacity-error-flow))
  (:report
   (lambda (c s)
     (format s "Cannot send ~A units of flow on graph ~A due to not enough capacity."
             (not-enough-capacity-error-flow c)
             (not-enough-capacity-error-graph c)))))

(defun min-cost-flow! (src-idx dest-idx flow graph &key density)
  "Returns the minimum cost to send FLOW units from SRC-IDX to DEST-IDX in
GRAPH. Destructively modifies GRAPH.

DENSITY := nil | the number of edges (assumed to be (size of GRAPH)^2 if NIL)"
  (declare #.OPT
           ((integer 0 #.most-positive-fixnum) flow)
           ((simple-array list (*)) graph))
  (macrolet ((the-cost-type (form)
               (reduce (lambda (x y) `(,(car form) (the cost-type ,x) (the cost-type ,y)))
		       (cdr form))))
    (let* ((size (length graph))
           (density (or density (* size size)))
           (prev-vertices (make-array size :element-type 'fixnum :initial-element 0))
           (prev-edges (make-array size :element-type 'edge))
           (potential (make-array size :element-type 'cost-type :initial-element 0))
           (dist (make-array size :element-type 'cost-type))
           (pqueue (make-fheap density))
           (res 0))
      (declare (fixnum density)
               (cost-type res))
      (loop while (> flow 0)
            do (fill dist +inf-distance+)
               (setf (aref dist src-idx) 0)
               (fheap-reinitialize pqueue)
               (fheap-push 0 src-idx pqueue)
               (loop until (fheap-empty-p pqueue)
                     do (multiple-value-bind (cost v) (fheap-pop pqueue)
                          (declare (cost-type cost)
                                   (fixnum v))
                          (when (<= cost (the integer (aref dist v)))
                            (dolist (edge (aref graph v))
                              (let* ((next-v (edge-to edge))
                                     (next-cost (the-cost-type
                                                 (+ (aref dist v)
                                                    (edge-cost edge)
                                                    (aref potential v)
                                                    (- (the integer (aref potential next-v)))))))
                                (when (and (> (edge-capacity edge) 0)
                                           (> (the integer (aref dist next-v)) next-cost))
                                  (setf (aref dist next-v) next-cost
                                        (aref prev-vertices next-v) v
                                        (aref prev-edges next-v) edge)
                                  (fheap-push next-cost next-v pqueue)))))))
               (when (= (the integer (aref dist dest-idx)) +inf-distance+)
                 (error 'not-enough-capacity-error :flow flow :graph graph))
               (let ((max-flow flow))
                 (declare (fixnum max-flow))
                 (dotimes (v size)
                   (incf (the integer (aref potential v)) (the integer (aref dist v))))
                 (do ((v dest-idx (aref prev-vertices v)))
                     ((= v src-idx))
                   (setf max-flow (min max-flow (edge-capacity (aref prev-edges v)))))
                 (decf flow max-flow)
                 (incf res (the cost-type (* max-flow (the integer (aref potential dest-idx)))))
                 (do ((v dest-idx (aref prev-vertices v)))
                     ((= v src-idx))
                   (decf (edge-capacity (aref prev-edges v)) max-flow)
                   (incf (edge-capacity (edge-reversed (aref prev-edges v))) max-flow))))
      res)))

(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
(defparameter *gains* (make-hash-table))
(dotimes (i 26)
  (setf (gethash (code-char (+ 65 i)) *gains*) (expt 51 (- 51 i))))
(dotimes (i 26)
  (setf (gethash (code-char (+ 97 i)) *gains*) (expt 51 (- 25 i))))

(defun main ()
  (declare #.OPT)
  (let* ((n (read))
         (graph (make-array (+ n n 2) :element-type 'list :initial-element nil))
         (start (+ n n))
         (goal (+ n n 1)))
    (declare (uint32 n))
    (dotimes (i n)
      (push-edge start i 1 0 graph))
    (dotimes (j n)
      (push-edge (+ j n) goal 1 0 graph))
    (dotimes (i n)
      (let ((line (read-line)))
        (dotimes (j n)
          (let ((gain (gethash (aref line j) *gains*)))
            (push-edge i (+ j n) 1 (- gain) graph)))))
    (let ((gain (- (min-cost-flow! start goal n graph)))
          (table (sort (hash-table-to-alist *gains*) #'> :key #'cdr)))
      (dolist (node table (terpri))
        (destructuring-bind (char . num) node
          (multiple-value-bind (quot rem) (floor gain num)
            (setq gain rem)
            (dotimes (_ quot) (write-char char))))))))

#-swank (main)

Submission Info

Judge Result